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

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

(def: #export (nth idx input)
  (-> Nat Text (Maybe Nat))
  ("lux text char" input idx))

(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))
  ("lux text clip" input from to))

(def: #export (clip' from input)
  (-> Nat Text (Maybe Text))
  ("lux text clip" input from (size input)))

(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 "\n"))

(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)
                   (let [char (|> idx ("lux text char" input) (maybe.default +0))]
                     (recur (inc idx)
                            (|> hash
                                (i64.left-shift +5)
                                (n/- hash)
                                (n/+ char))))
                   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)
  (|>> (replace-all "\\" "\\\\")
       (replace-all "\t" "\\t")
       (replace-all "\v" "\\v")
       (replace-all "\b" "\\b")
       (replace-all "\n" "\\n")
       (replace-all "\r" "\\r")
       (replace-all "\f" "\\f")
       (replace-all "\"" "\\\"")
       (..enclose' "\"")))

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

(def: #export (space? char)
  {#.doc "Checks whether the character is white-space."}
  (-> Nat Bit)
  (case char
    (^or (^ (char "\t")) (^ (char "\v"))
         (^ (char " "))  (^ (char "\n"))
         (^ (char "\r")) (^ (char "\f")))
    #1

    _
    #0))