(.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 ("[1]#[0]" monad)]
     ["[0]" sequence (.only sequence)]
     ["[0]" dictionary]]]
   [macro
    [syntax (.only syntax:)]
    ["[0]" code]]
   [math
    [number
     ["n" nat ("[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 (# nat_codec encoded)))
  (def: decoded
    (|>> (# nat_codec decoded) (# 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'))
         (# ..int_codec encoded)))
  (def: decoded
    (|>> (# ..int_codec decoded)
         (# try.functor each (debug.private unit.in')))))

(poly: encoded
  (with_expansions
    [<basic> (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)     (# (~! ..nat_codec) (~' encoded))]
               [(<type>.sub Int)     (# (~! ..int_codec) (~' encoded))]
               [(<type>.sub Frac)    (|>> {/.#Number})]
               [(<type>.sub Text)    (|>> {/.#String})])
     <time> (template [<type> <codec>]
              [(do !
                 [_ (<type>.exactly <type>)]
                 (in (` (is (~ (@JSON#encoded inputT))
                            (|>> (# (~! <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))
                        (# (~! 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> (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> (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)))
           ))))

(syntax: .public (codec [inputT <code>.any])
  (in (.list (` (is (codec.Codec /.JSON (~ inputT))
                    (implementation
                     (def: (~' encoded)
                       ((~! ..encoded) (~ inputT)))
                     (def: (~' decoded)
                       ((~! </>.result) ((~! ..decoded) (~ inputT))))
                     ))))))