(.module:
  [lux #*
   [control
    [monoid (#+ Monoid)]
    [equivalence (#+ Equivalence)]
    [order (#+ Order)]
    [monad (#+ Monad do)]
    [codec (#+ Codec)]
    hash]
   [data
    ["." maybe]
    [number
     ["." i64]]
    [collection
     ["." list ("list/." Fold<List>)]]]
   [compiler
    ["." host]]])

(type: #export Char Nat)

(def: #export from-code
  (-> Char Text)
  (|>> (:coerce Int) "lux int char"))

(do-template [<name> <code>]
  [(def: #export <name> (from-code <code>))]

  [back-space 8]
  [tab 9]
  [new-line 10]
  [vertical-tab 11]
  [form-feed 12]
  [carriage-return 13]
  [double-quote 34]
  )

(def: #export (size x)
  (-> Text Nat)
  ("lux text size" x))

(def: #export (nth idx input)
  (-> Nat Text (Maybe Char))
  (if (n/< ("lux text size" input) idx)
    (#.Some ("lux text char" input idx))
    #.None))

(def: #export (index-of' pattern from input)
  (-> Text Nat Text (Maybe Nat))
  ("lux text index" input pattern from))

(def: #export (index-of pattern input)
  (-> Text Text (Maybe Nat))
  ("lux text index" input pattern 0))

(def: (last-index-of'' part since text)
  (-> Text Nat Text (Maybe Nat))
  (case ("lux text index" text part (inc since))
    #.None
    (#.Some since)

    (#.Some since')
    (last-index-of'' part since' text)))

(def: #export (last-index-of' part from text)
  (-> Text Nat Text (Maybe Nat))
  (case ("lux text index" text part from)
    (#.Some since)
    (last-index-of'' part since text)

    #.None
    #.None))

(def: #export (last-index-of part text)
  (-> Text Text (Maybe Nat))
  (case ("lux text index" text part 0)
    (#.Some since)
    (last-index-of'' part since text)

    #.None
    #.None))

(def: #export (starts-with? prefix x)
  (-> Text Text Bit)
  (case (index-of prefix x)
    (#.Some 0)
    #1

    _
    #0))

(def: #export (ends-with? postfix x)
  (-> Text Text Bit)
  (case (last-index-of postfix x)
    (#.Some n)
    (n/= (size x)
         (n/+ (size postfix) n))

    _
    #0))

(def: #export (contains? sub text)
  (-> Text Text Bit)
  (case ("lux text index" text sub 0)
    (#.Some _)
    #1

    _
    #0))

(def: #export (clip from to input)
  (-> Nat Nat Text (Maybe Text))
  (if (and (n/<= to from)
           (n/<= ("lux text size" input) to))
    (#.Some ("lux text clip" input from to))
    #.None))

(def: #export (clip' from input)
  (-> Nat Text (Maybe Text))
  (let [size ("lux text size" input)]
    (if (n/<= size from)
      (#.Some ("lux text clip" input from size))
      #.None)))

(def: #export (split at x)
  (-> Nat Text (Maybe [Text Text]))
  (case [(..clip 0 at x) (..clip' at x)]
    [(#.Some pre) (#.Some post)]
    (#.Some [pre post])

    _
    #.None))

(def: #export (split-with token sample)
  (-> Text Text (Maybe [Text Text]))
  (do maybe.Monad<Maybe>
    [index (index-of token sample)
     [pre post'] (split index sample)
     [_ post] (split (size token) post')]
    (wrap [pre post])))

(def: #export (split-all-with token sample)
  (-> Text Text (List Text))
  (case (..split-with token sample)
    (#.Some [pre post])
    (#.Cons pre (split-all-with token post))

    #.None
    (#.Cons sample #.Nil)))

(def: #export split-lines
  (..split-all-with ..new-line))

(def: #export (replace-once pattern value template)
  (-> Text Text Text Text)
  (<| (maybe.default template)
      (do maybe.Monad<Maybe>
        [[pre post] (split-with pattern template)]
        (wrap ($_ "lux text concat" pre value post)))))

(def: #export (replace-all pattern value template)
  (-> Text Text Text Text)
  (case (..split-with pattern template)
    (#.Some [pre post])
    ($_ "lux text concat" pre value (replace-all pattern value post))

    #.None
    template))

(structure: #export _ (Equivalence Text)
  (def: (= test subject)
    ("lux text =" subject test)))

(structure: #export _ (Order Text)
  (def: eq Equivalence<Text>)

  (def: (< test subject)
    ("lux text <" subject test))

  (def: (<= test subject)
    (or ("lux text <" subject test)
        ("lux text =" subject test)))

  (def: (> test subject)
    ("lux text <" test subject))

  (def: (>= test subject)
    (or ("lux text <" test subject)
        ("lux text =" test subject)))
  )

(structure: #export _ (Monoid Text)
  (def: identity "")
  (def: (compose left right)
    ("lux text concat" left right)))

(structure: #export _ (Hash Text)
  (def: eq Equivalence<Text>)
  
  (def: (hash input)
    (`` (for {(~~ (static host.jvm))
              (|> input
                  (: (primitive "java.lang.String" []))
                  "jvm invokevirtual:java.lang.String:hashCode:"
                  "jvm convert int-to-long"
                  (:coerce Nat))}
             ## Platform-independent default.
             (let [length ("lux text size" input)]
               (loop [idx 0
                      hash 0]
                 (if (n/< length idx)
                   (recur (inc idx)
                          (|> hash
                              (i64.left-shift 5)
                              (n/- hash)
                              (n/+ ("lux text char" input idx))))
                   hash)))))))

(def: #export concat
  (-> (List Text) Text)
  (let [(^open ".") Monoid<Text>]
    (|>> list.reverse (list/fold compose identity))))

(def: #export (join-with sep texts)
  (-> Text (List Text) Text)
  (|> texts (list.interpose sep) concat))

(def: #export (empty? text)
  (-> Text Bit)
  (case text
    "" #1
    _  #0))

(def: #export (enclose [left right] content)
  {#.doc "Surrounds the given content text with left and right side additions."}
  (-> [Text Text] Text Text)
  (let [(^open ".") Monoid<Text>]
    ($_ "lux text concat" left content right)))

(def: #export (enclose' boundary content)
  {#.doc "Surrounds the given content text with the same boundary text."}
  (-> Text Text Text)
  (enclose [boundary boundary] content))

(def: #export encode
  (-> Text Text)
  (..enclose' ..double-quote))

(def: #export (space? char)
  {#.doc "Checks whether the character is white-space."}
  (-> Char Bit)
  (`` (case char
        (^or (^ (char (~~ (static ..tab))))
             (^ (char (~~ (static ..vertical-tab))))
             (^ (char " "))
             (^ (char (~~ (static ..new-line))))
             (^ (char (~~ (static ..carriage-return))))
             (^ (char (~~ (static ..form-feed)))))
        #1

        _
        #0)))