(.using
 [library
  [lux (.except type private)
   ["@" target]
   ["[0]" type]
   ["[0]" ffi (.only import:)]
   ["[0]" meta]
   [abstract
    ["[0]" monad (.only do)]]
   [control
    ["[0]" pipe]
    ["[0]" function]
    ["[0]" try (.only Try)]
    ["[0]" exception (.only exception:)]
    ["<>" parser
     ["<[0]>" type (.only Parser)]
     ["<[0]>" code]]]
   [data
    ["[0]" text
     ["%" format (.only Format)]]
    [format
     [xml (.only XML)]
     ["[0]" json]]
    [collection
     ["[0]" array]
     ["[0]" list ("[1]#[0]" monad)]
     ["[0]" dictionary]]]
   [macro
    ["^" pattern]
    ["[0]" template]
    ["[0]" syntax (.only syntax:)]
    ["[0]" code]]
   [math
    [number
     [ratio (.only Ratio)]
     ["n" nat]
     ["i" int]]]
   [time (.only Time)
    [instant (.only Instant)]
    [duration (.only Duration)]
    [date (.only Date)]
    [month (.only Month)]
    [day (.only Day)]]]])

(with_expansions [<jvm> (these (import: java/lang/String
                                 "[1]::[0]")

                               (import: (java/lang/Class a)
                                 "[1]::[0]"
                                 (getCanonicalName [] java/lang/String))

                               (import: java/lang/Object
                                 "[1]::[0]"
                                 (new [])
                                 (toString [] java/lang/String)
                                 (getClass [] (java/lang/Class java/lang/Object)))

                               (import: java/lang/Integer
                                 "[1]::[0]"
                                 (longValue [] long))

                               (import: java/lang/Long
                                 "[1]::[0]"
                                 (intValue [] int))

                               (import: java/lang/Number
                                 "[1]::[0]"
                                 (intValue [] int)
                                 (longValue [] long)
                                 (doubleValue [] double)))]
  (for @.old (these <jvm>)
       @.jvm (these <jvm>)

       @.js
       (these (import: JSON
                "[1]::[0]"
                ("static" stringify [.Any] ffi.String))
              (import: Array
                "[1]::[0]"
                ("static" isArray [.Any] ffi.Boolean)))

       @.python
       (these (type: PyType
                (Primitive "python_type"))
              
              (import: (type [.Any] PyType))
              (import: (str [.Any] ffi.String)))

       @.lua
       (these (import: (type [.Any] ffi.String))
              (import: (tostring [.Any] ffi.String))

              (import: math
                "[1]::[0]"
                ("static" type [.Any] "?" ffi.String)))

       @.ruby
       (these (import: Class
                "[1]::[0]")

              (import: Object
                "[1]::[0]"
                (class [] Class)
                (to_s [] ffi.String)))

       @.php
       (these (import: (gettype [.Any] ffi.String))
              (import: (strval [.Any] ffi.String)))

       @.scheme
       (these (import: (boolean? [.Any] Bit))
              (import: (integer? [.Any] Bit))
              (import: (real? [.Any] Bit))
              (import: (string? [.Any] Bit))
              (import: (vector? [.Any] Bit))
              (import: (pair? [.Any] Bit))
              (import: (car [.Any] .Any))
              (import: (cdr [.Any] .Any))
              (import: (format [Text .Any] Text)))
       ))

(def: Inspector
  (.type (Format Any)))

