(;module:
  lux
  (lux (control monad)
       (data [text "T/" Eq<Text>]
             text/format
             ["R" result]
             (coll [list "L/" Fold<List> Functor<List>]))
       [macro #+ Monad<Lux>])
  (luxc ["&" base]
        ["&;" env]))

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

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

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

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

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

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

(do-template [<flagger> <asker> <tag>]
  [(def: #export (<flagger> module-name)
     (-> Text (Lux 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?
             (#R;Success [(update@ #;modules
                                   (&;pl-put module-name (set@ #;module-state <tag> module))
                                   compiler)
                          []])
             (#R;Error "Can only change the state of a currently-active module.")))

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

         #;None
         (#R;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 (Lux <type>))
     (function [compiler]
       (case (|> compiler (get@ #;modules) (&;pl-get module-name))
         (#;Some module)
         (#R;Success [compiler (get@ <tag> module)])

         #;None
         (macro;run compiler (&;fail (format "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) (Lux Unit))
  (do Monad<Lux>
    [bindings (tags-by-module module-name)
     _ (mapM @
             (function [tag]
               (case (&;pl-get tag bindings)
                 #;None
                 (wrap [])

                 (#;Some _)
                 (&;fail (format "Cannot re-declare tag: " tag))))
             tags)]
    (wrap [])))

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

                               _
                               (&;fail (format "Cannot define tags for an unnamed type: " (%type type))))
     _ (ensure-undeclared-tags current-module tags)
     _ (macro;assert (format "Cannot define tags for a type belonging to a foreign module: " (%type type))
                     (T/= current-module type-module))]
    (function [compiler]
      (case (|> compiler (get@ #;modules) (&;pl-get current-module))
        (#;Some module)
        (let [namespaced-tags (L/map (|>. [current-module]) tags)]
          (#R;Success [(update@ #;modules
                                (&;pl-update current-module
                                             (|>. (update@ #;tags (function [tag-bindings]
                                                                    (L/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 (&;fail (format "Unknown module: " current-module)))))))