(.module:
  lux
  (lux (control [monad #+ do Monad]
                [functor]
                ["p" parser])
       (data [text]
             text/format
             (coll [list "L/" Monad<List> Monoid<List>])
             [product])
       [macro]
       (macro [code]
              [syntax #+ syntax: Syntax]
              (syntax [common])
              [poly #+ poly:])
       (lang [type])
       ))

(poly: #export Functor<?>
  (do @
    [#let [type-funcC (code.local-symbol "____________type-funcC")
           funcC (code.local-symbol "____________funcC")
           inputC (code.local-symbol "____________inputC")]
     *env* poly.env
     inputT poly.peek
     [polyC varsC non-functorT] (poly.local (list inputT)
                                            (poly.polymorphic poly.any))
     #let [num-vars (list.size varsC)]
     #let [@Functor (: (-> Type Code)
                       (function (_ unwrappedT)
                         (if (n/= +1 num-vars)
                           (` (functor.Functor (~ (poly.to-code *env* unwrappedT))))
                           (let [paramsC (|> num-vars dec list.indices (L/map (|>> %n code.local-symbol)))]
                             (` (All [(~+ paramsC)]
                                  (functor.Functor ((~ (poly.to-code *env* unwrappedT)) (~+ paramsC)))))))))
           Arg<?> (: (-> Code (poly.Poly Code))
                     (function (Arg<?> valueC)
                       ($_ p.either
                           ## Type-var
                           (do p.Monad<Parser>
                             [#let [varI (|> num-vars (n/* +2) dec)]
                              _ (poly.var varI)]
                             (wrap (` ((~ funcC) (~ valueC)))))
                           ## Variants
                           (do @
                             [_ (wrap [])
                              membersC (poly.variant (p.many (Arg<?> valueC)))]
                             (wrap (` (case (~ valueC)
                                        (~+ (L/join (L/map (function (_ [tag memberC])
                                                             (list (` ((~ (code.nat tag)) (~ valueC)))
                                                                   (` ((~ (code.nat tag)) (~ memberC)))))
                                                           (list.enumerate membersC))))))))
                           ## Tuples
                           (do p.Monad<Parser>
                             [pairsCC (: (poly.Poly (List [Code Code]))
                                         (poly.tuple (loop [idx +0
                                                            pairsCC (: (List [Code Code])
                                                                       (list))]
                                                       (p.either (let [slotC (|> idx %n (format "____________slot") code.local-symbol)]
                                                                   (do @
                                                                     [_ (wrap [])
                                                                      memberC (Arg<?> slotC)]
                                                                     (recur (inc idx)
                                                                            (L/compose pairsCC (list [slotC memberC])))))
                                                                 (wrap pairsCC)))))]
                             (wrap (` (case (~ valueC)
                                        [(~+ (L/map product.left pairsCC))]
                                        [(~+ (L/map product.right pairsCC))]))))
                           ## Functions
                           (do @
                             [_ (wrap [])
                              #let [g! (code.local-symbol "____________")
                                    outL (code.local-symbol "____________outL")]
                              [inT+ outC] (poly.function (p.many poly.any)
                                            (Arg<?> outL))
                              #let [inC+ (|> (list.size inT+) dec
                                             (list.n/range +0)
                                             (L/map (|>> %n (format "____________inC") code.local-symbol)))]]
                             (wrap (` (function ((~ g!) (~+ inC+))
                                        (let [(~ outL) ((~ valueC) (~+ inC+))]
                                          (~ outC))))))
                           ## Recursion
                           (do p.Monad<Parser>
                             [_ poly.recursive-call]
                             (wrap (` ((~' map) (~ funcC) (~ valueC)))))
                           ## Parameters
                           (do p.Monad<Parser>
                             [_ poly.any]
                             (wrap valueC))
                           )))]
     [_ _ outputC] (: (poly.Poly [Code (List Code) Code])
                      (p.either (poly.polymorphic
                                 (Arg<?> inputC))
                                (p.fail (format "Cannot create Functor for: " (%type inputT)))))]
    (wrap (` (: (~ (@Functor inputT))
                (struct (def: ((~' map) (~ funcC) (~ inputC))
                          (~ outputC))))))))