diff options
Diffstat (limited to 'src/pronouns/pages.clj')
| -rw-r--r-- | src/pronouns/pages.clj | 242 |
1 files changed, 169 insertions, 73 deletions
diff --git a/src/pronouns/pages.clj b/src/pronouns/pages.clj index 8aed689..e629329 100644 --- a/src/pronouns/pages.clj +++ b/src/pronouns/pages.clj @@ -1,10 +1,42 @@ +;; pronoun.is - a website for pronoun usage examples +;; Copyright (C) 2014 - 2018 Morgan Astra + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU Affero General Public License as +;; published by the Free Software Foundation, either version 3 of the +;; License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU Affero General Public License for more details. + +;; You should have received a copy of the GNU Affero General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/> + (ns pronouns.pages - (:require [clojure.string :as s] - [clojure.data.json :as json] + (:require [clojure.data.json :as json] + [clojure.string :as s] + [pronouns.config :refer [pronouns-table]] [pronouns.util :as u] [hiccup.core :refer :all] + [hiccup.element :as e] [hiccup.util :refer [escape-html]])) +(defn prose-comma-list + [items] + (let [c (count items)] + (cond + (<= c 1) (or (first items) "") + (= c 2) (s/join " and " items) + :else (str (s/join ", " (butlast items)) ", and " (last items))))) + +(defn href + [url text] + [:a {:href url} text]) + +;; FIXME morgan.astra <2018-11-14 Wed> +;; use a div for this instead of a plain bold tag (defn wrap-pronoun [pronoun] [:b pronoun]) @@ -29,7 +61,9 @@ (defn possessive-pronoun-example [possessive-pronoun] - (render-sentence "At least I think it was " (wrap-pronoun possessive-pronoun) ".")) + (render-sentence "At least I think it was " + (wrap-pronoun possessive-pronoun) + ".")) (defn reflexive-example [subject reflexive] @@ -38,73 +72,92 @@ (wrap-pronoun reflexive) ".")) -(defn title-block [title] - [:div {:class "title"} - [:h1 title]]) +(defn header-block [header] + [:div {:class "section title"} + (href "/" [:h1 header])]) (defn examples-block [subject object possessive-determiner possessive-pronoun reflexive] - [:div {:class "examples"} - [:p [:h2 "Here are some usage examples for my pronouns:"]] - (subject-example subject) - (object-example object) - (posessive-determiner-example subject possessive-determiner) - (possessive-pronoun-example possessive-pronoun) - (reflexive-example subject reflexive)]) - -(defn about-block [] - [:div {:class "about"} + (let [sub-obj (s/join "/" [subject object]) + header-str (str "Here are some example sentences using my " + sub-obj + " pronouns:")] + [:div {:class "section examples"} + [:h2 header-str] + [:p (subject-example subject) + (object-example object) + (posessive-determiner-example subject possessive-determiner) + (possessive-pronoun-example possessive-pronoun) + (reflexive-example subject reflexive)]])) + +(defn usage-block [] + [:div {:class "section usage"} [:p "Full usage: " - [:tt "http://pronoun.is/subject-pronoun/object-pronoun/possessive-determiner/possessive-pronoun/reflexive"] - " displays examples of your pronouns."] - [:p "This is a bit unwieldy. If we have a good guess we'll let you use just the first one or two."]]) + ;; FIXME morgan.astra <2018-11-14 Wed> + ;; This looks really ugly in the browser + [:tt "https://pronoun.is/subject-pronoun/object-pronoun/possessive-determiner/possessive-pronoun/reflexive"] + " displays examples of your pronouns."] + [:p "This is a bit unwieldy. If we have a good guess we'll let you use" + " just the first one or two."]]) (defn contact-block [] - (let [twitter-name (fn [handle] [:a {:href (str "https://www.twitter.com/" handle)} (str "@" handle)])] - [:div {:class "contact"} - [:p - "Written by " - (twitter-name "morganastra") - ", whose " - [:a {:href "http://pronoun.is/ze/zir"} "pronoun.is/ze/zir"] - ". " - "Visit the project on " [:a {:href "https://github.com/witch-house/pronoun.is"} "github!"]]])) - + (let [twitter-name (fn [handle] (href (str "https://www.twitter.com/" handle) + (str "@" handle)))] + [:div {:class "section contact"} + [:p "Written by " + (twitter-name "morganastra") + ", whose " + (href "https://pronoun.is/she" "pronoun.is/she")] + [:p "pronoun.is is free software under the " + (href "https://www.gnu.org/licenses/agpl.html" "AGPLv3") + "! visit the project on " + (href "https://github.com/witch-house/pronoun.is" "github")] + [:p "<3"]])) + +(defn footer-block [] + [:footer (usage-block) (contact-block)]) (defn format-pronoun-examples - [subject object possessive-determiner possessive-pronoun reflexive] - (let [title "Pronoun Island: English Language Examples"] - (html - [:html - [:head - [:title title] - [:meta {:name "viewport" :content "width=device-width"}] - [:link {:rel "stylesheet" :href "/pronouns.css"}]] - [:body - (title-block title) - (examples-block subject object possessive-determiner possessive-pronoun reflexive) - (about-block) - (contact-block)]]))) - - -(defn format-pronoun-json [& pronouns] - (json/write-str pronouns)) - + [pronoun-declensions] + (let [sub-objs (map #(s/join "/" (take 2 %)) pronoun-declensions) + title (str "Pronoun Island: " (prose-comma-list sub-objs) " examples") + examples (map #(apply examples-block %) pronoun-declensions)] + (html + [:html + [:head + [:title title] + [:meta {:name "viewport" :content "width=device-width"}] + [:meta {:name "description" :content (u/strip-markup examples)}] + [:meta {:name "twitter:card" :content "summary"}] + [:meta {:name "twitter:title" :content title}] + [:meta {:name "twitter:description" :content (u/strip-markup examples)}] + [:link {:rel "stylesheet" :href "/pronouns.css"}]] + [:body + (header-block title) + examples + (footer-block)]]))) -(defn parse-pronouns-with-lookup [pronouns-string pronouns-table] +(defn table-lookup* [pronouns-string] (let [inputs (s/split pronouns-string #"/") n (count inputs)] (if (>= n 5) (take 5 inputs) - (u/table-lookup inputs pronouns-table)))) + (u/table-lookup inputs @pronouns-table)))) + +(defn lookup-pronouns + "Given a seq of pronoun sets, look up each set in the pronouns table" + [pronoun-sets] + (->> pronoun-sets + (map (comp table-lookup* escape-html)) + (filter some?))) (defn make-link [path] (let [link (str "/" path) label path] - [:li [:a {:href link} label]])) + [:li (href link label)])) -(defn front [pronouns-table] - (let [abbreviations (u/abbreviate pronouns-table) +(defn front [] + (let [abbreviations (take 6 (u/abbreviate @pronouns-table)) links (map make-link abbreviations) title "Pronoun Island"] (html @@ -114,29 +167,72 @@ [:meta {:name "viewport" :content "width=device-width"}] [:link {:rel "stylesheet" :href "/pronouns.css"}]] [:body - (title-block title) - [:div {:class "table"} - [:p "pronoun.is is a www site for showing people how to use pronouns in English."] - [:p "here are some pronouns the site knows about:"] - [:ul links]]] - (contact-block)]))) - -(defn not-found [] - (str "We couldn't find those pronouns in our database, please ask us to " - "add them, or issue a pull request at " - "https://github.com/witch-house/pronoun.is/blob/master/resources/pronouns.tab")) + (header-block title) + [:div {:class "section table"} + [:p "pronoun.is is a website for personal pronoun usage examples"] + [:p "here are some pronouns the site knows about:"] + [:ul links] + [:p [:small (href "all-pronouns" "see all pronouns in the database")]]]] + (footer-block)]))) + +(defn all-pronouns [] + (let [abbreviations (u/abbreviate @pronouns-table) + links (map make-link abbreviations) + title "Pronoun Island"] + (html + [:html + [:head + [:title title] + [:meta {:name "viewport" :content "width=device-width"}] + [:link {:rel "stylesheet" :href "/pronouns.css"}]] + [:body + (header-block title) + [:div {:class "section table"} + [:p "All pronouns the site knows about:"] + [:ul links]]] + (footer-block)]))) + +(defn not-found [path] + (let [title "Pronoun Island: English Language Examples" + or-re #"/[oO][rR]/"] + (html + [:html + [:head + [:title title] + [:meta {:name "viewport" :content "width=device-width"}] + [:link {:rel "stylesheet" :href "/pronouns.css"}]] + [:body + (header-block title) + [:div {:class "section examples"} + [:p [:h2 "We couldn't find those pronouns in our database :("] + "If you think we should have them, please reach out!"] + (when (re-find or-re path) + (let [alts (s/split path or-re) + new-path (str "/" (s/join "/:OR/" alts))] + [:div + "Did you mean: " + (href new-path + (str "pronoun.is" + new-path))]))] + (footer-block)]]))) + +(defn pronouns [params format-fn not-found-fn] + (let [path (params :*) + param-alts (u/vec-coerce (or (params "or") [])) + path-alts (s/split path #"/:[oO][rR]/") + pronouns (lookup-pronouns (concat path-alts param-alts))] + (if (seq pronouns) + (format-fn pronouns) + (not-found-fn path)))) + +(defn format-pronoun-json [& pronouns] + (json/write-str pronouns)) (defn not-found-json [] (json/write-str {:error "Not found"})) -(defn pronouns-page [path pronouns-table format-pronouns not-found] - (let [pronouns (parse-pronouns-with-lookup (escape-html path) pronouns-table)] - (if pronouns - (apply format-pronouns pronouns) - (not-found)))) - -(defn pronouns [path pronouns-table] - (pronouns-page path pronouns-table format-pronoun-examples not-found)) - (defn pronouns-json [path pronouns-table] - (pronouns-page path pronouns-table format-pronoun-json not-found-json)) + (pronouns params format-pronoun-json not-found-json)) + +(defn pronouns-html [path pronouns-table] + (pronouns params format-pronoun-examples not-found)) |