diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index da166cd..1c9bac2 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -15,5 +15,4 @@ jobs: - name: "Test project" uses: pyrmont/action-janet-test@master with: - cmd-deps: "jpm -l run dev-deps" - cmd-test: "jpm -l test" + cmd-test: "jpm test" diff --git a/README.md b/README.md index d6c435f..b33c1b6 100644 --- a/README.md +++ b/README.md @@ -15,13 +15,13 @@ can be included in your repository and read easily on services like GitHub. To install, run: -```console +```shell $ jpm install https://github.com/pyrmont/documentarian ``` ## Usage -```console +```shell $ /path/to/documentarian ``` @@ -71,28 +71,6 @@ Documentarian supports the following command-line arguments: -h, --help Show this help message. ``` -## Development - -### Preparing - -Clone the repository and then run: - -```console -$ jpm [-l] run dev-deps -``` - -### Building - -```console -$ jpm [-l] build -``` - -### Testing - -```console -$ jpm [-l] test -``` - ## Bugs Found a bug? I'd love to know about it. The best way is to report your bug in diff --git a/bin/documentarian b/bin/documentarian new file mode 100755 index 0000000..14523af --- /dev/null +++ b/bin/documentarian @@ -0,0 +1,4 @@ +#!/usr/bin/env janet +(import documentarian/lib/cli) + +(cli/run) diff --git a/deps/argy-bargy/LICENSE b/deps/argy-bargy/LICENSE new file mode 100644 index 0000000..6115c71 --- /dev/null +++ b/deps/argy-bargy/LICENSE @@ -0,0 +1,19 @@ +Copyright (c) 2021 Michael Camilleri and contributors + +Permission is hereby granted, free of charge, to any person obtaining a copy of +this software and associated documentation files (the "Software"), to deal in +the Software without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies +of the Software, and to permit persons to whom the Software is furnished to do +so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/deps/argy-bargy/argy-bargy.janet b/deps/argy-bargy/argy-bargy.janet new file mode 100644 index 0000000..3949e41 --- /dev/null +++ b/deps/argy-bargy/argy-bargy.janet @@ -0,0 +1,742 @@ +# Global values + +(var max-width "Maximum number of columns to use for usage messages" 120) +(var pad-inset "Number of columns to pad argument descriptions from the left" 4) +(var pad-right "Number of columns to pad argument descriptions from the right" 0) +(var hr "String to use to insert line breaks between argument descriptions" "---") + +(var- cols nil) +(var- command nil) + +(def- err @"") +(def- help @"") + + +# Utility functions + +(defn- conform-args + ``` + Conforms arguments + + In particular, splits short-options out if provided together. + ``` + [args] + (def res @[]) + (def grammar ~{:main (+ :long-opt :short-opt :rest) + :rest '(some 1) + :long-opt (* '(* "--" (any (if-not "=" 1))) (? (* "=" :rest))) + :short-opt (* '(* "-" 1) (any (% (* (constant "-") '1))))}) + (def num-args (length args)) + (var i 0) + (while (< i num-args) + (def arg (args i)) + (when (= "--" arg) + (array/concat res (array/slice args i)) + (break)) + (array/concat res (peg/match grammar arg)) + (++ i)) + res) + + +(defn- conform-rules + ``` + Conforms rules + ``` + [rules] + (var rest-capture? false) + (def orules @[]) + (def prules @[]) + (var help? false) + + (var i 0) + (while (< i (length rules)) + (def k (get rules i)) + (if (string/has-prefix? hr k) + (array/push orules [hr nil]) + (do + (unless (or (string? k) (keyword? k)) + (errorf "names of rules must be strings or keywords: %p" k)) + (def v (get rules (++ i))) + (when (nil? v) + (errorf "number of elements in rules must be even: %p" rules)) + (unless (or (struct? v) (table? v)) + (errorf "each rule must be struct or table: %p" v)) + (unless (or (keyword? k) ({:flag true :count true :single true :multi true} (v :kind))) + (errorf "each option rule must be of kind :flag, :count, :single or :multi: %p" v)) + (when (and (keyword? k) rest-capture? (v :splat?)) + (errorf "multiple parameter rules cannot capture :splat? %p" v)) + (cond + (string? k) + (let [name (if (string/has-prefix? "--" k) (string/slice k 2) k)] + (when (nil? (peg/find '(* :w (some (+ :w (set "-_"))) -1) name)) + (errorf "option name must be at least two alphanumeric characters: %p" name)) + (array/push orules [name (merge v {:name name})]) + (set help? (= "help" name))) + + (keyword? k) + (do + (array/push prules [k v]) + (set rest-capture? (v :splat?)))))) + (++ i)) + + (unless help? + (array/push orules ["help" {:name "help" + :kind :help + :noex? true + :short "h" + :help "Show this help message."}])) + [orules prules]) + + +(defn- conform-subconfigs + ``` + Conforms subconfigs + ``` + [subcommands] + (def subconfigs @[]) + (var i 0) + (while (< i (length subcommands)) + (def k (get subcommands i)) + (if (string/has-prefix? hr k) + (array/push subconfigs [hr nil]) + (do + (unless (string? k) + (errorf "names of subcommands must be strings: %p" k)) + (def v (get subcommands (++ i))) + (when (nil? v) + (errorf "number of elements in subcommands must be even: %p" subcommands)) + (unless (or (struct? v) (table? v)) + (errorf "each subcommand must be struct or table: %p" v)) + (array/push subconfigs [k v]))) + (++ i)) + subconfigs) + + +(defn- get-cols + ``` + Gets the columns in the terminal + ``` + [] + (if (nil? cols) + (do + (def cmd + (if (= :windows (os/which)) + ["powershell" "-command" "&{(get-host).ui.rawui.WindowSize.Width;}"] + ["tput" "cols"])) + (with [f (file/temp)] + (os/execute cmd :p {:out f}) + (file/seek f :set 0) + (def out (file/read f :all)) + (def tcols (scan-number (string/trim out))) + (min tcols max-width))) + cols)) + + +(defn- get-rule + ``` + Gets a rule matching a name + ``` + [name rules] + (var res nil) + (each [k v] rules + (when (or (= k name) (= (get v :short) name)) + (set res v) + (break))) + res) + + +(defn- get-subconfig + ``` + Gets a subconfig matching a name + ``` + [subconfigs name] + (var res nil) + (each [k v] subconfigs + (when (= k name) + (set res v) + (break))) + res) + + +(defn- split-words + ``` + Splits a string into words + ``` + [str] + (def res @[]) + (def buf @"") + (var i 0) + (while (def curr-c (get str i)) + (++ i) + (if (not (or (= 32 curr-c) (= 10 curr-c)) ) + (buffer/push buf curr-c) + (when-let [next-c (get str i)] + (++ i) + (array/push res (string buf)) + (buffer/clear buf) + (cond + (= 10 next-c) + (array/push res (string/from-bytes curr-c next-c)) + + (= 32 next-c) + nil + + (buffer/push buf next-c))))) + (unless (empty? buf) + (array/push res (string buf))) + res) + + +(defn- stitch + ``` + Stitches together components into a string + + Only adds a separator when adjacent components are non-nil. + ``` + [parts &opt sep] + (default sep " ") + (string/join (filter truthy? parts) sep)) + + +(defn- indent-str + ``` + Indents a string by a number of spaces at the start + + If a maximum width is provided, wraps and indents lines by the hanging + padding. + ``` + [str startw &opt startp hangp maxw] + (default startp 0) + (default hangp 0) + (default maxw cols) + (def res (buffer (string/repeat " " startp))) + (var currw startw) + (var first? true) + (each word (split-words str) + (cond + first? + (do + (buffer/push res word) + (+= currw (length word)) + (set first? false)) + + (= "\n\n" word) + (do + (buffer/push res word (string/repeat " " hangp)) + (set currw hangp) + (set first? true)) + + (< (+ currw 1 (length word)) maxw) + (do + (buffer/push res " " word) + (+= currw (+ 1 (length word)))) + + (do + (buffer/push res "\n" (string/repeat " " hangp) word) + (set currw (+ hangp (length word)))))) + res) + + +# Usage messages + +(defn- usage-error + ``` + Prints the usage error message to `err` + ``` + [& msg] + (when (and (empty? err) (empty? help)) + (xprint err command ": " ;msg) + (xprint err "Try '" command " --help' for more information."))) + + +(defn- usage-parameters + ``` + Prints the usage descriptions for the parameters to `help` + ``` + [info rules] + (def usages @[]) + (var pad 0) + + (each [name rule] rules + (def proxy (or (rule :proxy) name)) + (def usage-prefix (string " " proxy)) + (def usage-help + (stitch [(rule :help) + (when (rule :default) + (string "(Default: " (rule :default) ")"))])) + (array/push usages [usage-prefix usage-help]) + (set pad (max (+ pad-inset (length usage-prefix)) pad))) + + (unless (empty? usages) + (xprint help) + (if (info :params-header) + (xprint help (info :params-header)) + (xprint help "Parameters:")) + (xprint help) + (each [prefix msg] usages + (def startp (- pad (length prefix))) + (xprint help prefix (indent-str msg (length prefix) startp pad (- cols pad-right)))))) + + +(defn- usage-options + ``` + Prints the usage descriptions for the options to `help` + ``` + [info rules] + (def usages @[]) + (var pad 0) + + (each [name rule] rules + (if (= hr name) + (array/push usages [nil nil]) + (do + (def usage-prefix + (stitch [(if (rule :short) + (string " -" (rule :short) ",") + " ") + (string "--" name) + (when (or (= :single (rule :kind)) (= :multi (rule :kind))) + (string "<" (or (rule :proxy) name) ">")) + ])) + (def usage-help + (stitch [(rule :help) + (when (rule :default) + (string "(Default: " (rule :default) ")"))])) + (array/push usages [usage-prefix usage-help]) + (set pad (max (+ pad-inset (length usage-prefix)) pad))))) + + (unless (empty? usages) + (xprint help) + (if (info :opts-header) + (xprint help (info :opts-header)) + (xprint help "Options:")) + (xprint help) + (each [prefix msg] usages + (if (nil? msg) + (xprint help) + (do + (def startp (- pad (length prefix))) + (xprint help prefix (indent-str msg (length prefix) startp pad (- cols pad-right)))))))) + + +(defn- usage-subcommands + ``` + Prints the usage descriptions for the subcommands to `help` + ``` + [info subconfigs] + (def usages @[]) + (var pad 0) + + (each [name config] subconfigs + (if (= hr name) + (array/push usages [nil nil]) + (do + (def usage-prefix (string " " name)) + (def usage-help (get config :help "")) + (array/push usages [usage-prefix usage-help]) + (set pad (max (+ pad-inset (length usage-prefix)) pad))))) + + (unless (empty? usages) + (xprint help) + (if (info :subs-header) + (xprint help (info :subs-header)) + (xprint help "Subcommands:")) + (xprint help) + (each [prefix msg] usages + (if (nil? msg) + (xprint help) + (do + (def startp (- pad (length prefix))) + (xprint help prefix (indent-str msg (length prefix) startp pad (- cols pad-right)))))) + (xprint help) + (xprint help "For more information on each subcommand, type '" command " help '."))) + + +(defn- usage-example + ``` + Prints a usage example to `help` + ``` + [orules prules subconfigs] + (xprint help + (indent-str + (string "Usage: " + command + ;(map (fn [[name rule]] + (unless (or (nil? rule) (rule :noex?)) + (string " [--" name + (when (or (= :single (rule :kind)) + (= :multi (rule :kind))) + (string " <" (or (rule :proxy) (rule :name)) ">")) + "]"))) + orules) + ;(map (fn [[name rule]] + (def proxy (or (rule :proxy) name)) + (string " " + (unless (rule :req?) "[") + "<" + proxy + (when (rule :splat?) "...") + ">" + (unless (rule :req?) "]")) + ) + prules) + (unless (empty? subconfigs) + " []")) + 0 + 0 + (+ 7 (length command) 1) + (- cols pad-right)))) + + +(defn- usage + ``` + Prints the usage message to `help` + ``` + [config] + (def info (get config :info {})) + (def [orules prules] (conform-rules (get config :rules []))) + (def subconfigs (conform-subconfigs (get config :subs []))) + + (when (and (empty? err) (empty? help)) + (if (info :usages) + (each example (info :usages) + (xprint help example)) + (usage-example orules prules subconfigs)) + + (when (info :about) + (xprint help) + (xprint help (indent-str (info :about) 0))) + + (unless (empty? prules) + (usage-parameters info prules)) + + (usage-options info orules) + + (unless (empty? subconfigs) + (usage-subcommands info subconfigs)) + + (when (info :rider) + (xprint help) + (xprint help (indent-str (info :rider) 0))))) + + +# Processing functions + +(defn- convert + ``` + Converts a textual value using the converter + + Internal functions are called if the converter is one of the following: + + * `:string` - Returns the value as-is. + * `:integer` - Converts the value to an integer. + ``` + [arg converter] + (if (nil? converter) + arg + (cond + (keyword? converter) + (case converter + :string + arg + + :integer + (let [[ok? res] (protect (scan-number arg))] + (when (and ok? (int? res)) + res))) + + (function? converter) + (converter arg)))) + + +(defn- consume-option + ``` + Consumes an option + ``` + [result orules args i &opt is-short?] + (def opts (result :opts)) + (def arg (in args i)) + (def name (string/slice arg (if is-short? 1 2))) + (if-let [rule (get-rule name orules) + long-name (rule :name) + kind (rule :kind)] + (case kind + :flag + (do + (put opts long-name true) + (inc i)) + + :count + (do + (put opts long-name (-> (opts long-name) (or 0) inc)) + (inc i)) + + (if (or (= kind :single) + (= kind :multi)) + (if-let [input (get args (inc i))] + (if-let [val (convert input (rule :value))] + (do + (case kind + :single (put opts long-name val) + :multi (put opts long-name (array/push (or (opts long-name) @[]) val))) + (+ 2 i)) + (usage-error "'" input "' is invalid value for " arg)) + (usage-error "no value after option of type " kind)))) + (usage-error "unrecognized option '" arg "'"))) + + +(defn- consume-param + ``` + Consumes a parameter + ``` + [result prule args i rem] + (def params (result :params)) + (def arg (args i)) + (if-let [[name rule] prule] + (if (rule :splat?) + (do + (def vals @[]) + (var j 0) + (each a (array/slice args i (- -1 rem)) + (if-let [val (convert a (rule :value))] + (do + (array/push vals val) + (++ j)) + (do + (usage-error "'" a "' is invalid value for " (or (rule :proxy) name)) + (break)))) + (when (empty? err) + (put params name vals) + (+ i j))) + (if-let [val (convert arg (rule :value))] + (do + (put params name val) + (inc i)) + (usage-error "'" arg "' is invalid value for " (or (rule :proxy) name)))) + (usage-error "too many parameters passed"))) + + +(defn- check-options + ``` + Checks options + ``` + [result rules] + (def opts (result :opts)) + (each [name rule] rules + (when (and (not (nil? rule)) (rule :default) (nil? (opts name))) + (put-in result [:opts name] (rule :default))))) + + +(defn- check-params + ``` + Checks params + ``` + [result params rules] + (def num-params (length params)) + (var i 0) + (def num-rules (length rules)) + (var j 0) + (while (< i num-params) + (def rule (get rules j)) + (set i (consume-param result rule params i (- num-rules j 1))) + (++ j)) + (while (< j num-rules) + (def [name rule] (rules j)) + (if (rule :req?) + (do + (usage-error (or (rule :proxy) name) " is required") + (break)) + (put-in result [:params name] (rule :default))) + (++ j))) + + +(defn- check-subcommand + ``` + Checks subcommands + ``` + [result config] + (unless (or (nil? (config :subs)) (result :sub)) + (usage config))) + + +# Parsing functions + +(defn- parse-args-impl + ``` + Parses arguments recursively if necessary to allow nested subcommands + ``` + [name config] + (set command name) + + (def [orules prules] (conform-rules (get config :rules []))) + (def subconfigs (conform-subconfigs (get config :subs []))) + (def args (conform-args (dyn :args))) + + (def result @{:cmd command :opts @{} :params (when (empty? subconfigs) @{})}) + (def params @[]) + + (def num-args (length args)) + (var i 1) + (while (< i num-args) + (def arg (get args i)) + (set i (cond + (or (= "--help" arg) (= "-h" arg)) + (do + (put-in result [:opts "help"] true) + (usage config)) + + (= "--" arg) + (do + (array/concat params (array/slice args (inc i))) + (break)) + + (string/has-prefix? "--" arg) + (consume-option result orules args i) + + (= "-" arg) + (do + (array/push params arg) + (inc i)) + + (string/has-prefix? "-" arg) + (consume-option result orules args i true) + + (empty? subconfigs) + (do + (array/push params arg) + (inc i)) + + (do + (def help? (= "help" arg)) + (def subcommand (if help? (get args (inc i)) arg)) + (def subconfig (get-subconfig subconfigs subcommand)) + (if subcommand + (if subconfig + (if (not help?) + (with-dyns [:args (array/slice args i)] + (def subresult (parse-args-impl (string command " " subcommand) subconfig)) + (when (and (empty? err) (empty? help)) + (put subresult :cmd subcommand) + (put result :sub subresult) + (break))) + (do + (put-in result [:opts "help"] true) + (set command (string command " " subcommand)) + (usage subconfig))) + (usage-error "unrecognized subcommand '" subcommand "'")) + (usage-error "no subcommand specified after 'help'"))))) + (when (nil? i) + (break))) + + (when (and (empty? err) (empty? help)) + (check-subcommand result config) + (check-options result orules) + (check-params result params prules)) + + result) + +(defn parse-args + ``` + Parses the `(dyn :args)` value for a program + + This function takes a `name` and a `config`. `name` is a string that + represents the name of the program and is used for usage messages. `config` + is a struct containing the following keys: + + * `:rules` - Tuple of rules to use to parse the arguments. + * `:info` - Struct of messages to use in help output. + + The `config` struct may also contain a tuple of subcommands under the `:subs` + key. + + ### Rules + + The rule tuple is a series of alternating rule names and rule contents. The + rule name is either a string or a key. The rule contents is a struct. + + #### Options + + If the rule name is a string, the rule contents will be applied to option + arguments (arguments that begin with a `-` or `--`). The rule contents struct + can have the following keys: + + * `:kind` - The kind of option. Values are `:flag`, `:count`, `:single` and + `:multi`. A flag is a binary choice (e.g. true/false, on/off) that can + only occur once. A count is a monotonically increasing integral value that + can occur one or more times. A single is a value that can only occur once. + A multi is a value that can occur one or more times. + * `:short` - A single letter that is used with `-` rather than `--` and can + be combined with other short options (e.g. `-lah`). + * `:help` - The help text for the option, displayed in the usage message. + * `:default` - A default value that is used if the option occurs. + * `:noex?` - Whether to hide the option from the generated usage example. + * `:value` - A one-argument function that converts the text that is parsed to + another kind of value. This function can be used for validation. If the + return value is `nil`, the input is considered to fail parsing and a usage + error message is printed instead. Instead of a function, a keyword can be + provided and Argy-Bargy's internal converter will be used instead. The + valid keywords are :string and :integer. + + A `--help` option is added automatically unless provided in the rules tuple. + Options will be separated by a blank line if the rules tuple includes a + `---` separator. + + #### Parameters + + If the rule name is a keyword, the rule contents will be applied to parameter + arguments (arguments that are not options). The rule contents struct can have + the following keys: + + * `:help` - Help text for the parameter, displayed in the usage message. + * `:default` - Default value that is used if the parameter is not present. + * `:req?` - Whether the parameter is required to be present. + * `:value` - One-argument function that converts the textual value that is + parsed to a value that will be returned in the return struct. This function + can be used for validation. If the return value is `nil`, the input is + considered to fail parsing and a usage error message is printed instead. + Instead of a function, a keyword can be provided and Argy-Bargy's converter + will be used instead. The valid keywords are `:string` and `:integer`. + * `:splat?` - Whether this rule should capture all unassigned parameters. Only + one parameter rule can have `:splat?` set to `true`. + + ### Info + + The info struct contains messages that are used in the usage help. The struct + can have the following keys: + + * `:about` - Message describing the program at a high level. + * `:usages` - Collection of usage examples to be used in the usage message. + If no examples are provided, one will be generated automatically based on + the provided rules. + * `:opts` - Message printed immediately prior to listing of options. + * `:params` - Message printed immediately prior to listing of parameters. + * `:rider` - Message printed at the end of the usage message. + + ### Subcommands + + The subcommands tuple is a series of alternating subcommand names and + subcommand configs. The subcommand name is a string that will match the name + of a subcommand. The config is a struct of the same form as the `config` + struct. Multiple levels of subcommands can be supported by simply having a + subcommand's `config` struct contain a `:subs` key with a subcommands tuple + of its own. + + In addition to names and configs, the tuple can contain instances of the + string "---". When printing usage information, subcommands that were + separated by a "---" will be separated by a line break. + + ### Return Value + + Once parsed, the return value is a table with `:cmd`, `:opts`, and either + `:params` or `:sub` keys. The values associated with `:opts` and `:params` + are tables containing the values parsed according to the rules. The table + also includes `:err` and `:help` keys that contain either the error or help + messages that may have been generated during parsing. + ``` + [name config] + (set cols (get-cols)) + (def res (-> (parse-args-impl name config) + (merge-into {:err (string err) :help (string help)}))) + (buffer/clear err) + (buffer/clear help) + res) diff --git a/deps/musty/LICENSE b/deps/musty/LICENSE new file mode 100644 index 0000000..30b09ab --- /dev/null +++ b/deps/musty/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2020 Michael Camilleri and Contributors + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/deps/musty/src/musty.janet b/deps/musty/src/musty.janet new file mode 100644 index 0000000..e602113 --- /dev/null +++ b/deps/musty/src/musty.janet @@ -0,0 +1,219 @@ +(def- messages + {:section-tag-mismatch + "Syntax error: The opening and closing section tags do not match" + + :syntax-error + "Syntax error at index %d: %q"}) + + +(defn- syntax-error + ``` + Raise a syntax error specifying the `col` and `fragment` + ``` + [col fragment] + (error (string/format (messages :syntax-error) col fragment))) + + +(defn- inverted + ``` + Return the computed `data` if the tag name in `open-id` and `close-id` does + not exist + ``` + [open-id data ws close-id] + (unless (= open-id close-id) (error (messages :section-tag-mismatch))) + ~(let [val (lookup ,(keyword open-id))] + (if (or (nil? val) (and (indexed? val) (empty? val))) + (string ,data ,ws) + ""))) + + +(defn- section + ``` + Return the computed `data` if the tag name in `open-id` and `close-id` exists + or is a non-empty list + + If the tag represents: + + 1. a non-empty list, will concatenate the generated value; + 2. a truthy value, will return the generated value. + ``` + [open-id data ws close-id] + (unless (= open-id close-id) (error (messages :section-tag-mismatch))) + ~(let [val (lookup ,open-id)] + (cond + (indexed? val) + (string ;(seq [el :in val + :before (array/push ctx el) + :after (array/pop ctx)] + (string ,data ,ws))) + (dictionary? val) + (defer (array/pop ctx) + (array/push ctx val) + (string ,data ,ws)) + + val + (string ,data ,ws) + + :else + ""))) + +(defn- variable + ``` + Return the HTML-escaped computed value `x` + ``` + [x &keys {:escape? escape?}] + (default escape? true) + ~(let [val (-> ,x lookup (or "") string)] + ,(if escape? '(escape val) 'val))) + + +(defn- variable-unescaped + ``` + Return the unescaped computer value `x` + ``` + [x] + (variable x :escape? false)) + + +(defn- text + ``` + Return the text `x` + ``` + [x] + x) + + +(defn- data + ``` + Concatenate the values `xs` + ``` + [& xs] + ~(string ,;xs)) + + +(defn- debugger + [& xs] + (print (string/format "%j" (gensym))) + (print (string/format "%j" xs))) + + +(def- mustache + ``` + The grammar for Mustache + ``` + (peg/compile + ~{:end-or-error (+ -1 (cmt '(* ($) (between 1 10 1)) ,syntax-error)) + + # :start (drop (cmt (* ($) (constant 0)) ,=)) + # :debug (drop (cmt (* (argument 0) (constant "Here: ") ($)) ,debugger)) + + :newline (* (? "\r") "\n") + :inspace (any (set " \t\v")) + + :identifier (* :s* (+ "." (* :w (any (if-not (set "{}") :S)))) :s*) + :delim-close "}}" + :delim-open "{{" + + :standalone-trail (+ (* (? "\r") "\n") (* :inspace -1)) + # Why does this only work with a double negative for the lookbehind? + :standalone-lead (* (not (> -1 (not "\n"))) :inspace) + + :tag-close-inline (* ':inspace :delim-open "/" ':identifier :delim-close) + :tag-close-standalone (* :standalone-lead :tag-close-inline :standalone-trail) + :tag-close (+ :tag-close-standalone :tag-close-inline) + + :partial (* "{{> " :identifier "}}") + + :comments-inline (* :delim-open "!" (any (if-not :delim-close 1)) :delim-close) + :comments-standalone (* :standalone-lead :comments-inline :standalone-trail) + :comments (+ :comments-standalone :comments-inline) + + :inverted-open-inline (* :delim-open "^" ':identifier :delim-close) + :inverted-open-standalone (* :standalone-lead :inverted-open-inline :standalone-trail) + :inverted-open (+ :inverted-open-standalone :inverted-open-inline) + :inverted (/ (* :inverted-open :data :tag-close) ,inverted) + + :section-open-inline (* :delim-open "#" ':identifier :delim-close) + :section-open-standalone (* :standalone-lead :section-open-inline :standalone-trail) + :section-open (+ :section-open-standalone :section-open-inline) + :section (/ (* :section-open :data :tag-close) ,section) + + :unescape-variable-ampersand (* :delim-open "&" (/ ':identifier ,variable-unescaped) :delim-close) + :unescape-variable-triple (* :delim-open "{" (/ ':identifier ,variable-unescaped) "}" :delim-close) + :variable (/ (* :delim-open ':identifier :delim-close) ,variable) + + :variables (+ :variable :unescape-variable-triple :unescape-variable-ampersand) + :others (+ :section :inverted :comments :partial) + :tag (+ :others :variables) + + :text (/ '(some (if-not (+ "\n" (* :inspace :delim-open)) 1)) ,text) + :newlines (/ '(some :newline) ,text) + :trailing (/ '(* :inspace (! (* :delim-open "/"))) ,text) + + :data (/ (any (+ :newlines :text :tag :trailing)) ,data) + :main (* :data :end-or-error)})) + + +(defn- escape + ``` + Escape the `str` of HTML entities + ``` + [str] + (def translations + {34 """ + 38 "&" + 39 "'" + 60 "<" + 62 ">"}) + (def result @"") + (each byte str + (if-let [replacement (get translations byte)] + (buffer/push-string result replacement) + (buffer/push-byte result byte))) + (string result)) + + +(defn- lookup-fn + ``` + Return a lookup function for a context `ctx` + ``` + [ctx] + (fn lookup [x] + (var result nil) + (def trimmed-x (string/trim x)) + (case trimmed-x + "." # The implicit dot iterator + (set result (array/peek ctx)) + + (do # Regular lookup + (def ks (->> trimmed-x (string/split ".") (map keyword))) + (loop [i :down-to [(- (length ctx) 1) 0]] + (when-let [val (get-in ctx [i ;ks])] + (set result val) + (break)) + (if (and (> (length ks) 1) (get-in ctx [i ;(slice ks 0 -2)])) + (break))))) + result)) + + +(defn render + ``` + Render the Mustache `template` using a dictionary `replacements` + + Musty will translate the Mustache template into a series of Janet expressions + and then evaluate those expressions to produce a string.. The translation is + accomplished by way of a parser expression grammar that matches particular + tags and then causes the tag and its enclosed value to be replaced with the + relevant Janet expression. + + Musty is a partial implementation of the Mustache specification. It supports + variable tags, section tags, inverted section tags and comment tags. + ``` + [template replacements] + (def output + (eval + ~(fn [ctx] + (let [lookup (,lookup-fn ctx) + escape ,escape] + ,;(peg/match mustache template))))) + (output @[replacements])) diff --git a/deps/testament/LICENSE b/deps/testament/LICENSE new file mode 100644 index 0000000..92d30e4 --- /dev/null +++ b/deps/testament/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2021 Michael Camilleri and Contributors + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/deps/testament/src/testament.janet b/deps/testament/src/testament.janet new file mode 100644 index 0000000..78db27a --- /dev/null +++ b/deps/testament/src/testament.janet @@ -0,0 +1,708 @@ +### Testament + +## A testing library for Janet + +## Thanks to Sean Walker (for tester) and to Stuart Sierra (for clojure.test), +## both of which served as inspirations. + + +### Globals used by the reporting functions + +(var- num-tests-run 0) +(var- num-asserts 0) +(var- num-tests-passed 0) +(var- curr-test nil) +(var- tests @{}) +(var- reports @{}) +(var- print-reports nil) +(var- on-result-hook (fn [&])) + + +### Equivalence functions + +(def- kind + {:tuple :list + :array :list + :struct :dictionary + :table :dictionary + :string :bytes + :buffer :bytes + :number :number}) + + +(defn- types-equivalent? + [tx ty] + (or + (= tx ty) + (and (not (nil? (kind tx))) + (= (kind tx) (kind ty))))) + + +(defn- not== + [x y] + (def tx (type x)) + (or + (not (types-equivalent? tx (type y))) + (case (kind tx) + :list (or (not= (length x) (length y)) + (some identity (map not== x y))) + :dictionary (or (not= (length (keys x)) (length (keys y))) + (some identity (seq [k :in (keys x)] (not== (get x k) (get y k))))) + :bytes (not= (string x) (string y)) + :number (or (and (nan? x) (not (nan? y))) + (and (not (nan? x)) (not= x y))) + (not= x y)))) + + +(defn == + ``` + Return true if the arguments are equivalent + + The arguments are considered equivalent for the purposes of this function if + they are of equivalent types and have the same structure. Types are equivalent + if they are the same or differ only in terms of mutability (e.g. arrays and + tuples). + + Instances of `math/nan` are considered equivalent for the purposes of this + function. + ``` + [x y] + (not (not== x y))) + + +### Reporting functions + +(defn set-report-printer + ``` + Set the `print-reports` function + + The function `f` will be applied with the following three arguments: + + 1. the number of tests run (as integer); + 2. number of assertions (as integer); and + 3. number of tests passed (as integer). + + The function will not be called if `run-tests!` is called with `:silent` set + to `true`. + ``` + [f] + (if (= :function (type f)) + (set print-reports f) + (error "argument not of type :function"))) + + +(defn- failure-message + ``` + Return the appropriate failure message for the given result + ``` + [result] + (case (result :kind) + :equal + (string "Expect (L): " (string/format "%q" (result :expect)) "\n" + "Actual (R): " (string/format "%q" (result :actual))) + + :matches + (string "Expect (L): Structure " (string/format "%q" (result :expect)) "\n" + "Actual (R): " (string/format "%q" (result :actual))) + + :thrown + "Reason: No error thrown" + + :thrown-message + (string "Expect (L): Error message " (string/format "%q" (result :expect)) "\n" + "Actual (R): Error message " (string/format "%q" (result :actual))) + + :expr + "Reason: Result is Boolean false")) + + +(defn- default-print-reports + ``` + Print reports + ``` + [num-tests-run num-asserts num-tests-passed] + (each report reports + (unless (empty? (report :failures)) + (do + (print "\n> Failed: " (report :test)) + (each failure (report :failures) + (print "Assertion: " (failure :note)) + (print (failure-message failure)))))) + (let [stats (string num-tests-run " tests run containing " + num-asserts " assertions\n" + num-tests-passed " tests passed, " + (- num-tests-run num-tests-passed) " tests failed") + len (->> (string/split "\n" stats) (map length) (splice) (max))] + (print) + (print (string/repeat "-" len)) + (print stats) + (print (string/repeat "-" len)))) + + +### Recording functions + +(defn set-on-result-hook + ``` + Set the `on-result-hook` + + The function `f` will be invoked when a result becomes available. The + function is called with a single argument, the `result`. The `result` is a + struct with the following keys: + + - `:test` the name of the test to which the assertion belongs (as `nil` or + symbol); + - `:kind` the kind of assertion (as keyword); + - `:passed?` whether an assertion succeeded (as boolean); + - `:expect` the expected value of the assertion; + - `:actual` the actual value of the assertion; and + - `:note` a description of the assertion (as string). + + The 'value' of the assertion depends on the kind of assertion: + + - `:expr` either `true` or `false`; + - `:equal` the value specified in the assertion; + - `:matches` the structure of the value in the assertion; + - `:thrown` either `true` or `false`; and + - `:thrown-message` the error specified in the assertion. + ``` + [f] + (if (= :function (type f)) + (set on-result-hook f) + (error "argument not of type :function"))) + + +(defn- add-to-report + ``` + Add `result` to the report for test `name` + ``` + [result] + (if-let [name (result :test) + report (reports name) + queue (if (result :passed?) (report :passes) (report :failures))] + (array/push queue result))) + + +(defn- compose-and-record-result + ``` + Compose a result and record it if applicable + ``` + [result] + (++ num-asserts) + (on-result-hook result) + (add-to-report result) + result) + + +### Test utility functions + +(defn- register-test + ``` + Register a test `t` with a `name `in the test suite + + This function will print a warning to `:err` if a test with the same `name` + has already been registered in the test suite. + ``` + [name t] + (unless (nil? (tests name)) + (eprint "[testament] registered multiple tests with the same name")) + (set (tests name) t)) + + +(defn- setup-test + ``` + Perform tasks to setup the test, `name` + ``` + [name] + (set curr-test name) + (put reports name @{:test name :passes @[] :failures @[]})) + + +(defn- teardown-test + ``` + Perform tasks to teardown the test, `name` + ``` + [name] + (++ num-tests-run) + (if (-> (reports name) (get :failures) length zero?) + (++ num-tests-passed)) + (set curr-test nil)) + + +### Utility function + +(defn- which + ``` + Determine the type of assertion being performed + ``` + [assertion] + (cond + (and (tuple? assertion) (= 3 (length assertion)) (= '= (first assertion))) + :equal + + (and (tuple? assertion) (= 3 (length assertion)) (= 'deep= (first assertion))) + :deep-equal + + (and (tuple? assertion) (= 3 (length assertion)) (= '== (first assertion))) + :equivalent + + (and (tuple? assertion) (= 3 (length assertion)) (= 'matches (first assertion))) + :matches + + (and (tuple? assertion) (= 2 (length assertion)) (= 'thrown? (first assertion))) + :thrown + + (and (tuple? assertion) (= 3 (length assertion)) (= 'thrown? (first assertion))) + :thrown-message + + :else + :expr)) + + +### Function form of assertion macros + +(defn- assert-expr* + ``` + Function form of assert-expr + ``` + [expr form note] + (let [passed? (not (not expr)) + result {:test curr-test + :kind :expr + :passed? passed? + :expect true + :actual passed? + :note (or note (string/format "%q" form))}] + (compose-and-record-result result))) + + +(defn- assert-equal* + ``` + Function form of assert-equal + ``` + [expect expect-form actual actual-form note] + (let [result {:test curr-test + :kind :equal + :passed? (= expect actual) + :expect expect + :actual actual + :note (or note (string/format "(= %q %q)" expect-form actual-form))}] + (compose-and-record-result result))) + + +(defn- assert-deep-equal* + ``` + Function form of assert-deep-equal + ``` + [expect expect-form actual actual-form note] + (let [result {:test curr-test + :kind :equal + :passed? (deep= expect actual) + :expect expect + :actual actual + :note (or note (string/format "(deep= %q %q)" expect-form actual-form))}] + (compose-and-record-result result))) + + +(defn- assert-equivalent* + ``` + Function form of assert-equivalent + ``` + [expect expect-form actual actual-form note] + (let [result {:test curr-test + :kind :equal + :passed? (== expect actual) + :expect expect + :actual actual + :note (or note (string/format "(== %q %q)" expect-form actual-form))}] + (compose-and-record-result result))) + + +(defn- assert-matches* + ``` + Function form of assert-matches + ``` + [structure actual actual-form note] + (let [result {:test curr-test + :kind :matches + :passed? (not (nil? (eval (apply match [actual structure true])))) + :expect structure + :actual actual + :note (or note (string/format "(matches %q %q)" structure actual-form))}] + (compose-and-record-result result))) + + +(defn- assert-thrown* + ``` + Function form of assert-thrown + ``` + [thrown? form note] + (let [result {:test curr-test + :kind :thrown + :passed? thrown? + :expect true + :actual thrown? + :note (or note (string/format "thrown? %q" form))}] + (compose-and-record-result result))) + + +(defn- assert-thrown-message* + ``` + Function form of assert-thrown-message + ``` + [thrown? form expect-message expect-form actual-message note] + (let [result {:test curr-test + :kind :thrown-message + :passed? thrown? + :expect expect-message + :actual actual-message + :note (or note (string/format "thrown? %q %q" expect-form form))}] + (compose-and-record-result result))) + + +### Assertion macros + +(defmacro assert-expr + ``` + Assert that the expression, `expr`, is true (with an optional `note`) + + The `assert-expr` macro provides a mechanism for creating a generic assertion. + + An optional `note` can be included that will be used in any failure result to + identify the assertion. If no `note` is provided, the form of `expr` is used. + ``` + [expr &opt note] + ~(,assert-expr* ,expr ',expr ,note)) + + +(defmacro assert-equal + ``` + Assert that `expect` is equal to `actual` (with an optional `note`) + + The `assert-equal` macro provides a mechanism for creating an assertion that + an expected result is equal to the actual result. The forms of `expect` and + `actual` will be used in the output of any failure report. + + An optional `note` can be included that will be used in any failure result to + identify the assertion. If no `note` is provided, the form `(= expect actual)` + is used. + ``` + [expect actual &opt note] + ~(,assert-equal* ,expect ',expect ,actual ',actual ,note)) + + +(defmacro assert-deep-equal + ``` + Assert that `expect` is deeply equal to `actual` (with an optional `note`) + + The `assert-deep-equal` macro provides a mechanism for creating an assertion + that an expected result is deeply equal to the actual result. The forms of + `expect` and `actual` will be used in the output of any failure report. + + An optional `note` can be included that will be used in any failure result to + identify the assertion. If no `note` is provided, the form + `(deep= expect actual)` is used. + ``` + [expect actual &opt note] + ~(,assert-deep-equal* ,expect ',expect ,actual ',actual ,note)) + + +(defmacro assert-equivalent + ``` + Assert that `expect` is equivalent to `actual` (with an optional `note`) + + The `assert-equivalent` macro provides a mechanism for creating an assertion + that an expected result is equivalent to the actual result. Testament + considers forms to be equivalent if the types are 'equivalent' (that is, they + are the same or differ only in terms of mutability) and the structure is + equivalent. The forms of `expect` and `actual` will be used in the output of + any failure report. + + An optional `note` can be included that will be used in any failure result to + identify the assertion. If no `note` is provided, the form `(== expect actual)` + is used. + ``` + [expect actual &opt note] + ~(,assert-equivalent* ,expect ',expect ,actual ',actual ,note)) + + +(defmacro assert-matches + ``` + Assert that `structure` matches `actual` (with an optional `note`) + + The `assert-matches` macro provides a mechanism for creating an assertion that + an expression matches a particular structure (at least in part). + + An optional `note` can be included that will be used in any failure result to + identify the assertion. If no `note` is provided, the form + `(matches structure actual)` is used. + ``` + [structure actual &opt note] + ~(,assert-matches* ',structure ,actual ',actual ,note)) + + +(defmacro assert-thrown + ``` + Assert that an expression, `expr`, throws an error (with an optional `note`) + + The `assert-thrown` macro provides a mechanism for creating an assertion that + an expression throws an error. + + An optional `note` can be included that will be used in any failure result to + identify the assertion. If no `note` is provided, the form `thrown? expr` is + used. + ``` + [expr &opt note] + (let [errsym (keyword (gensym))] + ~(,assert-thrown* (= ,errsym (try ,expr ([_] ,errsym))) ',expr ,note))) + + +(defmacro assert-thrown-message + ``` + Assert that the expression, `expr`, throws an error with the message `expect` + (with an optional `note`) + + The `assert-thrown` macro provides a mechanism for creating an assertion that + an expression throws an error with the specified message. + + An optional `note` can be included that will be used in any failure result to + identify the assertion. If no `note` is provided, the form + `thrown? expect expr` is used. + ``` + [expect expr &opt note] + (let [errsym (keyword (gensym)) + sentinel (gensym) + actual (gensym)] + ~(let [[,sentinel ,actual] (try (do ,expr [nil nil]) ([err] [,errsym err]))] + (,assert-thrown-message* (and (= ,sentinel ,errsym) (= ,expect ,actual )) ',expr ,expect ',expect ,actual ,note)))) + + +(defmacro is + ``` + Assert that an `assertion` is true (with an optional `note`) + + The `is` macro provides a succinct mechanism for creating assertions. + Testament includes support for seven types of assertions: + + 1. a generic assertion that asserts the Boolean truth of an expression; + 2. an equality assertion that asserts that an expected result and an actual + result are equal; + 3. a deep equality assertion that asserts that an expected result and an + actual result are deeply equal; + 4. an equivalence assertion that asserts that an expected result and an actual + result are equivalent; + 5. a matches assertion that asserts that an expected result matches a + particular structure (at least in part); + 6. a throwing assertion that asserts an error is thrown; and + 7. a throwing assertion that asserts an error with a specific message is + thrown. + + `is` causes the appropriate assertion to be inserted based on the form of the + asserted expression. + + An optional `note` can be included that will be used in any failure result to + identify the assertion. + ``` + [assertion &opt note] + (case (which assertion) + :equal + (let [[_ expect actual] assertion] + ~(,assert-equal* ,expect ',expect ,actual ',actual ,note)) + + :deep-equal + (let [[_ expect actual] assertion] + ~(,assert-deep-equal* ,expect ',expect ,actual ',actual ,note)) + + :equivalent + (let [[_ expect actual] assertion] + ~(,assert-equivalent* ,expect ',expect ,actual ',actual ,note)) + + :matches + (let [[_ structure actual] assertion] + ~(,assert-matches* ',structure ,actual ',actual ,note)) + + :thrown + (let [[_ form] assertion + errsym (keyword (gensym))] + ~(,assert-thrown* (= ,errsym (try ,form ([_] ,errsym))) ',form ,note)) + + :thrown-message + (let [[_ expect form] assertion + errsym (keyword (gensym)) + sentinel (gensym) + actual (gensym)] + ~(let [[,sentinel ,actual] (try (do ,form [nil nil]) ([err] [,errsym err]))] + (,assert-thrown-message* (and (= ,sentinel ,errsym) (= ,expect ,actual )) ',form ,expect ',expect ,actual ,note))) + + :expr + ~(,assert-expr* ,assertion ',assertion ,note))) + + +### Test definition macro + +(defmacro deftest + ``` + Define a test and register it in the test suite + + The `deftest` macro can be used to create named tests and anonymous tests. If + the first argument is a symbol, that argument is treated as the name of the + test. Otherwise, Testament uses `gensym` to generate a unique symbol to name + the test. If a test with the same name has already been defined, `deftest` + will raise an error. + + A test is just a function. `args` (excluding the first argument if that + argument is a symbol) is used as the body of the function. Testament adds + respective calls to a setup function and a teardown function before and after + the forms in the body. + + In addition to creating a function, `deftest` registers the test in the 'test + suite'. Testament's test suite is a global table of tests that have been + registered by `deftest`. When a user calls `run-tests!`, each test in the + test suite is called. The order in which each test is called is not + guaranteed. + + If `deftest` is called with no arguments or if the only argument is a symbol, + an arity error is raised. + ``` + [& args] + (when (or (zero? (length args)) + (and (one? (length args)) (= :symbol (type (first args))))) + (error "arity mismatch")) + (let [[name body] (if (= :symbol (type (first args))) [(first args) (slice args 1)] + [(symbol "test" (gensym)) args])] + ~(def ,name (,register-test ',name (fn [] + (,setup-test ',name) + ,;body + (,teardown-test ',name)))))) + + +### Test suite functions + +(defn- empty-module-cache! [] + ``` + Empty module/cache to prevent caching between test runs in the same process + ``` + (each key (keys module/cache) + (put module/cache key nil))) + + +(defn reset-tests! + ``` + Reset all reporting variables + ``` + [] + (set num-tests-run 0) + (set num-asserts 0) + (set num-tests-passed 0) + (set curr-test nil) + (set tests @{}) + (set reports @{}) + (set print-reports nil) + (set on-result-hook (fn [&]))) + + +(defn run-tests! + ``` + Run the registered tests + + This function will run the tests registered in the test suite via `deftest`. + It accepts two optional arguments: + + 1. `:silent` whether to omit the printing of reports (default: `false`); and + 2. `:exit-on-fail` whether to exit if any of the tests fail (default: `true`). + + Please note that `run-tests!` calls `os/exit` when there are failing tests + unless the argument `:exit-on-fail` is set to `false` or the + `:testament-repl?` dynamic variable is set to `true`. + + In all other cases, the function returns an indexed collection of test + reports. Each report in the collection is a dictionary collection containing + three keys: `:test`, `:passes` and `:failures`. `:test` is the name of the + test while `:passes` and `:failures` contain the results of each respective + passed and failed assertion. Each result is a data structure of the kind + described in the docstring for `set-on-result-hook`. + + When the dynamic variable `:testament-repl?` is set to `true`, this will + also reset the test reports and empty the module/cache to provide a fresh run + with the most up-to-date code. + ``` + [&keys {:silent silent? :exit-on-fail exit?}] + (default exit? true) + (each test (values tests) (test)) + (unless silent? + (when (nil? print-reports) + (set-report-printer default-print-reports)) + (print-reports num-tests-run num-asserts num-tests-passed)) + + (def in-repl? (dyn :testament-repl?)) + (def report-values (values reports)) + + (when (and exit? + (not (= num-tests-run num-tests-passed)) + (not in-repl?)) + (os/exit 1)) + (when in-repl? + (reset-tests!) + (empty-module-cache!)) + report-values) + + +(defmacro exercise! + ``` + Define, run and reset the tests provided in the macro body + + This macro will run the forms in `body`, call `run-test!`, call `reset-tests!` + and then return the value of `run-tests!`. + + The user can specify the arguments to be passed to `run-tests!` by providing a + tuple as `args`. If no arguments are necessary, `args` should be an empty + tuple. + + Please note that, like `run-tests!`, `exercise!` calls `os/exit` when there + are failing tests unless the argument `:exit-on-fail` is set to `false`. + ``` + [args & body] + (let [exit-code (gensym)] + ~(do + ,;body + (def ,exit-code (,run-tests! ,;args)) + (,reset-tests!) + ,exit-code))) + + +# Review macro + +(defn- review-1 + ``` + Function form of the review macro + ``` + [path & args] + (def env (curenv)) + (def kargs (table ;args)) + (def {:as as + :prefix pfx + :export ep} kargs) + (def newenv (require path ;args)) + (each [k v] (pairs newenv) + (when (dictionary? v) + (put v :private nil))) + (def prefix (or + (and as (string as "/")) + pfx + (string (last (string/split "/" path)) "/"))) + (merge-module env newenv prefix)) + + +(defmacro review + ``` + Import all bindings as public in the specified module + + This macro performs similarly to `import`. The difference is that it sets all + the bindings as public. This is intended for situations where it is not + desirable to make bindings public but the user would still like to be able to + subject the bindings to testing. + ``` + [path & args] + (def path (string path)) + (def ps (partition 2 args)) + (def argm (mapcat (fn [[k v]] [k (if (= k :as) (string v) v)]) ps)) + (tuple review-1 (string path) ;argm)) diff --git a/init.janet b/init.janet new file mode 100644 index 0000000..1fd1028 --- /dev/null +++ b/init.janet @@ -0,0 +1 @@ +(import ./lib/documentarian :prefix "" :export true) diff --git a/lib/cli.janet b/lib/cli.janet new file mode 100644 index 0000000..86a29ae --- /dev/null +++ b/lib/cli.janet @@ -0,0 +1,91 @@ +(import ../deps/argy-bargy/argy-bargy :as argy) +(import ./documentarian :as doc) + + +(def config + ``` + The configuration for Argy-Bargy + ``` + {:rules ["--defix" {:kind :single + :short "d" + :proxy "prefix" + :help "Remove from all namespaces."} + "--link-prefix" {:kind :single + :short "L" + :proxy "url" + :help "Use as prefix for source code links."} + "-------------------------------------------" + "--exclude" {:kind :multi + :short "x" + :proxy "path" + :help "Exclude bindings in from the API document."} + "--private" {:kind :flag + :short "P" + :help "Include private values in the API document."} + "-------------------------------------------" + "--project" {:kind :single + :short "p" + :proxy "path" + :help "Use as project file. (Default: project.janet)"} + "--local" {:kind :flag + :short "l" + :help "Set Janet's modpath to ./jpm_tree."} + "--tree" {:kind :single + :short "t" + :proxy "path" + :help "Set Janet's modpath to ."} + "-------------------------------------------" + "--echo" {:kind :flag + :short "e" + :help "Output to stdout rather than output file."} + "--out" {:kind :single + :short "o" + :proxy "path" + :help "Use as filename for the API document. (Default: api.md)"} + "--template" {:kind :single + :short "T" + :proxy "path" + :help "Use as template for the API document."} + "-------------------------------------------"] + :info {:about "A document generation tool for Janet projects."}}) + + +(defn args->opts + ``` + Converts Argy-Bargy processed args into options for use with generate-doc + ``` + [args] + (def modpath (if (get-in args [:opts "local"]) "jpm_tree" (get-in args [:opts "tree"]))) + @{:defix (get-in args [:opts "defix"] "") + :echo? (get-in args [:opts "echo"] false) + :exclude (get-in args [:opts "exclude"] []) + :include-private? (get-in args [:opts "private"] false) + :link-prefix (get-in args [:opts "link-prefix"] "") + :output-file (get-in args [:opts "out"] "api.md") + :project-file (get-in args [:opts "project"] "project.janet") + :modpath (when modpath (string modpath doc/sep "lib")) + :template-file (get-in args [:opts "template"])}) + + +(defn run + [] + (def parsed (argy/parse-args "documentarian" config)) + (def err (parsed :err)) + (def help (parsed :help)) + + (cond + (not (empty? help)) + (do + (prin help) + (os/exit (if (get-in parsed [:opts "help"]) 0 1))) + + (not (empty? err)) + (do + (eprin err) + (os/exit 1)) + + (doc/generate-doc (args->opts parsed)))) + + +# for testing in development +(defn- main [& args] (run)) diff --git a/documentarian.janet b/lib/documentarian.janet similarity index 76% rename from documentarian.janet rename to lib/documentarian.janet index f4b0f8e..60452f0 100644 --- a/documentarian.janet +++ b/lib/documentarian.janet @@ -1,56 +1,7 @@ -(import argy-bargy :as argy) -(import musty) - - -(def- sep (if (= :windows (os/which)) "\\" "/")) - - -(def config - ``` - The configuration for Argy-Bargy - ``` - {:rules ["--defix" {:kind :single - :short "d" - :proxy "prefix" - :help "Remove from all namespaces."} - "--link-prefix" {:kind :single - :short "L" - :proxy "url" - :help "Use as prefix for source code links."} - "-------------------------------------------" - "--exclude" {:kind :multi - :short "x" - :proxy "path" - :help "Exclude bindings in from the API document."} - "--private" {:kind :flag - :short "P" - :help "Include private values in the API document."} - "-------------------------------------------" - "--project" {:kind :single - :short "p" - :proxy "path" - :help "Use as project file. (Default: project.janet)"} - "--local" {:kind :flag - :short "l" - :help "Set Janet's modpath to ./jpm_tree."} - "--tree" {:kind :single - :short "t" - :proxy "path" - :help "Set Janet's modpath to ."} - "-------------------------------------------" - "--echo" {:kind :flag - :short "e" - :help "Output to stdout rather than output file."} - "--out" {:kind :single - :short "o" - :proxy "path" - :help "Use as filename for the API document. (Default: api.md)"} - "--template" {:kind :single - :short "T" - :proxy "path" - :help "Use as template for the API document."} - "-------------------------------------------"] - :info {:about "A document generation tool for Janet projects."}}) +(import ../deps/musty/src/musty) + + +(def sep (if (= :windows (os/which)) "\\" "/")) (def default-template @@ -94,6 +45,7 @@ {{/modules}} ````) + (defn- last-pos ``` Returns the position of the last occurrence of a character or nil @@ -148,6 +100,8 @@ (def- headings @{}) + + (defn- in-link ``` Creates an internal link @@ -454,31 +408,3 @@ (if (opts :echo?) (print document) (spit (opts :output-file) document))) - - -(defn args->opts - ``` - Converts Argy-Bargy processed args into options for use with generate-doc - ``` - [args] - (def modpath (if (get (args :opts) "local") "jpm_tree" (get (args :opts) "tree"))) - @{:defix (get (args :opts) "defix" "") - :echo? (get (args :opts) "echo" false) - :exclude (get (args :opts) "exclude" []) - :include-private? (get (args :opts) "private" false) - :link-prefix (get (args :opts) "link-prefix" "") - :output-file (get (args :opts) "out" "api.md") - :project-file (get (args :opts) "project" "project.janet") - :modpath (when modpath (string modpath sep "lib")) - :template-file (get (args :opts) "template")}) - - -(defn- main - [& argv] - (def args (argy/parse-args "documentarian" config)) - (unless (or (args :help?) (args :error?)) - (try - (generate-doc (args->opts args)) - ([err] - (eprint "documentarian: " err) - (os/exit 1))))) diff --git a/project.janet b/project.janet index 9e7936d..d0ccdbf 100644 --- a/project.janet +++ b/project.janet @@ -5,28 +5,70 @@ :license "MIT" :url "https://github.com/pyrmont/documentarian" :repo "git+https://github.com/pyrmont/documentarian" - :dependencies ["https://github.com/pyrmont/argy-bargy" - "https://github.com/pyrmont/musty"] - :dev-dependencies ["https://github.com/pyrmont/testament"]) + :vendored [{:url "https://github.com/pyrmont/argy-bargy" + :prefix "argy-bargy" + :include ["argy-bargy.janet" + "LICENSE"]} + {:url "https://github.com/pyrmont/musty" + :prefix "musty" + :include ["src/musty.janet" + "LICENSE"]} + {:url "https://github.com/pyrmont/testament" + :prefix "testament" + :include ["src/testament.janet" + "LICENSE"]}]) + + +(declare-binscript + :main "bin/documentarian") -(declare-executable - :name "documentarian" - :entry "documentarian.janet" - :install true) (declare-source - :source ["documentarian.janet"]) + :source ["deps" + "lib" + "init.janet"] + :prefix "documentarian") + -(task "dev-deps" [] - (if-let [deps ((dyn :project) :dependencies)] - (each dep deps - (bundle-install dep)) - (do - (print "no dependencies found") - (flush))) - (if-let [deps ((dyn :project) :dev-dependencies)] - (each dep deps - (bundle-install dep)) - (do - (print "no dev-dependencies found") - (flush)))) +(task "vendor" [] + (def sep (if (= :windows (os/which)) "\\" "/")) + (def deps-dir "deps") + (def temp-dir "tmp") + (defn mkdirp [path] + (def pwd (os/cwd)) + (each dir (string/split sep path) + (os/mkdir dir) + (os/cd dir)) + (os/cd pwd)) + (defn is-tarball? [url] + (or (string/has-suffix? ".gz" url) + (string/has-suffix? ".tar" url))) + (each {:url url + :tag tag + :prefix prefix + :include includes + :exclude excludes} (get (dyn :project) :vendored) + (if-not url + (error "Vended dependencies need a :url key") + (do + (default tag "HEAD") + (def tarball (if (is-tarball? url) url (string url "/archive/" tag ".tar.gz"))) + (def dest-dir (if prefix (string/join [deps-dir prefix] sep) deps-dir)) + (def filename (-> (string/split "/" tarball) last)) + (print "Vendoring " tarball " to " dest-dir) + (defer (rimraf temp-dir) + (do + (os/mkdir temp-dir) + (def tar-file (string/join [temp-dir filename] sep)) + (curl "-sL" tarball "-o" tar-file) + (tar "xf" tar-file "-C" temp-dir "--strip-components" "1") + (rimraf tar-file) + (when excludes + (each exclude excludes + (rimraf (string/join [temp-dir exclude] sep)))) + (def files (if includes includes (os/dir temp-dir))) + (each file files + (def from (string/join [temp-dir file] sep)) + (def to (string/join [dest-dir file] sep)) + (mkdirp (dirname to)) + (copy from to)))))))) diff --git a/test/documentarian.janet b/test/documentarian.janet index 4002c11..f67651f 100644 --- a/test/documentarian.janet +++ b/test/documentarian.janet @@ -1,6 +1,8 @@ -(import testament :prefix "" :exit true) +(import /deps/testament/src/testament :prefix "" :exit true) + + +(review ../lib/documentarian :as doc) -(review ../documentarian :as doc) (deftest parse-project (is (thrown? (doc/parse-project "fixtures/broken_project.janet"))))