-- | A built-in representation for efficient string manipulation.
-- @Text@ values are /not/ lists of characters.
module Text
  ( -- * Text
    Text,
    isEmpty,
    length,
    reverse,
    repeat,
    replace,

    -- * Building and Splitting
    append,
    concat,
    split,
    join,
    words,
    lines,

    -- * Get Substrings
    slice,
    left,
    right,
    dropLeft,
    dropRight,

    -- * Check for Substrings
    contains,
    startsWith,
    endsWith,
    indexes,
    indices,

    -- * Int Conversions
    toInt,
    fromInt,

    -- * Float Conversions
    toFloat,
    fromFloat,

    -- * Char Conversions
    fromChar,
    cons,
    uncons,

    -- * List Conversions
    toList,
    fromList,

    -- * Formatting

    -- | Cosmetic operations such as padding with extra characters or trimming whitespace.
    toUpper,
    toLower,
    pad,
    padLeft,
    padRight,
    trim,
    trimLeft,
    trimRight,

    -- * Higher-Order Functions
    map,
    filter,
    foldl,
    foldr,
    any,
    all,
  )
where

import Basics
  ( Bool,
    Float,
    Int,
    clamp,
    (+),
    (-),
    (<),
    (<<),
    (<=),
    (>>),
    (|>),
  )
import Char (Char)
import qualified Data.Text
import List (List)
import qualified List
import Maybe (Maybe)
import qualified Text.Read
import Prelude (otherwise)
import qualified Prelude

-- | A @Text@ is a chunk of text:
--
-- > "Hello!"
-- > "How are you?"
-- > "🙈🙉🙊"
-- >
-- > -- strings with escape characters
-- > "this\n\t\"that\""
-- > "\x1F648\x1F649\x1F64A" -- "🙈🙉🙊"
--
-- A @Text@ can represent any sequence of [unicode characters](https://en.wikipedia.org/wiki/Unicode). You can use the unicode escapes from @\x0000@ to @\x10FFFF@ to represent characters by their code point. You can also include the unicode characters directly. Using the escapes can be better if you need one of the many whitespace characters with different widths.
type Text = Data.Text.Text

-- | Determine if a string is empty.
--
-- > isEmpty "" == True
-- > isEmpty "the world" == False
isEmpty :: Text -> Bool
isEmpty :: Text -> Bool
isEmpty = Text -> Bool
Data.Text.null

-- | Get the length of a string.
--
-- > length "innumerable" == 11
-- > length "" == 0
length :: Text -> Int
length :: Text -> Int
length =
  Text -> Int
Data.Text.length (Text -> Int) -> (Int -> Int) -> Text -> Int
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral

-- | Reverse a string.
--
-- > reverse "stressed" == "desserts"
reverse :: Text -> Text
reverse :: Text -> Text
reverse = Text -> Text
Data.Text.reverse

-- | Repeat a string /n/ times.
--
-- > repeat 3 "ha" == "hahaha"
repeat :: Int -> Text -> Text
repeat :: Int -> Text -> Text
repeat =
  Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (Int -> Int) -> (Int -> Text -> Text) -> Int -> Text -> Text
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Int -> Text -> Text
Data.Text.replicate

-- | Replace all occurrences of some substring.
--
-- > replace "." "-" "Json.Decode.succeed" == "Json-Decode-succeed"
-- > replace "," "/" "a,b,c,d,e"           == "a/b/c/d/e"
replace :: Text -> Text -> Text -> Text
replace :: Text -> Text -> Text -> Text
replace = Text -> Text -> Text -> Text
Data.Text.replace

-- BUILDING AND SPLITTING

-- | Append two strings. You can also use the @(++)@ operator to do this.
--
-- > append "butter" "fly" == "butterfly"
append :: Text -> Text -> Text
append :: Text -> Text -> Text
append = Text -> Text -> Text
Data.Text.append

-- | Concatenate many strings into one.
--
-- > concat ["never","the","less"] == "nevertheless"
concat :: List Text -> Text
concat :: List Text -> Text
concat = List Text -> Text
Data.Text.concat

-- | Split a string using a given separator.
--
-- > split "," "cat,dog,cow"        == ["cat","dog","cow"]
-- > split "/" "home/evan/Desktop/" == ["home","evan","Desktop", ""]
split :: Text -> Text -> List Text
split :: Text -> Text -> List Text
split = Text -> Text -> List Text
Data.Text.splitOn

-- | Put many strings together with a given separator.
--
-- > join "a" ["H","w","ii","n"]        == "Hawaiian"
-- > join " " ["cat","dog","cow"]       == "cat dog cow"
-- > join "/" ["home","evan","Desktop"] == "home/evan/Desktop"
join :: Text -> List Text -> Text
join :: Text -> List Text -> Text
join = Text -> List Text -> Text
Data.Text.intercalate

-- | Break a string into words, splitting on chunks of whitespace.
--
-- > words "How are \t you? \n Good?" == ["How","are","you?","Good?"]
words :: Text -> List Text
words :: Text -> List Text
words = Text -> List Text
Data.Text.words

-- | Break a string into lines, splitting on newlines.
--
-- > lines "How are you?\nGood?" == ["How are you?", "Good?"]
lines :: Text -> List Text
lines :: Text -> List Text
lines = Text -> List Text
Data.Text.lines

-- SUBSTRINGS

-- | Take a substring given a start and end index. Negative indexes
-- are taken starting from the /end/ of the list.
--
-- > slice  7  9 "snakes on a plane!" == "on"
-- > slice  0  6 "snakes on a plane!" == "snakes"
-- > slice  0 -7 "snakes on a plane!" == "snakes on a"
-- > slice -6 -1 "snakes on a plane!" == "plane"
slice :: Int -> Int -> Text -> Text
slice :: Int -> Int -> Text -> Text
slice Int
from Int
to Text
text
  | Int
to' Int -> Int -> Int
forall number. Num number => number -> number -> number
- Int
from' Int -> Int -> Bool
forall comparable.
Ord comparable =>
comparable -> comparable -> Bool
<= Int
0 = Text
Data.Text.empty
  | Bool
otherwise =
    Int -> Text -> Text
Data.Text.drop Int
from' (Int -> Text -> Text
Data.Text.take Int
to' Text
text)
  where
    len :: Int
