(.require
 [library
  [lux (.except try macro type)
   [abstract
    [functor (.only Functor)]
    [apply (.only Apply)]
    ["[0]" monad (.only Monad do)]]
   [control
    ["[0]" maybe]
    ["[0]" try (.only Try)]]
   [data
    ["[0]" product]
    ["[0]" text (.use "[1]#[0]" monoid order)]
    [collection
     ["[0]" list (.use "[1]#[0]" monoid monad)
      ["[0]" property]]]]
   [math
    [number
     ["n" nat]
     ["i" int]]]]]
 [/
  ["[0]" location]
  ["[0]" symbol (.use "[1]#[0]" codec equivalence)]
  ["[0]" code]])

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

(def .public functor
  (Functor Meta)
  (implementation
   (def (each f fa)
     (function (_ lux)
       (when (fa lux)
         {try.#Success [lux' a]}
         {try.#Success [lux' (f a)]}

         {try.#Failure msg}
         {try.#Failure msg})))))

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

   (def (on fa ff)
     (function (_ lux)
       (when (ff lux)
         {try.#Success [lux' f]}
         (when (fa lux')
           {try.#Success [lux'' a]}
           {try.#Success [lux'' (f a)]}

           {try.#Failure msg}
           {try.#Failure msg})

         {try.#Failure msg}
         {try.#Failure msg})))))

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

   (def (in x)
     (function (_ lux)
       {try.#Success [lux x]}))
   
   (def (conjoint mma)
     (function (_ lux)
       (when (mma lux)
         {try.#Success [lux' ma]}
         (ma lux')

         {try.#Failure msg}
         {try.#Failure msg})))))

(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)))
  (when (action lux)
    {try.#Success [_ output]}
    {try.#Success output}

    {try.#Failure error}
    {try.#Failure error}))

(def .public (either left right)
  (All (_ a) (-> (Meta a) (Meta a) (Meta a)))
  (function (_ lux)
    (when (left lux)
      {try.#Success [lux' output]}
      {try.#Success [lux' output]}

      {try.#Failure error}
      (right lux))))

(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 (the .#location state) error)}))

(def .public (module name)
  (-> Text (Meta Module))
  (function (_ lux)
    (when (property.value name (the .#modules lux))
      {.#Some module}
      {try.#Success [lux module]}

      _
      {try.#Failure (all text#composite "Unknown module: " name)})))

(def .public current_module_name
  (Meta Text)
  (function (_ lux)
    (when (the .#current_module lux)
      {.#Some current_module}
      {try.#Success [lux current_module]}

      _
      {try.#Failure "No current module."})))

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

(def (macro_type? type)
  (-> Type Bit)
  (when type
    {.#Named [.prelude "Macro"]
             {.#Primitive "#Macro" {.#End}}}
    true

    _
    false))

(def .public (normal name)
  (-> Symbol (Meta Symbol))
  (when name
    ["" name]
    (do ..monad
      [module_name ..current_module_name]
      (in [module_name name]))

    _
    (at ..monad in name)))

(def .public (macro full_name)
  (-> Symbol (Meta (Maybe Macro)))
  (do ..monad
    [[module name] (..normal full_name)]
    (is (Meta (Maybe Macro))
        (function (_ lux)
          {try.#Success [lux
                         (when (..current_module_name lux)
                           {try.#Success [_ this_module]}
                           (let [modules (the .#modules lux)]
                             (loop (again [module module
                                           name name])
                               (do maybe.monad
                                 [$module (property.value module modules)
                                  definition (is (Maybe Global)
                                                 (|> $module
                                                     (is Module)
                                                     (the .#definitions)
                                                     (property.value name)))]
                                 (when definition
                                   {.#Alias [r_module r_name]}
                                   (again r_module r_name)
                                   
                                   {.#Definition [exported? def_type def_value]}
                                   (if (macro_type? def_type)
                                     {.#Some (as Macro def_value)}
                                     {.#None})

                                   {.#Type [exported? type labels]}
                                   {.#None}

                                   {.#Tag _}
                                   {.#None}

                                   {.#Slot _}
                                   {.#None}))))

                           {try.#Failure error}
                           {.#None})]}))))

(def .public seed
  (Meta Nat)
  (function (_ lux)
    {try.#Success [(revised .#seed ++ lux)
                   (the .#seed lux)]}))

(def .public (module_exists? module)
  (-> Text (Meta Bit))
  (function (_ lux)
    {try.#Success [lux (when (property.value module (the .#modules lux))
                         {.#Some _}
                         true
                         
                         {.#None}
                         false)]}))

(def (on_either f x1 x2)
  (All (_ a b)
    (-> (-> a (Maybe b)) a a (Maybe b)))
  (when (f x1)
    {.#None}   (f x2)
    {.#Some y} {.#Some y}))

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

(`` (def (clean_type type)
      (-> Type (Meta Type))
      (when type
        {.#Var var}
        (function (_ lux)
          (when (|> lux
                    (the [.#type_context .#var_bindings])
                    (type_variable var))
            (,, (with_template [<pattern>]
                  [<pattern>
                   {try.#Success [lux type]}]

                  [{.#None}]
                  [{.#Some {.#Var _}}]))
            

            {.#Some type'}
            {try.#Success [lux type']}))

        _
        (at ..monad in type))))

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

        {.#None}
        {try.#Failure (all 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
  (all 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)
  (-> Symbol (Meta Global))
  (do ..monad
    [name (..normal name)
     .let [[normal_module normal_short] name]]
    (function (_ lux)
      (when (is (Maybe Global)
                (do maybe.monad
                  [(open "[0]") (|> lux
                                    (the .#modules)
                                    (property.value normal_module))]
                  (property.value normal_short #definitions)))
        {.#Some definition}
        {try.#Success [lux definition]}

        _
        (let [current_module (|> lux (the .#current_module) (maybe.else "???"))
              all_known_modules (|> lux
                                    (the .#modules)
                                    (list#each product.left)
                                    ..module_listing)]
          {try.#Failure (all text#composite
                             "Unknown definition: " (symbol#encoded name) text.new_line
                             "    Current module: " current_module text.new_line
                             (when (property.value current_module (the .#modules lux))
                               {.#Some this_module}
                               (let [candidates (|> lux
                                                    (the .#modules)
                                                    (list#each (function (_ [module_name module])
                                                                 (|> module
                                                                     (the .#definitions)
                                                                     (list.all (function (_ [def_name global])
                                                                                 (`` (when global
                                                                                       (,, (with_template [<pattern>]
                                                                                             [<pattern>
                                                                                              (if (and exported?
                                                                                                       (text#= normal_short def_name))
                                                                                                {.#Some (symbol#encoded [module_name def_name])}
                                                                                                {.#None})]

                                                                                             [{.#Definition [exported? _]}]
                                                                                             [{.#Type [exported? _]}]))

                                                                                       {.#Alias _}
                                                                                       {.#None}

                                                                                       {.#Tag _}
                                                                                       {.#None}

                                                                                       {.#Slot _}
                                                                                       {.#None})))))))
                                                    list.together
                                                    (list.sorted text#<)
                                                    (text.interposed ..listing_separator))
                                     imports (|> this_module
                                                 (the .#imports)
                                                 ..module_listing)
                                     aliases (|> this_module
                                                 (the .#module_aliases)
                                                 (list#each (function (_ [alias real]) (all text#composite alias " => " real)))
                                                 (list.sorted text#<)
                                                 (text.interposed ..listing_separator))]
                                 (all 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)
  (-> Symbol (Meta Definition))
  (do ..monad
    [definition (..definition name)]
    (when definition
      {.#Definition definition}
      (let [[exported? def_type def_value] definition]
        (if exported?
          (in definition)
          (failure (all text#composite "Definition is not an export: " (symbol#encoded name)))))

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

      {.#Alias de_aliased}
      (failure (all text#composite
                    "Aliases are not considered exports: "
                    (symbol#encoded name)))

      {.#Tag _}
      (failure (all text#composite
                    "Tags are not considered exports: "
                    (symbol#encoded name)))

      {.#Slot _}
      (failure (all text#composite
                    "Slots are not considered exports: "
                    (symbol#encoded name))))))

(def .public (definition_type name)
  (-> Symbol (Meta Type))
  (do ..monad
    [definition (definition name)]
    (when definition
      {.#Alias de_aliased}
      (definition_type de_aliased)
      
      {.#Definition [exported? def_type def_value]}
      (clean_type def_type)

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

      {.#Tag _}
      (failure (all text#composite
                    "Tags have no type: "
                    (symbol#encoded name)))

      {.#Slot _}
      (failure (all text#composite
                    "Slots have no type: "
                    (symbol#encoded name))))))

(def .public (type name)
  (-> Symbol (Meta Type))
  (when name
    ["" _name]
    (either (var_type _name)
            (definition_type name))

    _
    (definition_type name)))

(def .public (type_definition name)
  (-> Symbol (Meta Type))
  (do ..monad
    [definition (definition name)]
    (when definition
      {.#Alias de_aliased}
      (type_definition de_aliased)
      
      {.#Definition [exported? def_type def_value]}
      (let [type_code (`` ("lux in-module" (,, (static .prelude)) .type_code))]
        (if (or (same? .Type def_type)
                (at code.equivalence =
                    (type_code .Type)
                    (type_code def_type)))
          (in (as Type def_value))
          (..failure (all text#composite "Definition is not a type: " (symbol#encoded name)))))

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

      {.#Tag _}
      (..failure (all text#composite "Tag is not a type: " (symbol#encoded name)))

      {.#Slot _}
      (..failure (all text#composite "Slot is not a type: " (symbol#encoded name))))))

(def .public (globals module)
  (-> Text (Meta (List [Text Global])))
  (function (_ lux)
    (when (property.value module (the .#modules lux))
      {.#Some module}
      {try.#Success [lux (the .#definitions module)]}

      {.#None}
      {try.#Failure (all text#composite "Unknown module: " module)})))

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

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

                    {.#Tag _}
                    {.#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_value]] constants]
          (if exported?
            (in [name [exported? def_type def_value]])
            (list))))))

(def .public modules
  (Meta (List [Text Module]))
  (function (_ lux)
    (|> lux
        (the .#modules)
        [lux]
        {try.#Success})))

(`` (def .public (tags_of type_name)
      (-> Symbol (Meta (Maybe (List Symbol))))
      (do ..monad
        [.let [[module_name name] type_name]
         module (..module module_name)]
        (when (property.value name (the .#definitions module))
          {.#Some {.#Type [exported? type labels]}}
          (when labels
            (,, (with_template [<pattern>]
                  [<pattern>
                   (in {.#Some (list#each (|>> [module_name])
                                          {.#Item labels})})]

                  [{.#Left labels}]
                  [{.#Right labels}])))

          _
          (in {.#None})))))

(def .public location
  (Meta Location)
  (function (_ lux)
    {try.#Success [lux (the .#location lux)]}))

(def .public expected_type
  (Meta Type)
  (function (_ lux)
    (when (the .#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
    [(open "_[0]") (..module module_name)]
    (in _#imports)))

(def .public (imported_by? import module)
  (-> Text Text (Meta Bit))
  (do ..monad
    [(open "_[0]") (..module module)]
    (in (list.any? (text#= import) _#imports))))

(def .public (imported? import)
  (-> Text (Meta Bit))
  (at ..functor each
      (|>> (the .#imports) (list.any? (text#= import)))
      ..current_module))

(with_template [<name> <tag> <description>]
  [(def .public (<name> label_name)
     (-> Symbol (Meta [Nat (List Symbol) Type]))
     (do ..monad
       [.let [[module name] label_name]
        =module (..module module)
        this_module_name ..current_module_name]
       (when (property.value name (the .#definitions =module))
         {.#Some {<tag> [exported? type group idx]}}
         (if (or (text#= this_module_name module)
                 exported?)
           (in [idx (list#each (|>> [module]) group) type])
           (..failure (all text#composite "Cannot access " <description>  ": " (symbol#encoded label_name) " from module " this_module_name)))

         _
         (..failure (all text#composite
                         "Unknown " <description>  ": " (symbol#encoded label_name))))))]

  [tag .#Tag "tag"]
  [slot .#Slot "slot"]
  )

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

                      _
                      {.#None}))
                  (the .#definitions =module)))))

(def .public locals
  (Meta (List (List [Text Type])))
  (function (_ lux)
    (when (list.inits (the .#scopes lux))
      {.#Some scopes}
      {try.#Success [lux
                     (list#each (|>> (the [.#locals .#mappings])
                                     (list#each (function (_ [name [type _]])
                                                  [name type])))
                                scopes)]}

      {.#None}
      {try.#Failure "No local environment"})))

(def .public (de_aliased def_name)
  (-> Symbol (Meta Symbol))
  (do ..monad
    [constant (..definition def_name)]
    (in (when constant
          {.#Alias real_def_name}
          real_def_name

          {.#Definition _}
          def_name

          {.#Type _}
          def_name

          {.#Tag _}
          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 (the .#type_context lux)]}))

(def .public (lifted result)
  (All (_ a) (-> (Try a) (Meta a)))
  (when result
    {try.#Success output}
    (at ..monad in output)

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

(def .public (eval type code)
  (-> Type Code (Meta Any))
  (do [! ..monad]
    [eval (at ! each (the .#eval)
              ..compiler_state)]
    (eval type code)))

(def .public (try computation)
  (All (_ it) (-> (Meta it) (Meta (Try it))))
  (function (_ lux)
    (when (computation lux)
      {try.#Success [lux' output]}
      {try.#Success [lux' {try.#Success output}]}

      {try.#Failure error}
      {try.#Success [lux {try.#Failure error}]})))

(with_template [<type> <name> <slot>]
  [(def .public <name>
     (Meta <type>)
     (function (_ lux)
       {try.#Success [lux
                      (the [.#info <slot>] lux)]}))]

  [Text target .#target]
  [Text version .#version]
  [(List [Text Text]) configuration .#configuration]
  )