(;module:
  lux
  (lux (control monoid
                eq
                [order]
                monad
                codec
                hash)
       (data (coll [list])
             maybe)))

## [Functions]
(def: #export (size x)
  (-> Text Nat)
  [(_lux_proc ["text" "size"] [x])])

(def: #export (nth idx input)
  (-> Nat Text (Maybe Char))
  (_lux_proc ["text" "char"] [input idx]))

(def: #export (contains? sub text)
  (-> Text Text Bool)
  (_lux_proc ["text" "contains?"] [text sub]))

(do-template [<name> <proc>]
  [(def: #export (<name> input)
     (-> Text Text)
     (_lux_proc ["text" <proc>] [input]))]
  [lower-case "lower-case"]
  [upper-case "upper-case"]
  [trim       "trim"]
  )

(def: #export (clip from to input)
  (-> Nat Nat Text (Maybe Text))
  (_lux_proc ["text" "clip"] [input from to]))

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

(def: #export (replace pattern value template)
  (-> Text Text Text Text)
  (_lux_proc ["text" "replace-all"] [template pattern value]))

(do-template [<general> <common> <proc> <start>]
  [(def: #export (<common> pattern input)
     (-> Text Text (Maybe Nat))
     (_lux_proc ["text" <proc>] [input pattern <start>]))

   (def: #export (<general> pattern from input)
     (-> Text Nat Text (Maybe Nat))
     (_lux_proc ["text" <proc>] [input pattern from]))]

  [index-of      index-of'      "index"      +0]
  [last-index-of last-index-of' "last-index" (size input)]
  )

(def: #export (starts-with? prefix x)
  (-> Text Text Bool)
  (case (index-of' prefix x)
    (#;Some +0)
    true

    _
    false))

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

    _
    false))

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

## [Structures]
(struct: #export _ (Eq Text)
  (def: (= test subject)
    (_lux_proc ["text" "="] [subject test])))

(struct: #export _ (order;Order Text)
  (def: eq Eq<Text>)

  (def: (< test subject)
    (_lux_proc ["text" "<"] [subject test]))

  (def: (<= test subject)
    (or (_lux_proc ["text" "<"] [subject test])
        (_lux_proc ["text" "="] [subject test])))

  (def: (> test subject)
    (_lux_proc ["text" "<"] [test subject]))

  (def: (>= test subject)
    (or (_lux_proc ["text" "<"] [test subject])
        (_lux_proc ["text" "="] [test subject])))
  )

(struct: #export _ (Monoid Text)
  (def: unit "")
  (def: (append left right)
    (_lux_proc ["text" "append"] [left right])))

(open Monoid<Text>)

(struct: #export _ (Codec Text Text)
  (def: (encode original)
    (let [escaped (|> original
                      (replace "\\" "\\\\")
                      (replace "\t" "\\t")
                      (replace "\v" "\\v")
                      (replace "\b" "\\b")
                      (replace "\n" "\\n")
                      (replace "\r" "\\r")
                      (replace "\f" "\\f")
                      (replace "\"" "\\\"")
                      )]
      ($_ append "\"" escaped "\"")))

  (def: (decode input)
    (if (and (starts-with? "\"" input)
             (ends-with? "\"" input))
      (case (clip +1 (n.dec (size input)) input)
        (#;Some input')
        (|> input'
            (replace "\\\\" "\\")
            (replace "\\t" "\t")
            (replace "\\v" "\v")
            (replace "\\b" "\b")
            (replace "\\n" "\n")
            (replace "\\r" "\r")
            (replace "\\f" "\f")
            (replace "\\\"" "\"")
            #;Some)

        #;None
        (#;Left "Couldn't decode text"))
      (#;Left "Couldn't decode text"))))

(struct: #export _ (Hash Text)
  (def: eq Eq<Text>)
  
  (def: (hash input)
    (_lux_proc ["text" "hash"] [input])))

(def: #export concat
  (-> (List Text) Text)
  (let [(^open) list;Fold<List>
        (^open) Monoid<Text>]
    (|>. list;reverse (fold append unit))))

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

(def: #export (empty? text)
  (-> Text Bool)
  (case text
    "" true
    _  false))

(def: #export (replace-once pattern value template)
  (-> Text Text Text Text)
  (default template
    (do Monad<Maybe>
      [[pre post] (split-with pattern template)]
      (let [(^open) Monoid<Text>]
        (wrap ($_ append pre value post))))))

(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>]
    ($_ append 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))