len = Text -> Int
Data.Text.length Text
text
    handleNegative :: Int -> Int
handleNegative Int
value
      | Int
value Int -> Int -> Bool
forall comparable.
Ord comparable =>
comparable -> comparable -> Bool
< Int
0 = Int
len Int -> Int -> Int
forall number. Num number => number -> number -> number
+ Int
value
      | Bool
otherwise = Int
value
    normalize :: Int -> Int
normalize =
      Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
        (Int -> Int) -> (Int -> Int) -> Int -> Int
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Int -> Int
handleNegative
        (Int -> Int) -> (Int -> Int) -> Int -> Int
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Int -> Int -> Int -> Int
forall number. Ord number => number -> number -> number -> number
clamp Int
0 Int
len
    from' :: Int
from' = Int -> Int
normalize Int
from
    to' :: Int
to' = Int -> Int
normalize Int
to

-- | Take /n/ characters from the left side of a string.
--
-- > left 2 "Mulder" == "Mu"
left :: Int -> Text -> Text
left :: Int -> Text -> Text
left =
  Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (Int -> Int) -> (Int -> Text -> Text) -> Int -> Text -> Text
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Int -> Text -> Text
Data.Text.take

-- | Take /n/ characters from the right side of a string.
--
-- > right 2 "Scully" == "ly"
right :: Int -> Text -> Text
right :: Int -> Text -> Text
right =
  Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (Int -> Int) -> (Int -> Text -> Text) -> Int -> Text -> Text
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Int -> Text -> Text
Data.Text.takeEnd

-- | Drop /n/ characters from the left side of a string.
--
-- > dropLeft 2 "The Lone Gunmen" == "e Lone Gunmen"
dropLeft :: Int -> Text -> Text
dropLeft :: Int -> Text -> Text
dropLeft =
  Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (Int -> Int) -> (Int -> Text -> Text) -> Int -> Text -> Text
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Int -> Text -> Text
Data.Text.drop

