aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--stdlib/source/lux.lux6
-rw-r--r--stdlib/source/lux/cli.lux12
-rw-r--r--stdlib/source/lux/concurrency/task.lux60
-rw-r--r--stdlib/source/lux/data/collection/dictionary.lux13
-rw-r--r--stdlib/source/lux/data/format/json.lux264
-rw-r--r--stdlib/source/lux/data/text/format.lux2
-rw-r--r--stdlib/source/lux/data/text/lexer.lux20
7 files changed, 201 insertions, 176 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 1fb0afe19..fafecd7ad 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -471,7 +471,7 @@
#Nil)))
(record$ #Nil))
-("lux def" default-def-meta-unexported
+("lux def" default-def-meta-private
("lux check" (#Apply (#Product Code Code) List)
(#Cons [(tag$ ["lux" "type?"])
(bit$ #1)]
@@ -540,7 +540,7 @@
("lux def" Code-List
(#Apply Code List)
- (record$ default-def-meta-unexported))
+ (record$ default-def-meta-private))
## (type: (Either l r)
## (#Left l)
@@ -1626,7 +1626,7 @@
(def:''' Monad
(list& [(tag$ ["lux" "tags"])
(tuple$ (list (text$ "wrap") (text$ "bind")))]
- default-def-meta-unexported)
+ default-def-meta-private)
Type
(#Named ["lux" "Monad"]
(All [m]
diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux
index 07e79d86f..043519111 100644
--- a/stdlib/source/lux/cli.lux
+++ b/stdlib/source/lux/cli.lux
@@ -96,9 +96,15 @@
#.Nil (#E.Success [inputs []])
_ (#E.Error (format "Unknown parameters: " (text.join-with " " inputs))))))
-(def: #export (parameter [short long])
- (-> [Text Text] (CLI Text))
- (|> ..any
+(def: #export (named name value)
+ (All [a] (-> Text (CLI a) (CLI a)))
+ (|> value
+ (p.after (..this name))
+ ..somewhere))
+
+(def: #export (parameter [short long] value)
+ (All [a] (-> [Text Text] (CLI a) (CLI a)))
+ (|> value
(p.after (p.either (..this short) (..this long)))
..somewhere))
diff --git a/stdlib/source/lux/concurrency/task.lux b/stdlib/source/lux/concurrency/task.lux
index f3043ce9b..c03ab7647 100644
--- a/stdlib/source/lux/concurrency/task.lux
+++ b/stdlib/source/lux/concurrency/task.lux
@@ -1,55 +1,57 @@
(.module:
[lux #*
- [data ["E" error]]
[control
- ["F" functor]
- ["A" apply]
- monad
+ [functor (#+ Functor)]
+ [apply (#+ Apply)]
+ [monad (#+ Monad do)]
["ex" exception (#+ Exception)]]
- [concurrency ["P" promise]]
- ["." macro ["s" syntax (#+ syntax: Syntax)]]
- ])
+ [data
+ ["." error (#+ Error)]]
+ ["." macro
+ ["s" syntax (#+ syntax: Syntax)]]]
+ [//
+ ["." promise (#+ Promise)]])
(type: #export (Task a)
- (P.Promise (E.Error a)))
+ (Promise (Error a)))
(def: #export (fail error)
(All [a] (-> Text (Task a)))
- (:: P.Monad<Promise> wrap (#E.Error error)))
+ (:: promise.Monad<Promise> wrap (#error.Error error)))
(def: #export (throw exception message)
(All [e a] (-> (Exception e) e (Task a)))
- (:: P.Monad<Promise> wrap
+ (:: promise.Monad<Promise> wrap
(ex.throw exception message)))
(def: #export (return value)
(All [a] (-> a (Task a)))
- (:: P.Monad<Promise> wrap (#E.Success value)))
+ (:: promise.Monad<Promise> wrap (#error.Success value)))
(def: #export (try computation)
- (All [a] (-> (Task a) (Task (E.Error a))))
- (:: P.Functor<Promise> map (|>> #E.Success) computation))
+ (All [a] (-> (Task a) (Task (Error a))))
+ (:: promise.Functor<Promise> map (|>> #error.Success) computation))
-(structure: #export _ (F.Functor Task)
+(structure: #export _ (Functor Task)
(def: (map f fa)
- (:: P.Functor<Promise> map
+ (:: promise.Functor<Promise> map
(function (_ fa')
(case fa'
- (#E.Error error)
- (#E.Error error)
+ (#error.Error error)
+ (#error.Error error)
- (#E.Success a)
- (#E.Success (f a))))
+ (#error.Success a)
+ (#error.Success (f a))))
fa)))
-(structure: #export _ (A.Apply Task)
+(structure: #export _ (Apply Task)
(def: functor Functor<Task>)
(def: (apply ff fa)
- (do P.Monad<Promise>
+ (do promise.Monad<Promise>
[ff' ff
fa' fa]
- (wrap (do E.Monad<Error>
+ (wrap (do error.Monad<Error>
[f ff'
a fa']
(wrap (f a)))))))
@@ -60,21 +62,21 @@
(def: wrap return)
(def: (join mma)
- (do P.Monad<Promise>
+ (do promise.Monad<Promise>
[mma' mma]
(case mma'
- (#E.Error error)
- (wrap (#E.Error error))
+ (#error.Error error)
+ (wrap (#error.Error error))
- (#E.Success ma)
+ (#error.Success ma)
ma))))
(syntax: #export (task {type s.any})
{#.doc (doc "Makes an uninitialized Task (in this example, of Any)."
(task Any))}
(wrap (list (` (: (..Task (~ type))
- (P.promise #.None))))))
+ (promise.promise #.None))))))
(def: #export (from-promise promise)
- (All [a] (-> (P.Promise a) (Task a)))
- (:: P.Functor<Promise> map (|>> #E.Success) promise))
+ (All [a] (-> (Promise a) (Task a)))
+ (:: promise.Functor<Promise> map (|>> #error.Success) promise))
diff --git a/stdlib/source/lux/data/collection/dictionary.lux b/stdlib/source/lux/data/collection/dictionary.lux
index 503ea312d..b0f0920fb 100644
--- a/stdlib/source/lux/data/collection/dictionary.lux
+++ b/stdlib/source/lux/data/collection/dictionary.lux
@@ -569,12 +569,12 @@
#.None #0
(#.Some _) #1))
-(def: #export (put~ key val dict)
+(def: #export (try-put key val dict)
{#.doc "Only puts the KV-pair if the key is not already present."}
(All [k v] (-> k v (Dictionary k v) (Dictionary k v)))
- (if (contains? key dict)
- dict
- (put key val dict)))
+ (case (get key dict)
+ #.None (put key val dict)
+ (#.Some _) dict))
(def: #export (update key f dict)
{#.doc "Transforms the value located at key (if available), using the given function."}
@@ -586,8 +586,9 @@
(#.Some val)
(put key (f val) dict)))
-(def: #export (update~ key default f dict)
- {#.doc "Transforms the value located at key (if available), using the given function."}
+(def: #export (upsert key default f dict)
+ {#.doc (doc "Updates the value at the key; if it exists."
+ "Otherwise, puts a value by applying the function to a default.")}
(All [k v] (-> k v (-> v v) (Dictionary k v) (Dictionary k v)))
(put key
(f (maybe.default default
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index 20f059503..63075804e 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -5,11 +5,12 @@
["." monad (#+ do Monad)]
[equivalence (#+ Equivalence)]
codec
- ["p" parser ("parser/." Monad<Parser>)]]
+ ["p" parser ("parser/." Monad<Parser>)]
+ ["ex" exception (#+ exception:)]]
[data
["." bit]
["." maybe]
- ["e" error]
+ ["." error (#+ Error)]
["." sum]
["." product]
["." number ("frac/." Codec<Text,Frac>) ("nat/." Codec<Text,Nat>)]
@@ -18,7 +19,7 @@
[collection
["." list ("list/." Fold<List> Monad<List>)]
["." row (#+ Row row) ("row/." Monad<Row>)]
- ["dict" dictionary (#+ Dictionary)]]]
+ ["." dictionary (#+ Dictionary)]]]
["." macro (#+ Monad<Meta> with-gensyms)
["s" syntax (#+ syntax:)]
["." code]]])
@@ -87,7 +88,7 @@
_
(macro.fail "Wrong syntax for JSON object.")))
pairs)]
- (wrap (list (` (: JSON (#Object (dict.from-list text.Hash<Text> (list (~+ pairs')))))))))
+ (wrap (list (` (: JSON (#Object (dictionary.from-list text.Hash<Text> (list (~+ pairs')))))))))
_
(wrap (list token))
@@ -95,52 +96,52 @@
(def: #export (get-fields json)
{#.doc "Get all the fields in a JSON object."}
- (-> JSON (e.Error (List String)))
+ (-> JSON (Error (List String)))
(case json
(#Object obj)
- (#e.Success (dict.keys obj))
+ (#error.Success (dictionary.keys obj))
_
- (#e.Error ($_ text/compose "Cannot get the fields of a non-object."))))
+ (#error.Error ($_ text/compose "Cannot get the fields of a non-object."))))
(def: #export (get key json)
{#.doc "A JSON object field getter."}
- (-> String JSON (e.Error JSON))
+ (-> String JSON (Error JSON))
(case json
(#Object obj)
- (case (dict.get key obj)
+ (case (dictionary.get key obj)
(#.Some value)
- (#e.Success value)
+ (#error.Success value)
#.None
- (#e.Error ($_ text/compose "Missing field '" key "' on object.")))
+ (#error.Error ($_ text/compose "Missing field '" key "' on object.")))
_
- (#e.Error ($_ text/compose "Cannot get field '" key "' of a non-object."))))
+ (#error.Error ($_ text/compose "Cannot get field '" key "' of a non-object."))))
(def: #export (set key value json)
{#.doc "A JSON object field setter."}
- (-> String JSON JSON (e.Error JSON))
+ (-> String JSON JSON (Error JSON))
(case json
(#Object obj)
- (#e.Success (#Object (dict.put key value obj)))
+ (#error.Success (#Object (dictionary.put key value obj)))
_
- (#e.Error ($_ text/compose "Cannot set field '" key "' of a non-object."))))
+ (#error.Error ($_ text/compose "Cannot set field '" key "' of a non-object."))))
(do-template [<name> <tag> <type> <desc>]
[(def: #export (<name> key json)
{#.doc (code.text ($_ text/compose "A JSON object field getter for " <desc> "."))}
- (-> Text JSON (e.Error <type>))
+ (-> Text JSON (Error <type>))
(case (get key json)
- (#e.Success (<tag> value))
- (#e.Success value)
+ (#error.Success (<tag> value))
+ (#error.Success value)
- (#e.Success _)
- (#e.Error ($_ text/compose "Wrong value type at key: " key))
+ (#error.Success _)
+ (#error.Error ($_ text/compose "Wrong value type at key: " key))
- (#e.Error error)
- (#e.Error error)))]
+ (#error.Error error)
+ (#error.Error error)))]
[get-boolean #Boolean Boolean "booleans"]
[get-number #Number Number "numbers"]
@@ -175,14 +176,14 @@
(list.indices (row.size xs))))
[(#Object xs) (#Object ys)]
- (and (n/= (dict.size xs) (dict.size ys))
+ (and (n/= (dictionary.size xs) (dictionary.size ys))
(list/fold (function (_ [xk xv] prev)
(and prev
- (case (dict.get xk ys)
+ (case (dictionary.get xk ys)
#.None #0
(#.Some yv) (= xv yv))))
#1
- (dict.entries xs)))
+ (dictionary.entries xs)))
_
#0)))
@@ -191,26 +192,79 @@
############################################################
############################################################
-(def: unconsumed-input-error Text "Unconsumed JSON.")
+(def: (encode-boolean value)
+ (-> Bit Text)
+ (case value
+ #0 "false"
+ #1 "true"))
+
+(def: (show-null _) (-> Null Text) "null")
+(do-template [<name> <type> <codec>]
+ [(def: <name> (-> <type> Text) <codec>)]
+
+ [show-boolean Boolean encode-boolean]
+ [show-number Number (:: number.Codec<Text,Frac> encode)]
+ [show-string String text.encode])
+
+(def: (show-array show-json elems)
+ (-> (-> JSON Text) (-> Array Text))
+ ($_ text/compose "["
+ (|> elems (row/map show-json) row.to-list (text.join-with ","))
+ "]"))
+
+(def: (show-object show-json object)
+ (-> (-> JSON Text) (-> Object Text))
+ ($_ text/compose "{"
+ (|> object
+ dictionary.entries
+ (list/map (function (_ [key value]) ($_ text/compose (show-string key) ":" (show-json value))))
+ (text.join-with ","))
+ "}"))
+
+(def: (show-json json)
+ (-> JSON Text)
+ (case json
+ (^template [<tag> <show>]
+ (<tag> value)
+ (<show> value))
+ ([#Null show-null]
+ [#Boolean show-boolean]
+ [#Number show-number]
+ [#String show-string]
+ [#Array (show-array show-json)]
+ [#Object (show-object show-json)])
+ ))
+
+############################################################
+############################################################
+############################################################
+
+(exception: #export (unconsumed-input {input (List JSON)})
+ (|> input
+ (list/map show-json)
+ (text.join-with text.new-line)))
+
+(exception: #export (empty-input)
+ "")
(def: #export (run json parser)
- (All [a] (-> JSON (Reader a) (e.Error a)))
+ (All [a] (-> JSON (Reader a) (Error a)))
(case (p.run (list json) parser)
- (#e.Success [remainder output])
+ (#error.Success [remainder output])
(case remainder
#.Nil
- (#e.Success output)
+ (#error.Success output)
_
- (#e.Error unconsumed-input-error))
+ (ex.throw unconsumed-input remainder))
- (#e.Error error)
- (#e.Error error)))
+ (#error.Error error)
+ (#error.Error error)))
(def: #export (fail error)
(All [a] (-> Text (Reader a)))
(function (_ inputs)
- (#e.Error error)))
+ (#error.Error error)))
(def: #export any
{#.doc "Just returns the JSON input without applying any logic."}
@@ -218,10 +272,10 @@
(<| (function (_ inputs))
(case inputs
#.Nil
- (#e.Error "Empty JSON stream.")
+ (ex.throw empty-input [])
(#.Cons head tail)
- (#e.Success [tail head]))))
+ (#error.Success [tail head]))))
(do-template [<name> <type> <tag> <desc>]
[(def: #export <name>
@@ -242,12 +296,6 @@
[string Text #String "string"]
)
-(def: (encode-boolean value)
- (-> Bit Text)
- (if value
- "true"
- "false"))
-
(do-template [<test> <check> <type> <eq> <encoder> <tag> <desc> <pre>]
[(def: #export (<test> test)
{#.doc (code.text ($_ text/compose "Asks whether a JSON value is a " <desc> "."))}
@@ -271,7 +319,7 @@
(let [value (<pre> value)]
(if (:: <eq> = test value)
(wrap [])
- (fail ($_ text/compose "Value mismatch: " (<encoder> test) "=/=" (<encoder> value)))))
+ (fail ($_ text/compose "Value mismatch: " (<encoder> test) " =/= " (<encoder> value)))))
_
(fail ($_ text/compose "JSON value is not a " <desc> ".")))))]
@@ -287,117 +335,85 @@
parser))
(def: #export (array parser)
- {#.doc "Parses a JSON array, assuming that every element can be parsed the same way."}
+ {#.doc "Parses a JSON array."}
(All [a] (-> (Reader a) (Reader a)))
(do p.Monad<Parser>
[head any]
(case head
(#Array values)
(case (p.run (row.to-list values) parser)
- (#e.Error error)
+ (#error.Error error)
(fail error)
- (#e.Success [remainder output])
+ (#error.Success [remainder output])
(case remainder
#.Nil
(wrap output)
_
- (fail unconsumed-input-error)))
+ (fail (ex.construct unconsumed-input remainder))))
_
- (fail "JSON value is not an array."))))
+ (fail (text/compose "JSON value is not an array: " (show-json head))))))
(def: #export (object parser)
- {#.doc "Parses a JSON object, assuming that every element can be parsed the same way."}
- (All [a] (-> (Reader a) (Reader (Dictionary Text a))))
+ {#.doc "Parses a JSON object. Use this with the 'field' combinator."}
+ (All [a] (-> (Reader a) (Reader a)))
(do p.Monad<Parser>
[head any]
(case head
- (#Object object)
- (case (do e.Monad<Error>
- []
- (|> (dict.entries object)
- (monad.map @ (function (_ [key val])
- (do @
- [val (run val parser)]
- (wrap [key val]))))
- (:: @ map (dict.from-list text.Hash<Text>))))
- (#e.Success table)
- (wrap table)
-
- (#e.Error error)
- (fail error))
+ (#Object kvs)
+ (case (p.run (|> kvs
+ dictionary.entries
+ (list/map (function (_ [key value])
+ (list (#String key) value)))
+ list.concat)
+ parser)
+ (#error.Error error)
+ (fail error)
+
+ (#error.Success [remainder output])
+ (case remainder
+ #.Nil
+ (wrap output)
+ _
+ (fail (ex.construct unconsumed-input remainder))))
+
_
- (fail "JSON value is not an array."))))
+ (fail (text/compose "JSON value is not an object: " (show-json head))))))
(def: #export (field field-name parser)
- {#.doc "Parses a field inside a JSON object."}
+ {#.doc "Parses a field inside a JSON object. Use this inside the 'object' combinator."}
(All [a] (-> Text (Reader a) (Reader a)))
- (do p.Monad<Parser>
- [head any]
- (case head
- (#Object object)
- (case (dict.get field-name object)
- (#.Some value)
- (case (run value parser)
- (#e.Success output)
- (function (_ tail)
- (#e.Success [(#.Cons (#Object (dict.remove field-name object))
- tail)
- output]))
-
- (#e.Error error)
- (fail error))
-
- _
- (fail ($_ text/compose "JSON object does not have field '" field-name "'.")))
+ (function (recur inputs)
+ (case inputs
+ (^ (list& (#String key) value inputs'))
+ (if (text/= key field-name)
+ (case (p.run (list value) parser)
+ (#error.Success [#.Nil output])
+ (#error.Success [inputs' output])
+
+ (#error.Success [inputs'' _])
+ (ex.throw unconsumed-input inputs'')
+
+ (#error.Error error)
+ (#error.Error error))
+ (do error.Monad<Error>
+ [[inputs'' output] (recur inputs')]
+ (wrap [(list& (#String key) value inputs'')
+ output])))
+
+ #.Nil
+ (ex.throw empty-input [])
_
- (fail "JSON value is not an object."))))
+ (ex.throw unconsumed-input inputs))))
############################################################
############################################################
############################################################
-(def: (show-null _) (-> Null Text) "null")
-(do-template [<name> <type> <codec>]
- [(def: <name> (-> <type> Text) <codec>)]
-
- [show-boolean Boolean encode-boolean]
- [show-number Number (:: number.Codec<Text,Frac> encode)]
- [show-string String text.encode])
-
-(def: (show-array show-json elems)
- (-> (-> JSON Text) (-> Array Text))
- ($_ text/compose "["
- (|> elems (row/map show-json) row.to-list (text.join-with ","))
- "]"))
-
-(def: (show-object show-json object)
- (-> (-> JSON Text) (-> Object Text))
- ($_ text/compose "{"
- (|> object
- dict.entries
- (list/map (function (_ [key value]) ($_ text/compose (show-string key) ":" (show-json value))))
- (text.join-with ","))
- "}"))
-
-(def: (show-json json)
- (-> JSON Text)
- (case json
- (^template [<tag> <show>]
- (<tag> value)
- (<show> value))
- ([#Null show-null]
- [#Boolean show-boolean]
- [#Number show-number]
- [#String show-string]
- [#Array (show-array show-json)]
- [#Object (show-object show-json)])
- ))
-
(def: space~
(l.Lexer Text)
(l.some l.space))
@@ -443,10 +459,10 @@
offset (l.many l.decimal)]
(wrap ($_ text/compose mark (if signed?' "-" "") offset))))]
(case (frac/decode ($_ text/compose (if signed? "-" "") digits "." decimals exp))
- (#e.Error message)
+ (#error.Error message)
(p.fail message)
- (#e.Success value)
+ (#error.Success value)
(wrap value))))
(def: escaped~
@@ -503,7 +519,7 @@
(wrap (<prep> elems))))]
[array~ Array "[" "]" (json~ []) row.from-list]
- [object~ Object "{" "}" (kv~ json~) (dict.from-list text.Hash<Text>)]
+ [object~ Object "{" "}" (kv~ json~) (dictionary.from-list text.Hash<Text>)]
)
(def: (json~' _)
diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux
index 02c3eaae2..ad0653e76 100644
--- a/stdlib/source/lux/data/text/format.lux
+++ b/stdlib/source/lux/data/text/format.lux
@@ -15,7 +15,6 @@
[list ("list/." Monad<List>)]]]
[time
["." instant]
- ["." duration]
["." date]]
[math
["." modular]]
@@ -55,7 +54,6 @@
[%xml xml.XML (:: xml.Codec<Text,XML> encode)]
[%json json.JSON (:: json.Codec<Text,JSON> encode)]
[%instant instant.Instant instant.to-text]
- [%duration duration.Duration (:: duration.Codec<Text,Duration> encode)]
[%date date.Date (:: date.Codec<Text,Date> encode)]
)
diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux
index 21aba8360..45a88bdf3 100644
--- a/stdlib/source/lux/data/text/lexer.lux
+++ b/stdlib/source/lux/data/text/lexer.lux
@@ -2,11 +2,13 @@
[lux (#- or and not)
[control
[monad (#+ do Monad)]
- ["p" parser]]
+ ["p" parser]
+ ["ex" exception (#+ exception:)]]
[data
["." product]
["." maybe]
["e" error]
+ [number ("nat/." Codec<Text,Nat>)]
[collection
["." list ("list/." Fold<List>)]]]
[macro
@@ -24,15 +26,16 @@
{#basis Offset
#distance Offset})
+(def: cannot-lex-error Text "Cannot lex from empty text.")
+
(def: (remaining offset tape)
(-> Offset Text Text)
(|> tape (//.split offset) maybe.assume product.right))
-(def: cannot-lex-error Text "Cannot lex from empty text.")
-
-(def: (unconsumed-input-error offset tape)
- (-> Offset Text Text)
- ($_ text/compose "Unconsumed input: " (remaining offset tape)))
+(exception: #export (unconsumed-input {offset Offset} {tape Text})
+ (ex.report ["Offset" (nat/encode offset)]
+ ["Input size" (nat/encode (//.size tape))]
+ ["Remaining input" (remaining offset tape)]))
(def: #export (run input lexer)
(All [a] (-> Text (Lexer a) (e.Error a)))
@@ -43,8 +46,7 @@
(#e.Success [[end-offset _] output])
(if (n/= end-offset (//.size input))
(#e.Success output)
- (#e.Error (unconsumed-input-error end-offset input)))
- ))
+ (ex.throw unconsumed-input [end-offset input]))))
(def: #export offset
(Lexer Offset)
@@ -130,7 +132,7 @@
(function (_ (^@ input [offset tape]))
(if (n/= offset (//.size tape))
(#e.Success [input []])
- (#e.Error (unconsumed-input-error offset tape)))))
+ (ex.throw unconsumed-input [offset tape]))))
(def: #export end?
{#.doc "Ask if the lexer's input is empty."}
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 11:26:30 +0000