(.module:
  lux
  (lux (control [monad #+ do]
                ["ex" exception #+ exception:])
       (data [text]
             text/format
             (coll [list "list/" Functor<List>]
                   [dict #+ Dict]))
       [macro]
       (lang (type ["tc" check]))
       [io #+ IO])
  [//]
  (luxc [lang]
        (lang [".L" host]
              (host ["$" jvm])
              (analysis [".A" common]
                        [".A" expression])
              (synthesis [".S" expression])
              (translation [".T" expression]
                           [".T" statement]
                           [".T" eval])
              [".L" eval])))

(exception: #export Invalid-Statement)
(exception: #export Invalid-Alias)

(def: (throw-invalid-statement procedure inputsC+)
  (All [a] (-> Text (List Code) (Meta a)))
  (lang.throw Invalid-Statement
              (format "Statement: " procedure "\n"
                      "  Inputs:"
                      (|> inputsC+
                          list.enumerate
                          (list/map (function [[idx inputC]]
                                      (format "\n  " (%n idx) " " (%code inputC))))
                          (text.join-with "")) "\n")))

(def: (process-annotations annsC)
  (-> Code (Meta [$.Inst Code]))
  (do macro.Monad<Meta>
    [[_ annsA] (lang.with-scope
                 (lang.with-type Code
                   (expressionA.analyser evalL.eval annsC)))
     annsI (expressionT.translate (expressionS.synthesize annsA))
     annsV (evalT.eval annsI)]
    (wrap [annsI (:! Code annsV)])))

(def: (ensure-valid-alias def-name annotations value)
  (-> Text Code Code (Meta Unit))
  (case [annotations value]
    (^multi [[_ (#.Record pairs)] [_ (#.Symbol _)]]
            (|> pairs list.size (n/= +1)))
    (:: macro.Monad<Meta> wrap [])

    _
    (lang.throw Invalid-Alias def-name)))

(def: (lux//def procedure)
  (-> Text //.Statement)
  (function [inputsC+]
    (case inputsC+
      (^ (list [_ (#.Symbol ["" def-name])] valueC annotationsC))
      (hostL.with-context def-name
        (lang.with-fresh-type-env
          (do macro.Monad<Meta>
            [[annotationsI annotationsV] (process-annotations annotationsC)]
            (case (macro.get-symbol-ann (ident-for #.alias) annotationsV)
              (#.Some real-def)
              (do @
                [_ (ensure-valid-alias def-name annotationsV valueC)
                 _ (lang.with-scope
                     (statementT.translate-def def-name Void id annotationsI annotationsV))]
                (wrap []))

              #.None
              (do @
                [[_ valueT valueA] (lang.with-scope
                                     (if (macro.type? (:! Code annotationsV))
                                       (do @
                                         [valueA (lang.with-type Type
                                                   (expressionA.analyser evalL.eval valueC))]
                                         (wrap [Type valueA]))
                                       (commonA.with-unknown-type
                                         (expressionA.analyser evalL.eval valueC))))
                 valueT (lang.with-type-env
                          (tc.clean valueT))
                 valueI (expressionT.translate (expressionS.synthesize valueA))
                 _ (lang.with-scope
                     (statementT.translate-def def-name valueT valueI annotationsI annotationsV))]
                (wrap []))))))

      _
      (throw-invalid-statement procedure inputsC+))))

(def: (lux//program procedure)
  (-> Text //.Statement)
  (function [inputsC+]
    (case inputsC+
      (^ (list [_ (#.Symbol ["" args])] programC))
      (do macro.Monad<Meta>
        [[_ programA] (lang.with-scope
                        (lang.with-type (type (IO Unit))
                          (expressionA.analyser evalL.eval programC)))
         programI (expressionT.translate (expressionS.synthesize programA))
         _ (statementT.translate-program args programI)]
        (wrap []))

      _
      (throw-invalid-statement procedure inputsC+))))

(do-template [<mame> <type> <installer>]
  [(def: (<mame> procedure)
     (-> Text //.Statement)
     (function [inputsC+]
       (case inputsC+
         (^ (list [_ (#.Text name)] valueC))
         (do macro.Monad<Meta>
           [[_ valueA] (lang.with-scope
                         (lang.with-type <type>
                           (expressionA.analyser evalL.eval valueC)))
            valueI (expressionT.translate (expressionS.synthesize valueA))
            valueV (evalT.eval valueI)
            _ (<installer> name (:! <type> valueV))]
           (wrap []))

         _
         (throw-invalid-statement procedure inputsC+))))]

  [lux//analysis    //.Expression //.install-analysis]
  [lux//synthesis   //.Expression //.install-synthesis]
  [lux//translation //.Expression //.install-translation]
  [lux//statement   //.Statement  //.install-statement])

(def: #export defaults
  (Dict Text //.Statement)
  (`` (|> (dict.new text.Hash<Text>)
          (~~ (do-template [<name> <extension>]
                [(dict.put <name> (<extension> <name>))]

                ["lux def"         lux//def]
                ["lux program"     lux//program]
                ["lux analysis"    lux//analysis]
                ["lux synthesis"   lux//synthesis]
                ["lux translation" lux//translation]
                ["lux statement"   lux//statement]
                )))))