-- | Drop /n/ characters from the right side of a string.
--
-- > dropRight 2 "Cigarette Smoking Man" == "Cigarette Smoking M"
dropRight :: Int -> Text -> Text
dropRight :: Int -> Text -> Text
dropRight =
  Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (Int -> Int) -> (Int -> Text -> Text) -> Int -> Text -> Text
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Int -> Text -> Text
Data.Text.dropEnd

-- DETECT SUBSTRINGS

-- | See if the second string contains the first one.
--
-- > contains "the" "theory" == True
-- > contains "hat" "theory" == False
-- > contains "THE" "theory" == False
contains :: Text -> Text -> Bool
contains :: Text -> Text -> Bool
contains = Text -> Text -> Bool
Data.Text.isInfixOf

-- | See if the second string starts with the first one.
--
-- > startsWith "the" "theory" == True
-- > startsWith "ory" "theory" == False
startsWith :: Text -> Text -> Bool
startsWith :: Text -> Text -> Bool
startsWith = Text -> Text -> Bool
Data.Text.isPrefixOf

-- | See if the second string ends with the first one.
--
-- > endsWith "the" "theory" == False
-- > endsWith "ory" "theory" == True
endsWith :: Text -> Text -> Bool
endsWith :: Text -> Text -> Bool
endsWith = Text -> Text -> Bool
Data.Text.isSuffixOf

-- | Get all of the indexes for a substring in another string.
--
-- > indexes "i" "Mississippi"   == [1,4,7,10]
-- > indexes "ss" "Mississippi"  == [2,5]
-- > indexes "needle" "haystack" == []
indexes :: Text -> Text -> List Int
indexes :: Text -> Text -> List Int
indexes Text
n Text
h
  | Text -> Bool
isEmpty Text
n = []
  | Bool
otherwise = Text -> Text -> List Int
forall b. Num b => Text -> Text -> List b
indexes' Text
n Text
h
  where
    indexes' :: Text -> Text -> List b
indexes' Text
needle Text
haystack =
      Text -> Text -> [(Text, Text)]
Data.Text.breakOnAll Text
needle Text
haystack
        [(Text, Text)] -> ([(Text, Text)] -> List b) -> List b
forall a b. a -> (a -> b) -> b
|> ((Text, Text) -> b) -> [(Text, Text)] -> List b
forall a b. (a -> b) -> List a -> List b
List.map
          ( \(Text
lhs, Text
_) ->
              Text -> Int
Data.Text.length Text
lhs
                Int -> (Int -> b) -> b
forall a b. a -> (a -> b) -> b
|> Int -> b
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
          )

-- | Alias for @indexes@.
indices :: Text -> Text -> List Int
indices :: Text -> Text -> List Int
indices = Text -> Text -> List Int
indexes

-- FORMATTING

-- | Convert a string to all upper case. Useful for case-insensitive comparisons
-- and VIRTUAL YELLING.
--
-- > toUpper "skinner" == "SKINNER"
toUpper :: Text -> Text
toUpper :: Text -> Text
toUpper = Text -> Text
Data.Text.toUpper

-- | Convert a string to all lower case. Useful for case-insensitive comparisons.
--
-- > toLower "X-FILES" == "x-files"
toLower :: Text -> Text
toLower :: Text -> Text
toLower = Text -> Text
Data.Text.toLower

-- | Pad a string on both sides until it has a given length.
--
-- > pad 5 ' ' "1"   == "  1  "
-- > pad 5 ' ' "11"  == "  11 "
-- > pad 5 ' ' "121" == " 121 "
pad :: Int -> Char -> Text -> Text
pad :: Int -> Char -> Text -> Text
pad =
  Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (Int -> Int)
-> (Int -> Char -> Text -> Text) -> Int -> Char -> Text -> Text
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Int -> Char -> Text -> Text
Data.Text.center

-- | Pad a string on the left until it has a given length.
--
-- > padLeft 5 '.' "1"   == "....1"
-- > padLeft 5 '.' "11"  == "...11"
-- > padLeft 5 '.' "121" == "..121"
padLeft :: Int -> Char -> Text -> Text
padLeft :: Int -> Char -> Text -> Text
padLeft =
  Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (Int -> Int)