(for @.lua (def: (tuple_array tuple)
             (-> (array.Array Any) (array.Array Any))
             (array.of_list
              (loop (again [idx 0])
                (let [member ("lua array read" idx tuple)]
                  (if ("lua object nil?" member)
                    {.#End}
                    {.#Item member (again (++ idx))})))))
     (these))

(def: (tuple_inspection inspection)
  (-> Inspector Inspector)
  (with_expansions [<adaption> (for @.lua (~~ (these ..tuple_array))
                                    (~~ (these)))]
    (`` (|>> (as (array.Array Any))
             <adaption>
             (array.list {.#None})
             (list#each inspection)
             (text.interposed " ")
             (text.enclosed ["[" "]"])))))

(def: .public (inspection value)
  Inspector
  (with_expansions [<jvm> (let [object (as java/lang/Object value)]
                            (`` (<| (~~ (template [<class> <processing>]
                                          [(case (ffi.as <class> object)
                                             {.#Some value}
                                             (`` (|> value (~~ (template.spliced <processing>))))
                                             
                                             {.#None})]

                                          [java/lang/Boolean [ffi.of_boolean %.bit]]
                                          [java/lang/Long [ffi.of_long %.int]]
                                          [java/lang/Number [java/lang/Number::doubleValue ffi.of_double %.frac]]
                                          [java/lang/String [ffi.of_string %.text]]
                                          ))
                                    (case (ffi.as [java/lang/Object] object)
                                      {.#Some value}
                                      (let [value (as (array.Array java/lang/Object) value)]
                                        (case (array.item 0 value)
                                          (^.multi {.#Some tag}
                                                   [(ffi.as java/lang/Integer tag)
                                                    {.#Some tag}]
                                                   [[(array.item 1 value) (array.item 2 value)]
                                                    [last? {.#Some choice}]])
                                          (let [last? (case last?
                                                        {.#Some _} #1
                                                        {.#None} #0)]
                                            (|> (%.format (%.nat (.nat (ffi.of_long (java/lang/Integer::longValue tag))))
                                                          " " (%.bit last?)
                                                          " " (inspection choice))
                                                (text.enclosed ["{" "}"])))

                                          _
                                          (tuple_inspection inspection value)))
                                      {.#None})
                                    (ffi.of_string (java/lang/Object::toString object)))))]
    (for @.old <jvm>
         @.jvm <jvm>

         @.js
         (case (ffi.type_of value)
           (^.template [<type_of> <then>]
             [<type_of>
              (`` (|> value (~~ (template.spliced <then>))))])
           (["boolean" [(as .Bit) %.bit]]
            ["number" [(as .Frac) %.frac]]
            ["string" [(as .Text) %.text]]
            ["undefined" [JSON::stringify]])
           
           "object"
           (let [variant_tag ("js object get" "_lux_tag" value)
                 variant_flag ("js object get" "_lux_flag" value)
                 variant_value ("js object get" "_lux_value" value)]
             (cond (not (or ("js object undefined?" variant_tag)
                            ("js object undefined?" variant_flag)
                            ("js object undefined?" variant_value)))
                   (|> (%.format (JSON::stringify variant_tag)
                                 " " (%.bit (not ("js object null?" variant_flag)))
                                 " " (inspection variant_value))
                       (text.enclosed ["{" "}"]))

                   (not (or ("js object undefined?" ("js object get" "_lux_low" value))
                            ("js object undefined?" ("js object get" "_lux_high" value))))
                   (|> value (as .Int) %.int)

                   (Array::isArray value)
                   (tuple_inspection inspection value)
                   
                   ... else
                   (JSON::stringify value)))

           _
           (JSON::stringify value))

         @.python
         (case (..str (..type value))
           (^.template [<type_of> <class_of> <then>]
             [(^.or <type_of> <class_of>)
              (`` (|> value (~~ (template.spliced <then>))))])
           (["<type 'bool'>" "<class 'bool'>" [(as .Bit) %.bit]]
            ["<type 'int'>" "<class 'int'>" [(as .Int) %.int]]
            ["<type 'float'>" "<class 'float'>" [(as .Frac) %.frac]]
            ["<type 'str'>" "<class 'str'>" [(as .Text) %.text]]
            ["<type 'unicode'>" "<class 'unicode'>" [(as .Text) %.text]])

           (^.or "<type 'list'>" "<class 'list'>")
           (tuple_inspection inspection value)

           (^.or "<type 'tuple'>" "<class 'tuple'>")
           (let [variant (as (array.Array Any) value)]
             (case (array.size variant)
               3 (let [variant_tag ("python array read" 0 variant)
                       variant_flag ("python array read" 1 variant)
                       variant_value ("python array read" 2 variant)]
                   (if (or ("python object none?" variant_tag)
                           ("python object none?" variant_value))
                     (..str value)
                     (|> (%.format (|> variant_tag (as .Nat) %.nat)
                                   " " (|> variant_flag "python object none?" not %.bit)
                                   " " (inspection variant_value))
                         (text.enclosed ["{" "}"]))))
               _ (..str value)))

           _
           (..str value))

         @.lua
         (case (..type value)
           (^.template [<type_of> <then>]
             [<type_of>
              (`` (|> value (~~ (template.spliced <then>))))])
           (["boolean" [(as .Bit) %.bit]]
            ["string" [(as .Text) %.text]]
            ["nil" [(pipe.new "nil" [])]])

           "number"
           (case (math::type value)
             {.#Some "integer"} (|> value (as .Int) %.int)
             {.#Some "float"} (|> value (as .Frac) %.frac)
             
             _
             (..tostring value))
           
           "table"
           (let [variant_tag ("lua object get" "_lux_tag" value)
                 variant_flag ("lua object get" "_lux_flag" value)
                 variant_value ("lua object get" "_lux_value" value)]
             (if (or ("lua object nil?" variant_tag)
                     ("lua object nil?" variant_value))
               (tuple_inspection inspection value)
               (|> (%.format (|> variant_tag (as .Nat) %.nat)
                             " " (%.bit (not ("lua object nil?" variant_flag)))
                             " " (inspection variant_value))
                   (text.enclosed ["{" "}"]))))

           _
           (..tostring value))

         @.ruby
         (template.let [(class_of <literal>)
                        [(|> <literal>
                             (as ..Object)
                             Object::class)]

                        (to_s <object>)
                        [(|> <object>
                             (as ..Object)
                             Object::to_s)]]
           (let [value_class (class_of value)]
             (`` (cond (~~ (template [<literal> <type> <format>]
                             [(same? (class_of <literal>) value_class)
                              (|> value (as <type>) <format>)]

                             [#0 Bit %.bit]
                             [#1 Bit %.bit]
                             [+1 Int %.int]
                             [+1.0 Frac %.frac]
                             ["" Text %.text]
                             [("ruby object nil") Any (pipe.new "nil" [])]
                             ))

                       (same? (class_of {.#None}) value_class)
                       (let [variant_tag ("ruby object get" "_lux_tag" value)
                             variant_flag ("ruby object get" "_lux_flag" value)
                             variant_value ("ruby object get" "_lux_value" value)]
                         (if (or ("ruby object nil?" variant_tag)
                                 ("ruby object nil?" variant_value))
                           (tuple_inspection inspection value)
                           (|> (%.format (|> variant_tag (as .Nat) %.nat)
                                         " " (%.bit (not ("ruby object nil?" variant_flag)))
                                         " " (inspection variant_value))
                               (text.enclosed ["{" "}"]))))

                       (same? (class_of [[] []]) value_class)
                       (tuple_inspection inspection value)

                       ... else
                       (to_s value)))))

         @.php
         (case (..gettype value)
           (^.template [<type_of> <then>]
             [<type_of>
              (`` (|> value (~~ (template.spliced <then>))))])
           (["boolean" [(as .Bit) %.bit]]
            ["integer" [(as .Int) %.int]]
            ["double" [(as .Frac) %.frac]]
            ["string" [(as .Text) %.text]]
            ["NULL" [(pipe.new "null" [])]]
            ["array" [(tuple_inspection inspection)]])

           "object"
           (let [variant_tag ("php object get" "_lux_tag" value)
                 variant_flag ("php object get" "_lux_flag" value)
                 variant_value ("php object get" "_lux_value" value)]
             (if (or ("php object null?" variant_tag)
                     ("php object null?" variant_value))
               (..strval value)
               (|> (%.format (|> variant_tag (as .Nat) %.nat)
                             " " (%.bit (not ("php object null?" variant_flag)))
                             " " (inspection variant_value))
                   (text.enclosed ["{" "}"]))))

           _
           (..strval value))

         @.scheme
         (`` (cond (~~ (template [<when> <then>]
                         [(<when> value)
                          (`` (|> value (~~ (template.spliced <then>))))]

                         [..boolean? [(as .Bit) %.bit]]
                         [..integer? [(as .Int) %.int]]
                         [..real? [(as .Frac) %.frac]]
                         [..string? [(as .Text) %.text]]
                         ["scheme object nil?" [(pipe.new "()" [])]]
                         [..vector? [(tuple_inspection inspection)]]))

                   (..pair? value)
                   (let [variant_tag (..car value)
                         variant_rest (..cdr value)]
                     (if (and (..integer? variant_tag)
                              (i.> +0 (as Int variant_tag))
                              (..pair? variant_rest))
                       (let [variant_flag (..car variant_rest)
                             variant_value (..cdr variant_rest)]
                         (|> (%.format (|> variant_tag (as .Nat) %.nat)
                                       " " (%.bit (not ("scheme object nil?" variant_flag)))
                                       " " (inspection variant_value))
                             (text.enclosed ["{" "}"])))
                       (..format ["~s" value])))

                   ... else
                   (..format ["~s" value])
                   ))
         )))

(exception: .public (cannot_represent_value [type Type])
  (exception.report
   "Type" (%.type type)))

(type: Representation
  (-> Any Text))

(def: primitive_representation
  (Parser Representation)
  (`` (all <>.either
           (do <>.monad
             [_ (<type>.exactly Any)]
             (in (function.constant "[]")))
           
           (~~ (template [<type> <formatter>]
                 [(do <>.monad
                    [_ (<type>.sub <type>)]
                    (in (|>> (as <type>) <formatter>)))]

                 [Bit %.bit]
                 [Nat %.nat]
                 [Int %.int]
                 [Rev %.rev]
                 [Frac %.frac]
                 [Text %.text]))
           )))

(def: (special_representation representation)
  (-> (Parser Representation) (Parser Representation))
  (`` (all <>.either
           (~~ (template [<type> <formatter>]
                 [(do <>.monad
                    [_ (<type>.sub <type>)]
                    (in (|>> (as <type>) <formatter>)))]

                 [Ratio %.ratio]
                 [Symbol %.symbol]
                 [Location %.location]
                 [Type %.type]
                 [Code %.code]
                 
                 [Instant %.instant]
                 [Duration %.duration]
                 [Date %.date]
                 [Time %.time]
                 [Month %.month]
                 [Day %.day]
                 
                 [json.JSON %.json]
                 [XML %.xml]))

           (do <>.monad
             [[_ elemT] (<type>.applied (<>.and (<type>.exactly List) <type>.any))
              elemR (<type>.local (list elemT) representation)]
             (in (|>> (as (List Any)) (%.list elemR))))

           (do <>.monad
             [[_ elemT] (<type>.applied (<>.and (<type>.exactly Maybe) <type>.any))
              elemR (<type>.local (list elemT) representation)]
             (in (|>> (as (Maybe Any))
                      (%.maybe elemR)))))))

(def: (variant_representation representation)
  (-> (Parser Representation) (Parser Representation))
  (do <>.monad
    [membersR+ (<type>.variant (<>.many representation))]
    (in (function (_ variantV)
          (let [[lefts right? sub_repr] (loop (again [lefts 0
                                                      representations membersR+
                                                      variantV variantV])
                                          (case representations
                                            {.#Item leftR {.#Item rightR extraR+}}
                                            (case (as (Or Any Any) variantV)
                                              {.#Left left}
                                              [lefts #0 (leftR left)]

                                              {.#Right right}
                                              (case extraR+
                                                {.#End}
                                                [lefts #1 (rightR right)]

                                                _
                                                (again (++ lefts) {.#Item rightR extraR+} right)))

                                            _
                                            (undefined)))]
            (%.format "{" (%.nat lefts) " " (%.bit right?) " " sub_repr "}"))))))

(def: (tuple_representation representation)
  (-> (Parser Representation) (Parser Representation))
  (do <>.monad
    [membersR+ (<type>.tuple (<>.many representation))]
    (in (function (_ tupleV)
          (let [tuple_body (loop (again [representations membersR+
                                         tupleV tupleV])
                             (case representations
                               {.#End}
                               ""
                               
                               {.#Item lastR {.#End}}
                               (lastR tupleV)
                               
                               {.#Item headR tailR}
                               (let [[leftV rightV] (as [Any Any] tupleV)]
                                 (%.format (headR leftV) " " (again tailR rightV)))))]
            (%.format "[" tuple_body "]"))))))

(def: representation_parser
  (Parser Representation)
  (<>.rec
   (function (_ representation)
     (all <>.either
          ..primitive_representation
          (..special_representation representation)
          (..variant_representation representation)
          (..tuple_representation representation)

          (do <>.monad
            [[funcT inputsT+] (<type>.applied (<>.and <type>.any (<>.many <type>.any)))]
            (case (type.applied inputsT+ funcT)
              {.#Some outputT}
              (<type>.local (list outputT) representation)

              {.#None}
              (<>.failure "")))

          (do <>.monad
            [[name anonymous] <type>.named]
            (<type>.local (list anonymous) representation))

          (<>.failure "")
          ))))

(def: .public (representation type value)
  (-> Type Any (Try Text))
  (case (<type>.result ..representation_parser type)
    {try.#Success representation}
    {try.#Success (representation value)}

    {try.#Failure _}
    (exception.except ..cannot_represent_value type)))

(syntax: .public (private [definition <code>.symbol])
  (let [[module _] definition]
    (in (list (` ("lux in-module"
                  (~ (code.text module))
                  (~ (code.symbol definition))))))))

(def: .public (log! message)
  (-> Text Any)
  ("lux io log" message))

(exception: .public (type_hole [location Location
                                type Type])
  (exception.report
   "Location" (%.location location)
   "Type" (%.type type)))

(syntax: .public (hole [])
  (do meta.monad
    [location meta.location
     expectedT meta.expected_type]
    (function.constant (exception.except ..type_hole [location expectedT]))))

(type: Target
  [Text (Maybe Code)])

(def: target
  (<code>.Parser Target)
  (<>.either (<>.and <code>.local
                     (# <>.monad in {.#None}))
             (<code>.tuple (<>.and <code>.local
                                   (# <>.monad each (|>> {.#Some}) <code>.any)))))

(exception: .public (unknown_local_binding [name Text])
  (exception.report
   "Name" (%.text name)))

(syntax: .public (here [targets (is (<code>.Parser (List Target))
                                    (|> ..target
                                        <>.some
                                        (<>.else (list))))])
  (do [! meta.monad]
    [location meta.location
     locals meta.locals
     .let [environment (|> locals
                           list.together
                           ... The list is reversed to make sure that, when building the dictionary,
                           ... later bindings overshadow earlier ones if they have the same name.
                           list.reversed
                           (dictionary.of_list text.hash))]
     targets (is (Meta (List Target))
                 (case targets
                   {.#End}
                   (|> environment
                       dictionary.keys
                       (list#each (function (_ local) [local {.#None}]))
                       in)

                   _
                   (monad.each ! (function (_ [name format])
                                   (if (dictionary.key? environment name)
                                     (in [name format])
                                     (function.constant (exception.except ..unknown_local_binding [name]))))
                               targets)))]
    (in (list (` (..log! ("lux text concat"
                          (~ (code.text (%.format (%.location location) text.new_line)))
                          ((~! exception.report)
                           (~+ (|> targets
                                   (list#each (function (_ [name format])
                                                (let [format (case format
                                                               {.#None}
                                                               (` (~! ..inspection))
                                                               
                                                               {.#Some format}
                                                               format)]
                                                  (list (code.text name)
                                                        (` ((~ format) (~ (code.local name))))))))
                                   list#conjoint))))))))))