(.module:
  lux
  (lux (control [monad #+ do]
                ["ex" exception #+ exception:]
                ["p" parser]
                pipe)
       (data [maybe]
             ["e" error #+ Error]
             [text "text/" Eq<Text>]
             text/format
             (format [xml #+ XML]
                     [json #+ JSON])
             (coll [array]
                   [list "list/" Functor<List>]
                   [dict]))
       (time [instant #+ Instant]
             [duration #+ Duration]
             [date #+ Date])
       [function #+ const]
       [macro]
       (macro [code]
              [poly #+ Poly])
       (lang [syntax #+ Aliases]
             [type]
             (type [check]))
       (concurrency [promise]
                    [task #+ Task])
       [io]
       (world [file #+ File]
              [console #+ Console]))
  (luxc [lang]
        (lang [".L" module]
              [".L" scope]
              [".L" host]
              [".L" translation]
              [".L" eval]
              (translation [".T" runtime])
              [".L" extension]
              (extension [".E" analysis]
                         [".E" synthesis]
                         [".E" translation]
                         [".E" statement]))))

(exception: #export REPL-Initialization-Failed)
(exception: #export REPL-Error)

(def: repl-module "<REPL>")

(def: no-aliases Aliases (dict.new text.Hash<Text>))

(def: (initialize source-dirs target-dir console)
  (-> (List File) File Console (Task Compiler))
  (do promise.Monad<Promise>
    [output (promise.future
             (do io.Monad<IO>
               [host hostL.init-host]
               (case (macro.run' (translationL.init-compiler host)
                                 (moduleL.with-module +0 repl-module
                                   runtimeT.translate))
                 (#e.Success [compiler _])
                 (|> compiler
                     (set@ [#.info #.mode] #.REPL)
                     (set@ #.extensions
                           (:! Void
                               {#extensionL.analysis analysisE.defaults
                                #extensionL.synthesis synthesisE.defaults
                                #extensionL.translation translationE.defaults
                                #extensionL.statement statementE.defaults}))
                     (translationL.translate-module source-dirs target-dir translationL.prelude))

                 (#e.Error error)
                 (wrap (#e.Error error)))))]
    (case output
      (#e.Success compiler)
      (do task.Monad<Task>
        [_ (console.write (format "\nWelcome to the REPL!\n"
                                  "Type \"exit\" to leave.\n\n")
                          console)]
        (wrap compiler))
      
      (#e.Error message)
      (task.throw REPL-Initialization-Failed message))))

(def: (add-line line [where offset input])
  (-> Text Source Source)
  [where offset (format input "\n" line)])

(type: Representation (-> Top Text))

(def: (represent-together representations values)
  (-> (List Representation) (List Top) (List Text))
  (|> (list.zip2 representations values)
      (list/map (function [[representation value]] (representation value)))))

(def: primitive-representation
  (Poly Representation)
  (`` ($_ p.either
          (do p.Monad<Parser>
            [_ poly.unit]
            (wrap (const "[]")))
          
          (~~ (do-template [<parser> <type> <formatter>]
                [(do p.Monad<Parser>
                   [_ <parser>]
                   (wrap (|>> (:! <type>) <formatter>)))]

                [poly.bool Bool %b]
                [poly.nat Nat %n]
                [poly.int Int %i]
                [poly.deg Deg %d]
                [poly.frac Frac %f]
                [poly.text Text %t])))))

(def: (special-representation representation)
  (-> (Poly Representation) (Poly Representation))
  (`` ($_ p.either
          (~~ (do-template [<type> <formatter>]
                [(do p.Monad<Parser>
                   [_ (poly.this <type>)]
                   (wrap (|>> (:! <type>) <formatter>)))]

                [Type %type]
                [Code %code]
                [Instant %instant]
                [Duration %duration]
                [Date %date]
                [JSON %json]
                [XML %xml]
                ))

          (do p.Monad<Parser>
            [[_ elemT] (poly.apply (p.seq (poly.this List) poly.any))
             elemR (poly.local (list elemT) representation)]
            (wrap (|>> (:! (List Top)) (%list elemR))))

          (do p.Monad<Parser>
            [[_ elemT] (poly.apply (p.seq (poly.this Maybe) poly.any))
             elemR (poly.local (list elemT) representation)]
            (wrap (|>> (:! (Maybe Top))
                       (case> #.None
                              "#.None"

                              (#.Some elemV)
                              (format "(#.Some " (elemR elemV) ")"))))))))

(def: (record-representation tags representation)
  (-> (List Ident) (Poly Representation) (Poly Representation))
  (do p.Monad<Parser>
    [membersR+ (poly.tuple (p.many representation))
     _ (p.assert "Number of tags does not match record type size."
                 (n/= (list.size tags) (list.size membersR+)))]
    (wrap (function [recordV]
            (let [record-body (loop [pairs-left (list.zip2 tags membersR+)
                                     recordV recordV]
                                (case pairs-left
                                  #.Nil
                                  ""

                                  (#.Cons [tag repr] #.Nil)
                                  (format (%code (code.tag tag)) " " (repr recordV))

                                  (#.Cons [tag repr] tail)
                                  (let [[leftV rightV] (:! [Top Top] recordV)]
                                    (format (%code (code.tag tag)) " " (repr leftV) " "
                                            (recur tail rightV)))))]
              (format "{" record-body "}"))))))

(def: (variant-representation tags representation)
  (-> (List Ident) (Poly Representation) (Poly Representation))
  (do p.Monad<Parser>
    [casesR+ (poly.variant (p.many representation))
     #let [num-tags (list.size tags)]
     _ (p.assert "Number of tags does not match variant type size."
                 (n/= num-tags (list.size casesR+)))]
    (wrap (function [variantV]
            (loop [cases-left (list.zip3 tags
                                         (list.n/range +0 (n/dec num-tags))
                                         casesR+)
                   variantV variantV]
              (case cases-left
                #.Nil
                ""

                (#.Cons [tag-name tag-idx repr] #.Nil)
                (let [[_tag _last? _value] (:! [Nat Text Top] variantV)]
                  (if (n/= tag-idx _tag)
                    (format "(" (%code (code.tag tag-name)) " " (repr _value) ")")
                    (undefined)))

                (#.Cons [tag-name tag-idx repr] tail)
                (let [[_tag _last? _value] (:! [Nat Text Top] variantV)]
                  (if (n/= tag-idx _tag)
                    (format "(" (%code (code.tag tag-name)) " " (repr _value) ")")
                    (recur tail variantV)))))))))

(def: (tagged-representation compiler representation)
  (-> Compiler (Poly Representation) (Poly Representation))
  (do p.Monad<Parser>
    [[name anonymous] poly.named]
    (case (macro.run compiler (macro.tags-of name))
      (#e.Success ?tags)
      (case ?tags
        (#.Some tags)
        (poly.local (list anonymous)
                    (p.either (record-representation tags representation)
                              (variant-representation tags representation)))
        
        #.None
        representation)
      
      (#e.Error error)
      (p.fail error))))

(def: (tuple-representation representation)
  (-> (Poly Representation) (Poly Representation))
  (do p.Monad<Parser>
    [membersR+ (poly.tuple (p.many representation))]
    (wrap (function [tupleV]
            (let [tuple-body (loop [representations membersR+
                                    tupleV tupleV]
                               (case representations
                                 #.Nil
                                 ""
                                 
                                 (#.Cons lastR #.Nil)
                                 (lastR tupleV)
                                 
                                 (#.Cons headR tailR)
                                 (let [[leftV rightV] (:! [Top Top] tupleV)]
                                   (format (headR leftV) " " (recur tailR rightV)))))]
              (format "[" tuple-body "]"))))))

(def: (representation compiler)
  (-> Compiler (Poly Representation))
  (p.rec
   (function [representation]
     ($_ p.either
         primitive-representation
         (special-representation representation)
         (tagged-representation compiler representation)
         (tuple-representation representation)

         (do p.Monad<Parser>
           [[funcT inputsT+] (poly.apply (p.seq poly.any (p.many poly.any)))]
           (case (type.apply inputsT+ funcT)
             (#.Some outputT)
             (poly.local (list outputT) representation)

             #.None
             (p.fail "")))

         (do p.Monad<Parser>
           [[name anonymous] poly.named]
           (poly.local (list anonymous) representation))

         (p.fail "")
         ))))

(def: (represent compiler type value)
  (-> Compiler Type Top Text)
  (case (poly.run type (representation compiler))
    (#e.Success representation)
    (representation value)

    (#e.Error error)
    ". . . cannot represent value . . ."))

(def: (repl-translate source-dirs target-dir code)
  (-> (List File) File Code (Meta [Type Top]))
  (function [compiler]
    (case ((translationL.translate (translationL.translate-module source-dirs target-dir)
                                   no-aliases
                                   code)
           compiler)
      (#e.Success [compiler' aliases'])
      (#e.Success [compiler' [Void []]])

      (#e.Error error)
      (if (ex.match? translationL.Unrecognized-Statement error)
        ((do macro.Monad<Meta>
           [[var-id varT] (lang.with-type-env check.var)
            exprV (scopeL.with-scope repl-module
                    (evalL.eval varT code))
            ?exprT (lang.with-type-env (check.read var-id))]
           (wrap [(maybe.assume ?exprT) exprV]))
         compiler)
        (#e.Error error)))))

(def: fresh-source Source [[repl-module +1 +0] +0 ""])

(def: #export (run source-dirs target-dir)
  (-> (List File) File (Task Unit))
  (do task.Monad<Task>
    [console (promise.future console.open)
     compiler (initialize source-dirs target-dir console)]
    (loop [compiler compiler
           source fresh-source
           multi-line? false]
      (do @
        [_ (if multi-line?
             (console.write "  " console)
             (console.write "> " console))
         line (console.read-line console)]
        (if (text/= "exit" line)
          (console.write "Till next time..." console)
          (case (do e.Monad<Error>
                  [[source' exprC] (syntax.read repl-module no-aliases (add-line line source))]
                  (macro.run' compiler
                              (lang.with-current-module repl-module
                                (do macro.Monad<Meta>
                                  [[exprT exprV] (repl-translate source-dirs target-dir exprC)]
                                  (wrap [source' exprT exprV])))))
            (#e.Success [compiler' [source' exprT exprV]])
            (do @
              [_ (console.write (format " Type: " (type.to-text exprT) "\n"
                                        "Value: " (represent compiler' exprT exprV) "\n\n")
                                console)]
              (recur compiler' source' false))

            (#e.Error error)
            (if (ex.match? syntax.End-Of-File error)
              (recur compiler source true)
              (exec (log! (REPL-Error error))
                (recur compiler fresh-source false))))))
      )))