diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/data/coll/dict.lux | 1 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/json.lux | 87 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/xml.lux | 55 | ||||
| -rw-r--r-- | stdlib/source/lux/data/text/format.lux | 36 | ||||
| -rw-r--r-- | stdlib/source/lux/data/text/lexer.lux | 19 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/poly.lux | 31 | ||||
| -rw-r--r-- | stdlib/source/lux/time/instant.lux | 33 | ||||
| -rw-r--r-- | stdlib/source/lux/type/model.lux | 28 | ||||
| -rw-r--r-- | stdlib/test/test/lux/time/instant.lux | 2 |
9 files changed, 148 insertions, 144 deletions
diff --git a/stdlib/source/lux/data/coll/dict.lux b/stdlib/source/lux/data/coll/dict.lux index ac6a47891..0af8ed43e 100644 --- a/stdlib/source/lux/data/coll/dict.lux +++ b/stdlib/source/lux/data/coll/dict.lux @@ -7,7 +7,6 @@ [array #+ Array "Array/" Functor<Array> Fold<Array>]) [bit] [product] - text/format [number]) )) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 6d7ed16a7..c4951f188 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -9,10 +9,9 @@ codec ["p" parser "p/" Monad<Parser>]) (data [bool] - [text "Text/" Eq<Text> Monoid<Text>] - text/format + [text "text/" Eq<Text> Monoid<Text>] (text ["l" lexer]) - [number "Real/" Codec<Text,Real>] + [number "real/" Codec<Text,Real> "nat/" Codec<Text,Nat>] maybe ["R" result] [sum] @@ -116,18 +115,18 @@ (def: (show-array show-json elems) (-> (-> JSON Text) (-> Array Text)) - (format "[" - (|> elems (Vector/map show-json) vector;to-list (text;join-with ",")) - "]")) + ($_ text/append "[" + (|> elems (Vector/map show-json) vector;to-list (text;join-with ",")) + "]")) (def: (show-object show-json object) (-> (-> JSON Text) (-> Object Text)) - (format "{" - (|> object - d;entries - (L/map (function [[key value]] (format (show-string key) ":" (show-json value)))) - (text;join-with ",")) - "}")) + ($_ text/append "{" + (|> object + d;entries + (L/map (function [[key value]] ($_ text/append (show-string key) ":" (show-json value)))) + (text;join-with ",")) + "}")) (def: (show-json json) (-> JSON Text) @@ -156,7 +155,7 @@ (#R;Success (d;keys obj)) _ - (#R;Error (format "Cannot get the fields of a non-object.")))) + (#R;Error ($_ text/append "Cannot get the fields of a non-object.")))) (def: #export (get key json) {#;doc "A JSON object field getter."} @@ -168,10 +167,10 @@ (#R;Success value) #;None - (#R;Error (format "Missing field " (show-string key) " on object."))) + (#R;Error ($_ text/append "Missing field " (show-string key) " on object."))) _ - (#R;Error (format "Cannot get field " (show-string key) " of a non-object.")))) + (#R;Error ($_ text/append "Cannot get field " (show-string key) " of a non-object.")))) (def: #export (set key value json) {#;doc "A JSON object field setter."} @@ -181,18 +180,18 @@ (#R;Success (#Object (d;put key value obj))) _ - (#R;Error (format "Cannot set field " (show-string key) " of a non-object.")))) + (#R;Error ($_ text/append "Cannot set field " (show-string key) " of a non-object.")))) (do-template [<name> <tag> <type> <desc>] [(def: #export (<name> key json) - {#;doc (#;TextA (format "A JSON object field getter for " <desc> "."))} + {#;doc (#;TextA ($_ text/append "A JSON object field getter for " <desc> "."))} (-> Text JSON (R;Result <type>)) (case (get key json) (#R;Success (<tag> value)) (#R;Success value) (#R;Success _) - (#R;Error (format "Wrong value type at key " (show-string key))) + (#R;Error ($_ text/append "Wrong value type at key " (show-string key))) (#R;Error error) (#R;Error error)))] @@ -206,7 +205,7 @@ (do-template [<name> <type> <tag> <desc>] [(def: #export (<name> value) - {#;doc (#;TextA (format "A JSON generator for " <desc> "."))} + {#;doc (#;TextA ($_ text/append "A JSON generator for " <desc> "."))} (Gen <type>) (<tag> value))] @@ -269,8 +268,8 @@ [mark (l;one-of "eE") signed?' (l;this? "-") offset (l;many l;decimal)] - (wrap (format mark (if signed?' "-" "") offset))))] - (case (Real/decode (format (if signed? "-" "") digits "." decimals exp)) + (wrap ($_ text/append mark (if signed?' "-" "") offset))))] + (case (real/decode ($_ text/append (if signed? "-" "") digits "." decimals exp)) (#R;Error message) (p;fail message) @@ -295,11 +294,11 @@ (do p;Monad<Parser> [chars (l;some (l;none-of "\\\"")) stop l;peek] - (if (Text/= "\\" stop) + (if (text/= "\\" stop) (do @ [escaped escaped~ next-chars (recur [])] - (wrap (format chars escaped next-chars))) + (wrap ($_ text/append chars escaped next-chars))) (wrap chars)))))) (def: (kv~ json~) @@ -378,14 +377,14 @@ ## Syntax (do-template [<name> <type> <tag> <desc> <pre>] [(def: #export (<name> json) - {#;doc (#;TextA (format "Reads a JSON value as " <desc> "."))} + {#;doc (#;TextA ($_ text/append "Reads a JSON value as " <desc> "."))} (Parser <type>) (case json (<tag> value) (#R;Success (<pre> value)) _ - (#R;Error (format "JSON value is not " <desc> ": " (show-json json)))))] + (#R;Error ($_ text/append "JSON value is not " <desc> ": " (show-json json)))))] [unit Unit #Null "unit" id] [bool Bool #Boolean "bool" id] @@ -396,28 +395,28 @@ (do-template [<test> <check> <type> <eq> <encoder> <tag> <desc> <pre>] [(def: #export (<test> test json) - {#;doc (#;TextA (format "Asks whether a JSON value is a " <desc> "."))} + {#;doc (#;TextA ($_ text/append "Asks whether a JSON value is a " <desc> "."))} (-> <type> (Parser Bool)) (case json (<tag> value) (#R;Success (:: <eq> = test (<pre> value))) _ - (#R;Error (format "JSON value is not a " <desc> ": " (show-json json))))) + (#R;Error ($_ text/append "JSON value is not a " <desc> ": " (show-json json))))) (def: #export (<check> test json) - {#;doc (#;TextA (format "Ensures a JSON value is a " <desc> "."))} + {#;doc (#;TextA ($_ text/append "Ensures a JSON value is a " <desc> "."))} (-> <type> (Parser Unit)) (case json (<tag> value) (let [value (<pre> value)] (if (:: <eq> = test value) (#R;Success []) - (#R;Error (format "Value mismatch: " - (<encoder> test) "=/=" (<encoder> value))))) + (#R;Error ($_ text/append "Value mismatch: " + (<encoder> test) "=/=" (<encoder> value))))) _ - (#R;Error (format "JSON value is not a " <desc> ": " (show-json json)))))] + (#R;Error ($_ text/append "JSON value is not a " <desc> ": " (show-json json)))))] [bool? bool! Bool bool;Eq<Bool> (:: bool;Codec<Text,Bool> encode) #Boolean "boolean" id] [int? int! Int number;Eq<Int> (:: number;Codec<Text,Int> encode) #Number "number" real-to-int] @@ -453,7 +452,7 @@ (wrap elems)) _ - (#R;Error (format "JSON value is not an array: " (show-json json)))))) + (#R;Error ($_ text/append "JSON value is not an array: " (show-json json)))))) (def: #export (object parser) {#;doc "Parses a JSON object, assuming that every field's value can be parsed the same way."} @@ -471,7 +470,7 @@ (wrap (d;from-list text;Hash<Text> kvs))) _ - (#R;Error (format "JSON value is not an object: " (show-json json)))))) + (#R;Error ($_ text/append "JSON value is not an object: " (show-json json)))))) (def: #export (nth idx parser) {#;doc "Parses an element inside a JSON array."} @@ -486,13 +485,13 @@ (#R;Success output) (#R;Error error) - (#R;Error (format "JSON array index [" (%n idx) "]: (" error ") @ " (show-json json)))) + (#R;Error ($_ text/append "JSON array index [" (nat/encode idx) "]: (" error ") @ " (show-json json)))) #;None - (#R;Error (format "JSON array does not have index " (%n idx) " @ " (show-json json)))) + (#R;Error ($_ text/append "JSON array does not have index " (nat/encode idx) " @ " (show-json json)))) _ - (#R;Error (format "JSON value is not an array: " (show-json json)))))) + (#R;Error ($_ text/append "JSON value is not an array: " (show-json json)))))) (def: #export (field field-name parser) {#;doc "Parses a field inside a JSON object."} @@ -505,10 +504,10 @@ (#R;Success output) (#R;Error error) - (#R;Error (format "Failed to get JSON object field " (show-string field-name) ": (" error ") @ " (show-json json)))) + (#R;Error ($_ text/append "Failed to get JSON object field " (show-string field-name) ": (" error ") @ " (show-json json)))) (#R;Error _) - (#R;Error (format "JSON object does not have field " (show-string field-name) " @ " (show-json json)))))) + (#R;Error ($_ text/append "JSON object does not have field " (show-string field-name) " @ " (show-json json)))))) (def: #export any {#;doc "Just returns the JSON input without applying any logic."} @@ -583,10 +582,10 @@ (#Array parts) (if (n.= size (vector;size parts)) (#R;Success []) - (#R;Error (format "JSON array does no have size " (%n size) " " (show-json json)))) + (#R;Error ($_ text/append "JSON array does no have size " (nat/encode size) " " (show-json json)))) _ - (#R;Error (format "JSON value is not an array: " (show-json json)))))) + (#R;Error ($_ text/append "JSON value is not an array: " (show-json json)))))) (def: #export (object-fields! wanted-fields) {#;doc "Ensures that every field in the list of wanted-fields is present in a JSON object."} @@ -599,10 +598,10 @@ (list;every? (list;member? text;Eq<Text> wanted-fields) actual-fields)) (#R;Success []) - (#R;Error (format "JSON object has wrong field-set. Expected: [" (text;join-with ", " wanted-fields) "]. Actual: [" (text;join-with ", " actual-fields) "]")))) + (#R;Error ($_ text/append "JSON object has wrong field-set. Expected: [" (text;join-with ", " wanted-fields) "]. Actual: [" (text;join-with ", " actual-fields) "]")))) _ - (#R;Error (format "JSON value is not an object: " (show-json json)))))) + (#R;Error ($_ text/append "JSON value is not an object: " (show-json json)))))) ## [Structures] (struct: #export _ (Eq JSON) @@ -876,7 +875,7 @@ ## Bound type-vars (poly;bound env :x:) ## If all else fails... - (macro;fail (format "Cannot create JSON encoder for: " (%type :x:))) + (macro;fail ($_ text/append "Cannot create JSON encoder for: " (type;to-text :x:))) )))) (def: #hidden (rec-decode non-rec) @@ -1063,7 +1062,7 @@ [g!bound (poly;bound env :x:)] (wrap g!bound)) ## If all else fails... - (macro;fail (format "Cannot create JSON decoder for: " (%type :x:))) + (macro;fail ($_ text/append "Cannot create JSON decoder for: " (type;to-text :x:))) )))) (syntax: #export (Codec<JSON,?> :x:) diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index 94bb19089..e3a76fce2 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -4,14 +4,13 @@ [eq #+ Eq] codec ["p" parser "p/" Monad<Parser>]) - (data [text "t/" Eq<Text>] - text/format + (data [text "text/" Eq<Text> Monoid<Text>] (text ["l" lexer]) [number] ["R" result] [product] [maybe "m/" Monad<Maybe>] - [ident "Ident/" Eq<Ident>] + [ident "Ident/" Eq<Ident> Codec<Text,Ident>] (coll [list "L/" Monad<List>] ["d" dict] (tree ["T" rose] @@ -75,7 +74,7 @@ l;alpha) tail (l;some (p;either (l;one-of "_.-") l;alpha-num))] - (wrap (format head tail)))) + (wrap ($_ text/append head tail)))) (def: namespaced-symbol^ (l;Lexer Ident) @@ -119,9 +118,9 @@ spaced^ (p;after (l;this "/")) (l;enclosed ["<" ">"]))] - (p;assert (format "Close tag does not match open tag.\n" - "Expected: " (%ident expected) "\n" - " Actual: " (%ident actual) "\n") + (p;assert ($_ text/append "Close tag does not match open tag.\n" + "Expected: " (Ident/encode expected) "\n" + " Actual: " (Ident/encode actual) "\n") (Ident/= expected actual)))) (def: comment^ @@ -197,14 +196,14 @@ (-> Tag Text) (case namespace "" name - _ (format namespace ":" name))) + _ ($_ text/append namespace ":" name))) (def: (write-attrs attrs) (-> Attrs Text) (|> attrs d;entries (L/map (function [[key value]] - (format (write-tag key) "=" "\""(sanitize-value value) "\""))) + ($_ text/append (write-tag key) "=" "\""(sanitize-value value) "\""))) (text;join-with " "))) (def: xml-header @@ -213,24 +212,24 @@ (def: #export (write input) (-> XML Text) - (format xml-header - (loop [input input] - (case input - (#Text value) - (sanitize-value value) - - (#Node xml-tag xml-attrs xml-children) - (let [tag (write-tag xml-tag) - attrs (if (d;empty? xml-attrs) - "" - (format " " (write-attrs xml-attrs)))] - (if (list;empty? xml-children) - (format "<" tag attrs "/>") - (format "<" tag attrs ">" - (|> xml-children - (L/map recur) - (text;join-with "")) - "</" tag ">"))))))) + ($_ text/append xml-header + (loop [input input] + (case input + (#Text value) + (sanitize-value value) + + (#Node xml-tag xml-attrs xml-children) + (let [tag (write-tag xml-tag) + attrs (if (d;empty? xml-attrs) + "" + ($_ text/append " " (write-attrs xml-attrs)))] + (if (list;empty? xml-children) + ($_ text/append "<" tag attrs "/>") + ($_ text/append "<" tag attrs ">" + (|> xml-children + (L/map recur) + (text;join-with "")) + "</" tag ">"))))))) ## [Structs] (struct: #export _ (Codec Text XML) @@ -241,7 +240,7 @@ (def: (= reference sample) (case [reference sample] [(#Text reference/value) (#Text sample/value)] - (t/= reference/value sample/value) + (text/= reference/value sample/value) [(#Node reference/tag reference/attrs reference/children) (#Node sample/tag sample/attrs sample/children)] diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index 61a8600cb..88ea5ecc0 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -6,7 +6,12 @@ [number] [text] [ident] - (coll [list "L/" Monad<List>])) + (coll [list "L/" Monad<List>]) + (format [xml] + [json])) + (time [instant] + [duration] + [date]) [type] [macro] (macro [code] @@ -32,18 +37,23 @@ (Formatter <type>) <formatter>)] - [%b Bool (:: bool;Codec<Text,Bool> encode)] - [%n Nat (:: number;Codec<Text,Nat> encode)] - [%i Int (:: number;Codec<Text,Int> encode)] - [%d Deg (:: number;Codec<Text,Deg> encode)] - [%r Real (:: number;Codec<Text,Real> encode)] - [%t Text text;encode] - [%ident Ident (:: ident;Codec<Text,Ident> encode)] - [%code Code code;to-text] - [%type Type type;to-text] - [%bin Nat (:: number;Binary@Codec<Text,Nat> encode)] - [%oct Nat (:: number;Octal@Codec<Text,Nat> encode)] - [%hex Nat (:: number;Hex@Codec<Text,Nat> encode)] + [%b Bool (:: bool;Codec<Text,Bool> encode)] + [%n Nat (:: number;Codec<Text,Nat> encode)] + [%i Int (:: number;Codec<Text,Int> encode)] + [%d Deg (:: number;Codec<Text,Deg> encode)] + [%r Real (:: number;Codec<Text,Real> encode)] + [%t Text text;encode] + [%ident Ident (:: ident;Codec<Text,Ident> encode)] + [%code Code code;to-text] + [%type Type type;to-text] + [%bin Nat (:: number;Binary@Codec<Text,Nat> encode)] + [%oct Nat (:: number;Octal@Codec<Text,Nat> encode)] + [%hex Nat (:: number;Hex@Codec<Text,Nat> encode)] + [%xml xml;XML (:: xml;Codec<Text,XML> encode)] + [%json json;JSON (:: json;Codec<Text,JSON> encode)] + [%instant instant;Instant (:: instant;Codec<Text,Instant> encode)] + [%duration duration;Duration (:: duration;Codec<Text,Duration> encode)] + [%date date;Date (:: date;Codec<Text,Date> encode)] ) (def: #export (%list formatter) diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux index f30e09c94..984fc4b09 100644 --- a/stdlib/source/lux/data/text/lexer.lux +++ b/stdlib/source/lux/data/text/lexer.lux @@ -5,8 +5,7 @@ [monad #+ do Monad] codec ["p" parser]) - (data [text "T/" Order<Text>] - text/format + (data [text "text/" Monoid<Text>] [product] [maybe] ["R" result] @@ -27,7 +26,7 @@ (def: (unconsumed-input-error offset tape) (-> Offset Text Text) - (format "Unconsumed input: " (remaining offset tape))) + ($_ text/append "Unconsumed input: " (remaining offset tape))) (def: #export (run input lexer) (All [a] (-> Text (Lexer a) (R;Result a))) @@ -73,7 +72,7 @@ (#R;Success [[(n.+ (text;size reference) offset) tape] []]) _ - (#R;Error (format "Could not match: " (text;encode reference) " @ " tape))))) + (#R;Error ($_ text/append "Could not match: " (text;encode reference) " @ " tape))))) (def: #export (this? reference) {#;doc "Lex a text if it matches the given sample."} @@ -124,14 +123,14 @@ (do p;Monad<Parser> [char any #let [char' (assume (text;nth +0 char))] - _ (p;assert (format "Character is not within range: " (text;from-code bottom) "-" (text;from-code top)) + _ (p;assert ($_ text/append "Character is not within range: " (text;from-code bottom) "-" (text;from-code top)) (and (n.>= bottom char') (n.<= top char')))] (wrap char))) (do-template [<name> <bottom> <top> <desc>] [(def: #export <name> - {#;doc (#;TextA (format "Only lex " <desc> " characters."))} + {#;doc (#;TextA ($_ text/append "Only lex " <desc> " characters."))} (Lexer Text) (range (char <bottom>) (char <top>)))] @@ -168,7 +167,7 @@ (let [output (text;from-code output)] (if (text;contains? output options) (#R;Success [[(n.inc offset) tape] output]) - (#R;Error (format "Character (" output ") is not one of: " options)))) + (#R;Error ($_ text/append "Character (" output ") is not one of: " options)))) _ (#R;Error cannot-lex-error)))) @@ -182,7 +181,7 @@ (let [output (text;from-code output)] (if (;not (text;contains? output options)) (#R;Success [[(n.inc offset) tape] output]) - (#R;Error (format "Character (" output ") is one of: " options)))) + (#R;Error ($_ text/append "Character (" output ") is one of: " options)))) _ (#R;Error cannot-lex-error)))) @@ -195,7 +194,7 @@ (#;Some output) (if (p output) (#R;Success [[(n.inc offset) tape] (text;from-code output)]) - (#R;Error (format "Character does not satisfy predicate: " (text;from-code output)))) + (#R;Error ($_ text/append "Character does not satisfy predicate: " (text;from-code output)))) _ (#R;Error cannot-lex-error)))) @@ -210,7 +209,7 @@ (do p;Monad<Parser> [=left left =right right] - (wrap (format =left =right)))) + (wrap ($_ text/append =left =right)))) (do-template [<name> <base> <doc>] [(def: #export (<name> p) diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index b1031296b..560847afd 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -3,15 +3,14 @@ (lux (control ["M" monad #+ do Monad] [eq] ["p" parser]) - (data [text] - text/format + (data [text "text/" Monoid<Text>] (coll [list "List/" Fold<List> Monad<List>] [dict #+ Dict]) [number] [product] [bool] [maybe] - [ident "Ident/" Eq<Ident>]) + [ident "Ident/" Eq<Ident> Codec<Text,Ident>]) [macro #+ with-gensyms "Lux/" Monad<Lux>] (macro [code] ["s" syntax #+ syntax: Syntax] @@ -37,7 +36,7 @@ (Lux/wrap []) _ - (macro;fail (format "Not " <name> " type: " (%type :type:))))))] + (macro;fail ($_ text/append "Not " <name> " type: " (type;to-text :type:))))))] [void "Void" #;Void] [unit "Unit" #;Unit] @@ -52,7 +51,7 @@ (Lux/wrap []) _ - (macro;fail (format "Not " <name> " type: " (%type :type:))))))] + (macro;fail ($_ text/append "Not " <name> " type: " (type;to-text :type:))))))] [bool "Bool"] [nat "Nat"] @@ -94,7 +93,7 @@ (Lux/wrap [:left: :right:]) _ - (macro;fail (format "Not a " ($Code$ <tag>) " type: " (%type :type:)))))) + (macro;fail ($_ text/append "Not a " ($Code$ <tag>) " type: " (type;to-text :type:)))))) (def: #export <multi> (Matcher (List Type)) @@ -102,7 +101,7 @@ (let [members (<flattener> (type;un-name :type:))] (if (n.> +1 (list;size members)) (Lux/wrap members) - (macro;fail (format "Not a " ($Code$ <tag>) " type: " (%type :type:)))))))] + (macro;fail ($_ text/append "Not a " ($Code$ <tag>) " type: " (type;to-text :type:)))))))] [sum sum+ type;flatten-variant #;Sum] [prod prod+ type;flatten-tuple #;Product] @@ -118,7 +117,7 @@ (wrap [tags :def:])) _ - (macro;fail (format "Unnamed types cannot have tags: " (%type :type:)))))) + (macro;fail ($_ text/append "Unnamed types cannot have tags: " (type;to-text :type:)))))) (def: #export polymorphic (Matcher [(List Code) Type]) @@ -202,7 +201,7 @@ (Lux/wrap :arg:) _ - (macro;fail (format "Not " (%ident name) " type: " (%type :type:)))))) + (macro;fail ($_ text/append "Not " (Ident/encode name) " type: " (type;to-text :type:)))))) (def: #export (apply-2 name) (-> Ident (Matcher [Type Type])) @@ -214,7 +213,7 @@ (Lux/wrap [:arg0: :arg1:]) _ - (macro;fail (format "Not " (%ident name) " type: " (%type :type:)))))) + (macro;fail ($_ text/append "Not " (Ident/encode name) " type: " (type;to-text :type:)))))) (def: #export recursive (Matcher Type) @@ -224,7 +223,7 @@ (Lux/wrap :type:') _ - (macro;fail (format "Not a recursive type: " (%type :type:)))))) + (macro;fail ($_ text/append "Not a recursive type: " (type;to-text :type:)))))) (def: (adjusted-idx env idx) (-> Env Nat Nat) @@ -243,10 +242,10 @@ (Lux/wrap poly-ast) #;None - (macro;fail (format "Unknown bound type: " (%type :type:)))) + (macro;fail ($_ text/append "Unknown bound type: " (type;to-text :type:)))) _ - (macro;fail (format "Not a bound type: " (%type :type:)))))) + (macro;fail ($_ text/append "Not a bound type: " (type;to-text :type:)))))) (def: #export (recursion env) (-> Env (Matcher Code)) @@ -271,7 +270,7 @@ (wrap call) _ - (macro;fail (format "Type is not a recursive instance: " (%type :type:)))) + (macro;fail ($_ text/append "Type is not a recursive instance: " (type;to-text :type:)))) ))) (def: #export (self env) @@ -285,7 +284,7 @@ (Lux/wrap self-call) _ - (macro;fail (format "Type is not a recursive self-call: " (%type :type:)))))) + (macro;fail ($_ text/append "Type is not a recursive self-call: " (type;to-text :type:)))))) (def: #export (var env var-id) (-> Env Nat (Matcher Unit)) @@ -296,7 +295,7 @@ (Lux/wrap []) _ - (macro;fail (format "Not a bound type: " (%type :type:)))))) + (macro;fail ($_ text/append "Not a bound type: " (type;to-text :type:)))))) ## [Syntax] (def: #export (extend-env [funcT funcA] type-vars env) diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index e4e079983..2901d5828 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -8,9 +8,8 @@ [monad #+ do Monad] ["p" parser]) (data [text "text/" Monoid<Text>] - (text ["l" lexer] - format) - [number] + (text ["l" lexer]) + [number "int/" Codec<Text,Int>] ["R" result] (coll [list "L/" Fold<List> Functor<List>] ["v" vector "v/" Functor<Vector> Fold<Vector>])) @@ -30,9 +29,9 @@ (-> Instant Int) (|>. @repr)) - (def: #export (span param subject) + (def: #export (span from to) (-> Instant Instant duration;Duration) - (duration;from-millis (i.- (@repr param) (@repr subject)))) + (duration;from-millis (i.- (@repr from) (@repr to)))) (def: #export (shift duration instant) (-> duration;Duration Instant Instant) @@ -133,8 +132,8 @@ (def: (pad value) (-> Int Text) (if (i.< 10 value) - (text/append "0" (%i value)) - (%i value))) + (text/append "0" (int/encode value)) + (int/encode value))) (def: (adjust-negative space duration) (-> duration;Duration duration;Duration duration;Duration) @@ -145,10 +144,10 @@ (def: (encode-millis millis) (-> Int Text) (cond (i.= 0 millis) "" - (i.< 10 millis) (format ".00" (%i millis)) - (i.< 100 millis) (format ".0" (%i millis)) + (i.< 10 millis) ($_ text/append ".00" (int/encode millis)) + (i.< 100 millis) ($_ text/append ".0" (int/encode millis)) ## (i.< 1_000 millis) - (format "." (%i millis)))) + ($_ text/append "." (int/encode millis)))) (def: seconds-per-day Int (duration;query duration;second duration;day)) (def: days-up-to-epoch Int 719468) @@ -202,13 +201,13 @@ [minutes day-time] [(duration;query duration;minute day-time) (duration;frame duration;minute day-time)] [seconds millis] [(duration;query duration;second day-time) (duration;frame duration;second day-time)] ] - (format (%i year) "-" (pad month) "-" (pad day) "T" - (pad hours) ":" (pad minutes) ":" (pad seconds) - (|> millis - (adjust-negative duration;second) - duration;to-millis - encode-millis) - "Z"))) + ($_ text/append (int/encode year) "-" (pad month) "-" (pad day) "T" + (pad hours) ":" (pad minutes) ":" (pad seconds) + (|> millis + (adjust-negative duration;second) + duration;to-millis + encode-millis) + "Z"))) ## Codec::decode (def: lex-year diff --git a/stdlib/source/lux/type/model.lux b/stdlib/source/lux/type/model.lux index 58b6d2fee..e77a8ac70 100644 --- a/stdlib/source/lux/type/model.lux +++ b/stdlib/source/lux/type/model.lux @@ -3,8 +3,7 @@ (lux (control [applicative] [monad #+ do Monad] ["p" parser "p/" Monad<Parser>]) - (data [text "text/" Eq<Text>] - text/format + (data [text "text/" Eq<Text> Monoid<Text>] ["R" result] (coll [list "L/" Functor<List> Monoid<List>])) [macro #+ Monad<Lux>] @@ -12,8 +11,7 @@ ["s" syntax #+ syntax:] (syntax ["cs" common] (common ["csr" reader] - ["csw" writer]))) - type/auto)) + ["csw" writer]))))) (def: (get k plist) (All [a] @@ -57,7 +55,7 @@ (def: representation-name (-> Text Text) - (|>. (format "{" kind "@" module "}") + (|>. ($_ text/append "{" kind "@" module "}") (let [[module kind] (ident-for #;;Representation)]))) (def: (install-casts' this-module-name name type-vars) @@ -79,7 +77,7 @@ (~ value))))) _ - (macro;fail (format "Wrong syntax for " down-cast))))]))) + (macro;fail ($_ text/append "Wrong syntax for " down-cast))))]))) (update@ #;defs (put up-cast (: Def [Macro macro-anns (function [tokens] @@ -91,7 +89,7 @@ (~ value))))) _ - (macro;fail (format "Wrong syntax for " up-cast))))]))))]] + (macro;fail ($_ text/append "Wrong syntax for " up-cast))))]))))]] (function [compiler] (#R;Success [(update@ #;modules (put this-module-name this-module) compiler) []])))) @@ -120,9 +118,10 @@ (wrap (list))) _ - (macro;fail (format "Cannot temporarily define casting functions (" - down-cast " & " up-cast - ") because definitions like that already exist."))))) + (macro;fail ($_ text/append + "Cannot temporarily define casting functions (" + down-cast " & " up-cast + ") because definitions like that already exist."))))) (syntax: #hidden (un-install-casts) (do Monad<Lux> @@ -136,14 +135,15 @@ (wrap (list))) _ - (macro;fail (format "Cannot un-define casting functions (" - down-cast " & " up-cast - ") because they do not exist."))))) + (macro;fail ($_ text/append + "Cannot un-define casting functions (" + down-cast " & " up-cast + ") because they do not exist."))))) (def: declaration (s;Syntax [Text (List Text)]) (p;either (s;form (p;seq s;local-symbol (p;some s;local-symbol))) - (p;seq s;local-symbol (::: wrap (list))))) + (p;seq s;local-symbol (:: p;Monad<Parser> wrap (list))))) (syntax: #export (model: [export csr;export] [[name type-vars] declaration] diff --git a/stdlib/test/test/lux/time/instant.lux b/stdlib/test/test/lux/time/instant.lux index 40ab587d7..2343beac1 100644 --- a/stdlib/test/test/lux/time/instant.lux +++ b/stdlib/test/test/lux/time/instant.lux @@ -15,7 +15,7 @@ (def: boundary Int 99_999_999_999_999) -(def: instant +(def: #export instant (r;Random @;Instant) (|> r;int (:: r;Monad<Random> map (|>. (i.% boundary) @;from-millis)))) |