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

(do-template [<name>]
  [(exception: #export (<name> {message Text})
     message)]

  [Invalid-Statement]
  [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 syntheses annsC)
  (-> Syntheses 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 syntheses annsA))
     annsV (evalT.eval annsI)]
    (wrap [annsI (:coerce Code annsV)])))

(def: (ensure-valid-alias def-name annotations value)
  (-> Text Code Code (Meta Any))
  (case [annotations value]
    (^multi [[_ (#.Record pairs)] [_ (#.Identifier _)]]
            (|> 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 [_ (#.Identifier ["" def-name])] valueC annotationsC))
      (hostL.with-context def-name
        (lang.with-fresh-type-env
          (do macro.Monad<Meta>
            [syntheses //.all-syntheses
             [annotationsI annotationsV] (process-annotations syntheses annotationsC)]
            (case (macro.get-identifier-ann (name-of #.alias) annotationsV)
              (#.Some real-def)
              (do @
                [_ (ensure-valid-alias def-name annotationsV valueC)
                 _ (lang.with-scope
                     (statementT.translate-def def-name Nothing id annotationsV))]
                (wrap []))

              #.None
              (do @
                [[_ valueT valueA] (lang.with-scope
                                     (if (macro.type? (:coerce 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 syntheses valueA))
                 _ (lang.with-scope
                     (statementT.translate-def def-name valueT valueI annotationsV))]
                (wrap []))))))

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

(def: (lux//program procedure)
  (-> Text //.Statement)
  (function (_ inputsC+)
    (case inputsC+
      (^ (list [_ (#.Identifier ["" args])] programC))
      (do macro.Monad<Meta>
        [[_ programA] (<| lang.with-scope
                          (scopeL.with-local [args (type (List Text))])
                          (lang.with-type (type (IO Any)))
                          (expressionA.analyser evalL.eval programC))
         syntheses //.all-syntheses
         programI (expressionT.translate (expressionS.synthesize syntheses programA))
         _ (statementT.translate-program 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)))
            syntheses //.all-syntheses
            valueI (expressionT.translate (expressionS.synthesize syntheses valueA))
            valueV (evalT.eval valueI)
            _ (<installer> name (:coerce <type> valueV))]
           (wrap []))

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

  [lux//analysis    //.Analysis    //.install-analysis]
  [lux//synthesis   //.Synthesis   //.install-synthesis]
  [lux//translation //.Translation //.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]
                )))))