##  Copyright (c) Eduardo Julian. All rights reserved.
##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
##  If a copy of the MPL was not distributed with this file,
##  You can obtain one at http://mozilla.org/MPL/2.0/.

(;module:
  lux
  (lux/control eq
               [ord]
               codec
               hash)
  (.. [text "Text/" Monoid<Text>]))

## [Structures]
(struct: #export _ (Eq Char)
  (def: (= x y)
    (_lux_proc ["jvm" "ceq"] [x y])))

(struct: #export _ (Hash Char)
  (def: eq Eq<Char>)
  (def: hash
    (|>. []
         (_lux_proc ["jvm" "c2i"])
         []
         (_lux_proc ["jvm" "i2l"])
         int-to-nat)))

(struct: #export _ (ord;Ord Char)
  (def: eq Eq<Char>)

  (do-template [<name> <op>]
    [(def: (<name> test subject)
       (_lux_proc ["jvm" <op>] [subject test]))]

    [<  "clt"]
    [>  "cgt"]
    )

  (do-template [<name> <op>]
    [(def: (<name> test subject)
       (or (_lux_proc ["jvm" "ceq"] [subject test])
           (_lux_proc ["jvm" <op>] [subject test])))]

    [<= "clt"]
    [>= "cgt"]
    ))

(struct: #export _ (Codec Text Char)
  (def: (encode x)
    (let [as-text (case x
                    #"\t" "\\t"
                    #"\b" "\\b"
                    #"\n" "\\n"
                    #"\r" "\\r"
                    #"\f" "\\f"
                    #"\"" "\\\""
                    #"\\" "\\\\"
                    _     (_lux_proc ["jvm" "invokevirtual:java.lang.Object:toString:"] [x]))]
      ($_ Text/append "#\"" as-text "\"")))

  (def: (decode y)
    (let [size (text;size y)]
      (if (and (text;starts-with? "#\"" y)
               (text;ends-with? "\"" y)
               (or (=+ +4 size)
                   (=+ +5 size)))
        (if (=+ +4 size)
          (case (text;at +2 y)
            #;None
            (#;Left (Text/append "Wrong syntax for Char: " y))

            (#;Some char)
            (#;Right char))
          (case [(text;at +2 y) (text;at +3 y)]
            [(#;Some #"\\") (#;Some char)]
            (case char
              #"t" (#;Right #"\t")
              #"b" (#;Right #"\b")
              #"n" (#;Right #"\n")
              #"r" (#;Right #"\r")
              #"f" (#;Right #"\f")
              #"\"" (#;Right #"\"")
              #"\\" (#;Right #"\\")
              #"t" (#;Right #"\t")
              _    (#;Left (Text/append "Wrong syntax for Char: " y)))

            _
            (#;Left (Text/append "Wrong syntax for Char: " y))))
        (#;Left (Text/append "Wrong syntax for Char: " y))))))

## [Values]
(def: #export (space? x)
  {#;doc "Checks whether the character is white-space."}
  (-> Char Bool)
  (_lux_proc ["jvm" "invokestatic:java.lang.Character:isWhitespace:char"] [x]))

(def: #export (as-text x)
  (-> Char Text)
  (_lux_proc ["jvm" "invokevirtual:java.lang.Object:toString:"] [x]))

(def: #export (char x)
  (-> Nat Char)
  (_lux_proc ["nat" "to-char"] [x]))

(def: #export (code x)
  (-> Char Nat)
  (_lux_proc ["char" "to-nat"] [x]))