-> (Int -> Char -> Text -> Text) -> Int -> Char -> Text -> Text
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Int -> Char -> Text -> Text
Data.Text.justifyRight

-- | Pad a string on the right until it has a given length.
--
-- > padRight 5 '.' "1"   == "1...."
-- > padRight 5 '.' "11"  == "11..."
-- > padRight 5 '.' "121" == "121.."
padRight :: Int -> Char -> Text -> Text
padRight :: Int -> Char -> Text -> Text
padRight =
  Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (Int -> Int)
-> (Int -> Char -> Text -> Text) -> Int -> Char -> Text -> Text
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Int -> Char -> Text -> Text
Data.Text.justifyLeft

-- | Get rid of whitespace on both sides of a string.
--
-- > trim "  hats  \n" == "hats"
trim :: Text -> Text
trim :: Text -> Text
trim = Text -> Text
Data.Text.strip

-- | Get rid of whitespace on the left of a string.
--
-- > trimLeft "  hats  \n" == "hats  \n"
trimLeft :: Text -> Text
trimLeft :: Text -> Text
trimLeft = Text -> Text
Data.Text.stripStart

-- | Get rid of whitespace on the right of a string.
--
-- > trimRight "  hats  \n" == "  hats"
trimRight :: Text -> Text
trimRight :: Text -> Text
trimRight = Text -> Text
Data.Text.stripEnd

-- INT CONVERSIONS

