path: root/stdlib/source/library/lux/data/text.lux

(.require
 [library
  [lux (.except char)
   ["@" target]
   [abstract
    [hash (.only Hash)]
    [monoid (.only Monoid)]
    [equivalence (.only Equivalence)]
    [order (.only Order)]
    [monad (.only do)]
    [codec (.only Codec)]]
   [control
    ["[0]" maybe]]
   [data
    [collection
     ["[0]" list (.use "[1]#[0]" mix)]]]
   [macro
    ["^" pattern]]
   [math
    [number
     ["n" nat]
     ["[0]" i64]]]]])

(type .public Char
  Nat)

... TODO: Instead of ints, chars should be produced fron nats.
... (The JVM specifies chars as 16-bit unsigned integers)
(def .public of_char
  (-> Char Text)
  (|>> .int "lux i64 char"))

(with_template [<code> <short> <long>]
  [(def .public <long> (..of_char <code>))
   (def .public <short> <long>)]

  [00 \0  null]
  [07 \a  alarm]
  [08 \b  back_space]
  [09 \t  tab]
  [10 \n  new_line]
  [11 \v  vertical_tab]
  [12 \f  form_feed]
  [13 \r  carriage_return]
  [34 \'' double_quote]
  )

(def .public line_feed
  ..new_line)

(def .public size
  (-> Text Nat)
  (|>> "lux text size"))

