(;module:
  lux
  (lux (control [monad #+ do]
                ["ex" exception #+ exception:])
       (data [text "text/" Eq<Text>]
             text/format
             ["e" error]
             (coll [list "list/" Fold<List> Functor<List>]))
       [macro]
       (macro [code]))
  (luxc ["&" lang]
        (lang ["&;" scope])))

(exception: #export Unknown-Module)
(exception: #export Cannot-Declare-Tag-Twice)
(exception: #export Cannot-Declare-Tags-For-Unnamed-Type)
(exception: #export Cannot-Declare-Tags-For-Foreign-Type)

(def: (new-module hash)
  (-> Nat Module)
  {#;module-hash        hash
   #;module-aliases     (list)
   #;defs               (list)
   #;imports            (list)
   #;tags               (list)
   #;types              (list)
   #;module-annotations (' {})
   #;module-state       #;Active})

(def: #export (define (^@ full-name [module-name def-name])
                      definition)
  (-> Ident Def (Meta Unit))
  (function [compiler]
    (case (&;pl-get module-name (get@ #;modules compiler))
      (#;Some module)
      (case (&;pl-get def-name (get@ #;defs module))
        #;None
        (#e;Success [(update@ #;modules
                              (&;pl-put module-name
                                        (update@ #;defs
                                                 (: (-> (List [Text Def]) (List [Text Def]))
                                                    (|>. (#;Cons [def-name definition])))
                                                 module))
                              compiler)
                     []])

        (#;Some already-existing)
        (#e;Error (format "Cannot re-define definiton: " (%ident full-name))))

      #;None
      (#e;Error (format "Cannot define in unknown module: " module-name)))))

(def: #export (create hash name)
  (-> Nat Text (Meta Module))
  (function [compiler]
    (let [module (new-module hash)]
      (#e;Success [(update@ #;modules
                            (&;pl-put name module)
                            compiler)
                   module]))))

(def: #export (with-module hash name action)
  (All [a] (-> Nat Text (Meta a) (Meta [Module a])))
  (do macro;Monad<Meta>
    [_ (create hash name)
     output (&;with-current-module name
              (&scope;with-scope name action))
     module (macro;find-module name)]
    (wrap [module output])))

(do-template [<flagger> <asker> <tag>]
  [(def: #export (<flagger> module-name)
     (-> Text (Meta Unit))
     (function [compiler]
       (case (|> compiler (get@ #;modules) (&;pl-get module-name))
         (#;Some module)
         (let [active? (case (get@ #;module-state module)
                         #;Active true
                         _     false)]
           (if active?
             (#e;Success [(update@ #;modules
                                   (&;pl-put module-name (set@ #;module-state <tag> module))
                                   compiler)
                          []])
             (#e;Error "Can only change the state of a currently-active module.")))

         #;None
         (#e;Error (format "Module does not exist: " module-name)))))
   (def: #export (<asker> module-name)
     (-> Text (Meta Bool))
     (function [compiler]
       (case (|> compiler (get@ #;modules) (&;pl-get module-name))
         (#;Some module)
         (#e;Success [compiler
                      (case (get@ #;module-state module)
                        <tag> true
                        _     false)])

         #;None
         (#e;Error (format "Module does not exist: " module-name)))
       ))]

  [flag-active!   active?   #;Active]
  [flag-compiled! compiled? #;Compiled]
  [flag-cached!   cached?   #;Cached]
  )

(do-template [<name> <tag> <type>]
  [(def: (<name> module-name)
     (-> Text (Meta <type>))
     (function [compiler]
       (case (|> compiler (get@ #;modules) (&;pl-get module-name))
         (#;Some module)
         (#e;Success [compiler (get@ <tag> module)])

         #;None
         (macro;run compiler (&;throw Unknown-Module module-name)))
       ))]

  [tags-by-module  #;tags        (List [Text [Nat (List Ident) Bool Type]])]
  [types-by-module #;types       (List [Text [(List Ident) Bool Type]])]
  [module-hash     #;module-hash Nat]
  )

(def: (ensure-undeclared-tags module-name tags)
  (-> Text (List Text) (Meta Unit))
  (do macro;Monad<Meta>
    [bindings (tags-by-module module-name)
     _ (monad;map @
                  (function [tag]
                    (case (&;pl-get tag bindings)
                      #;None
                      (wrap [])

                      (#;Some _)
                      (&;throw Cannot-Declare-Tag-Twice (format "Module: " module-name "\n"
                                                                "   Tag: " tag))))
                  tags)]
    (wrap [])))

(def: #export (declare-tags tags exported? type)
  (-> (List Text) Bool Type (Meta Unit))
  (do macro;Monad<Meta>
    [current-module macro;current-module-name
     [type-module type-name] (case type
                               (#;Named type-ident _)
                               (wrap type-ident)

                               _
                               (&;throw Cannot-Declare-Tags-For-Unnamed-Type
                                        (format "Tags: " (|> tags (list/map code;text) code;tuple %code) "\n"
                                                "Type: " (%type type))))
     _ (ensure-undeclared-tags current-module tags)
     _ (&;assert Cannot-Declare-Tags-For-Foreign-Type
                 (format "Tags: " (|> tags (list/map code;text) code;tuple %code) "\n"
                         "Type: " (%type type))
                 (text/= current-module type-module))]
    (function [compiler]
      (case (|> compiler (get@ #;modules) (&;pl-get current-module))
        (#;Some module)
        (let [namespaced-tags (list/map (|>. [current-module]) tags)]
          (#e;Success [(update@ #;modules
                                (&;pl-update current-module
                                             (|>. (update@ #;tags (function [tag-bindings]
                                                                    (list/fold (function [[idx tag] table]
                                                                                 (&;pl-put tag [idx namespaced-tags exported? type] table))
                                                                               tag-bindings
                                                                               (list;enumerate tags))))
                                                  (update@ #;types (&;pl-put type-name [namespaced-tags exported? type]))))
                                compiler)
                       []]))
        #;None
        (macro;run compiler (&;throw Unknown-Module current-module))))))