-- | Try to convert a string into an int, failing on improperly formatted strings.
--
-- > Text.toInt "123" == Just 123
-- > Text.toInt "-42" == Just -42
-- > Text.toInt "3.1" == Nothing
-- > Text.toInt "31a" == Nothing
--
-- If you are extracting a number from some raw user input, you will typically
-- want to use [@Maybe.withDefault@](Maybe#withDefault) to handle bad data:
--
-- > Maybe.withDefault 0 (Text.toInt "42") == 42
-- > Maybe.withDefault 0 (Text.toInt "ab") == 0
toInt :: Text -> Maybe Int
toInt :: Text -> Maybe Int
toInt Text
text =
  String -> Maybe Int
forall a. Read a => String -> Maybe a
Text.Read.readMaybe String
str'
  where
    str :: String
str = Text -> String
Data.Text.unpack Text
text
    str' :: String
str' = case String
str of
      Char
'+' : String
rest -> String
rest
      String
other -> String
other

-- | Convert an @Int@ to a @Text@.
--
-- > Text.fromInt 123 == "123"
-- > Text.fromInt -42 == "-42"
fromInt :: Int -> Text
fromInt :: Int -> Text
fromInt = String -> Text
Data.Text.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Int -> String
forall a. Show a => a -> String
Prelude.show

-- FLOAT CONVERSIONS

-- | Try to convert a string into a float, failing on improperly formatted strings.
--
-- > Text.toFloat "123" == Just 123.0
-- > Text.toFloat "-42" == Just -42.0
-- > Text.toFloat "3.1" == Just 3.1
-- > Text.toFloat "31a" == Nothing
--
-- If you are extracting a number from some raw user input, you will typically
-- want to use [@Maybe.withDefault@](Maybe#withDefault) to handle bad data:
--
-- > Maybe.withDefault 0 (Text.toFloat "42.5") == 42.5
-- > Maybe.withDefault 0 (Text.toFloat "cats") == 0
toFloat :: Text -> Maybe Float
toFloat :: Text -> Maybe Float
toFloat Text
text =
  String -> Maybe Float
forall a. Read a => String -> Maybe a
Text.Read.readMaybe String
str'
  where
    str :: String
str = Text -> String
Data.Text.unpack Text
text
    str' :: String
str' = case String
str of
      Char
'+' : String
rest -> String
rest
      Char
'.' : String
rest -> Char
'0' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'.' Char -> String -> String
forall a. a -> [a] -> [a]
: String
rest
      String
other -> String
other

-- | Convert a @Float@ to a @Text@.
--
-- > Text.fromFloat 123 == "123"
-- > Text.fromFloat -42 == "-42"
-- > Text.fromFloat 3.9 == "3.9"
fromFloat :: Float -> Text
fromFloat :: Float -> Text
fromFloat = String -> Text
Data.Text.pack (String -> Text) -> (Float -> String) -> Float -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Float -> String
forall a. Show a => a -> String
Prelude.show

-- LIST CONVERSIONS

-- | Convert a Text to a list of characters.
--
-- > toList "abc" == ['a','b','c']
-- > toList "🙈🙉🙊" == ['🙈','🙉','🙊']
toList :: Text -> List Char
toList :: Text -> String
toList = Text -> String
Data.Text.unpack

-- | Convert a list of characters into a Text. Can be useful if you
-- want to create a string primarily by consing, perhaps for decoding
-- something.
--
-- > fromList ['a','b','c'] == "abc"
-- > fromList ['🙈','🙉','🙊'] == "🙈🙉🙊"
fromList :: List Char -> Text
fromList :: String -> Text
fromList = String -> Text
Data.Text.pack

-- CHAR CONVERSIONS

-- | Create a Text from a given character.
--
-- > fromChar 'a' == "a"
fromChar :: Char -> Text
fromChar :: Char -> Text
fromChar = Char -> Text
Data.Text.singleton

-- | Add a character to the beginning of a Text.
--
-- > cons 'T' "he truth is out there" == "The truth is out there"
cons :: Char -> Text -> Text
cons :: Char -> Text -> Text
cons = Char -> Text -> Text
Data.Text.cons

-- | Split a non-empty Text into its head and tail. This lets you
-- pattern match on strings exactly as you would with lists.
--
-- > uncons "abc" == Just ('a',"bc")
-- > uncons ""    == Nothing
uncons :: Text -> Maybe (Char, Text)
uncons :: Text -> Maybe (Char, Text)
uncons = Text -> Maybe (Char, Text)
Data.Text.uncons

-- HIGHER-ORDER FUNCTIONS

-- | Transform every character in a Text
--
-- > map (\c -> if c == '/' then '.' else c) "a/b/c" == "a.b.c"
map :: (Char -> Char) -> Text -> Text
map :: (Char -> Char) -> Text -> Text
map = (Char -> Char) -> Text -> Text
Data.Text.map

-- | Keep only the characters that pass the test.
--
-- > filter isDigit "R2-D2" == "22"
filter :: (Char -> Bool) -> Text -> Text
filter :: (Char -> Bool) -> Text -> Text
filter = (Char -> Bool) -> Text -> Text
Data.Text.filter

-- | Reduce a Text from the left.
--
-- > foldl cons "" "time" == "emit"
foldl :: (Char -> b -> b) -> b -> Text -> b
foldl :: (Char -> b -> b) -> b -> Text -> b
foldl Char -> b -> b
f = (b -> Char -> b) -> b -> Text -> b
forall a. (a -> Char -> a) -> a -> Text -> a
Data.Text.foldl' (\b
a Char
b -> Char -> b -> b
f Char
b b
a)

-- | Reduce a Text from the right.
--
-- > foldr cons "" "time" == "time"
foldr :: (Char -> b -> b) -> b -> Text -> b
foldr :: (Char -> b -> b) -> b -> Text -> b
foldr = (Char -> b -> b) -> b -> Text -> b
forall a. (Char -> a -> a) -> a -> Text -> a
Data.Text.foldr

-- | Determine whether /any/ characters pass the test.
--
-- > any isDigit "90210" == True
-- > any isDigit "R2-D2" == True
-- > any isDigit "heart" == False
any :: (Char -> Bool) -> Text -> Bool
any :: (Char -> Bool) -> Text -> Bool
any = (Char -> Bool) -> Text -> Bool
Data.Text.any

-- | Determine whether /all/ characters pass the test.
--
-- > all isDigit "90210" == True
-- > all isDigit "R2-D2" == False
-- > all isDigit "heart" == False
all :: (Char -> Bool) -> Text -> Bool
all :: (Char -> Bool) -> Text -> Bool
all = (Char -> Bool) -> Text -> Bool
Data.Text.all