{-# LANGUAGE CPP, FlexibleInstances, Safe #-}

{-|
Module      : Data.String.Like
Description : A module that aims to provide a uniform interface to string-like types.
Maintainer  : hapytexeu+gh@gmail.com
Stability   : experimental
Portability : POSIX

The module defines a typeclass that can be implemented to provide a uniform interface for 'String'-like objects (like 'String', 'LT.Text', etc.).

The typeclass itself has default implementations that convert the 'StringLike' item first to a lazy 'LT.Text', then performs the operation, and
converts results back to its 'StringLike' object. This is usually /not/ as efficient as an operation for that specific type. Therefore it is advisable
to implement the other functions as well. One can however decide to only implement 'fromText' and 'toText'; or 'toString'.

The module contains instances for 'String', 'T.Text', 'LT.Text', 'BS.ByteString' and 'LBS.ByteString'.
-}

module Data.String.Like(
    StringLike(
        empty, cons, snoc, uncons, unsnoc
      , length, compareLength
      , toString, fromChar
      , strMap, strConcat, strConcatMap, append
      , strAny, strAll, strNull
      , intercalate, intersperse
      , transpose, reverse
      , toLower, toUpper, toTitle
      , fromText, toText
    )
  , IsString(fromString)
  , convertStringLike
  ) where

import Prelude as P

import Control.Arrow(first, second)

import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.Char as C
import Data.List as L
import Data.Function(on)
#if __GLASGOW_HASKELL__ < 803
import Data.Semigroup((<>))
#endif
import Data.String(IsString(fromString))
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Data.Text.Lazy.Encoding

-- | A typeclass that provides a uniform interface for string-like objects.
class IsString a => StringLike a where
    -- | Return an empty string-like object.
    empty :: a
    empty = Text -> a
forall a. StringLike a => Text -> a
fromText Text
LT.empty
    -- | Create a stringlike object by prepending a 'Char' to an already
    -- existing string-like object.
    cons :: Char -> a -> a
    cons = (Text -> Text) -> a -> a
forall a. StringLike a => (Text -> Text) -> a -> a
_sandwich ((Text -> Text) -> a -> a)
-> (Char -> Text -> Text) -> Char -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
LT.cons
    -- | Create a stringlike object by appending a 'Char' at the end of an
    -- already existing string-like object.
    snoc :: a -> Char -> a
    snoc a :: a
a c :: Char
c = (Text -> Text) -> a -> a
forall a. StringLike a => (Text -> Text) -> a -> a
_sandwich (Text -> Char -> Text
`LT.snoc` Char
c) a
a
    -- | Unpack a stringlike object by obtaining the first character, and
    -- the rest of the string, given the string is non-empty. 'Nothing'
    -- otherwise.
    uncons :: a -> Maybe (Char, a)
    uncons = ((Char, Text) -> (Char, a))
-> Maybe (Char, Text) -> Maybe (Char, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> a) -> (Char, Text) -> (Char, a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Text -> a
forall a. StringLike a => Text -> a
fromText) (Maybe (Char, Text) -> Maybe (Char, a))
-> (a -> Maybe (Char, Text)) -> a -> Maybe (Char, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe (Char, Text)) -> a -> Maybe (Char, Text)
forall a b. StringLike a => (Text -> b) -> a -> b
_throughText Text -> Maybe (Char, Text)
LT.uncons
    -- | Unpack a string-like object by obtaining te last character, and the
    -- string without the last character, given the string is non-empty.
    -- 'Nothing' otherwise.
    unsnoc :: a -> Maybe (a, Char)
    unsnoc = ((Text, Char) -> (a, Char))
-> Maybe (Text, Char) -> Maybe (a, Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> a) -> (Text, Char) -> (a, Char)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Text -> a
forall a. StringLike a => Text -> a
fromText) (Maybe (Text, Char) -> Maybe (a, Char))
-> (a -> Maybe (Text, Char)) -> a -> Maybe (a, Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe (Text, Char)) -> a -> Maybe (Text, Char)
forall a b. StringLike a => (Text -> b) -> a -> b
_throughText Text -> Maybe (Text, Char)
LT.unsnoc
    -- | Obtain the length of the string-like object.
    length :: a -> Int
    length = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> (a -> Int64) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Int64) -> a -> Int64
