aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/poly
diff options
context:
space:
mode:
authorEduardo Julian2022-06-12 02:29:28 -0400
committerEduardo Julian2022-06-12 02:29:28 -0400
commit9c21fd1f33eb52fb971d493ad21a67036d68b841 (patch)
tree525d0f841edfa94645317ac905cb69c8a7983a5c /stdlib/source/poly
parentb48ea68a83d01903554c7696c77eedaaf1035680 (diff)
Re-named the "poly" hierarchy to "polytypic".
Diffstat (limited to 'stdlib/source/poly')
-rw-r--r--stdlib/source/poly/lux/abstract/equivalence.lux167
-rw-r--r--stdlib/source/poly/lux/abstract/functor.lux110
-rw-r--r--stdlib/source/poly/lux/data/format/json.lux335
3 files changed, 0 insertions, 612 deletions
diff --git a/stdlib/source/poly/lux/abstract/equivalence.lux b/stdlib/source/poly/lux/abstract/equivalence.lux
deleted file mode 100644
index 1e882e32d..000000000
--- a/stdlib/source/poly/lux/abstract/equivalence.lux
+++ /dev/null
@@ -1,167 +0,0 @@
-(.using
- [library
- [lux (.except)
- [abstract
- [monad (.only Monad do)]]
- [control
- ["[0]" maybe]
- ["<>" parser (.only)
- ["<[0]>" type]]]
- [data
- ["[0]" product]
- ["[0]" bit]
- ["[0]" text (.open: "[1]#[0]" monoid)
- ["%" format (.only format)]]
- [collection
- ["[0]" list (.open: "[1]#[0]" monad)]
- ["[0]" sequence]
- ["[0]" array]
- ["[0]" queue]
- ["[0]" set]
- ["[0]" dictionary (.only Dictionary)]
- ["[0]" tree]]]
- [macro
- ["[0]" code]]
- [math
- [number
- ["[0]" nat (.open: "[1]#[0]" decimal)]
- ["[0]" int]
- ["[0]" rev]
- ["[0]" frac]]]
- [time
- ["[0]" duration]
- ["[0]" date]
- ["[0]" instant]
- ["[0]" day]
- ["[0]" month]]
- ["[0]" type (.only)
- ["[0]" poly (.only poly:)]
- ["[0]" unit]]]]
- [\\library
- ["[0]" /]])
-
-(poly: .public equivalence
- (`` (do [! <>.monad]
- [.let [g!_ (code.local "_____________")]
- *env* <type>.env
- inputT <type>.next
- .let [@Equivalence (is (-> Type Code)
- (function (_ type)
- (` ((~! /.Equivalence) (~ (poly.code *env* type))))))]]
- (all <>.either
- ... Basic types
- (~~ (with_template [<matcher> <eq>]
- [(do !
- [_ <matcher>]
- (in (` (is (~ (@Equivalence inputT))
- <eq>))))]
-
- [(<type>.exactly Any) (function ((~ g!_) (~ g!_) (~ g!_)) #1)]
- [(<type>.sub Bit) (~! bit.equivalence)]
- [(<type>.sub Nat) (~! nat.equivalence)]
- [(<type>.sub Int) (~! int.equivalence)]
- [(<type>.sub Rev) (~! rev.equivalence)]
- [(<type>.sub Frac) (~! frac.equivalence)]
- [(<type>.sub Text) (~! text.equivalence)]))
- ... Composite types
- (~~ (with_template [<name> <eq>]
- [(do !
- [[_ argC] (<type>.applied (<>.and (<type>.exactly <name>)
- equivalence))]
- (in (` (is (~ (@Equivalence inputT))
- (<eq> (~ argC))))))]
-
- [.Maybe (~! maybe.equivalence)]
- [.List (~! list.equivalence)]
- [sequence.Sequence (~! sequence.equivalence)]
- [array.Array (~! array.equivalence)]
- [queue.Queue (~! queue.equivalence)]
- [set.Set (~! set.equivalence)]
- [tree.Tree (~! tree.equivalence)]
- ))
- (do !
- [[_ _ valC] (<type>.applied (all <>.and
- (<type>.exactly dictionary.Dictionary)
- <type>.any
- equivalence))]
- (in (` (is (~ (@Equivalence inputT))
- ((~! dictionary.equivalence) (~ valC))))))
- ... Models
- (~~ (with_template [<type> <eq>]
- [(do !
- [_ (<type>.exactly <type>)]
- (in (` (is (~ (@Equivalence inputT))
- <eq>))))]
-
- [duration.Duration duration.equivalence]
- [instant.Instant instant.equivalence]
- [date.Date date.equivalence]
- [day.Day day.equivalence]
- [month.Month month.equivalence]
- ))
- (do !
- [_ (<type>.applied (<>.and (<type>.exactly unit.Qty)
- <type>.any))]
- (in (` (is (~ (@Equivalence inputT))
- unit.equivalence))))
- ... Variants
- (do !
- [members (<type>.variant (<>.many equivalence))
- .let [last (-- (list.size members))
- g!_ (code.local "_____________")
- g!left (code.local "_____________left")
- g!right (code.local "_____________right")]]
- (in (` (is (~ (@Equivalence inputT))
- (function ((~ g!_) (~ g!left) (~ g!right))
- (case [(~ g!left) (~ g!right)]
- (~+ (list#conjoint (list#each (function (_ [tag g!eq])
- (if (nat.= last tag)
- (list (` [{(~ (code.nat (-- tag))) #1 (~ g!left)}
- {(~ (code.nat (-- tag))) #1 (~ g!right)}])
- (` ((~ g!eq) (~ g!left) (~ g!right))))
- (list (` [{(~ (code.nat tag)) #0 (~ g!left)}
- {(~ (code.nat tag)) #0 (~ g!right)}])
- (` ((~ g!eq) (~ g!left) (~ g!right))))))
- (list.enumeration members))))
- (~ g!_)
- #0))))))
- ... Tuples
- (do !
- [g!eqs (<type>.tuple (<>.many equivalence))
- .let [g!_ (code.local "_____________")
- indices (list.indices (list.size g!eqs))
- g!lefts (list#each (|>> nat#encoded (text#composite "left") code.local) indices)
- g!rights (list#each (|>> nat#encoded (text#composite "right") code.local) indices)]]
- (in (` (is (~ (@Equivalence inputT))
- (function ((~ g!_) [(~+ g!lefts)] [(~+ g!rights)])
- (and (~+ (|> (list.zipped_3 g!eqs g!lefts g!rights)
- (list#each (function (_ [g!eq g!left g!right])
- (` ((~ g!eq) (~ g!left) (~ g!right)))))))))))))
- ... Type recursion
- (do !
- [[g!self bodyC] (<type>.recursive equivalence)
- .let [g!_ (code.local "_____________")]]
- (in (` (is (~ (@Equivalence inputT))
- ((~! /.rec) (.function ((~ g!_) (~ g!self))
- (~ bodyC)))))))
- <type>.recursive_self
- ... Type applications
- (do !
- [[funcC argsC] (<type>.applied (<>.and equivalence (<>.many equivalence)))]
- (in (` ((~ funcC) (~+ argsC)))))
- ... Parameters
- <type>.parameter
- ... Polymorphism
- (do !
- [[funcC varsC bodyC] (<type>.polymorphic equivalence)]
- (in (` (is (All ((~ g!_) (~+ varsC))
- (-> (~+ (list#each (|>> (~) ((~! /.Equivalence)) (`)) varsC))
- ((~! /.Equivalence) ((~ (poly.code *env* inputT)) (~+ varsC)))))
- (function ((~ funcC) (~+ varsC))
- (~ bodyC))))))
- <type>.recursive_call
- ... If all else fails...
- (|> <type>.any
- (at ! each (|>> %.type (format "Cannot create Equivalence for: ") <>.failure))
- (at ! conjoint))
- ))))
diff --git a/stdlib/source/poly/lux/abstract/functor.lux b/stdlib/source/poly/lux/abstract/functor.lux
deleted file mode 100644
index 310c3ff9a..000000000
--- a/stdlib/source/poly/lux/abstract/functor.lux
+++ /dev/null
@@ -1,110 +0,0 @@
-(.using
- [library
- [lux (.except)
- [abstract
- [monad (.only Monad do)]]
- [control
- ["p" parser (.only)
- ["<[0]>" type]
- ["s" code (.only Parser)]]]
- [data
- ["[0]" product]
- ["[0]" text (.only)
- ["%" format (.only format)]]
- [collection
- ["[0]" list (.open: "[1]#[0]" monad monoid)]]]
- [macro
- ["[0]" code]]
- [math
- [number
- ["n" nat]]]
- ["[0]" type (.only)
- ["[0]" poly (.only poly:)]]]]
- [\\library
- ["[0]" /]])
-
-(poly: .public functor
- (do [! p.monad]
- [.let [g!_ (code.local "____________")
- type_funcC (code.local "____________type_funcC")
- funcC (code.local "____________funcC")
- inputC (code.local "____________inputC")]
- *env* <type>.env
- inputT <type>.next
- [polyC varsC non_functorT] (<type>.local (list inputT)
- (<type>.polymorphic <type>.any))
- .let [num_vars (list.size varsC)]
- .let [@Functor (is (-> Type Code)
- (function (_ unwrappedT)
- (if (n.= 1 num_vars)
- (` ((~! /.Functor) (~ (poly.code *env* unwrappedT))))
- (let [paramsC (|> num_vars -- list.indices (list#each (|>> %.nat code.local)))]
- (` (All ((~ g!_) (~+ paramsC))
- ((~! /.Functor) ((~ (poly.code *env* unwrappedT)) (~+ paramsC)))))))))
- Arg<?> (is (-> Code (<type>.Parser Code))
- (function (Arg<?> valueC)
- (all p.either
- ... Type-var
- (do p.monad
- [.let [varI (|> num_vars (n.* 2) --)]
- _ (<type>.this_parameter varI)]
- (in (` ((~ funcC) (~ valueC)))))
- ... Variants
- (do !
- [_ (in [])
- membersC (<type>.variant (p.many (Arg<?> valueC)))
- .let [last (-- (list.size membersC))]]
- (in (` (case (~ valueC)
- (~+ (list#conjoint (list#each (function (_ [tag memberC])
- (if (n.= last tag)
- (list (` {(~ (code.nat (-- tag))) #1 (~ valueC)})
- (` {(~ (code.nat (-- tag))) #1 (~ memberC)}))
- (list (` {(~ (code.nat tag)) #0 (~ valueC)})
- (` {(~ (code.nat tag)) #0 (~ memberC)}))))
- (list.enumeration membersC))))))))
- ... Tuples
- (do p.monad
- [pairsCC (is (<type>.Parser (List [Code Code]))
- (<type>.tuple (loop (again [idx 0
- pairsCC (is (List [Code Code])
- (list))])
- (p.either (let [slotC (|> idx %.nat (format "____________slot") code.local)]
- (do !
- [_ (in [])
- memberC (Arg<?> slotC)]
- (again (++ idx)
- (list#composite pairsCC (list [slotC memberC])))))
- (in pairsCC)))))]
- (in (` (case (~ valueC)
- [(~+ (list#each product.left pairsCC))]
- [(~+ (list#each product.right pairsCC))]))))
- ... Functions
- (do !
- [_ (in [])
- .let [g! (code.local "____________")
- outL (code.local "____________outL")]
- [inT+ outC] (<type>.function (p.many <type>.any)
- (Arg<?> outL))
- .let [inC+ (|> (list.size inT+)
- list.indices
- (list#each (|>> %.nat (format "____________inC") code.local)))]]
- (in (` (function ((~ g!) (~+ inC+))
- (let [(~ outL) ((~ valueC) (~+ inC+))]
- (~ outC))))))
- ... Recursion
- (do p.monad
- [_ <type>.recursive_call]
- (in (` ((~' each) (~ funcC) (~ valueC)))))
- ... Parameters
- (do p.monad
- [_ <type>.any]
- (in valueC))
- )))]
- [_ _ outputC] (is (<type>.Parser [Code (List Code) Code])
- (p.either (<type>.polymorphic
- (Arg<?> inputC))
- (p.failure (format "Cannot create Functor for: " (%.type inputT)))))]
- (in (` (is (~ (@Functor inputT))
- (implementation
- (def: ((~' each) (~ funcC) (~ inputC))
- (~ outputC))))))))
diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux
deleted file mode 100644
index 391556a50..000000000
--- a/stdlib/source/poly/lux/data/format/json.lux
+++ /dev/null
@@ -1,335 +0,0 @@
-(.using
- [library
- [lux (.except)
- ["[0]" debug]
- [abstract
- [monad (.only do)]
- ["[0]" codec]]
- [control
- ["[0]" try]
- ["<>" parser (.only)
- ["</>" json]
- ["<[0]>" type]
- ["<[0]>" code]]]
- [data
- ["[0]" text (.only)
- ["%" format (.only format)]]
- [collection
- ["[0]" list (.open: "[1]#[0]" monad)]
- ["[0]" sequence (.only sequence)]
- ["[0]" dictionary]]]
- [macro
- [syntax (.only syntax)]
- ["[0]" code]]
- [math
- [number
- ["n" nat (.open: "[1]#[0]" decimal)]
- ["[0]" i64]
- ["[0]" int]
- ["[0]" frac]]]
- [time
- ... ["[0]" instant]
- ... ["[0]" duration]
- ["[0]" date]
- ["[0]" day]
- ["[0]" month]]
- ["[0]" type (.only)
- ["[0]" unit]
- ["[0]" poly (.only poly:)]]]]
- [\\library
- ["[0]" / (.only JSON)]])
-
-(def: tag
- (-> Nat Frac)
- (|>> .int int.frac))
-
-(def: (rec_encoded non_rec)
- (All (_ a) (-> (-> (-> a JSON)
- (-> a JSON))
- (-> a JSON)))
- (function (_ input)
- (non_rec (rec_encoded non_rec) input)))
-
-(def: low_mask Nat (|> 1 (i64.left_shifted 32) --))
-(def: high_mask Nat (|> low_mask (i64.left_shifted 32)))
-
-(implementation: nat_codec
- (codec.Codec JSON Nat)
-
- (def: (encoded input)
- (let [high (|> input (i64.and high_mask) (i64.right_shifted 32))
- low (i64.and low_mask input)]
- {/.#Array (sequence (|> high .int int.frac {/.#Number})
- (|> low .int int.frac {/.#Number}))}))
- (def: decoded
- (</>.result (</>.array
- (do <>.monad
- [high </>.number
- low </>.number]
- (in (n.+ (|> high frac.int .nat (i64.left_shifted 32))
- (|> low frac.int .nat))))))))
-
-(implementation: int_codec
- (codec.Codec JSON Int)
-
- (def: encoded
- (|>> .nat (at nat_codec encoded)))
- (def: decoded
- (|>> (at nat_codec decoded) (at try.functor each (|>> .int)))))
-
-... Builds a JSON generator for potentially inexistent values.
-(def: (nullable writer)
- (All (_ a) (-> (-> a JSON) (-> (Maybe a) JSON)))
- (function (_ elem)
- (case elem
- {.#None} {/.#Null}
- {.#Some value} (writer value))))
-
-(implementation: qty_codec
- (All (_ unit)
- (codec.Codec JSON (unit.Qty unit)))
-
- (def: encoded
- (|>> ((debug.private unit.out'))
- (at ..int_codec encoded)))
- (def: decoded
- (|>> (at ..int_codec decoded)
- (at try.functor each (debug.private unit.in')))))
-
-(poly: encoded
- (with_expansions
- [<basic> (with_template [<matcher> <encoder>]
- [(do !
- [.let [g!_ (code.local "_______")]
- _ <matcher>]
- (in (` (is (~ (@JSON#encoded inputT))
- <encoder>))))]
-
- [(<type>.exactly Any) (function ((~ g!_) (~ (code.symbol ["" "0"]))) {/.#Null})]
- [(<type>.sub Bit) (|>> {/.#Boolean})]
- [(<type>.sub Nat) (at (~! ..nat_codec) (~' encoded))]
- [(<type>.sub Int) (at (~! ..int_codec) (~' encoded))]
- [(<type>.sub Frac) (|>> {/.#Number})]
- [(<type>.sub Text) (|>> {/.#String})])
- <time> (with_template [<type> <codec>]
- [(do !
- [_ (<type>.exactly <type>)]
- (in (` (is (~ (@JSON#encoded inputT))
- (|>> (at (~! <codec>) (~' encoded)) {/.#String})))))]
-
- ... [duration.Duration duration.codec]
- ... [instant.Instant instant.codec]
- [date.Date date.codec]
- [day.Day day.codec]
- [month.Month month.codec])]
- (do [! <>.monad]
- [*env* <type>.env
- .let [g!_ (code.local "_______")
- @JSON#encoded (is (-> Type Code)
- (function (_ type)
- (` (-> (~ (poly.code *env* type)) /.JSON))))]
- inputT <type>.next]
- (all <>.either
- <basic>
- <time>
- (do !
- [unitT (<type>.applied (<>.after (<type>.exactly unit.Qty)
- <type>.any))]
- (in (` (is (~ (@JSON#encoded inputT))
- (at (~! qty_codec) (~' encoded))))))
- (do !
- [.let [g!_ (code.local "_______")
- g!key (code.local "_______key")
- g!val (code.local "_______val")]
- [_ _ =val=] (<type>.applied (all <>.and
- (<type>.exactly dictionary.Dictionary)
- (<type>.exactly .Text)
- encoded))]
- (in (` (is (~ (@JSON#encoded inputT))
- (|>> ((~! dictionary.entries))
- ((~! list#each) (function ((~ g!_) [(~ g!key) (~ g!val)])
- [(~ g!key) ((~ =val=) (~ g!val))]))
- ((~! dictionary.of_list) (~! text.hash))
- {/.#Object})))))
- (do !
- [[_ =sub=] (<type>.applied (all <>.and
- (<type>.exactly .Maybe)
- encoded))]
- (in (` (is (~ (@JSON#encoded inputT))
- ((~! ..nullable) (~ =sub=))))))
- (do !
- [[_ =sub=] (<type>.applied (all <>.and
- (<type>.exactly .List)
- encoded))]
- (in (` (is (~ (@JSON#encoded inputT))
- (|>> ((~! list#each) (~ =sub=)) ((~! sequence.of_list)) {/.#Array})))))
- (do !
- [.let [g!_ (code.local "_______")
- g!input (code.local "_______input")]
- members (<type>.variant (<>.many encoded))
- .let [last (-- (list.size members))]]
- (in (` (is (~ (@JSON#encoded inputT))
- (function ((~ g!_) (~ g!input))
- (case (~ g!input)
- (~+ (list#conjoint (list#each (function (_ [tag g!encoded])
- (if (n.= last tag)
- (.list (` {(~ (code.nat (-- tag))) #1 (~ g!input)})
- (` ((~! /.json) [(~ (code.frac (..tag (-- tag))))
- #1
- ((~ g!encoded) (~ g!input))])))
- (.list (` {(~ (code.nat tag)) #0 (~ g!input)})
- (` ((~! /.json) [(~ (code.frac (..tag tag)))
- #0
- ((~ g!encoded) (~ g!input))])))))
- (list.enumeration members))))))))))
- (do !
- [g!encoders (<type>.tuple (<>.many encoded))
- .let [g!_ (code.local "_______")
- g!members (|> (list.size g!encoders)
- list.indices
- (list#each (|>> n#encoded code.local)))]]
- (in (` (is (~ (@JSON#encoded inputT))
- (function ((~ g!_) [(~+ g!members)])
- ((~! /.json) [(~+ (list#each (function (_ [g!member g!encoded])
- (` ((~ g!encoded) (~ g!member))))
- (list.zipped_2 g!members g!encoders)))]))))))
- ... Type recursion
- (do !
- [[selfC non_recC] (<type>.recursive encoded)
- .let [g! (code.local "____________")]]
- (in (` (is (~ (@JSON#encoded inputT))
- ((~! ..rec_encoded) (.function ((~ g!) (~ selfC))
- (~ non_recC)))))))
- <type>.recursive_self
- ... Type applications
- (do !
- [partsC (<type>.applied (<>.many encoded))]
- (in (` ((~+ partsC)))))
- ... Polymorphism
- (do !
- [[funcC varsC bodyC] (<type>.polymorphic encoded)]
- (in (` (is (All ((~ g!_) (~+ varsC))
- (-> (~+ (list#each (function (_ varC) (` (-> (~ varC) /.JSON)))
- varsC))
- (-> ((~ (poly.code *env* inputT)) (~+ varsC))
- /.JSON)))
- (function ((~ funcC) (~+ varsC))
- (~ bodyC))))))
- <type>.parameter
- <type>.recursive_call
- ... If all else fails...
- (<>.failure (format "Cannot create JSON encoder for: " (type.format inputT)))
- ))))
-
-(poly: decoded
- (with_expansions
- [<basic> (with_template [<matcher> <decoder>]
- [(do !
- [_ <matcher>]
- (in (` (is (~ (@JSON#decoded inputT))
- (~! <decoder>)))))]
-
- [(<type>.exactly Any) </>.null]
- [(<type>.sub Bit) </>.boolean]
- [(<type>.sub Nat) (<>.codec ..nat_codec </>.any)]
- [(<type>.sub Int) (<>.codec ..int_codec </>.any)]
- [(<type>.sub Frac) </>.number]
- [(<type>.sub Text) </>.string])
- <time> (with_template [<type> <codec>]
- [(do !
- [_ (<type>.exactly <type>)]
- (in (` (is (~ (@JSON#decoded inputT))
- ((~! <>.codec) (~! <codec>) (~! </>.string))))))]
-
- ... [duration.Duration duration.codec]
- ... [instant.Instant instant.codec]
- [date.Date date.codec]
- [day.Day day.codec]
- [month.Month month.codec])]
- (do [! <>.monad]
- [*env* <type>.env
- .let [g!_ (code.local "_______")
- @JSON#decoded (is (-> Type Code)
- (function (_ type)
- (` (</>.Parser (~ (poly.code *env* type))))))]
- inputT <type>.next]
- (all <>.either
- <basic>
- <time>
- (do !
- [unitT (<type>.applied (<>.after (<type>.exactly unit.Qty)
- <type>.any))]
- (in (` (is (~ (@JSON#decoded inputT))
- ((~! <>.codec) (~! qty_codec) (~! </>.any))))))
- (do !
- [[_ _ valC] (<type>.applied (all <>.and
- (<type>.exactly dictionary.Dictionary)
- (<type>.exactly .Text)
- decoded))]
- (in (` (is (~ (@JSON#decoded inputT))
- ((~! </>.dictionary) (~ valC))))))
- (do !
- [[_ subC] (<type>.applied (<>.and (<type>.exactly .Maybe)
- decoded))]
- (in (` (is (~ (@JSON#decoded inputT))
- ((~! </>.nullable) (~ subC))))))
- (do !
- [[_ subC] (<type>.applied (<>.and (<type>.exactly .List)
- decoded))]
- (in (` (is (~ (@JSON#decoded inputT))
- ((~! </>.array) ((~! <>.some) (~ subC)))))))
- (do !
- [members (<type>.variant (<>.many decoded))
- .let [last (-- (list.size members))]]
- (in (` (is (~ (@JSON#decoded inputT))
- (all ((~! <>.or))
- (~+ (list#each (function (_ [tag memberC])
- (if (n.= last tag)
- (` (|> (~ memberC)
- ((~! <>.after) ((~! </>.this_boolean) (~ (code.bit #1))))
- ((~! <>.after) ((~! </>.this_number) (~ (code.frac (..tag (-- tag))))))
- ((~! </>.array))))
- (` (|> (~ memberC)
- ((~! <>.after) ((~! </>.this_boolean) (~ (code.bit #0))))
- ((~! <>.after) ((~! </>.this_number) (~ (code.frac (..tag tag)))))
- ((~! </>.array))))))
- (list.enumeration members))))))))
- (do !
- [g!decoders (<type>.tuple (<>.many decoded))]
- (in (` (is (~ (@JSON#decoded inputT))
- ((~! </>.array) (all ((~! <>.and)) (~+ g!decoders)))))))
- ... Type recursion
- (do !
- [[selfC bodyC] (<type>.recursive decoded)
- .let [g! (code.local "____________")]]
- (in (` (is (~ (@JSON#decoded inputT))
- ((~! <>.rec) (.function ((~ g!) (~ selfC))
- (~ bodyC)))))))
- <type>.recursive_self
- ... Type applications
- (do !
- [[funcC argsC] (<type>.applied (<>.and decoded (<>.many decoded)))]
- (in (` ((~ funcC) (~+ argsC)))))
- ... Polymorphism
- (do !
- [[funcC varsC bodyC] (<type>.polymorphic decoded)]
- (in (` (is (All ((~ g!_) (~+ varsC))
- (-> (~+ (list#each (|>> (~) </>.Parser (`)) varsC))
- (</>.Parser ((~ (poly.code *env* inputT)) (~+ varsC)))))
- (function ((~ funcC) (~+ varsC))
- (~ bodyC))))))
- <type>.parameter
- <type>.recursive_call
- ... If all else fails...
- (<>.failure (format "Cannot create JSON decoder for: " (type.format inputT)))
- ))))
-
-(def: .public codec
- (syntax (_ [inputT <code>.any])
- (in (.list (` (is (codec.Codec /.JSON (~ inputT))
- (implementation
- (def: (~' encoded)
- ((~! ..encoded) (~ inputT)))
- (def: (~' decoded)
- ((~! </>.result) ((~! ..decoded) (~ inputT))))
- )))))))