(def .public (char index input)
  (-> Nat Text (Maybe Char))
  (if (n.< ("lux text size" input) index)
    {.#Some ("lux text char" index input)}
    {.#None}))

(def .public (index_since offset pattern input)
  (-> Nat Text Text (Maybe Nat))
  ("lux text index" offset pattern input))

(def .public (index pattern input)
  (-> Text Text (Maybe Nat))
  (index_since 0 pattern input))

(def .public (last_index part text)
  (-> Text Text (Maybe Nat))
  (loop (again [offset 0
                output (is (Maybe Nat)
                           {.#None})])
    (let [output' ("lux text index" offset part text)]
      (case output'
        {.#None}
        output

        {.#Some offset'}
        (again (++ offset') output')))))

(def .public (starts_with? prefix x)
  (-> Text Text Bit)
  (case (index prefix x)
    {.#Some 0}
    true

    _
    false))

(def .public (ends_with? postfix x)
  (-> Text Text Bit)
  (case (last_index postfix x)
    {.#Some n}
    (n.= (size x)
         (n.+ (size postfix) n))

    _
    false))

(def .public (enclosed_by? boundary value)
  (-> Text Text Bit)
  (and (starts_with? boundary value)
       (ends_with? boundary value)))

(def .public (contains? sub text)
  (-> Text Text Bit)
  (case ("lux text index" 0 sub text)
    {.#Some _}
    true

    _
    false))

(def .public (prefix param subject)
  (-> Text Text Text)
  ("lux text concat" param subject))

(def .public (suffix param subject)
  (-> Text Text Text)
  ("lux text concat" subject param))

(def .public (enclosed [left right] content)
  (-> [Text Text] Text Text)
  (all "lux text concat" left content right))

(def .public (enclosed' boundary content)
  (-> Text Text Text)
  (enclosed [boundary boundary] content))

(def .public format
  (-> Text Text)
  (..enclosed' ..double_quote))

(def .public (clip offset size input)
  (-> Nat Nat Text (Maybe Text))
  (if (|> size (n.+ offset) (n.> ("lux text size" input)))
    {.#None}
    {.#Some ("lux text clip" offset size input)}))

(def .public (clip_since offset input)
  (-> Nat Text (Maybe Text))
  (let [size ("lux text size" input)]
    (if (n.> size offset)
      {.#None}
      {.#Some ("lux text clip" offset (n.- offset size) input)})))

(def .public (split_at at x)
  (-> Nat Text (Maybe [Text Text]))
  (case [(..clip 0 at x) (..clip_since at x)]
    [{.#Some pre} {.#Some post}]
    {.#Some [pre post]}

    _
    {.#None}))

(def .public (split_by token sample)
  (-> Text Text (Maybe [Text Text]))
  (do maybe.monad
    [index (index token sample)
     [pre post'] (split_at index sample)
     [_ post] (split_at (size token) post')]
    (in [pre post])))

(def .public (all_split_by token sample)
  (-> Text Text (List Text))
  (loop (again [input sample
                output (is (List Text) (list))])
    (case (..split_by token input)
      {.#Some [pre post]}
      (|> output
          {.#Item pre}
          (again post))

      {.#None}
      (|> output
          {.#Item input}
          list.reversed))))

(def .public (replaced_once pattern replacement template)
  (-> Text Text Text Text)
  (<| (maybe.else template)
      (do maybe.monad
        [[pre post] (..split_by pattern template)]
        (in (all "lux text concat" pre replacement post)))))

(for @.js (these (def defined?
                   (macro (_ tokens lux)
                     (case tokens
                       (pattern (list it))
                       {.#Right [lux (list (` (.case ("js type-of" ("js constant" (~ it)))
                                                "undefined"
                                                .false

                                                (~' _)
                                                .true)))]}

                       _
                       {.#Left ""})))
                 (def if_nashorn
                   (macro (_ tokens lux)
                     (case tokens
                       (pattern (list then else))
                       {.#Right [lux (list (if (and (..defined? "java")
                                                    (..defined? "java.lang")
                                                    (..defined? "java.lang.Object"))
                                             then
                                             else))]}

                       _
                       {.#Left ""}))))
     (these))

(def .public (replaced pattern replacement template)
  (-> Text Text Text Text)
  (with_expansions [... Inefficient default
                    <default> (loop (again [left ""
                                            right template])
                                (case (..split_by pattern right)
                                  {.#Some [pre post]}
                                  (again (all "lux text concat" left pre replacement) post)

                                  {.#None}
                                  ("lux text concat" left right)))]
    (for @.old
         (as Text
             ("jvm invokevirtual:java.lang.String:replace:java.lang.CharSequence,java.lang.CharSequence"
              (as (Primitive "java.lang.String") template)
              (as (Primitive "java.lang.CharSequence") pattern)
              (as (Primitive "java.lang.CharSequence") replacement)))
         @.jvm
         (as Text
             ("jvm member invoke virtual" [] "java.lang.String" "replace" []
              (as (Primitive "java.lang.String") template)
              ["Ljava/lang/CharSequence;" (as (Primitive "java.lang.CharSequence") pattern)]
              ["Ljava/lang/CharSequence;" (as (Primitive "java.lang.CharSequence") replacement)]))
         @.js
         ... TODO: Remove this when Nashorn is no longer being used.
         (..if_nashorn
          <default>
          (as Text
              ("js object do" "replaceAll" template [pattern replacement])))
         @.python
         (as Text
             ("python object do" "replace" template [pattern replacement]))
         ... TODO @.lua
         @.ruby
         (as Text
             ("ruby object do" "gsub" template [pattern replacement]))
         @.php
         (as Text
             ("php apply" (as_expected ("php constant" "str_replace"))
              pattern replacement template))
         ... TODO @.scheme
         ... TODO @.common_lisp
         ... TODO @.r
         
         ... Inefficient default
         <default>)))

(def .public equivalence
  (Equivalence Text)
  (implementation
   (def (= reference sample)
     ("lux text =" reference sample))))

(def .public order
  (Order Text)
  (implementation
   (def equivalence ..equivalence)

   (def (< reference sample)
     ("lux text <" reference sample))))

(def .public monoid
  (Monoid Text)
  (implementation
   (def identity "")
   
   (def (composite left right)
     ("lux text concat" left right))))

(def .public hash
  (Hash Text)
  (implementation
   (def equivalence ..equivalence)
   
   (def (hash input)
     (for @.old
          (|> input
              (is (Primitive "java.lang.Object"))
              "jvm invokevirtual:java.lang.Object:hashCode:"
              "jvm convert int-to-long"
              (as Nat))

          @.jvm
          (|> input
              (as (Primitive "java.lang.Object"))
              ("jvm member invoke virtual" [] "java.lang.Object" "hashCode" [])
              "jvm conversion int-to-long"
              "jvm object cast"
              (is (Primitive "java.lang.Long"))
              (as Nat))
          ... Platform-independent default.
          (let [length ("lux text size" input)]
            (loop (again [index 0
                          hash 0])
              (if (n.< length index)
                (again (++ index)
                       (|> hash
                           (i64.left_shifted 5)
                           (n.- hash)
                           (n.+ ("lux text char" index input))))
                hash)))))))

(def .public together
  (-> (List Text) Text)
  (let [(^.open "[0]") ..monoid]
    (|>> list.reversed
         (list#mix composite identity))))

(def .public (interposed separator texts)
  (-> Text (List Text) Text)
  (case separator
    "" (..together texts)
    _ (|> texts (list.interposed separator) ..together)))

(def .public (empty? text)
  (-> Text Bit)
  (case text
    "" true
    _  false))

(def .public space
  Text
  " ")

(def .public (space? char)
  (-> Char Bit)
  (with_expansions [<options> (with_template [<char>]
                                [(pattern (.char (~~ (static <char>))))]

                                [..tab]
                                [..vertical_tab]
                                [..space]
                                [..new_line]
                                [..carriage_return]
                                [..form_feed]
                                )]
    (`` (case char
          (^.or <options>)
          true

          _
          false))))

(def .public (lower_cased value)
  (-> Text Text)
  (for @.old
       (as Text
           ("jvm invokevirtual:java.lang.String:toLowerCase:"
            (as (Primitive "java.lang.String") value)))
       @.jvm
       (as Text
           ("jvm member invoke virtual" [] "java.lang.String" "toLowerCase" []
            (as (Primitive "java.lang.String") value)))
       @.js
       (as Text
           ("js object do" "toLowerCase" value []))
       @.python
       (as Text
           ("python object do" "lower" value []))
       @.lua
       (as Text
           ("lua apply" ("lua constant" "string.lower") [value]))
       @.ruby
       (as Text
           ("ruby object do" "downcase" value []))))

(def .public (upper_cased value)
  (-> Text Text)
  (for @.old
       (as Text
           ("jvm invokevirtual:java.lang.String:toUpperCase:"
            (as (Primitive "java.lang.String") value)))
       @.jvm
       (as Text
           ("jvm member invoke virtual" [] "java.lang.String" "toUpperCase" []
            (as (Primitive "java.lang.String") value)))
       @.js
       (as Text
           ("js object do" "toUpperCase" value []))
       @.python
       (as Text
           ("python object do" "upper" value []))
       @.lua
       (as Text
           ("lua apply" ("lua constant" "string.upper") [value]))
       @.ruby
       (as Text
           ("ruby object do" "upcase" value []))))