forall a b. StringLike a => (Text -> b) -> a -> b
_throughText Text -> Int64
LT.length
    -- | Compare the length of the string with the given length. Returns 'EQ' if
    -- the string has the same length, 'LT' if the string is shorter, and 'GT'
    -- if the string is longer. If the length is not explicitly stored, this
    -- function can stop from the moment the string-like object is exhausted, or
    -- the threshold has been reached.
    compareLength :: a -> Int -> Ordering
    compareLength = (Text -> Int -> Ordering) -> a -> Int -> Ordering
forall a b. StringLike a => (Text -> b) -> a -> b
_throughText Text -> Int -> Ordering
forall a. StringLike a => a -> Int -> Ordering
compareLength
    -- | Convert the given string-like object to a 'String'. If not specified,
    -- it will use 'toText', and then unpack the 'LT.Text' object in a 'String'.
    toString :: a -> String
    toString = Text -> String
LT.unpack (Text -> String) -> (a -> Text) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. StringLike a => a -> Text
toText
    -- | Convert a given 'Char' to a string-like object containing the single
    -- character.
    fromChar :: Char -> a
    fromChar = String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> (Char -> String) -> Char -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    -- | Concatenate the list of string-like objects to a string-like object.
    strConcat :: [a] -> a
    strConcat = Text -> a
forall a. StringLike a => Text -> a
fromText (Text -> a) -> ([a] -> Text) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
LT.concat ([Text] -> Text) -> ([a] -> [Text]) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map a -> Text
forall a. StringLike a => a -> Text
toText
    -- | Create a string-like object by mapping each character to another
    -- string-like object, and concatenate these.
    strConcatMap :: (Char -> a) -> a -> a
    strConcatMap = (Text -> Text) -> a -> a
forall a. StringLike a => (Text -> Text) -> a -> a
_sandwich ((Text -> Text) -> a -> a)
-> ((Char -> a) -> Text -> Text) -> (Char -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Text) -> Text -> Text
LT.concatMap ((Char -> Text) -> Text -> Text)
-> ((Char -> a) -> Char -> Text) -> (Char -> a) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text
forall a. StringLike a => a -> Text
toText (a -> Text) -> (Char -> a) -> Char -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
    -- | Check if any of the 'Char's in the string-like object satisfy a given
    -- condition.
    strAny :: (Char -> Bool) -> a -> Bool
    strAny = (Text -> Bool) -> a -> Bool
forall a b. StringLike a => (Text -> b) -> a -> b
_throughText ((Text -> Bool) -> a -> Bool)
-> ((Char -> Bool) -> Text -> Bool) -> (Char -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Bool
LT.any
    -- | Check if all of the 'Char's of the string-like object satisfy a given
    -- condition.
    strAll :: (Char -> Bool) -> a -> Bool
    strAll = (Text -> Bool) -> a -> Bool
forall a b. StringLike a => (Text -> b) -> a -> b
_throughText ((Text -> Bool) -> a -> Bool)
-> ((Char -> Bool) -> Text -> Bool) -> (Char -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Bool
LT.all
    -- | Check if the given string is empty.
    strNull :: a -> Bool
    strNull = (Text -> Bool) -> a -> Bool
forall a b. StringLike a => (Text -> b) -> a -> b
_throughText Text -> Bool
LT.null
    -- | Append two string-like objects to a new string-like object.
    append :: a -> a -> a
    append a :: a
a = Text -> a
forall a. StringLike a => Text -> a
fromText (Text -> a) -> (a -> Text) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text) -> (a -> Text) -> a -> a -> Text
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) a -> Text
forall a. StringLike a => a -> Text
toText a
a
    -- | Map all the characters of a string-like object to a new string-like
    -- object.
    strMap :: (Char -> Char) -> a -> a
    strMap = (Text -> Text) -> a -> a
forall a. StringLike a => (Text -> Text) -> a -> a
_sandwich ((Text -> Text) -> a -> a)
-> ((Char -> Char) -> Text -> Text) -> (Char -> Char) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Text -> Text
LT.map
    -- | Inserts the given string-like object in between the string-like objects
    -- in the list. For example to make a comma-separated string.
    intercalate :: a -> [a] -> a
    intercalate t :: a
