module ASCII.Superset
  (
    {- * Characters -}
    {- ** Class -} ToCaselessChar (..), ToChar (..), FromChar (..), CharSuperset (..), ToCasefulChar (..),
    {- ** Functions -} asCharUnsafe, toCharMaybe, toCaselessCharMaybe, toCharOrFail, toCaselessCharOrFail,
        toCharSub, toCaselessCharSub, substituteChar, convertCharMaybe, convertCharOrFail,

    {- * Strings -}
    {- ** Class -} ToCaselessString (..), ToString (..), FromString (..), StringSuperset (..), ToCasefulString (..),
    {- ** Functions -} toCharListMaybe, toCaselessCharListMaybe, toCharListOrFail, toCaselessCharListOrFail,
        convertStringMaybe, convertStringOrFail
  )
  where

import ASCII.Case (Case (..))
import ASCII.Caseless (CaselessChar)
import {-# source #-} ASCII.CaseRefinement (KnownCase (..))
import Control.Monad (return)
import Control.Monad.Fail (MonadFail (fail))
import Data.Bool (Bool, (&&))
import Data.Function (id, (.))
import Data.Functor (fmap)
import Data.Maybe (Maybe (..))
import Data.Ord ((<=), (>=))
import Prelude ((+), (-))

import qualified ASCII.Case as Case
import qualified ASCII.Caseless as Caseless
import qualified ASCII.Char as ASCII
import qualified Data.Bool as Bool
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Char as Unicode
import qualified Data.Int as Int
import qualified Data.List as List
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Builder as TB
import qualified Data.Word as Word
import qualified Numeric.Natural as Nat
import qualified Prelude


---  Char  ---

{-| Partial conversion to 'CaselessChar'

Generally this will be a superset of the ASCII character set with a 'ToChar'
instance as well, and the conversion will be achieved by discarding the case of
letters. A notable exception is the instance for the 'CaselessChar' type itself,
which is already represented without case and does not have a 'ToChar' instance.
-}
class ToCaselessChar char where

    -- | Test whether a character can be converted to 'CaselessChar'
    isAsciiCaselessChar :: char -> Bool

    -- | Conversion to 'CaselessChar', defined only where 'isAsciiCaselessChar' is satisfied
    toCaselessCharUnsafe :: char -> CaselessChar

{-| Partial conversion to 'ASCII.Char'

This includes the 'ASCII.Char' type itself, character sets that are supersets
of ASCII, and numeric types such as 'Word8' that are often used to represent
ASCII characters.

This does /not/ include 'CaselessChar', because that cannot be converted to
'ASCII.Char' without choosing a case. -}
class ToCaselessChar char => ToChar char where

    -- | Test whether a character can be converted to 'ASCII.Char'
    isAsciiChar :: char -> Bool

    -- | Conversion to 'ASCII.Char', defined only where 'isAsciiChar' is satisfied
    toCharUnsafe :: char -> ASCII.Char

{-| Total conversion from 'ASCII.Char'

This class includes supersets of ASCII, in which case 'fromChar' is a lifting
function. It also includes 'CaselessChar', in which case 'fromChar' discards
case information.

This does /not/ include 'ASCII.CaseRefinement.ASCII'case', because that represents
a subset of 'ASCII.Char'; not all characters are of the wanted case, so no total
conversion is possible without changing case. -}
class FromChar char where

    -- | Conversion from 'ASCII.Char'
    fromChar :: ASCII.Char -> char

{- | Character type with:

- a total conversion from ASCII; and
- a partial conversion to ASCII -}
class (ToChar char, FromChar char) => CharSuperset char where

    {- | Convert a character in the superset to the designated case,
    if it is an ASCII letter of the opposite case. Otherwise, return
    the argument unmodified. -}
    toCaseChar :: Case -> char -> char

class ToCasefulChar (letterCase :: Case) char where

    toCasefulChar :: CaselessChar -> char

{-| Manipulate a character as if it were an ASCII 'ASCII.Char', assuming that it is

Defined only where 'isAsciiChar' is satisfied. -}
asCharUnsafe :: CharSuperset char => (ASCII.Char -> ASCII.Char) -> char -> char
asCharUnsafe :: forall char. CharSuperset char => (Char -> Char) -> char -> char
asCharUnsafe Char -> Char
f = forall char. FromChar char => Char -> char
fromChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall char. ToChar char => char -> Char
toCharUnsafe

toCharMaybe :: ToChar char => char -> Maybe ASCII.Char
toCharMaybe :: forall char. ToChar char => char -> Maybe Char
toCharMaybe = forall char (context :: * -> *).
(ToChar char, MonadFail context) =>
char -> context Char
toCharOrFail

toCaselessCharMaybe :: ToCaselessChar char => char -> Maybe CaselessChar
toCaselessCharMaybe :: forall char. ToCaselessChar char => char -> Maybe CaselessChar
toCaselessCharMaybe = forall char (context :: * -> *).
(ToCaselessChar char, MonadFail context) =>
char -> context CaselessChar
toCaselessCharOrFail

toCharOrFail :: (ToChar char, MonadFail context) => char -> context ASCII.Char
toCharOrFail :: forall char (context :: * -> *).
(ToChar char, MonadFail context) =>
char -> context Char
toCharOrFail char
x = if forall char. ToChar char => char -> Bool
isAsciiChar char
x then forall (m :: * -> *) a. Monad m => a -> m a
return (forall char. ToChar char => char -> Char
toCharUnsafe char
x)
    else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not an ASCII character"

toCaselessCharOrFail :: (ToCaselessChar char, MonadFail context) => char -> context CaselessChar
toCaselessCharOrFail :: forall char (context :: * -> *).
(ToCaselessChar char, MonadFail context) =>
char -> context CaselessChar
toCaselessCharOrFail char
x = if forall char. ToCaselessChar char => char -> Bool
isAsciiCaselessChar char
x then forall (m :: * -> *) a. Monad m => a -> m a
return (forall char. ToCaselessChar char => char -> CaselessChar
toCaselessCharUnsafe char
x)
    else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not an ASCII character"

toCharSub :: ToChar char => char -> ASCII.Char
toCharSub :: forall char. ToChar char => char -> Char
toCharSub char
x = if forall char. ToChar char => char -> Bool
isAsciiChar char
x then forall char. ToChar char => char -> Char
toCharUnsafe char
x else Char
ASCII.Substitute

toCaselessCharSub :: ToCaselessChar char => char -> CaselessChar
toCaselessCharSub :: forall char. ToCaselessChar char => char -> CaselessChar
toCaselessCharSub char
x = if forall char. ToCaselessChar char => char -> Bool
isAsciiCaselessChar char
x then forall char. ToCaselessChar char => char -> CaselessChar
toCaselessCharUnsafe char
x else CaselessChar
Caseless.Substitute

{-| Force a character into ASCII by replacing it with 'ASCII.Substitute' if it
    is not already an ASCII character

The resulting character satisfies 'isAsciiChar' and 'isAsciiCaselessChar'. -}
substituteChar :: CharSuperset char => char -> char
substituteChar :: forall char. CharSuperset char => char -> char
substituteChar char
x = if forall char. ToChar char => char -> Bool
isAsciiChar char
x then char
x else forall char. FromChar char => Char -> char
fromChar Char
ASCII.Substitute

{-| Convert from one ASCII-superset character type to another via the ASCII
'ASCII.Char' type. Fails as 'Nothing' if the input is outside the ASCII
character set. -}
convertCharMaybe :: (ToChar char1, FromChar char2) => char1 -> Maybe char2
convertCharMaybe :: forall char1 char2.
(ToChar char1, FromChar char2) =>
char1 -> Maybe char2
convertCharMaybe = forall char1 char2 (context :: * -> *).
(ToChar char1, FromChar char2, MonadFail context) =>
char1 -> context char2
convertCharOrFail

{-| Convert from one ASCII-superset character type to another via the ASCII
'ASCII.Char' type. Fails with 'fail' if the input is outside the ASCII character
set. -}
convertCharOrFail :: (ToChar char1, FromChar char2, MonadFail context) =>
    char1 -> context char2
convertCharOrFail :: forall char1 char2 (context :: * -> *).
(ToChar char1, FromChar char2, MonadFail context) =>
char1 -> context char2
convertCharOrFail = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall char. FromChar char => Char -> char
fromChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall char (context :: * -> *).
(ToChar char, MonadFail context) =>
char -> context Char
toCharOrFail


---  String  ---

{-| Partial conversion to @['CaselessChar']@

Generally this will be a superset of ASCII strings with a 'ToString' instance as
well, and the conversion will be achieved by discarding the case of letters. A
notable exception is the instance for @['CaselessChar']@ type itself, which is
already represented without case and does not have a 'ToString' instance. -}
class ToCaselessString string where

    -- | Test whether a character can be converted to @['CaselessChar']@
    isAsciiCaselessString :: string -> Bool

    {-| Conversion to @['CaselessChar']@, defined only where
        'isAsciiCaselessString' is satisfied -}
    toCaselessCharListUnsafe :: string -> [CaselessChar]

    {-| Conversion to @['CaselessChar']@ achieved by using
        'Caseless.Substitute' in place of any non-ASCII characters -}
    toCaselessCharListSub :: string -> [CaselessChar]

{-| Partial conversion to @['ASCII.Char']@

This includes @['ASCII.Char']@ type itself, strings of character sets that are
supersets of ASCII, and sequences of numeric types such as 'Word8' that are
often used to represent ASCII characters.

This does /not/ include @['CaselessChar']@, because that cannot be converted
to @['ASCII.Char']@ without choosing a case. -}
class ToCaselessString string => ToString string where

    -- | Test whether a string can be converted to @['ASCII.Char']@
    isAsciiString :: string -> Bool

    {-| Conversion to @['ASCII.Char']@, defined only where 'isAsciiString'
        is satisfied -}
    toCharListUnsafe :: string -> [ASCII.Char]

    {-| Conversion to @['ASCII.Char']@ achieved by using
        'ASCII.Substitute' in place of any non-ASCII characters -}
    toCharListSub :: string -> [ASCII.Char]

{-| Total conversion from @['ASCII.Char']@

This class includes supersets of ASCII, in which case 'fromCharList' lifts each
character into the larger character set. It also includes @['CaselessChar']@, in
which case 'fromCharList' discards case information from letters.

This does /not/ include @['ASCII.CaseRefinement.ASCII'case']@, because that
represents a subset of ASCII; not all ASCII characters are of case wanted by
'ASCII.CaseRefinement.ASCII'case', so no total conversion is possible without
changing case. -}
class FromString string where

    -- | Conversion from @['ASCII.Char']@
    fromCharList :: [ASCII.Char] -> string

{- | String type with:

- a total conversion from ASCII; and
- a partial conversion to ASCII -}
class (ToString string, FromString string) => StringSuperset string where

    {-| Force a string into ASCII by replacing any non-ASCII character with 'ASCII.Substitute'

        The resulting string satisfies 'isAsciiString' and 'isAsciiCaselessString'. -}
    substituteString :: string -> string

    mapCharsUnsafe :: (ASCII.Char -> ASCII.Char) -> string -> string
    mapCharsUnsafe Char -> Char
f = forall string. FromString string => [Char] -> string
fromCharList  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
List.map Char -> Char
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall string. ToString string => string -> [Char]
toCharListUnsafe

    {- | Convert each character in the superset to the designated case, if it is
    an ASCII letter of the opposite case. Leaves other characters unchanged. -}
    toCaseString :: Case -> string -> string

class ToCasefulString (letterCase :: Case) string where

    toCasefulString :: [CaselessChar] -> string

toCharListMaybe :: ToString string => string -> Maybe [ASCII.Char]
toCharListMaybe :: forall string. ToString string => string -> Maybe [Char]
toCharListMaybe = forall string (context :: * -> *).
(ToString string, MonadFail context) =>
string -> context [Char]
toCharListOrFail

toCaselessCharListMaybe :: ToCaselessString string => string -> Maybe [CaselessChar]
toCaselessCharListMaybe :: forall string.
ToCaselessString string =>
string -> Maybe [CaselessChar]
toCaselessCharListMaybe = forall string (context :: * -> *).
(ToCaselessString string, MonadFail context) =>
string -> context [CaselessChar]
toCaselessCharListOrFail

toCharListOrFail :: (ToString string, MonadFail context) =>
    string -> context [ASCII.Char]
toCharListOrFail :: forall string (context :: * -> *).
(ToString string, MonadFail context) =>
string -> context [Char]
toCharListOrFail string
x = if forall string. ToString string => string -> Bool
isAsciiString string
x then forall (m :: * -> *) a. Monad m => a -> m a
return (forall string. ToString string => string -> [Char]
toCharListUnsafe string
x)
    else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"String contains non-ASCII characters"

toCaselessCharListOrFail :: (ToCaselessString string, MonadFail context) =>
    string -> context [CaselessChar]
toCaselessCharListOrFail :: forall string (context :: * -> *).
(ToCaselessString string, MonadFail context) =>
string -> context [CaselessChar]
toCaselessCharListOrFail string
x = if forall string. ToCaselessString string => string -> Bool
isAsciiCaselessString string
x then forall (m :: * -> *) a. Monad m => a -> m a
return (forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListUnsafe string
x)
    else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"String contains non-ASCII characters"

{-| Convert from one ASCII-superset string type to another by converting each
character of the input string to an ASCII 'ASCII.Char', and then converting the
ASCII character list to the desired output type. Fails as 'Nothing' if the input
contains any character that is outside the ASCII character set. -}
convertStringMaybe :: (ToString string1, FromString string2) =>
    string1 -> Maybe string2
convertStringMaybe :: forall string1 string2.
(ToString string1, FromString string2) =>
string1 -> Maybe string2
convertStringMaybe = forall string1 string2 (context :: * -> *).
(ToString string1, FromString string2, MonadFail context) =>
string1 -> context string2
convertStringOrFail

{-| Convert from one ASCII-superset string type to another by converting each
character of the input string to an ASCII 'ASCII.Char', and then converting the
ASCII character list to the desired output type. Fails with 'fail' if the input
contains any character that is outside the ASCII character set. -}
convertStringOrFail :: (ToString string1, FromString string2, MonadFail context) =>
    string1 -> context string2
convertStringOrFail :: forall string1 string2 (context :: * -> *).
(ToString string1, FromString string2, MonadFail context) =>
string1 -> context string2
convertStringOrFail = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall string. FromString string => [Char] -> string
fromCharList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall string (context :: * -> *).
(ToString string, MonadFail context) =>
string -> context [Char]
toCharListOrFail


---  Instances  ---

-- | 'CaselessChar' is trivially convertible to itself.
instance ToCaselessChar CaselessChar where
    isAsciiCaselessChar :: CaselessChar -> Bool
isAsciiCaselessChar CaselessChar
_ = Bool
Bool.True
    toCaselessCharUnsafe :: CaselessChar -> CaselessChar
toCaselessCharUnsafe = forall a. a -> a
id

instance FromChar CaselessChar where
    fromChar :: Char -> CaselessChar
fromChar = Char -> CaselessChar
Caseless.disregardCase

---

instance ToCaselessChar ASCII.Char where
    isAsciiCaselessChar :: Char -> Bool
isAsciiCaselessChar Char
_ = Bool
Bool.True
    toCaselessCharUnsafe :: Char -> CaselessChar
toCaselessCharUnsafe = Char -> CaselessChar
Caseless.disregardCase

instance ToChar ASCII.Char where
    isAsciiChar :: Char -> Bool
isAsciiChar Char
_ = Bool
Bool.True
    toCharUnsafe :: Char -> Char
toCharUnsafe = forall a. a -> a
id

instance FromChar ASCII.Char where
    fromChar :: Char -> Char
fromChar = forall a. a -> a
id

-- | 'ASCII.Char' is trivially a superset of itself.
instance CharSuperset ASCII.Char where
    toCaseChar :: Case -> Char -> Char
toCaseChar = Case -> Char -> Char
Case.toCase

instance KnownCase letterCase => ToCasefulChar letterCase ASCII.Char where
    toCasefulChar :: CaselessChar -> Char
toCasefulChar = Case -> CaselessChar -> Char
Caseless.toCase (forall (letterCase :: Case). KnownCase letterCase => Case
theCase @letterCase)

---

instance ToCaselessChar Unicode.Char where
    isAsciiCaselessChar :: Char -> Bool
isAsciiCaselessChar = forall char. ToChar char => char -> Bool
isAsciiChar
    toCaselessCharUnsafe :: Char -> CaselessChar
toCaselessCharUnsafe = forall char. ToCaselessChar char => char -> CaselessChar
toCaselessCharUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall char. ToChar char => char -> Char
toCharUnsafe

instance ToChar Unicode.Char where
    isAsciiChar :: Char -> Bool
isAsciiChar = (forall a. Ord a => a -> a -> Bool
<= Char
'\DEL')
    toCharUnsafe :: Char -> Char
toCharUnsafe = forall char. ToChar char => char -> Char
toCharUnsafe @Int.Int forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
Unicode.ord

instance FromChar Unicode.Char where
    fromChar :: Char -> Char
fromChar = Int -> Char
Unicode.chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ASCII.toInt

instance CharSuperset Unicode.Char where
    toCaseChar :: Case -> Char -> Char
toCaseChar Case
UpperCase Char
x | Char
x forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
x forall a. Ord a => a -> a -> Bool
<= Char
'z' = Int -> Char
Unicode.chr (Char -> Int
Unicode.ord Char
x forall a. Num a => a -> a -> a
- Int
32)
    toCaseChar Case
LowerCase Char
x | Char
x forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
x forall a. Ord a => a -> a -> Bool
<= Char
'Z' = Int -> Char
Unicode.chr (Char -> Int
Unicode.ord Char
x forall a. Num a => a -> a -> a
+ Int
32)
    toCaseChar Case
_ Char
x = Char
x

instance KnownCase letterCase => ToCasefulChar letterCase Unicode.Char where
    toCasefulChar :: CaselessChar -> Char
toCasefulChar = forall char. FromChar char => Char -> char
fromChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (letterCase :: Case) char.
ToCasefulChar letterCase char =>
CaselessChar -> char
toCasefulChar @letterCase

---

instance ToCaselessChar Nat.Natural where
    isAsciiCaselessChar :: Natural -> Bool
isAsciiCaselessChar = forall char. ToChar char => char -> Bool
isAsciiChar
    toCaselessCharUnsafe :: Natural -> CaselessChar
toCaselessCharUnsafe = forall char. ToCaselessChar char => char -> CaselessChar
toCaselessCharUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall char. ToChar char => char -> Char
toCharUnsafe

instance ToChar Nat.Natural where
    isAsciiChar :: Natural -> Bool
isAsciiChar = (forall a. Ord a => a -> a -> Bool
<= Natural
127)
    toCharUnsafe :: Natural -> Char
toCharUnsafe = forall char. ToChar char => char -> Char
toCharUnsafe @Int.Int forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral

instance FromChar Nat.Natural where
    fromChar :: Char -> Natural
fromChar = forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ASCII.toInt

instance CharSuperset Nat.Natural where
    toCaseChar :: Case -> Natural -> Natural
toCaseChar Case
UpperCase Natural
x | Natural
x forall a. Ord a => a -> a -> Bool
>= Natural
97 Bool -> Bool -> Bool
&& Natural
x forall a. Ord a => a -> a -> Bool
<= Natural
122 = Natural
x forall a. Num a => a -> a -> a
- Natural
32
    toCaseChar Case
LowerCase Natural
x | Natural
x forall a. Ord a => a -> a -> Bool
>= Natural
65 Bool -> Bool -> Bool
&& Natural
x forall a. Ord a => a -> a -> Bool
<= Natural
90  = Natural
x forall a. Num a => a -> a -> a
+ Natural
32
    toCaseChar Case
_ Natural
x = Natural
x

instance KnownCase letterCase => ToCasefulChar letterCase Nat.Natural where
    toCasefulChar :: CaselessChar -> Natural
toCasefulChar = forall char. FromChar char => Char -> char
fromChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (letterCase :: Case) char.
ToCasefulChar letterCase char =>
CaselessChar -> char
toCasefulChar @letterCase

---

instance ToCaselessChar Int.Int where
    isAsciiCaselessChar :: Int -> Bool
isAsciiCaselessChar = forall char. ToChar char => char -> Bool
isAsciiChar
    toCaselessCharUnsafe :: Int -> CaselessChar
toCaselessCharUnsafe = forall char. ToCaselessChar char => char -> CaselessChar
toCaselessCharUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall char. ToChar char => char -> Char
toCharUnsafe

instance ToChar Int.Int where
    isAsciiChar :: Int -> Bool
isAsciiChar Int
x = (Int
x forall a. Ord a => a -> a -> Bool
>= Int
0) Bool -> Bool -> Bool
&& (Int
x forall a. Ord a => a -> a -> Bool
<= Int
127)
    toCharUnsafe :: Int -> Char
toCharUnsafe = Int -> Char
ASCII.fromIntUnsafe

instance FromChar Int.Int where
    fromChar :: Char -> Int
fromChar = Char -> Int
ASCII.toInt

instance CharSuperset Int.Int where
    toCaseChar :: Case -> Int -> Int
toCaseChar Case
UpperCase Int
x | Int
x forall a. Ord a => a -> a -> Bool
>= Int
97 Bool -> Bool -> Bool
&& Int
x forall a. Ord a => a -> a -> Bool
<= Int
122 = Int
x forall a. Num a => a -> a -> a
- Int
32
    toCaseChar Case
LowerCase Int
x | Int
x forall a. Ord a => a -> a -> Bool
>= Int
65 Bool -> Bool -> Bool
&& Int
x forall a. Ord a => a -> a -> Bool
<= Int
90  = Int
x forall a. Num a => a -> a -> a
+ Int
32
    toCaseChar Case
_ Int
x = Int
x

instance KnownCase letterCase => ToCasefulChar letterCase Int.Int where
    toCasefulChar :: CaselessChar -> Int
toCasefulChar = forall char. FromChar char => Char -> char
fromChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (letterCase :: Case) char.
ToCasefulChar letterCase char =>
CaselessChar -> char
toCasefulChar @letterCase

---

instance ToCaselessChar Word.Word8 where
    isAsciiCaselessChar :: Word8 -> Bool
isAsciiCaselessChar = forall char. ToChar char => char -> Bool
isAsciiChar
    toCaselessCharUnsafe :: Word8 -> CaselessChar
toCaselessCharUnsafe = forall char. ToCaselessChar char => char -> CaselessChar
toCaselessCharUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall char. ToChar char => char -> Char
toCharUnsafe

instance ToChar Word.Word8 where
    isAsciiChar :: Word8 -> Bool
isAsciiChar = (forall a. Ord a => a -> a -> Bool
<= Word8
127)
    toCharUnsafe :: Word8 -> Char
toCharUnsafe = Int -> Char
ASCII.fromIntUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral

instance FromChar Word.Word8 where
    fromChar :: Char -> Word8
fromChar = forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ASCII.toInt

instance CharSuperset Word.Word8 where
    toCaseChar :: Case -> Word8 -> Word8
toCaseChar Case
UpperCase Word8
x | Word8
x forall a. Ord a => a -> a -> Bool
>= Word8
97 Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
122 = Word8
x forall a. Num a => a -> a -> a
- Word8
32
    toCaseChar Case
LowerCase Word8
x | Word8
x forall a. Ord a => a -> a -> Bool
>= Word8
65 Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
90  = Word8
x forall a. Num a => a -> a -> a
+ Word8
32
    toCaseChar Case
_ Word8
x = Word8
x

instance KnownCase letterCase => ToCasefulChar letterCase Word.Word8 where
    toCasefulChar :: CaselessChar -> Word8
toCasefulChar = forall char. FromChar char => Char -> char
fromChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (letterCase :: Case) char.
ToCasefulChar letterCase char =>
CaselessChar -> char
toCasefulChar @letterCase

---

instance ToCaselessChar char => ToCaselessString [char] where
    isAsciiCaselessString :: [char] -> Bool
isAsciiCaselessString    = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
List.all forall char. ToCaselessChar char => char -> Bool
isAsciiCaselessChar
    toCaselessCharListUnsafe :: [char] -> [CaselessChar]
toCaselessCharListUnsafe = forall a b. (a -> b) -> [a] -> [b]
List.map forall char. ToCaselessChar char => char -> CaselessChar
toCaselessCharUnsafe
    toCaselessCharListSub :: [char] -> [CaselessChar]
toCaselessCharListSub    = forall a b. (a -> b) -> [a] -> [b]
List.map forall char. ToCaselessChar char => char -> CaselessChar
toCaselessCharSub

instance ToChar char => ToString [char] where
    isAsciiString :: [char] -> Bool
isAsciiString    = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
List.all forall char. ToChar char => char -> Bool
isAsciiChar
    toCharListUnsafe :: [char] -> [Char]
toCharListUnsafe = forall a b. (a -> b) -> [a] -> [b]
List.map forall char. ToChar char => char -> Char
toCharUnsafe
    toCharListSub :: [char] -> [Char]
toCharListSub    = forall a b. (a -> b) -> [a] -> [b]
List.map forall char. ToChar char => char -> Char
toCharSub

instance FromChar char => FromString [char] where
    fromCharList :: [Char] -> [char]
fromCharList = forall a b. (a -> b) -> [a] -> [b]
List.map forall char. FromChar char => Char -> char
fromChar

instance CharSuperset char => StringSuperset [char] where
    substituteString :: [char] -> [char]
substituteString = forall a b. (a -> b) -> [a] -> [b]
List.map forall char. CharSuperset char => char -> char
substituteChar
    toCaseString :: Case -> [char] -> [char]
toCaseString Case
c = forall a b. (a -> b) -> [a] -> [b]
List.map (forall char. CharSuperset char => Case -> char -> char
toCaseChar Case
c)

instance (ToCasefulChar letterCase char, KnownCase letterCase) => ToCasefulString letterCase [char] where
    toCasefulString :: [CaselessChar] -> [char]
toCasefulString = forall a b. (a -> b) -> [a] -> [b]
List.map (forall (letterCase :: Case) char.
ToCasefulChar letterCase char =>
CaselessChar -> char
toCasefulChar @letterCase)

---

instance ToCaselessString T.Text where
    isAsciiCaselessString :: Text -> Bool
isAsciiCaselessString = (Char -> Bool) -> Text -> Bool
T.all forall char. ToChar char => char -> Bool
isAsciiChar
    toCaselessCharListUnsafe :: Text -> [CaselessChar]
toCaselessCharListUnsafe = forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
    toCaselessCharListSub :: Text -> [CaselessChar]
toCaselessCharListSub    = forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListSub    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

instance ToString T.Text where
    isAsciiString :: Text -> Bool
isAsciiString = (Char -> Bool) -> Text -> Bool
T.all forall char. ToChar char => char -> Bool
isAsciiChar
    toCharListUnsafe :: Text -> [Char]
toCharListUnsafe = forall string. ToString string => string -> [Char]
toCharListUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
    toCharListSub :: Text -> [Char]
toCharListSub = forall string. ToString string => string -> [Char]
toCharListSub forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

instance FromString T.Text where
    fromCharList :: [Char] -> Text
fromCharList = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall string. FromString string => [Char] -> string
fromCharList

instance StringSuperset T.Text where
    substituteString :: Text -> Text
substituteString = (Char -> Char) -> Text -> Text
T.map forall char. CharSuperset char => char -> char
substituteChar
    mapCharsUnsafe :: (Char -> Char) -> Text -> Text
mapCharsUnsafe Char -> Char
f = (Char -> Char) -> Text -> Text
T.map (forall char. CharSuperset char => (Char -> Char) -> char -> char
asCharUnsafe Char -> Char
f)
    toCaseString :: Case -> Text -> Text
toCaseString Case
c   = (Char -> Char) -> Text -> Text
T.map (forall char. CharSuperset char => Case -> char -> char
toCaseChar Case
c)

instance KnownCase letterCase => ToCasefulString letterCase T.Text where
    toCasefulString :: [CaselessChar] -> Text
toCasefulString = forall string. FromString string => [Char] -> string
fromCharList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (letterCase :: Case) string.
ToCasefulString letterCase string =>
[CaselessChar] -> string
toCasefulString @letterCase

---

instance ToCaselessString LT.Text where
    isAsciiCaselessString :: Text -> Bool
isAsciiCaselessString = (Char -> Bool) -> Text -> Bool
LT.all forall char. ToChar char => char -> Bool
isAsciiChar
    toCaselessCharListUnsafe :: Text -> [CaselessChar]
toCaselessCharListUnsafe = forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
LT.unpack
    toCaselessCharListSub :: Text -> [CaselessChar]
toCaselessCharListSub    = forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListSub    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
LT.unpack

instance ToString LT.Text where
    isAsciiString :: Text -> Bool
isAsciiString = (Char -> Bool) -> Text -> Bool
LT.all forall char. ToChar char => char -> Bool
isAsciiChar
    toCharListUnsafe :: Text -> [Char]
toCharListUnsafe = forall string. ToString string => string -> [Char]
toCharListUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
LT.unpack
    toCharListSub :: Text -> [Char]
toCharListSub    = forall string. ToString string => string -> [Char]
toCharListSub    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
LT.unpack

instance FromString LT.Text where
    fromCharList :: [Char] -> Text
fromCharList = String -> Text
LT.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall string. FromString string => [Char] -> string
fromCharList

instance StringSuperset LT.Text where
    substituteString :: Text -> Text
substituteString = (Char -> Char) -> Text -> Text
LT.map forall char. CharSuperset char => char -> char
substituteChar
    mapCharsUnsafe :: (Char -> Char) -> Text -> Text
mapCharsUnsafe Char -> Char
f = (Char -> Char) -> Text -> Text
LT.map (forall char. CharSuperset char => (Char -> Char) -> char -> char
asCharUnsafe Char -> Char
f)
    toCaseString :: Case -> Text -> Text
toCaseString Case
c   = (Char -> Char) -> Text -> Text
LT.map (forall char. CharSuperset char => Case -> char -> char
toCaseChar Case
c)

instance KnownCase letterCase => ToCasefulString letterCase LT.Text where
    toCasefulString :: [CaselessChar] -> Text
toCasefulString = forall string. FromString string => [Char] -> string
fromCharList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (letterCase :: Case) string.
ToCasefulString letterCase string =>
[CaselessChar] -> string
toCasefulString @letterCase

---

instance ToCaselessString TB.Builder where
    isAsciiCaselessString :: Builder -> Bool
isAsciiCaselessString    = forall string. ToCaselessString string => string -> Bool
isAsciiCaselessString    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText
    toCaselessCharListUnsafe :: Builder -> [CaselessChar]
toCaselessCharListUnsafe = forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText
    toCaselessCharListSub :: Builder -> [CaselessChar]
toCaselessCharListSub    = forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListSub    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText

instance ToString TB.Builder where
    isAsciiString :: Builder -> Bool
isAsciiString    = forall string. ToString string => string -> Bool
isAsciiString    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText
    toCharListUnsafe :: Builder -> [Char]
toCharListUnsafe = forall string. ToString string => string -> [Char]
toCharListUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText
    toCharListSub :: Builder -> [Char]
toCharListSub    = forall string. ToString string => string -> [Char]
toCharListSub    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText

instance FromString TB.Builder where
    fromCharList :: [Char] -> Builder
fromCharList = String -> Builder
TB.fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall string. FromString string => [Char] -> string
fromCharList

instance StringSuperset TB.Builder where
    substituteString :: Builder -> Builder
substituteString = Text -> Builder
TB.fromLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall string. StringSuperset string => string -> string
substituteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText
    mapCharsUnsafe :: (Char -> Char) -> Builder -> Builder
mapCharsUnsafe Char -> Char
f = Text -> Builder
TB.fromLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall string.
StringSuperset string =>
(Char -> Char) -> string -> string
mapCharsUnsafe Char -> Char
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText
    toCaseString :: Case -> Builder -> Builder
toCaseString Case
c   = Text -> Builder
TB.fromLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall string. StringSuperset string => Case -> string -> string
toCaseString Case
c   forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText

instance KnownCase letterCase => ToCasefulString letterCase TB.Builder where
    toCasefulString :: [CaselessChar] -> Builder
toCasefulString = forall string. FromString string => [Char] -> string
fromCharList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (letterCase :: Case) string.
ToCasefulString letterCase string =>
[CaselessChar] -> string
toCasefulString @letterCase

---

instance ToCaselessString BS.ByteString where
    isAsciiCaselessString :: ByteString -> Bool
isAsciiCaselessString = (Word8 -> Bool) -> ByteString -> Bool
BS.all forall char. ToCaselessChar char => char -> Bool
isAsciiCaselessChar
    toCaselessCharListUnsafe :: ByteString -> [CaselessChar]
toCaselessCharListUnsafe = forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack
    toCaselessCharListSub :: ByteString -> [CaselessChar]
toCaselessCharListSub    = forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListSub    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack

instance ToString BS.ByteString where
    isAsciiString :: ByteString -> Bool
isAsciiString = (Word8 -> Bool) -> ByteString -> Bool
BS.all forall char. ToChar char => char -> Bool
isAsciiChar
    toCharListUnsafe :: ByteString -> [Char]
toCharListUnsafe = forall string. ToString string => string -> [Char]
toCharListUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack
    toCharListSub :: ByteString -> [Char]
toCharListSub    = forall string. ToString string => string -> [Char]
toCharListSub    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack

instance FromString BS.ByteString where
    fromCharList :: [Char] -> ByteString
fromCharList = [Word8] -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall string. FromString string => [Char] -> string
fromCharList

instance StringSuperset BS.ByteString where
    substituteString :: ByteString -> ByteString
substituteString = (Word8 -> Word8) -> ByteString -> ByteString
BS.map forall char. CharSuperset char => char -> char
substituteChar
    mapCharsUnsafe :: (Char -> Char) -> ByteString -> ByteString
mapCharsUnsafe Char -> Char
f = (Word8 -> Word8) -> ByteString -> ByteString
BS.map (forall char. CharSuperset char => (Char -> Char) -> char -> char
asCharUnsafe Char -> Char
f)
    toCaseString :: Case -> ByteString -> ByteString
toCaseString Case
c   = (Word8 -> Word8) -> ByteString -> ByteString
BS.map (forall char. CharSuperset char => Case -> char -> char
toCaseChar Case
c)

instance KnownCase letterCase => ToCasefulString letterCase BS.ByteString where
    toCasefulString :: [CaselessChar] -> ByteString
toCasefulString = forall string. FromString string => [Char] -> string
fromCharList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (letterCase :: Case) string.
ToCasefulString letterCase string =>
[CaselessChar] -> string
toCasefulString @letterCase

---

instance ToCaselessString LBS.ByteString where
    isAsciiCaselessString :: ByteString -> Bool
isAsciiCaselessString = (Word8 -> Bool) -> ByteString -> Bool
LBS.all forall char. ToCaselessChar char => char -> Bool
isAsciiCaselessChar
    toCaselessCharListUnsafe :: ByteString -> [CaselessChar]
toCaselessCharListUnsafe = forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
LBS.unpack
    toCaselessCharListSub :: ByteString -> [CaselessChar]
toCaselessCharListSub    = forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListSub    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
LBS.unpack

instance ToString LBS.ByteString where
    isAsciiString :: ByteString -> Bool
isAsciiString = (Word8 -> Bool) -> ByteString -> Bool
LBS.all forall char. ToChar char => char -> Bool
isAsciiChar
    toCharListUnsafe :: ByteString -> [Char]
toCharListUnsafe = forall string. ToString string => string -> [Char]
toCharListUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
LBS.unpack
    toCharListSub :: ByteString -> [Char]
toCharListSub    = forall string. ToString string => string -> [Char]
toCharListSub    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
LBS.unpack

instance FromString LBS.ByteString where
    fromCharList :: [Char] -> ByteString
fromCharList = [Word8] -> ByteString
LBS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall string. FromString string => [Char] -> string
fromCharList

instance StringSuperset LBS.ByteString where
    substituteString :: ByteString -> ByteString
substituteString = (Word8 -> Word8) -> ByteString -> ByteString
LBS.map forall char. CharSuperset char => char -> char
substituteChar
    mapCharsUnsafe :: (Char -> Char) -> ByteString -> ByteString
mapCharsUnsafe Char -> Char
f = (Word8 -> Word8) -> ByteString -> ByteString
LBS.map (forall char. CharSuperset char => (Char -> Char) -> char -> char
asCharUnsafe Char -> Char
f)
    toCaseString :: Case -> ByteString -> ByteString
toCaseString Case
c   = (Word8 -> Word8) -> ByteString -> ByteString
LBS.map (forall char. CharSuperset char => Case -> char -> char
toCaseChar Case
c)

instance KnownCase letterCase => ToCasefulString letterCase LBS.ByteString where
    toCasefulString :: [CaselessChar] -> ByteString
toCasefulString = forall string. FromString string => [Char] -> string
fromCharList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (letterCase :: Case) string.
ToCasefulString letterCase string =>
[CaselessChar] -> string
toCasefulString @letterCase

---

instance ToCaselessString BSB.Builder where
    isAsciiCaselessString :: Builder -> Bool
isAsciiCaselessString    = forall string. ToCaselessString string => string -> Bool
isAsciiCaselessString    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString
    toCaselessCharListUnsafe :: Builder -> [CaselessChar]
toCaselessCharListUnsafe = forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString
    toCaselessCharListSub :: Builder -> [CaselessChar]
toCaselessCharListSub    = forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListSub    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString

instance ToString BSB.Builder where
    isAsciiString :: Builder -> Bool
isAsciiString    = forall string. ToString string => string -> Bool
isAsciiString    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString
    toCharListUnsafe :: Builder -> [Char]
toCharListUnsafe = forall string. ToString string => string -> [Char]
toCharListUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString
    toCharListSub :: Builder -> [Char]
toCharListSub    = forall string. ToString string => string -> [Char]
toCharListSub    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString

instance FromString BSB.Builder where
    fromCharList :: [Char] -> Builder
fromCharList = ByteString -> Builder
BSB.lazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall string. FromString string => [Char] -> string
fromCharList

instance StringSuperset BSB.Builder where
    substituteString :: Builder -> Builder
substituteString = ByteString -> Builder
BSB.lazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall string. StringSuperset string => string -> string
substituteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString
    mapCharsUnsafe :: (Char -> Char) -> Builder -> Builder
mapCharsUnsafe Char -> Char
f = ByteString -> Builder
BSB.lazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall string.
StringSuperset string =>
(Char -> Char) -> string -> string
mapCharsUnsafe Char -> Char
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString
    toCaseString :: Case -> Builder -> Builder
toCaseString Case
c   = ByteString -> Builder
BSB.lazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall string. StringSuperset string => Case -> string -> string
toCaseString Case
c   forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString

instance KnownCase letterCase => ToCasefulString letterCase BSB.Builder where
    toCasefulString :: [CaselessChar] -> Builder
toCasefulString = forall string. FromString string => [Char] -> string
fromCharList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (letterCase :: Case) string.
ToCasefulString letterCase string =>
[CaselessChar] -> string
toCasefulString @letterCase