(.module:
  [library
   [lux (#- type macro)
    [abstract
     [functor (#+ Functor)]
     [apply (#+ Apply)]
     ["." monad (#+ Monad do)]]
    [control
     ["." maybe]
     ["." try (#+ Try)]]
    [data
     ["." product]
     ["." text ("#\." monoid order)]
     ["." name ("#\." codec equivalence)]
     [collection
      ["." list ("#\." monoid monad)]
      [dictionary
       ["." plist]]]]
    [macro
     ["." code]]
    [math
     [number
      ["n" nat]
      ["i" int]]]]]
  [/
   ["." location]])

... (type: (Meta a)
...   (-> Lux (Try [Lux a])))

(implementation: .public functor
  (Functor Meta)
  
  (def: (each f fa)
    (function (_ lux)
      (case (fa lux)
        (#try.Failure msg)
        (#try.Failure msg)

        (#try.Success [lux' a])
        (#try.Success [lux' (f a)])))))

(implementation: .public apply
  (Apply Meta)
  
  (def: &functor ..functor)

  (def: (on fa ff)
    (function (_ lux)
      (case (ff lux)
        (#try.Success [lux' f])
        (case (fa lux')
          (#try.Success [lux'' a])
          (#try.Success [lux'' (f a)])

          (#try.Failure msg)
          (#try.Failure msg))

        (#try.Failure msg)
        (#try.Failure msg)))))

(implementation: .public monad
  (Monad Meta)
  
  (def: &functor ..functor)

  (def: (in x)
    (function (_ lux)
      (#try.Success [lux x])))
  
  (def: (conjoint mma)
    (function (_ lux)
      (case (mma lux)
        (#try.Failure msg)
        (#try.Failure msg)

        (#try.Success [lux' ma])
        (ma lux')))))

(def: .public (result' lux action)
  (All (_ a) (-> Lux (Meta a) (Try [Lux a])))
  (action lux))

(def: .public (result lux action)
  (All (_ a) (-> Lux (Meta a) (Try a)))
  (case (action lux)
    (#try.Failure error)
    (#try.Failure error)

    (#try.Success [_ output])
    (#try.Success output)))

(def: .public (either left right)
  (All (_ a) (-> (Meta a) (Meta a) (Meta a)))
  (function (_ lux)
    (case (left lux)
      (#try.Failure error)
      (right lux)

      (#try.Success [lux' output])
      (#try.Success [lux' output]))))

(def: .public (assertion message test)
  (-> Text Bit (Meta Any))
  (function (_ lux)
    (if test
      (#try.Success [lux []])
      (#try.Failure message))))

(def: .public (failure error)
  (All (_ a)
    (-> Text (Meta a)))
  (function (_ state)
    (#try.Failure (location.with (value@ #.location state) error))))

(def: .public (module name)
  (-> Text (Meta Module))
  (function (_ lux)
    (case (plist.value name (value@ #.modules lux))
      (#.Some module)
      (#try.Success [lux module])

      _
      (#try.Failure ($_ text\composite "Unknown module: " name)))))

(def: .public current_module_name
  (Meta Text)
  (function (_ lux)
    (case (value@ #.current_module lux)
      (#.Some current_module)
      (#try.Success [lux current_module])

      _
      (#try.Failure "No current module."))))

(def: .public current_module
  (Meta Module)
  (let [(^open "\.") ..monad]
    (|> ..current_module_name
        (\each ..module)
        \conjoint)))

(def: (macro_type? type)
  (-> Type Bit)
  (`` (case type
        (#.Named [(~~ (static .prelude_module)) "Macro"] (#.Primitive "#Macro" #.End))
        true

        _
        false)))

(def: .public (normal name)
  (-> Name (Meta Name))
  (case name
    ["" name]
    (do ..monad
      [module_name ..current_module_name]
      (in [module_name name]))

    _
    (\ ..monad in name)))

(def: .public (macro full_name)
  (-> Name (Meta (Maybe Macro)))
  (do ..monad
    [[module name] (..normal full_name)]
    (: (Meta (Maybe Macro))
       (function (_ lux)
         (#try.Success [lux
                        (case (..current_module_name lux)
                          (#try.Failure error)
                          #.None

                          (#try.Success [_ this_module])
                          (let [modules (value@ #.modules lux)]
                            (loop [module module
                                   name name]
                              (do maybe.monad
                                [$module (plist.value module modules)
                                 definition (: (Maybe Global)
                                               (|> $module
                                                   (: Module)
                                                   (value@ #.definitions)
                                                   (plist.value name)))]
                                (case definition
                                  (#.Alias [r_module r_name])
                                  (recur r_module r_name)
                                  
                                  (#.Definition [exported? def_type def_anns def_value])
                                  (if (macro_type? def_type)
                                    (#.Some (:as Macro def_value))
                                    #.None)

                                  (#.Type [exported? type labels])
                                  #.None

                                  (#.Label _)
                                  #.None

                                  (#.Slot _)
                                  #.None)))))])))))

(def: .public seed
  (Meta Nat)
  (function (_ lux)
    (#try.Success [(revised@ #.seed ++ lux)
                   (value@ #.seed lux)])))

(def: .public (module_exists? module)
  (-> Text (Meta Bit))
  (function (_ lux)
    (#try.Success [lux (case (plist.value module (value@ #.modules lux))
                         (#.Some _)
                         #1
                         
                         #.None
                         #0)])))

(def: (on_either f x1 x2)
  (All (_ a b)
    (-> (-> a (Maybe b)) a a (Maybe b)))
  (case (f x1)
    #.None     (f x2)
    (#.Some y) (#.Some y)))

(def: (type_variable idx bindings)
  (-> Nat (List [Nat (Maybe Type)]) (Maybe Type))
  (case bindings
    #.End
    #.None
    
    (#.Item [var bound] bindings')
    (if (n.= idx var)
      bound
      (type_variable idx bindings'))))

(def: (clean_type type)
  (-> Type (Meta Type))
  (case type
    (#.Var var)
    (function (_ lux)
      (case (|> lux
                (value@ [#.type_context #.var_bindings])
                (type_variable var))
        (^or #.None (#.Some (#.Var _)))
        (#try.Success [lux type])

        (#.Some type')
        (#try.Success [lux type'])))

    _
    (\ ..monad in type)))

(def: .public (var_type name)
  (-> Text (Meta Type))
  (function (_ lux)
    (let [test (: (-> [Text [Type Any]] Bit)
                  (|>> product.left (text\= name)))]
      (case (do maybe.monad
              [scope (list.example (function (_ env)
                                     (or (list.any? test (: (List [Text [Type Any]])
                                                            (value@ [#.locals #.mappings] env)))
                                         (list.any? test (: (List [Text [Type Any]])
                                                            (value@ [#.captured #.mappings] env)))))
                                   (value@ #.scopes lux))
               [_ [type _]] (on_either (list.example test)
                                       (: (List [Text [Type Any]])
                                          (value@ [#.locals #.mappings] scope))
                                       (: (List [Text [Type Any]])
                                          (value@ [#.captured #.mappings] scope)))]
              (in type))
        (#.Some var_type)
        ((clean_type var_type) lux)

        #.None
        (#try.Failure ($_ text\composite "Unknown variable: " name))))))

(def: without_lux_runtime
  (-> (List Text) (List Text))
  ... The Lux runtime shows up as ""
  ... so I'm excluding it.
  (list.only (|>> text.empty? not)))

(def: listing_separator
  Text
  ($_ text\composite text.new_line "                    "))

(def: module_listing
  (-> (List Text) Text)
  (|>> ..without_lux_runtime
       (list.sorted text\<)
       (text.interposed ..listing_separator)))

(def: .public (definition name)
  (-> Name (Meta Global))
  (do ..monad
    [name (..normal name)
     .let [[normal_module normal_short] name]]
    (function (_ lux)
      (case (: (Maybe Global)
               (do maybe.monad
                 [(^slots [#.definitions]) (|> lux
                                               (value@ #.modules)
                                               (plist.value normal_module))]
                 (plist.value normal_short definitions)))
        (#.Some definition)
        (#try.Success [lux definition])

        _
        (let [current_module (|> lux (value@ #.current_module) (maybe.else "???"))
              all_known_modules (|> lux
                                    (value@ #.modules)
                                    (list\each product.left)
                                    ..module_listing)]
          (#try.Failure ($_ text\composite
                            "Unknown definition: " (name\encoded name) text.new_line
                            "    Current module: " current_module text.new_line
                            (case (plist.value current_module (value@ #.modules lux))
                              (#.Some this_module)
                              (let [candidates (|> lux
                                                   (value@ #.modules)
                                                   (list\each (function (_ [module_name module])
                                                                (|> module
                                                                    (value@ #.definitions)
                                                                    (list.all (function (_ [def_name global])
                                                                                (case global
                                                                                  (^or (#.Definition [exported? _])
                                                                                       (#.Type [exported? _]))
                                                                                  (if (and exported?
                                                                                           (text\= normal_short def_name))
                                                                                    (#.Some (name\encoded [module_name def_name]))
                                                                                    #.None)

                                                                                  (#.Alias _)
                                                                                  #.None

                                                                                  (#.Label _)
                                                                                  #.None

                                                                                  (#.Slot _)
                                                                                  #.None))))))
                                                   list.together
                                                   (list.sorted text\<)
                                                   (text.interposed ..listing_separator))
                                    imports (|> this_module
                                                (value@ #.imports)
                                                ..module_listing)
                                    aliases (|> this_module
                                                (value@ #.module_aliases)
                                                (list\each (function (_ [alias real]) ($_ text\composite alias " => " real)))
                                                (list.sorted text\<)
                                                (text.interposed ..listing_separator))]
                                ($_ text\composite
                                    "        Candidates: " candidates text.new_line
                                    "           Imports: " imports text.new_line
                                    "           Aliases: " aliases text.new_line))

                              _
                              "")
                            " All known modules: " all_known_modules text.new_line)))))))

(def: .public (export name)
  (-> Name (Meta Definition))
  (do ..monad
    [definition (..definition name)]
    (case definition
      (#.Definition definition)
      (let [[exported? def_type def_data def_value] definition]
        (if exported?
          (in definition)
          (failure ($_ text\composite "Definition is not an export: " (name\encoded name)))))

      (#.Type [exported? type labels])
      (if exported?
        (in [exported? .Type (' {}) type])
        (failure ($_ text\composite "Type is not an export: " (name\encoded name))))

      (#.Alias de_aliased)
      (failure ($_ text\composite
                   "Aliases are not considered exports: "
                   (name\encoded name)))

      (#.Label _)
      (failure ($_ text\composite
                   "Tags are not considered exports: "
                   (name\encoded name)))

      (#.Slot _)
      (failure ($_ text\composite
                   "Slots are not considered exports: "
                   (name\encoded name))))))

(def: .public (definition_type name)
  (-> Name (Meta Type))
  (do ..monad
    [definition (definition name)]
    (case definition
      (#.Alias de_aliased)
      (definition_type de_aliased)
      
      (#.Definition [exported? def_type def_data def_value])
      (clean_type def_type)

      (#.Type [exported? type labels])
      (in .Type)

      (#.Label _)
      (failure ($_ text\composite
                   "Tags have no type: "
                   (name\encoded name)))

      (#.Slot _)
      (failure ($_ text\composite
                   "Slots have no type: "
                   (name\encoded name))))))

(def: .public (type name)
  (-> Name (Meta Type))
  (case name
    ["" _name]
    (either (var_type _name)
            (definition_type name))

    _
    (definition_type name)))

(def: .public (type_definition name)
  (-> Name (Meta Type))
  (do ..monad
    [definition (definition name)]
    (case definition
      (#.Alias de_aliased)
      (type_definition de_aliased)
      
      (#.Definition [exported? def_type def_data def_value])
      (let [type_code (`` ("lux in-module" (~~ (static .prelude_module)) .type_code))]
        (if (or (same? .Type def_type)
                (\ code.equivalence =
                   (type_code .Type)
                   (type_code def_type)))
          (in (:as Type def_value))
          (..failure ($_ text\composite "Definition is not a type: " (name\encoded name)))))

      (#.Type [exported? type labels])
      (in type)

      (#.Label _)
      (..failure ($_ text\composite "Tag is not a type: " (name\encoded name)))

      (#.Slot _)
      (..failure ($_ text\composite "Slot is not a type: " (name\encoded name))))))

(def: .public (globals module)
  (-> Text (Meta (List [Text Global])))
  (function (_ lux)
    (case (plist.value module (value@ #.modules lux))
      #.None
      (#try.Failure ($_ text\composite "Unknown module: " module))
      
      (#.Some module)
      (#try.Success [lux (value@ #.definitions module)]))))

(def: .public (definitions module)
  (-> Text (Meta (List [Text Definition])))
  (\ ..monad each
     (list.all (function (_ [name global])
                 (case global
                   (#.Alias de_aliased)
                   #.None
                   
                   (#.Definition definition)
                   (#.Some [name definition])

                   (#.Type [exported? type labels])
                   (#.Some [name [exported? .Type (' {}) type]])

                   (#.Label _)
                   #.None

                   (#.Slot _)
                   #.None)))
     (..globals module)))

(def: .public (exports module_name)
  (-> Text (Meta (List [Text Definition])))
  (do ..monad
    [constants (..definitions module_name)]
    (in (do list.monad
          [[name [exported? def_type def_data def_value]] constants]
          (if exported?
            (in [name [exported? def_type def_data def_value]])
            (list))))))

(def: .public modules
  (Meta (List [Text Module]))
  (function (_ lux)
    (|> lux
        (value@ #.modules)
        [lux]
        #try.Success)))

(def: .public (tags_of type_name)
  (-> Name (Meta (Maybe (List Name))))
  (do ..monad
    [.let [[module_name name] type_name]
     module (..module module_name)]
    (case (plist.value name (value@ #.definitions module))
      (#.Some (#.Type [exported? type (#.Right slots)]))
      (in (#.Some (list\each (|>> [module_name])
                             (#.Item slots))))

      _
      (in #.None))))

(def: .public location
  (Meta Location)
  (function (_ lux)
    (#try.Success [lux (value@ #.location lux)])))

(def: .public expected_type
  (Meta Type)
  (function (_ lux)
    (case (value@ #.expected lux)
      (#.Some type)
      (#try.Success [lux type])

      #.None
      (#try.Failure "Not expecting any type."))))

(def: .public (imported_modules module_name)
  (-> Text (Meta (List Text)))
  (do ..monad
    [(^slots [#.imports]) (..module module_name)]
    (in imports)))

(def: .public (imported_by? import module)
  (-> Text Text (Meta Bit))
  (do ..monad
    [(^slots [#.imports]) (..module module)]
    (in (list.any? (text\= import) imports))))

(def: .public (imported? import)
  (-> Text (Meta Bit))
  (\ ..functor each
     (|>> (value@ #.imports) (list.any? (text\= import)))
     ..current_module))

(def: .public (tag tag_name)
  (-> Name (Meta [Nat (List Name) Type]))
  (do ..monad
    [.let [[module name] tag_name]
     =module (..module module)
     this_module_name ..current_module_name
     imported! (..imported? module)]
    (case (plist.value (text\composite "#" name) (value@ #.definitions =module))
      (^or (#.Some (#.Label [exported? type group idx]))
           (#.Some (#.Slot [exported? type group idx])))
      (if (or (text\= this_module_name module)
              (and imported! exported?))
        (in [idx (list\each (|>> [module]) group) type])
        (..failure ($_ text\composite "Cannot access tag: " (name\encoded tag_name) " from module " this_module_name)))

      _
      (..failure ($_ text\composite
                     "Unknown tag: " (name\encoded tag_name))))))

(def: .public (tag_lists module)
  (-> Text (Meta (List [(List Name) Type])))
  (do ..monad
    [=module (..module module)
     this_module_name ..current_module_name]
    (in (list.all (function (_ [short global])
                    (case global
                      (#.Type [exported? type labels])
                      (if (or exported?
                              (text\= this_module_name module))
                        (#.Some [(list\each (|>> [module])
                                            (case labels
                                              (#.Left tags)
                                              (#.Item tags)
                                              
                                              (#.Right slots)
                                              (#.Item slots)))
                                 type])
                        #.None)

                      _
                      #.None))
                  (value@ #.definitions =module)))))

(def: .public locals
  (Meta (List (List [Text Type])))
  (function (_ lux)
    (case (list.inits (value@ #.scopes lux))
      #.None
      (#try.Failure "No local environment")

      (#.Some scopes)
      (#try.Success [lux
                     (list\each (|>> (value@ [#.locals #.mappings])
                                     (list\each (function (_ [name [type _]])
                                                  [name type])))
                                scopes)]))))

(def: .public (de_aliased def_name)
  (-> Name (Meta Name))
  (do ..monad
    [constant (..definition def_name)]
    (in (case constant
          (#.Alias real_def_name)
          real_def_name

          (#.Definition _)
          def_name

          (#.Type _)
          def_name

          (#.Label _)
          def_name

          (#.Slot _)
          def_name))))

(def: .public compiler_state
  (Meta Lux)
  (function (_ lux)
    (#try.Success [lux lux])))

(def: .public type_context
  (Meta Type_Context)
  (function (_ lux)
    (#try.Success [lux (value@ #.type_context lux)])))

(def: .public (lifted result)
  (All (_ a) (-> (Try a) (Meta a)))
  (case result
    (#try.Success output)
    (\ ..monad in output)

    (#try.Failure error)
    (..failure error)))

(def: .public (eval type code)
  (-> Type Code (Meta Any))
  (do {! ..monad}
    [eval (\ ! each (value@ #.eval)
             ..compiler_state)]
    (eval type code)))