path: root/stdlib/source/lux/debug.lux

(.module:
  [lux (#- type)
   ["@" target]
   ["." type]
   ["." host (#+ import:)]
   [abstract
    [monad (#+ do)]]
   [control
    [pipe (#+ case> new>)]
    ["." function]
    ["." try (#+ Try)]
    ["." exception (#+ exception:)]
    ["<>" parser
     ["<.>" type (#+ Parser)]
     ["<.>" code]]]
   [data
    ["." text
     ["%" format (#+ format)]]
    [format
     [xml (#+ XML)]
     ["." json]]
    [collection
     ["." array]
     ["." list ("#\." functor)]]]
   ["." meta
    ["." location]]
   [macro
    ["." template]
    ["." syntax (#+ syntax:)]
    ["." code]]
   [time
    [instant (#+ Instant)]
    [duration (#+ Duration)]
    [date (#+ Date)]]])

(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] host.String))
               (import: Array
                 (#static isArray [.Any] host.Boolean)))

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

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

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

        @.ruby
        (as_is (import: Class)

               (import: Object
                 (type [] Class)))}))

(def: Inspector (-> Any Text))

(def: (inspect_tuple inspect)
  (-> Inspector Inspector)
  (|>> (:coerce (array.Array Any))
       array.to_list
       (list\map inspect)
       (text.join_with " ")
       (text.enclose ["[" "]"])))

(def: #export (inspect value)
  Inspector
  (with_expansions [<jvm> (let [object (:coerce java/lang/Object value)]
                            (`` (<| (~~ (template [<class> <processing>]
                                          [(case (host.check <class> object)
                                             (#.Some value)
                                             (`` (|> value (~~ (template.splice <processing>))))
                                             #.None)]

                                          [java/lang/Boolean [(:coerce .Bit) %.bit]]
                                          [java/lang/String [(:coerce .Text) %.text]]
                                          [java/lang/Long [(:coerce .Int) %.int]]
                                          [java/lang/Number [java/lang/Number::doubleValue %.frac]]
                                          ))
                                    (case (host.check [java/lang/Object] object)
                                      (#.Some value)
                                      (let [value (:coerce (array.Array java/lang/Object) value)]
                                        (case (array.read 0 value)
                                          (^multi (#.Some tag)
                                                  [(host.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?)
                                                        " " (inspect choice))
                                                (text.enclose ["(" ")"])))

                                          _
                                          (inspect_tuple inspect value)))
                                      #.None)
                                    (java/lang/Object::toString object))))]
    (for {@.old <jvm>
          @.jvm <jvm>

          @.js
          (case (host.type_of value)
            (^template [<type_of> <then>]
              [<type_of>
               (`` (|> value (~~ (template.splice <then>))))])
            (["boolean" [(:coerce .Bit) %.bit]]
             ["string" [(:coerce .Text) %.text]]
             ["number" [(:coerce .Frac) %.frac]]
             ["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)))
                                " " (inspect variant_value))
                        (text.enclose ["(" ")"]))

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

                    (Array::isArray value)
                    (inspect_tuple inspect value)
                    
                    ## else
                    (JSON::stringify value)))

            _
            (JSON::stringify value))

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

            "<type 'list'>"
            (inspect_tuple inspect value)

            "<type 'tuple'>"
            (let [variant (:coerce (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 (:coerce .Int) %.int)
                                  " " (|> variant_flag "python object none?" not %.bit)
                                  " " (inspect variant_value))
                          (text.enclose ["(" ")"]))))
                _ (..str value)))

            _
            (..str value))

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

            "number"
            (case (math::type [value])
              (#.Some "integer") (|> value (:coerce .Int) %.int)
              (#.Some "float") (|> value (:coerce .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 (not (or ("lua object nil?" variant_tag)
                           ("lua object nil?" variant_flag)
                           ("lua object nil?" variant_value)))
                (|> (format (|> variant_tag (:coerce .Int) %.int)
                            " " (%.bit (not ("lua object nil?" variant_flag)))
                            " " (inspect variant_value))
                    (text.enclose ["(" ")"]))
                (inspect_tuple inspect value)))

            _
            (..tostring value))

          @.ruby
          (template.with [(class_of <literal>)
                          (Object::type (:coerce ..Object <literal>))]
            (let [value_class (Object::type (:coerce ..Object value))]
              (`` (cond (~~ (template [<literal> <type> <format>]
                              [(is? (class_of <literal>) value_class)
                               (|> value (:coerce <type>) <format>)]

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

                        (is? (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 (not (or ("ruby object nil?" variant_tag)
                                       ("ruby object nil?" variant_flag)
                                       ("ruby object nil?" variant_value)))
                            (|> (format (|> variant_tag (:coerce .Int) %.int)
                                        " " (%.bit (not ("ruby object nil?" variant_flag)))
                                        " " (inspect variant_value))
                                (text.enclose ["(" ")"]))
                            (inspect_tuple inspect value)))

                        (is? (class_of [[] []]) value_class)
                        (inspect_tuple inspect value)

                        ## else
                        (:coerce Text ("ruby object do" "to_s" value))))))
          })))

(exception: #export (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)]
            (wrap (function.constant "[]")))
          
          (~~ (template [<type> <formatter>]
                [(do <>.monad
                   [_ (<type>.sub <type>)]
                   (wrap (|>> (:coerce <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>)]
                   (wrap (|>> (:coerce <type>) <formatter>)))]

                [Type %.type]
                [Code %.code]
                [Instant %.instant]
                [Duration %.duration]
                [Date %.date]
                [json.JSON %.json]
                [XML %.xml]))

          (do <>.monad
            [[_ elemT] (<type>.apply (<>.and (<type>.exactly List) <type>.any))
             elemR (<type>.local (list elemT) representation)]
            (wrap (|>> (:coerce (List Any)) (%.list elemR))))

          (do <>.monad
            [[_ elemT] (<type>.apply (<>.and (<type>.exactly Maybe) <type>.any))
             elemR (<type>.local (list elemT) representation)]
            (wrap (|>> (:coerce (Maybe Any))
                       (case> #.None
                              "#.None"

                              (#.Some elemV)
                              (format "(#.Some " (elemR elemV) ")"))))))))

(def: (variant_representation representation)
  (-> (Parser Representation) (Parser Representation))
  (do <>.monad
    [membersR+ (<type>.variant (<>.many representation))]
    (wrap (function (_ variantV)
            (let [[lefts right? sub_repr] (loop [lefts 0
                                                 representations membersR+
                                                 variantV variantV]
                                            (case representations
                                              (#.Cons leftR (#.Cons rightR extraR+))
                                              (case (:coerce (| Any Any) variantV)
                                                (#.Left left)
                                                [lefts #0 (leftR left)]

                                                (#.Right right)
                                                (case extraR+
                                                  #.Nil
                                                  [lefts #1 (rightR right)]

                                                  extraR+
                                                  (recur (inc lefts) (#.Cons 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))]
    (wrap (function (_ tupleV)
            (let [tuple_body (loop [representations membersR+
                                    tupleV tupleV]
                               (case representations
                                 #.Nil
                                 ""
                                 
                                 (#.Cons lastR #.Nil)
                                 (lastR tupleV)
                                 
                                 (#.Cons headR tailR)
                                 (let [[leftV rightV] (:coerce [Any Any] tupleV)]
                                   (format (headR leftV) " " (recur tailR rightV)))))]
              (format "[" tuple_body "]"))))))

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

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

             #.None
             (<>.fail "")))

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

         (<>.fail "")
         ))))

(def: #export (represent type value)
  (-> Type Any (Try Text))
  (case (<type>.run ..representation type)
    (#try.Success representation)
    (#try.Success (representation value))

    (#try.Failure _)
    (exception.throw ..cannot_represent_value type)))

(syntax: #export (private {definition <code>.identifier})
  (let [[module _] definition]
    (wrap (list (` ("lux in-module"
                    (~ (code.text module))
                    (~ (code.identifier definition))))))))

(def: #export (log! message)
  {#.doc "Logs message to standard output."}
  (-> Text Any)
  ("lux io log" message))

(exception: #export (type_hole {location Location} {type Type})
  (exception.report
   ["Location" (location.format location)]
   ["Type" (%.type type)]))

(syntax: #export (:hole)
  (do meta.monad
    [location meta.location
     expectedT meta.expected_type]
    (meta.fail (exception.construct ..type_hole [location expectedT]))))