t = Text -> a
forall a. StringLike a => Text -> a
fromText (Text -> a) -> ([a] -> Text) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
LT.intercalate (a -> Text
forall a. StringLike a => a -> Text
toText a
t) ([Text] -> Text) -> ([a] -> [Text]) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map a -> Text
forall a. StringLike a => a -> Text
toText
    -- | Inserts the given character in between the string-like objects in the
    -- list. For example to make a string of words.
    intersperse :: Char -> a -> a
    intersperse = (Text -> Text) -> a -> a
forall a. StringLike a => (Text -> Text) -> a -> a
_sandwich ((Text -> Text) -> a -> a)
-> (Char -> Text -> Text) -> Char -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
LT.intersperse
    -- | Transposes the rows and columns of the list of string-like objects.
    transpose :: [a] -> [a]
    transpose = (Text -> a) -> [Text] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Text -> a
forall a. StringLike a => Text -> a
fromText ([Text] -> [a]) -> ([a] -> [Text]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
LT.transpose ([Text] -> [Text]) -> ([a] -> [Text]) -> [a] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map a -> Text
forall a. StringLike a => a -> Text
toText
    -- | Calculate the reverse string of the given string.
    reverse :: a -> a
    reverse = (Text -> Text) -> a -> a
forall a. StringLike a => (Text -> Text) -> a -> a
_sandwich Text -> Text
LT.reverse
    -- | Convert the given string-like object to its lowercase equivalent.
    toLower :: a -> a
    toLower = (Text -> Text) -> a -> a
forall a. StringLike a => (Text -> Text) -> a -> a
_sandwich Text -> Text
LT.toLower
    -- | Convert the given string-like object to its uppercase equivalent.
    toUpper :: a -> a
    toUpper = (Text -> Text) -> a -> a
forall a. StringLike a => (Text -> Text) -> a -> a
_sandwich Text -> Text
LT.toUpper
    -- | Convert the given string-like object to its title-case equivalent.
    toTitle :: a -> a
    toTitle = (Text -> Text) -> a -> a
forall a. StringLike a => (Text -> Text) -> a -> a
_sandwich Text -> Text
LT.toTitle
    -- | Convert a 'LT.Text' object to the string-like object.
    fromText :: LT.Text -> a
    fromText = String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> (Text -> String) -> Text -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
LT.unpack
    -- | Convert the string-like object to an 'LT.Text' object.
    toText :: a -> LT.Text
    toText = String -> Text
LT.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. StringLike a => a -> String
toString
    {-# MINIMAL fromText, toText | toString #-}

_sandwich :: StringLike a => (LT.Text -> LT.Text) -> a -> a
_sandwich :: (Text -> Text) -> a -> a
_sandwich f :: Text -> Text
f = Text -> a
forall a. StringLike a => Text -> a
fromText (Text -> a) -> (a -> Text) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
f (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. StringLike a => a -> Text
toText

_throughText :: StringLike a => (LT.Text -> b) -> a -> b
_throughText :: (Text -> b) -> a -> b
_throughText = ((Text -> b) -> (a -> Text) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. StringLike a => a -> Text
toText)

instance StringLike [Char] where
    empty :: String
empty = []
    cons :: Char -> String -> String
cons = (:)
    snoc :: String -> Char -> String
snoc = ((String -> String) -> (Char -> String) -> Char -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure) ((String -> String) -> Char -> String)
-> (String -> String -> String) -> String -> Char -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall a. [a] -> [a] -> [a]
(++)
    uncons :: String -> Maybe (Char, String)
uncons = String -> Maybe (Char, String)
forall a. [a] -> Maybe (a, [a])
L.uncons
    unsnoc :: String -> Maybe (String, Char)
unsnoc [] = Maybe (String, Char)
forall a. Maybe a
Nothing
    unsnoc (x :: Char
x:xs :: String
xs) = (String, Char) -> Maybe (String, Char)
forall a. a -> Maybe a
Just (Char -> String -> (String, Char)
forall a. a -> [a] -> ([a], a)
go Char
x String
xs)
        where go :: a -> [a] -> ([a], a)
go y :: a
y [] = ([], a
y)
              go y :: a
y (z :: a
z:zs :: [a]
zs) = let ~(ws :: [a]
ws,w :: a
w) = a -> [a] -> ([a], a)
go a
z [a]
zs in (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ws,a
w)
    length :: String -> Int
length = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length
    compareLength :: String -> Int -> Ordering
compareLength [] n :: Int
n
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = Ordering
GT
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Ordering
LT
      | Bool
otherwise = Ordering
EQ
    compareLength xs :: String
xs n :: Int
n
      | [] <- String
dn = Ordering
LT
      | [_] <- String
dn = Ordering
EQ
      | Bool
otherwise = Ordering
GT
      where dn :: String
dn = Int -> String -> String
forall a. Int -> [a] -> [a]
drop (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) String
xs
    toString :: String -> String
toString = String -> String
forall a. a -> a
id
    fromChar :: Char -> String
fromChar = Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    strConcat :: [String] -> String
strConcat = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    strConcatMap :: (Char -> String) -> String -> String
strConcatMap = (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
    strAny :: (Char -> Bool) -> String -> Bool
strAny = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
    strAll :: (Char -> Bool) -> String -> Bool
strAll = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
    strNull :: String -> Bool
strNull = String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
    append :: String -> String -> String
append = String -> String -> String
forall a. [a] -> [a] -> [a]
(++)
    strMap :: (Char -> Char) -> String -> String
strMap = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map
    intercalate :: String -> [String] -> String
intercalate = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate
    intersperse :: Char -> String -> String
intersperse = Char -> String -> String
forall a. a -> [a] -> [a]
L.intersperse
    transpose :: [String] -> [String]
transpose = [String] -> [String]
forall a. [[a]] -> [[a]]
L.transpose
    reverse :: String -> String
reverse = String -> String
forall a. [a] -> [a]
P.reverse
    toLower :: String -> String
toLower = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
C.toLower
    toUpper :: String -> String
toUpper = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
C.toUpper


instance StringLike T.Text where
    empty :: Text
empty = Text
T.empty
    cons :: Char -> Text -> Text
cons = Char -> Text -> Text
T.cons
    snoc :: Text -> Char -> Text
snoc = Text -> Char -> Text
T.snoc
    uncons :: Text -> Maybe (Char, Text)
uncons = Text -> Maybe (Char, Text)
T.uncons
    unsnoc :: Text -> Maybe (Text, Char)
unsnoc = Text -> Maybe (Text, Char)
T.unsnoc
    length :: Text -> Int
length = Text -> Int
T.length
    compareLength :: Text -> Int -> Ordering
compareLength = Text -> Int -> Ordering
T.compareLength
    toString :: Text -> String
toString = Text -> String
T.unpack
    fromChar :: Char -> Text
fromChar = Char -> Text
T.singleton
    strConcat :: [Text] -> Text
strConcat = [Text] -> Text
T.concat
    strConcatMap :: (Char -> Text) -> Text -> Text
strConcatMap = (Char -> Text) -> Text -> Text
T.concatMap
    strAny :: (Char -> Bool) -> Text -> Bool
strAny = (Char -> Bool) -> Text -> Bool
T.any
    strAll :: (Char -> Bool) -> Text -> Bool
strAll = (Char -> Bool) -> Text -> Bool
T.all
    strNull :: Text -> Bool
strNull = Text -> Bool
T.null
    append :: Text -> Text -> Text
append = Text -> Text -> Text
T.append
    strMap :: (Char -> Char) -> Text -> Text
strMap = (Char -> Char) -> Text -> Text
T.map
    intercalate :: Text -> [Text] -> Text
intercalate = Text -> [Text] -> Text
T.intercalate
    intersperse :: Char -> Text -> Text
intersperse = Char -> Text -> Text
T.intersperse
    transpose :: [Text] -> [Text]
transpose = [Text] -> [Text]
T.transpose
    reverse :: Text -> Text
reverse = Text -> Text
T.reverse
    toLower :: Text -> Text
toLower = Text -> Text
T.toLower
    toUpper :: Text -> Text
toUpper = Text -> Text
T.toUpper
    toTitle :: Text -> Text
toTitle = Text -> Text
T.toTitle
    toText :: Text -> Text
toText = Text -> Text
LT.fromStrict
    fromText :: Text -> Text
fromText = Text -> Text
LT.toStrict

instance StringLike LT.Text where
    empty :: Text
empty = Text
LT.empty
    cons :: Char -> Text -> Text
cons = Char -> Text -> Text
LT.cons
    snoc :: Text -> Char -> Text
snoc = Text -> Char -> Text
LT.snoc
    uncons :: Text -> Maybe (Char, Text)
uncons = Text -> Maybe (Char, Text)
LT.uncons
    unsnoc :: Text -> Maybe (Text, Char)
unsnoc = Text -> Maybe (Text, Char)
LT.unsnoc
    length :: Text -> Int
length = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> (Text -> Int64) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int64
LT.length
    compareLength :: Text -> Int -> Ordering
compareLength = ((Int64 -> Ordering) -> (Int -> Int64) -> Int -> Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ((Int64 -> Ordering) -> Int -> Ordering)
-> (Text -> Int64 -> Ordering) -> Text -> Int -> Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int64 -> Ordering
LT.compareLength
    toString :: Text -> String
toString = Text -> String
LT.unpack
    fromChar :: Char -> Text
fromChar = Char -> Text
LT.singleton
    strConcat :: [Text] -> Text
strConcat = [Text] -> Text
LT.concat
    strConcatMap :: (Char -> Text) -> Text -> Text
strConcatMap = (Char -> Text) -> Text -> Text
LT.concatMap
    strAny :: (Char -> Bool) -> Text -> Bool
strAny = (Char -> Bool) -> Text -> Bool
LT.any
    strAll :: (Char -> Bool) -> Text -> Bool
strAll = (Char -> Bool) -> Text -> Bool
LT.all
    strNull :: Text -> Bool
strNull = Text -> Bool
LT.null
    append :: Text -> Text -> Text
append = Text -> Text -> Text
LT.append
    strMap :: (Char -> Char) -> Text -> Text
strMap = (Char -> Char) -> Text -> Text
LT.map
    intercalate :: Text -> [Text] -> Text
intercalate = Text -> [Text] -> Text
LT.intercalate
    intersperse :: Char -> Text -> Text
intersperse = Char -> Text -> Text
LT.intersperse
    transpose :: [Text] -> [Text]
transpose = [Text] -> [Text]
LT.transpose
    reverse :: Text -> Text
reverse = Text -> Text
LT.reverse
    toLower :: Text -> Text
toLower = Text -> Text
LT.toLower
    toUpper :: Text -> Text
toUpper = Text -> Text
LT.toUpper
    toTitle :: Text -> Text
toTitle = Text -> Text
LT.toTitle
    toText :: Text -> Text
toText = Text -> Text
forall a. a -> a
id
    fromText :: Text -> Text
fromText = Text -> Text
forall a. a -> a
id

instance StringLike BS.ByteString where
    empty :: ByteString
empty = ByteString
BS.empty
    cons :: Char -> ByteString -> ByteString
cons = Char -> ByteString -> ByteString
BS.cons
    snoc :: ByteString -> Char -> ByteString
snoc = ByteString -> Char -> ByteString
BS.snoc
    uncons :: ByteString -> Maybe (Char, ByteString)
uncons = ByteString -> Maybe (Char, ByteString)
BS.uncons
    unsnoc :: ByteString -> Maybe (ByteString, Char)
unsnoc = ByteString -> Maybe (ByteString, Char)
BS.unsnoc
    length :: ByteString -> Int
length = ByteString -> Int
BS.length
    fromChar :: Char -> ByteString
fromChar = Char -> ByteString
BS.singleton
    strConcat :: [ByteString] -> ByteString
strConcat = [ByteString] -> ByteString
BS.concat
    strConcatMap :: (Char -> ByteString) -> ByteString -> ByteString
strConcatMap = (Char -> ByteString) -> ByteString -> ByteString
BS.concatMap
    strAny :: (Char -> Bool) -> ByteString -> Bool
strAny = (Char -> Bool) -> ByteString -> Bool
BS.any
    strAll :: (Char -> Bool) -> ByteString -> Bool
strAll = (Char -> Bool) -> ByteString -> Bool
BS.all
    strNull :: ByteString -> Bool
strNull = ByteString -> Bool
BS.null
    append :: ByteString -> ByteString -> ByteString
append = ByteString -> ByteString -> ByteString
BS.append
    strMap :: (Char -> Char) -> ByteString -> ByteString
strMap = (Char -> Char) -> ByteString -> ByteString
BS.map
    intercalate :: ByteString -> [ByteString] -> ByteString
intercalate = ByteString -> [ByteString] -> ByteString
BS.intercalate
    intersperse :: Char -> ByteString -> ByteString
intersperse = Char -> ByteString -> ByteString
BS.intersperse
    transpose :: [ByteString] -> [ByteString]
transpose = [ByteString] -> [ByteString]
BS.transpose
    reverse :: ByteString -> ByteString
reverse = ByteString -> ByteString
BS.reverse
    toLower :: ByteString -> ByteString
toLower = (Char -> Char) -> ByteString -> ByteString
BS.map Char -> Char
C.toLower
    toUpper :: ByteString -> ByteString
toUpper = (Char -> Char) -> ByteString -> ByteString
BS.map Char -> Char
C.toUpper
    toText :: ByteString -> Text
toText = ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.fromStrict
    fromText :: Text -> ByteString
fromText = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

instance StringLike LBS.ByteString where
    empty :: ByteString
empty = ByteString
LBS.empty
    cons :: Char -> ByteString -> ByteString
cons = Char -> ByteString -> ByteString
LBS.cons
    snoc :: ByteString -> Char -> ByteString
snoc = ByteString -> Char -> ByteString
LBS.snoc
    uncons :: ByteString -> Maybe (Char, ByteString)
uncons = ByteString -> Maybe (Char, ByteString)
LBS.uncons
    unsnoc :: ByteString -> Maybe (ByteString, Char)
unsnoc = ByteString -> Maybe (ByteString, Char)
LBS.unsnoc
    length :: ByteString -> Int
length = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> (ByteString -> Int64) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
LBS.length
    fromChar :: Char -> ByteString
fromChar = Char -> ByteString
LBS.singleton
    strConcat :: [ByteString] -> ByteString
strConcat = [ByteString] -> ByteString
LBS.concat
    strConcatMap :: (Char -> ByteString) -> ByteString -> ByteString
strConcatMap = (Char -> ByteString) -> ByteString -> ByteString
LBS.concatMap
    strAny :: (Char -> Bool) -> ByteString -> Bool
strAny = (Char -> Bool) -> ByteString -> Bool
LBS.any
    strAll :: (Char -> Bool) -> ByteString -> Bool
strAll = (Char -> Bool) -> ByteString -> Bool
LBS.all
    strNull :: ByteString -> Bool
strNull = ByteString -> Bool
LBS.null
    append :: ByteString -> ByteString -> ByteString
append = ByteString -> ByteString -> ByteString
LBS.append
    strMap :: (Char -> Char) -> ByteString -> ByteString
strMap = (Char -> Char) -> ByteString -> ByteString
LBS.map
    intercalate :: ByteString -> [ByteString] -> ByteString
intercalate = ByteString -> [ByteString] -> ByteString
LBS.intercalate
    intersperse :: Char -> ByteString -> ByteString
intersperse = Char -> ByteString -> ByteString
LBS.intersperse
    transpose :: [ByteString] -> [ByteString]
transpose = [ByteString] -> [ByteString]
LBS.transpose
    reverse :: ByteString -> ByteString
reverse = ByteString -> ByteString
LBS.reverse
    toLower :: ByteString -> ByteString
toLower = (Char -> Char) -> ByteString -> ByteString
LBS.map Char -> Char
C.toLower
    toUpper :: ByteString -> ByteString
toUpper = (Char -> Char) -> ByteString -> ByteString
LBS.map Char -> Char
C.toUpper
    toText :: ByteString -> Text
toText = ByteString -> Text
decodeUtf8
    fromText :: Text -> ByteString
fromText = Text -> ByteString
encodeUtf8

-- | Convert from one 'StringLike' type to another 'StringLike' type. This is
-- done through a lazy 'LT.Text'.
convertStringLike :: (StringLike a, StringLike b)
  => a -- ^ The 'StringLike' object to convert.
  -> b -- ^ The 'StringLike' object that is the equivalent of the given 'StringLike' object.
convertStringLike :: a -> b
convertStringLike = Text -> b
forall a. StringLike a => Text -> a
fromText (Text -> b) -> (a -> Text) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. StringLike a => a -> Text
toText