001  (ns dog-and-duck.quack.cli
002    (:require [clojure.data.json :refer [read-str]]
003              [clojure.java.io :refer [resource]]
004              [clojure.pprint :refer [pprint]]
005              [clojure.string :refer [join]]
006              [clojure.tools.cli :refer [parse-opts]]
007              [clojure.walk :refer [keywordize-keys]]
008              [dog-and-duck.quack.picky.constants :refer [severity]]
009              [dog-and-duck.quack.picky.objects :refer [object-faults]]
010              [dog-and-duck.quack.picky.utils :refer [filter-severity]]
011              [hiccup.core :refer [html]]
012              [scot.weft.i18n.core :refer [get-message *config*]]
013              [trptr.java-wrapper.locale :as locale])
014    (:gen-class))
015  
016  (def ^:const stylesheet-url
017    ;; TODO: fix this to github pages before go live
018    "https://simon-brooke.github.io/dog-and-duck/style.css")
019  
020  (def cli-options
021    ;; An option with a required argument
022    [["-i" "--input SOURCE" "The file or URL to validate"
023      :default "standard input"]
024     ["-o" "--output DEST" "The file to write to, defaults to standard out"
025      :default "standard output"]
026     ["-f" "--format FORMAT" "The format to output, one of `edn` `csv` `html`"
027      :default :edn
028      :parse-fn #(keyword %)
029      :validate [#(#{:csv :edn :html} %) "Expect one of `edn` `csv` `html`"]]
030     ["-l" "--language LANG" "The ISO 639-1 code for the language to output"
031      :default (-> (locale/get-default) locale/to-language-tag)]
032     ["-s" "--severity LEVEL" "The minimum severity of faults to report"
033      :default :info
034      :parse-fn #(keyword %)
035      :validate [#(severity %) (join " "
036                                     (cons
037                                      "Expected one of"
038                                      (map name severity)))]]
039     ["-h" "--help"]])
040  
041  (defn validate
042    [source]
043    (println (str "Reading " source))
044    (let [input (read-str (slurp source))]
045      (cond (map? input) (object-faults (keywordize-keys input))
046            (and (coll? input)
047                 (every? map? input)) (map #(object-faults
048                                             (keywordize-keys %)
049                                             input)))))
050  
051  (defn output-csv
052    [faults]
053    (let [cols (set (reduce concat (map keys faults)))]
054      (with-out-str
055        (println (join ", " (map name cols)))
056        (map
057         #(println (join ", " (map (fn [p] (p %)) cols)))
058         faults))))
059  
060  (defn html-header-row
061    [cols]
062    (apply vector (cons :tr (map #(vector :th (name %)) cols))))
063  
064  (defn html-fault-row
065    [fault cols]
066    (apply
067     vector (cons :tr (map (fn [col] (vector :td (col fault))) cols))))
068  
069  (defn- version-string []
070    (join
071     " "
072     ["dog-and-duck/quack"
073      (try
074        (some->>
075         (resource "META-INF/maven/dog-and-duck/dog-and-duck/pom.properties")
076         slurp
077         (re-find #"version=(.*)")
078         second)
079        (catch Exception _ nil))]))
080  
081  (defn output-html
082    [faults opts]
083    (let [source-name (if (= (:input opts) *in*) "Standard input" (str (:input opts)))
084          title (join " " [(get-message :validation-report-for) source-name])
085          cols (set (reduce concat (map keys faults)))
086          version (version-string)]
087      (str
088       "<!DOCTYPE html>"
089       (html
090        [:html
091         [:head
092          [:title title]
093          [:meta {:name "generator" :content version}]
094          [:link {:rel "stylesheet" :media "screen" :href stylesheet-url :type "text/css"}]]
095         [:body
096          [:h1 title]
097          [:p (join " " (remove nil? [(get-message :generated-on)
098                                      (java.time.LocalDateTime/now)
099                                      (get-message :by)
100                                      version]))]
101          (if-not
102           (empty? faults)
103            (apply
104             vector
105             :table
106             (html-header-row cols)
107             (map
108              #(html-fault-row % cols)
109              faults))
110            [:p (get-message :no-faults-found)])]]))))
111  
112  (defn output
113    [content options]
114    (let [faults (filter-severity content (:severity options))]
115      (spit (:output options)
116            (case (:format options)
117              :html (output-html faults options)
118              :csv (output-csv faults)
119              (with-out-str (pprint faults))))))
120  
121  (defn -main [& args]
122    (let [opts (parse-opts args cli-options)
123          options (assoc (:options opts)
124                         :input (if (= (:input (:options opts)) "standard input")
125                                  *in*
126                                  (:input (:options opts)))
127                         :output (if (= (:output (:options opts)) "standard output")
128                                   *out*
129                                   (:output (:options opts))))]
130      ;;(println options)
131      (when (:help options)
132        (println (:summary opts)))
133      (when (:errors opts)
134        (println (:errors opts)))
135      (when-not (or (:help options) (:errors options))
136        (binding [*config* (assoc *config* :default-language (:language options))]
137          (output
138           (validate (:input options))
139           options)))))