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

(with_expansions [<jvm> (as_is (import: java/lang/String)

                               (import: (java/lang/Class a)
                                 ["#::."
                                  (getCanonicalName [] java/lang/String)])

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

                               (import: java/lang/Integer
                                 ["#::."
                                  (longValue [] long)])

                               (import: java/lang/Long
                                 ["#::."
                                  (intValue [] int)])

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

        @.js
        (as_is (import: JSON
                 ["#::."
                  (#static stringify [.Any] ffi.String)])
               (import: Array
                 ["#::."
                  (#static isArray [.Any] ffi.Boolean)]))

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

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

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

        @.ruby
        (as_is (import: Class)

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

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

        @.scheme
        (as_is (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 [idx 0]
                 (let [member ("lua array read" idx tuple)]
                   (if ("lua object nil?" member)
                     #.End
                     (#.Item member (recur (++ idx))))))))}
     (as_is))

(def: (tuple_inspection inspection)
  (-> Inspector Inspector)
  (with_expansions [<adaption> (for {@.lua (~~ (as_is ..tuple_array))}
                                    (~~ (as_is)))]
    (`` (|>> (:as (array.Array Any))
             <adaption>
             array.list
             (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.check <class> object)
                                             (#.Some value)
                                             (`` (|> value (~~ (template.spliced <processing>))))
                                             #.None)]

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

                                          _
                                          (tuple_inspection inspection value)))
                                      #.None)
                                    (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'>" "<type '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" [(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 (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" [(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?" [(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)
  (`` ($_ <>.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))
  (`` ($_ <>.either
          (~~ (template [<type> <formatter>]
                [(do <>.monad
                   [_ (<type>.sub <type>)]
                   (in (|>> (:as <type>) <formatter>)))]

                [Ratio %.ratio]
                [Name %.name]
                [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 [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)]

                                                _
                                                (recur (++ 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 [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) " " (recur tailR rightV)))))]
            (%.format "[" tuple_body "]"))))))

(def: representation_parser
  (Parser Representation)
  (<>.rec
   (function (_ representation)
     ($_ <>.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>.identifier])
  (let [[module _] definition]
    (in (list (` ("lux in-module"
                  (~ (code.text module))
                  (~ (code.identifier 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_identifier
                     (\ <>.monad in #.None))
             (<code>.record (<>.and <code>.local_identifier
                                    (\ <>.monad each (|>> #.Some) <code>.any)))))

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

(syntax: .public (here [targets (: (<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 (: (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)
                           (~+ (list\each (function (_ [name format])
                                            (let [format (case format
                                                           #.None
                                                           (` (~! ..inspection))
                                                           
                                                           (#.Some format)
                                                           format)]
                                              (` [(~ (code.text name))
                                                  ((~ format) (~ (code.local_identifier name)))])))
                                          targets))))))))))