aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2017-07-31 20:34:12 -0400
committerEduardo Julian2017-07-31 20:34:12 -0400
commit27466e65e78af24f8e750549055123d6c8559839 (patch)
tree6cd273e3ade1999cdec22dd6eb183be11114912f /stdlib
parent8ddeafb14fdb4511f2d0632801f18699cfcaf3ea (diff)
- Added formatters for JSON, XML and time types.
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/data/coll/dict.lux1
-rw-r--r--stdlib/source/lux/data/format/json.lux87
-rw-r--r--stdlib/source/lux/data/format/xml.lux55
-rw-r--r--stdlib/source/lux/data/text/format.lux36
-rw-r--r--stdlib/source/lux/data/text/lexer.lux19
-rw-r--r--stdlib/source/lux/macro/poly.lux31
-rw-r--r--stdlib/source/lux/time/instant.lux33
-rw-r--r--stdlib/source/lux/type/model.lux28
-rw-r--r--stdlib/test/test/lux/time/instant.lux2
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))))