empath

#!/usr/bin/env bb

;; Generated by uberscriptify, do not edit directly.

(ns scribe.string
  "String utilities."
  (:require [clojure.string :as string]))

(defn- find-indent
  [string]
  (let [candidate (->> (string/split-lines string)
                       (next)
                       (filter seq)
                       first)
        [_ indent] (when candidate (re-matches #"^(\s+).*" candidate))]
    indent))

(defn dedent
  "Remove leading indent on strings. Typically called on strings defined in
  scripts that are to be printed to the terminal. If leading indent is not
  passed, it will be detected from the first line with leading whitespace."
  ([string]
   (dedent (find-indent string) string))
  ([indent string]
   (cond->> (string/split-lines string)
     indent (map #(string/replace % (re-pattern (str "^" indent)) ""))
     :always (string/join "\n"))))
(ns scribe.opts
  "A set of functions to handle command line options in an opinionated
  functional manner. Here is the general strategy:

  1. Args are parsed by clojure.tools.cli.
  2. The parsed args are examined for errors and the --help flag with a pure
     function.
  3. If errors are found, an appropriate message (optionally with usage) is
     assembled with a pure function.
  4. The message is printed and the script exits.

  Most of the above is pure, and therefore testable. Here's an example main
  function:

    (defn -main
      [& args]
      (let [parsed (parse-opts args [[\"-h\" \"--help\" \"Show help\"]
                                     [\"-n\" \"--name NAME\" \"Name to use\" :default \"world\"]])
            {:keys [name]} (:options parsed)]
        (or (some-> (opts/validate parsed usage-text)
                    (opts/format-help parsed)
                    (opts/print-and-exit))
            (println \"Hello\" name))))

  For a more complete sample script, check out `samples` in the repository."
  (:require [babashka.tasks :as tasks]
            [clojure.java.io :as io]
            [clojure.string :as string]
            [scribe.string]))

(defn validate
  "Look for the most common of errors:
  * `--help` was passed
  * clojure.tools.cli detected errors

  To detect other errors specific to a given script, wrap the call with an
  `or`, like this:

  (or (opts/validate parsed usage-text)
      (script-specific-validate parsed))

  The script-specific-validate function should return a map with information
  about the error that occurred. The keys are:
  * :message - (optional) Message to be printed
  * :exit - The numeric exit code that should be returned
  * :wrap-context - Whether or not to wrap the message with script help heading
                    and options documentation"
  [parsed usage]
  (let [{:keys [errors options]} parsed
        {:keys [help]} options]
    (cond
      help
      {:exit 0
       :message usage
       :wrap-context true}

      errors
      {:exit 1
       :message (string/join "\n" errors)
       :wrap-context true})))

(defn detect-script-name
  "Detect the name of the currently running script, for usage in the printed
  help."
  ([]
   (or (some->> (tasks/current-task)
                :name
                (format "bb %s"))
       (some-> (System/getProperty "babashka.file")
               detect-script-name)
       ;; Fallback if we're using the REPL for development
       "script"))
  ([filename]
   (.getName (io/file filename))))

(def ^:private help-fmt
  (scribe.string/dedent
    "usage: %s [opts]

    %s

    options:
    %s"))

(defn format-help
  "Take an error (as returned from `validate`) and format the help message
  that will be printed to the end user."
  ([errors parsed]
   (format-help errors (detect-script-name) parsed))
  ([errors script-name-or-ns parsed]
   (let [script-name (str script-name-or-ns)
         {:keys [summary]} parsed
         {:keys [message exit wrap-context]} errors
         final-message (-> message
                           scribe.string/dedent
                           (string/replace "SCRIPT_NAME" script-name))]
     {:help (if wrap-context
              (format help-fmt script-name final-message summary)
              final-message)
      :exit exit})))

(defn print-and-exit
  "Print help message and exit. Accepts a map with `:help`
  and `:exit` keys.

  Uses the :babashka/exit ex-info trick to exit Babashka."
  [{:keys [help exit]}]
  (throw (ex-info help {:babashka/exit exit})))
(ns doric.core
  (:refer-clojure :exclude [format name join split when])
  (:use [clojure.string :only [join split]]))

(defn- title-case-word [w]
  (if (zero? (count w))
    w
    (str (Character/toTitleCase (first w))
         (subs w 1))))

(defn title-case [s]
  (join " " (map title-case-word (split s #"\s"))))

(defn align [col & [data]]
  (or (keyword (:align col))
      :left))

(defn format [col & [data]]
  (or (:format col)
      identity))

(defn title [col & [data]]
  (or (:title col)
      (title-case
       (.replaceAll (clojure.core/name (let [n (:name col)]
                                         (if (number? n)
                                           (str n)
                                           n)))
                    "-" " "))))

(defn title-align [col & [data]]
  (keyword (or (:title-align col)
               (:align col)
               :center)))

(defn when [col & [data]]
  (:when col true))

(defn width [col & [data]]
  (or (:width col)
      (apply max (map count (cons (:title col)
                                  (map str data))))))

(defn format-cell [col s]
  ((:format col) s))

(defn align-cell [col s align]
  (let [width (:width col)
        s (str s)
        s (cond (<= (count s) width) s
                (:ellipsis col) (str (subs s 0 (- width 3)) "...")
                :else (subs s 0 width))
        len (count s)
        pad #(apply str (take % (repeat " ")))
        padding (- width len)
        half-padding (/ (- width len) 2)]
    (case align
      :left (str s (pad padding))
      :right (str (pad padding) s)
      :center (str (pad (Math/ceil half-padding))
                   s
                   (pad (Math/floor half-padding))))))

(defn header [th cols]
  (for [col cols :when (:when col)]
    (th col)))

(defn body [td cols rows]
  (for [row rows]
    (for [col cols :when (:when col)]
      (td col row))))

(defn- col-data [col rows]
  (map #(get % (:name col)) rows))

(defn- column1 [col & [data]]
  {:align (align col data)
   :format (format col data)
   :title (title col data)
   :title-align (title-align col data)
   :when (when col data)})

(defn- column-map [col]
  (if (map? col)
    col
    {:name col}))

(defn- columns1 [cols rows]
  (for [col cols :let [col (column-map col)]]
    (merge col
           (column1 col (col-data col rows)))))

(defn- format-rows [cols rows]
  (for [row rows]
    (into {}
          (for [col cols :let [name (:name col)]]
            [name (format-cell col (row name))]))))

(defn- column2 [col & [data]]
  {:width (width col data)})

(defn- columns2 [cols rows]
  (for [col cols]
    (merge col
           (column2 col (col-data col rows)))))

;; data formats
(defn bar [x]
  (apply str (repeat x "#")))

;; table formats
(def csv 'doric.csv)
(def html 'doric.html)
(def org 'doric.org)
(def raw 'doric.raw)

;; table format helpers
;; aligned th and td are useful for whitespace sensitive formats, like
;; raw and org
(defn aligned-th [col]
  (align-cell col (:title col) (:title-align col)))

(defn aligned-td [col row]
  (align-cell col (row (:name col)) (:align col)))

;; unalighed-th and td are useful for whitespace immune formats, like
;; csv and html
(defn unaligned-th [col]
  (:title col))

(defn unaligned-td [col row]
  (row (:name col)))

(defn mapify [rows]
  (let [example (first rows)]
    (cond (map? rows) (for [k (sort (keys rows))]
                        {:key k :val (rows k)} )
          (vector? example) (for [row rows]
                              (into {}
                                    (map-indexed (fn [i x] [i x]) row)))
          (map? example) rows)))

(defn table*
  {:arglists '[[rows]
               [opts rows]
               [cols rows]
               [opts cols rows]]}
  [& args]
  (let [rows (mapify (last args))
        [opts cols] (case (count args)
                      1 [nil nil]
                      2 (if (map? (first args))
                          [(first args) nil]
                          [nil (first args)])
                      3 [(first args) (second args)])
        cols (or cols (keys (first rows)))
        format (or (:format opts) org)
        _ (require format)
        th (ns-resolve format 'th)
        td (ns-resolve format 'td)
        render (ns-resolve format 'render)
        cols (columns1 cols rows)
        rows (format-rows cols rows)
        cols (columns2 cols rows)]
    (render (cons (header th cols) (body td cols rows)))))

(defn table
  {:arglists '[[rows]
               [opts rows]
               [cols rows]
               [otps cols rows]]}
  [& args]
  (apply str (join "\n" (apply table* args))))
(ns doric.org
  (:refer-clojure :exclude [join])
  (:use [clojure.string :only [join]]
        [doric.core :only [aligned-th aligned-td]]))

(def th aligned-th)

(def td aligned-td)

(defn render [table]
  (let [spacer (str "|-"
                    (join "-+-"
                          (map #(apply str (repeat (.length %) "-"))
                               (first table)))
                    "-|")]
    (concat [spacer
             (str "| " (join " | " (first table)) " |")
             spacer]
            (for [tr (rest table)]
              (str "| " (join " | " tr) " |"))
            [spacer])))
(ns empath
  (:require
    [clojure.java.io :as io]
    [clojure.string :as string]
    [clojure.tools.cli :refer [parse-opts]]

    [cheshire.core :as json]
    [doric.org :as dorig.org]
    [doric.core :as doric]

    [scribe.opts :as opts]
    [scribe.string]
    ))

(def script-name (opts/detect-script-name))


;; Common utilities

(defn analyze
  [path]
  (for [part (string/split path #":")]
    (let [f (io/file part)]
      {:element part
       :exists (.exists f)
       :dir (.isDirectory f)
       :file (.isFile f)
       :can-write (.canWrite f)})))

(defn get-path
  [options]
  (or (:path options)
      (string/trim (slurp *in*))))


;; Print subcommand

(def print-options
  [["-h" "--help" "Show help"]
   ["-t" "--table" "Print in a table"]
   ["-e" "--edn" "Print raw edn"]
   ["-j" "--json" "Print raw json"]
   ["-p" "--plain" "Print one entry per line"]])

(def print-usage
  (scribe.string/dedent
    "    "
    "Print the elements of a path in various ways."))

(defn prepare-output
  [options analyzed]
  (when (seq analyzed)
    (cond
      (:plain options)
      (->> (map :element analyzed)
           (string/join "\n"))

      (:json options)
      (->> (map #(json/generate-string %) analyzed)
           (string/join "\n"))

      (:edn options)
      (->> (map pr-str analyzed)
           (string/join "\n"))

      (or (empty? options) (:table options))
      (doric/table [:element :exists :dir :file :can-write] analyzed))))

(defn handle-print
  [global-options subargs]
  (let [parsed (parse-opts subargs print-options)
        {:keys [options]} parsed]
    (or (some-> (opts/validate parsed print-usage)
                (opts/format-help (str script-name " print") parsed)
                (opts/print-and-exit))
        (->> (get-path global-options)
             (analyze)
             (prepare-output options)
             (println)))))


;; Edit subcommand

(def edit-options
  [["-h" "--help" "Show help"]
   ["-e" "--empty" "Start with empty path"]])

(def edit-usage
  (scribe.string/dedent
    "    "
    "Edit elements of a path.

    Takes a list of action/element pairs. Valid actions are:

      append [element] - append element to end of path
      remove [element] - remove element from path
      prepend [element] - prepend element to beginning of path
      xappend [element] - append element after removing from rest of path
      xprepend [element] - prepend element after removing from rest of path
    "))

(defn munge-path
  [path args]
  (let [parts (into [] (string/split path #":"))]
    (string/join
      ":"
      (reduce
        (fn [result [op arg]]
          (case op
            "prepend" (into [arg] result)
            "append" (conj result arg)
            "remove" (into [] (remove #(= arg %)) result)
            "xappend" (conj (into [] (remove #(= arg %)) result) arg)
            "xprepend" (into [arg] (remove #(= arg %) result))))
        parts (partition 2 args)))))

(defn find-edit-errors
  [parsed]
  (or (opts/validate parsed edit-usage)
      (let [{:keys [arguments]} parsed]
        (cond
          (odd? (count arguments))
          {:message "Even number of arguments expected."
           :exit 1}))))

(defn handle-edit
  [global-options subargs]
  (let [parsed (parse-opts subargs edit-options :in-order true)
        {:keys [options arguments]} parsed]
    (or (some-> (find-edit-errors parsed)
                (opts/format-help (str script-name " edit") parsed)
                (opts/print-and-exit))
        (let [path (if (:empty options)
                     ":"
                     (get-path global-options))]
          (println (munge-path path arguments))))))


;; Main

(def cli-options
  [["-h" "--help" "Show help"]
   ["-p" "--path PATH" "Specify path to operate on"]])

(def global-usage
  (scribe.string/dedent
    "    "
    "Path inspection and manipulation tool.

    Manipulate and inspect path-like data with ease. Path data is a
    string delimited by colons.

    To specify which path to use, pass it via stdin or use the -p global
    option.

    Available subcommands:

      print - print a path in a variety of ways
      edit - edit a path by adding and removing elements

    Pass '-h' to see further help on each subcommand."))

(defn process
  [options arguments]
  (let [[subcommand & subargs] arguments]
    (case subcommand
      "print" (handle-print options subargs)
      "edit" (handle-edit options subargs)
      )))

(def subcommands #{:print :edit})

(defn find-errors
  [parsed]
  (or (opts/validate parsed global-usage)
      (let [{:keys [arguments]} parsed
            subcommand (-> arguments first keyword)]
        (cond
          (nil? subcommand)
          {:exit 1}

          (not (contains? subcommands subcommand))
          {:message (str "Invalid subcommand: " (name subcommand))
           :exit 1}))))

(defn -main [& args]
  (let [parsed (parse-opts args cli-options :in-order true)
        {:keys [options arguments]} parsed]
    (or (some-> (find-errors parsed)
                (opts/format-help script-name parsed)
                (opts/print-and-exit))
        (process options arguments))))
(ns user (:require [empath])) (apply empath/-main *command-line-args*)