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.Case qualified as Case
import {-# SOURCE #-} ASCII.CaseRefinement (KnownCase (..))
import ASCII.Caseless (CaselessChar)
import ASCII.Caseless qualified as Caseless
import ASCII.Char qualified as ASCII
import Control.Monad (return)
import Control.Monad.Fail (MonadFail (fail))
import Data.Bool (Bool, (&&))
import Data.Bool qualified as Bool
import Data.ByteString qualified as BS
import Data.ByteString.Builder qualified as BSB
import Data.ByteString.Lazy qualified as LBS
import Data.Char qualified as Unicode
import Data.Function (id, (.))
import Data.Functor (fmap)
import Data.Int qualified as Int
import Data.Kind (Type)
import Data.List qualified as List
import Data.Maybe (Maybe (..))
import Data.Ord ((<=), (>=))
import Data.Text qualified as T
import Data.Text.Lazy qualified as LT
import Data.Text.Lazy.Builder qualified as TB
import Data.Word qualified as Word
import Numeric.Natural qualified as Nat
import Prelude ((+), (-))
import Prelude qualified

---  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 :: Type) 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 :: Type) 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 :: Type) 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 :: Type) 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 :: Type) 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 = Char -> char
forall char. FromChar char => Char -> char
fromChar (Char -> char) -> (char -> Char) -> char -> char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
f (Char -> Char) -> (char -> Char) -> char -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. char -> Char
forall char. ToChar char => char -> Char
toCharUnsafe

toCharMaybe :: ToChar char => char -> Maybe ASCII.Char
toCharMaybe :: forall char. ToChar char => char -> Maybe Char
toCharMaybe = char -> Maybe Char
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 = char -> Maybe CaselessChar
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 char -> Bool
forall char. ToChar char => char -> Bool
isAsciiChar char
x
    then Char -> context Char
forall a. a -> context a
forall (m :: * -> *) a. Monad m => a -> m a
return (char -> Char
forall char. ToChar char => char -> Char
toCharUnsafe char
x)
    else String -> context Char
forall a. String -> context a
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 char -> Bool
forall char. ToCaselessChar char => char -> Bool
isAsciiCaselessChar char
x
    then CaselessChar -> context CaselessChar
forall a. a -> context a
forall (m :: * -> *) a. Monad m => a -> m a
return (char -> CaselessChar
forall char. ToCaselessChar char => char -> CaselessChar
toCaselessCharUnsafe char
x)
    else String -> context CaselessChar
forall a. String -> context a
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 char -> Bool
forall char. ToChar char => char -> Bool
isAsciiChar char
x then char -> Char
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 char -> Bool
forall char. ToCaselessChar char => char -> Bool
isAsciiCaselessChar char
x then char -> CaselessChar
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 char -> Bool
forall char. ToChar char => char -> Bool
isAsciiChar char
x then char
x else Char -> char
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 = char1 -> Maybe char2
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 = (Char -> char2) -> context Char -> context char2
forall a b. (a -> b) -> context a -> context b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> char2
forall char. FromChar char => Char -> char
fromChar (context Char -> context char2)
-> (char1 -> context Char) -> char1 -> context char2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. char1 -> context Char
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 :: Type) 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 :: Type) 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 :: Type) 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 :: Type) 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 = [Char] -> string
forall string. FromString string => [Char] -> string
fromCharList ([Char] -> string) -> (string -> [Char]) -> string -> string
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
List.map Char -> Char
f ([Char] -> [Char]) -> (string -> [Char]) -> string -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. string -> [Char]
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 :: Type) where
  toCasefulString :: [CaselessChar] -> string

toCharListMaybe :: ToString string => string -> Maybe [ASCII.Char]
toCharListMaybe :: forall string. ToString string => string -> Maybe [Char]
toCharListMaybe = string -> Maybe [Char]
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 = string -> Maybe [CaselessChar]
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 string -> Bool
forall string. ToString string => string -> Bool
isAsciiString string
x
    then [Char] -> context [Char]
forall a. a -> context a
forall (m :: * -> *) a. Monad m => a -> m a
return (string -> [Char]
forall string. ToString string => string -> [Char]
toCharListUnsafe string
x)
    else String -> context [Char]
forall a. String -> context a
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 string -> Bool
forall string. ToCaselessString string => string -> Bool
isAsciiCaselessString string
x
    then [CaselessChar] -> context [CaselessChar]
forall a. a -> context a
forall (m :: * -> *) a. Monad m => a -> m a
return (string -> [CaselessChar]
forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListUnsafe string
x)
    else String -> context [CaselessChar]
forall a. String -> context a
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 = string1 -> Maybe string2
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 = ([Char] -> string2) -> context [Char] -> context string2
forall a b. (a -> b) -> context a -> context b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> string2
forall string. FromString string => [Char] -> string
fromCharList (context [Char] -> context string2)
-> (string1 -> context [Char]) -> string1 -> context string2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. string1 -> context [Char]
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 = CaselessChar -> CaselessChar
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 = Char -> Char
forall a. a -> a
id

instance FromChar ASCII.Char where
  fromChar :: Char -> Char
fromChar = Char -> Char
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 = Char -> Bool
forall char. ToChar char => char -> Bool
isAsciiChar
  toCaselessCharUnsafe :: Char -> CaselessChar
toCaselessCharUnsafe = Char -> CaselessChar
forall char. ToCaselessChar char => char -> CaselessChar
toCaselessCharUnsafe (Char -> CaselessChar) -> (Char -> Char) -> Char -> CaselessChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
forall char. ToChar char => char -> Char
toCharUnsafe

instance ToChar Unicode.Char where
  isAsciiChar :: Char -> Bool
isAsciiChar = (Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\DEL')
  toCharUnsafe :: Char -> Char
toCharUnsafe = forall char. ToChar char => char -> Char
toCharUnsafe @Int.Int (Int -> Char) -> (Char -> Int) -> Char -> Char
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 (Int -> Char) -> (Char -> Int) -> Char -> Char
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 Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z' = Int -> Char
Unicode.chr (Char -> Int
Unicode.ord Char
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
32)
  toCaseChar Case
LowerCase Char
x | Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z' = Int -> Char
Unicode.chr (Char -> Int
Unicode.ord Char
x Int -> Int -> Int
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 = Char -> Char
forall char. FromChar char => Char -> char
fromChar (Char -> Char) -> (CaselessChar -> Char) -> CaselessChar -> Char
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 = Natural -> Bool
forall char. ToChar char => char -> Bool
isAsciiChar
  toCaselessCharUnsafe :: Natural -> CaselessChar
toCaselessCharUnsafe = Char -> CaselessChar
forall char. ToCaselessChar char => char -> CaselessChar
toCaselessCharUnsafe (Char -> CaselessChar)
-> (Natural -> Char) -> Natural -> CaselessChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Char
forall char. ToChar char => char -> Char
toCharUnsafe

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

instance FromChar Nat.Natural where
  fromChar :: Char -> Natural
fromChar = Int -> Natural
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (Int -> Natural) -> (Char -> Int) -> Char -> Natural
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 Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= Natural
97 Bool -> Bool -> Bool
&& Natural
x Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
122 = Natural
x Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
32
  toCaseChar Case
LowerCase Natural
x | Natural
x Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= Natural
65 Bool -> Bool -> Bool
&& Natural
x Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
90 = Natural
x Natural -> Natural -> Natural
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 = Char -> Natural
forall char. FromChar char => Char -> char
fromChar (Char -> Natural)
-> (CaselessChar -> Char) -> CaselessChar -> Natural
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 = Int -> Bool
forall char. ToChar char => char -> Bool
isAsciiChar
  toCaselessCharUnsafe :: Int -> CaselessChar
toCaselessCharUnsafe = Char -> CaselessChar
forall char. ToCaselessChar char => char -> CaselessChar
toCaselessCharUnsafe (Char -> CaselessChar) -> (Int -> Char) -> Int -> CaselessChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall char. ToChar char => char -> Char
toCharUnsafe

instance ToChar Int.Int where
  isAsciiChar :: Int -> Bool
isAsciiChar Int
x = (Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) Bool -> Bool -> Bool
&& (Int
x Int -> Int -> Bool
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
97 Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
122 = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
32
  toCaseChar Case
LowerCase Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
65 Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
90 = Int
x Int -> Int -> Int
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 = Char -> Int
forall char. FromChar char => Char -> char
fromChar (Char -> Int) -> (CaselessChar -> Char) -> CaselessChar -> Int
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 = Word8 -> Bool
forall char. ToChar char => char -> Bool
isAsciiChar
  toCaselessCharUnsafe :: Word8 -> CaselessChar
toCaselessCharUnsafe = Char -> CaselessChar
forall char. ToCaselessChar char => char -> CaselessChar
toCaselessCharUnsafe (Char -> CaselessChar) -> (Word8 -> Char) -> Word8 -> CaselessChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
forall char. ToChar char => char -> Char
toCharUnsafe

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

instance FromChar Word.Word8 where
  fromChar :: Char -> Word8
fromChar = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
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 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
97 Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
122 = Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
32
  toCaseChar Case
LowerCase Word8
x | Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
65 Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
90 = Word8
x Word8 -> Word8 -> Word8
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 = Char -> Word8
forall char. FromChar char => Char -> char
fromChar (Char -> Word8) -> (CaselessChar -> Char) -> CaselessChar -> Word8
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 = (char -> Bool) -> [char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
List.all char -> Bool
forall char. ToCaselessChar char => char -> Bool
isAsciiCaselessChar
  toCaselessCharListUnsafe :: [char] -> [CaselessChar]
toCaselessCharListUnsafe = (char -> CaselessChar) -> [char] -> [CaselessChar]
forall a b. (a -> b) -> [a] -> [b]
List.map char -> CaselessChar
forall char. ToCaselessChar char => char -> CaselessChar
toCaselessCharUnsafe
  toCaselessCharListSub :: [char] -> [CaselessChar]
toCaselessCharListSub = (char -> CaselessChar) -> [char] -> [CaselessChar]
forall a b. (a -> b) -> [a] -> [b]
List.map char -> CaselessChar
forall char. ToCaselessChar char => char -> CaselessChar
toCaselessCharSub

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

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

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

instance (ToCasefulChar letterCase char, KnownCase letterCase) => ToCasefulString letterCase [char] where
  toCasefulString :: [CaselessChar] -> [char]
toCasefulString = (CaselessChar -> char) -> [CaselessChar] -> [char]
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 Char -> Bool
forall char. ToChar char => char -> Bool
isAsciiChar
  toCaselessCharListUnsafe :: Text -> [CaselessChar]
toCaselessCharListUnsafe = String -> [CaselessChar]
forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListUnsafe (String -> [CaselessChar])
-> (Text -> String) -> Text -> [CaselessChar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
  toCaselessCharListSub :: Text -> [CaselessChar]
toCaselessCharListSub = String -> [CaselessChar]
forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListSub (String -> [CaselessChar])
-> (Text -> String) -> Text -> [CaselessChar]
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 Char -> Bool
forall char. ToChar char => char -> Bool
isAsciiChar
  toCharListUnsafe :: Text -> [Char]
toCharListUnsafe = String -> [Char]
forall string. ToString string => string -> [Char]
toCharListUnsafe (String -> [Char]) -> (Text -> String) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
  toCharListSub :: Text -> [Char]
toCharListSub = String -> [Char]
forall string. ToString string => string -> [Char]
toCharListSub (String -> [Char]) -> (Text -> String) -> Text -> [Char]
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 (String -> Text) -> ([Char] -> String) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> String
forall string. FromString string => [Char] -> string
fromCharList

instance StringSuperset T.Text where
  substituteString :: Text -> Text
substituteString = (Char -> Char) -> Text -> Text
T.map Char -> Char
forall char. CharSuperset char => char -> char
substituteChar
  mapCharsUnsafe :: (Char -> Char) -> Text -> Text
mapCharsUnsafe Char -> Char
f = (Char -> Char) -> Text -> Text
T.map ((Char -> Char) -> Char -> Char
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 (Case -> Char -> Char
forall char. CharSuperset char => Case -> char -> char
toCaseChar Case
c)

instance KnownCase letterCase => ToCasefulString letterCase T.Text where
  toCasefulString :: [CaselessChar] -> Text
toCasefulString = [Char] -> Text
forall string. FromString string => [Char] -> string
fromCharList ([Char] -> Text)
-> ([CaselessChar] -> [Char]) -> [CaselessChar] -> Text
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 Char -> Bool
forall char. ToChar char => char -> Bool
isAsciiChar
  toCaselessCharListUnsafe :: Text -> [CaselessChar]
toCaselessCharListUnsafe = String -> [CaselessChar]
forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListUnsafe (String -> [CaselessChar])
-> (Text -> String) -> Text -> [CaselessChar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
LT.unpack
  toCaselessCharListSub :: Text -> [CaselessChar]
toCaselessCharListSub = String -> [CaselessChar]
forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListSub (String -> [CaselessChar])
-> (Text -> String) -> Text -> [CaselessChar]
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 Char -> Bool
forall char. ToChar char => char -> Bool
isAsciiChar
  toCharListUnsafe :: Text -> [Char]
toCharListUnsafe = String -> [Char]
forall string. ToString string => string -> [Char]
toCharListUnsafe (String -> [Char]) -> (Text -> String) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
LT.unpack
  toCharListSub :: Text -> [Char]
toCharListSub = String -> [Char]
forall string. ToString string => string -> [Char]
toCharListSub (String -> [Char]) -> (Text -> String) -> Text -> [Char]
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 (String -> Text) -> ([Char] -> String) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> String
forall string. FromString string => [Char] -> string
fromCharList

instance StringSuperset LT.Text where
  substituteString :: Text -> Text
substituteString = (Char -> Char) -> Text -> Text
LT.map Char -> Char
forall char. CharSuperset char => char -> char
substituteChar
  mapCharsUnsafe :: (Char -> Char) -> Text -> Text
mapCharsUnsafe Char -> Char
f = (Char -> Char) -> Text -> Text
LT.map ((Char -> Char) -> Char -> Char
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 (Case -> Char -> Char
forall char. CharSuperset char => Case -> char -> char
toCaseChar Case
c)

instance KnownCase letterCase => ToCasefulString letterCase LT.Text where
  toCasefulString :: [CaselessChar] -> Text
toCasefulString = [Char] -> Text
forall string. FromString string => [Char] -> string
fromCharList ([Char] -> Text)
-> ([CaselessChar] -> [Char]) -> [CaselessChar] -> Text
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 = Text -> Bool
forall string. ToCaselessString string => string -> Bool
isAsciiCaselessString (Text -> Bool) -> (Builder -> Text) -> Builder -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText
  toCaselessCharListUnsafe :: Builder -> [CaselessChar]
toCaselessCharListUnsafe = Text -> [CaselessChar]
forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListUnsafe (Text -> [CaselessChar])
-> (Builder -> Text) -> Builder -> [CaselessChar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText
  toCaselessCharListSub :: Builder -> [CaselessChar]
toCaselessCharListSub = Text -> [CaselessChar]
forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListSub (Text -> [CaselessChar])
-> (Builder -> Text) -> Builder -> [CaselessChar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText

instance ToString TB.Builder where
  isAsciiString :: Builder -> Bool
isAsciiString = Text -> Bool
forall string. ToString string => string -> Bool
isAsciiString (Text -> Bool) -> (Builder -> Text) -> Builder -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText
  toCharListUnsafe :: Builder -> [Char]
toCharListUnsafe = Text -> [Char]
forall string. ToString string => string -> [Char]
toCharListUnsafe (Text -> [Char]) -> (Builder -> Text) -> Builder -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText
  toCharListSub :: Builder -> [Char]
toCharListSub = Text -> [Char]
forall string. ToString string => string -> [Char]
toCharListSub (Text -> [Char]) -> (Builder -> Text) -> Builder -> [Char]
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 (String -> Builder) -> ([Char] -> String) -> [Char] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> String
forall string. FromString string => [Char] -> string
fromCharList

instance StringSuperset TB.Builder where
  substituteString :: Builder -> Builder
substituteString = Text -> Builder
TB.fromLazyText (Text -> Builder) -> (Builder -> Text) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall string. StringSuperset string => string -> string
substituteString (Text -> Text) -> (Builder -> Text) -> Builder -> Text
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 (Text -> Builder) -> (Builder -> Text) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Text -> Text
forall string.
StringSuperset string =>
(Char -> Char) -> string -> string
mapCharsUnsafe Char -> Char
f (Text -> Text) -> (Builder -> Text) -> Builder -> Text
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 (Text -> Builder) -> (Builder -> Text) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Case -> Text -> Text
forall string. StringSuperset string => Case -> string -> string
toCaseString Case
c (Text -> Text) -> (Builder -> Text) -> Builder -> Text
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 = [Char] -> Builder
forall string. FromString string => [Char] -> string
fromCharList ([Char] -> Builder)
-> ([CaselessChar] -> [Char]) -> [CaselessChar] -> Builder
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 Word8 -> Bool
forall char. ToCaselessChar char => char -> Bool
isAsciiCaselessChar
  toCaselessCharListUnsafe :: ByteString -> [CaselessChar]
toCaselessCharListUnsafe = [Word8] -> [CaselessChar]
forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListUnsafe ([Word8] -> [CaselessChar])
-> (ByteString -> [Word8]) -> ByteString -> [CaselessChar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack
  toCaselessCharListSub :: ByteString -> [CaselessChar]
toCaselessCharListSub = [Word8] -> [CaselessChar]
forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListSub ([Word8] -> [CaselessChar])
-> (ByteString -> [Word8]) -> ByteString -> [CaselessChar]
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 Word8 -> Bool
forall char. ToChar char => char -> Bool
isAsciiChar
  toCharListUnsafe :: ByteString -> [Char]
toCharListUnsafe = [Word8] -> [Char]
forall string. ToString string => string -> [Char]
toCharListUnsafe ([Word8] -> [Char])
-> (ByteString -> [Word8]) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack
  toCharListSub :: ByteString -> [Char]
toCharListSub = [Word8] -> [Char]
forall string. ToString string => string -> [Char]
toCharListSub ([Word8] -> [Char])
-> (ByteString -> [Word8]) -> ByteString -> [Char]
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 ([Word8] -> ByteString)
-> ([Char] -> [Word8]) -> [Char] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Word8]
forall string. FromString string => [Char] -> string
fromCharList

instance StringSuperset BS.ByteString where
  substituteString :: ByteString -> ByteString
substituteString = (Word8 -> Word8) -> ByteString -> ByteString
BS.map Word8 -> Word8
forall char. CharSuperset char => char -> char
substituteChar
  mapCharsUnsafe :: (Char -> Char) -> ByteString -> ByteString
mapCharsUnsafe Char -> Char
f = (Word8 -> Word8) -> ByteString -> ByteString
BS.map ((Char -> Char) -> Word8 -> Word8
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 (Case -> Word8 -> Word8
forall char. CharSuperset char => Case -> char -> char
toCaseChar Case
c)

instance KnownCase letterCase => ToCasefulString letterCase BS.ByteString where
  toCasefulString :: [CaselessChar] -> ByteString
toCasefulString = [Char] -> ByteString
forall string. FromString string => [Char] -> string
fromCharList ([Char] -> ByteString)
-> ([CaselessChar] -> [Char]) -> [CaselessChar] -> ByteString
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 Word8 -> Bool
forall char. ToCaselessChar char => char -> Bool
isAsciiCaselessChar
  toCaselessCharListUnsafe :: ByteString -> [CaselessChar]
toCaselessCharListUnsafe = [Word8] -> [CaselessChar]
forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListUnsafe ([Word8] -> [CaselessChar])
-> (ByteString -> [Word8]) -> ByteString -> [CaselessChar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
LBS.unpack
  toCaselessCharListSub :: ByteString -> [CaselessChar]
toCaselessCharListSub = [Word8] -> [CaselessChar]
forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListSub ([Word8] -> [CaselessChar])
-> (ByteString -> [Word8]) -> ByteString -> [CaselessChar]
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 Word8 -> Bool
forall char. ToChar char => char -> Bool
isAsciiChar
  toCharListUnsafe :: ByteString -> [Char]
toCharListUnsafe = [Word8] -> [Char]
forall string. ToString string => string -> [Char]
toCharListUnsafe ([Word8] -> [Char])
-> (ByteString -> [Word8]) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
LBS.unpack
  toCharListSub :: ByteString -> [Char]
toCharListSub = [Word8] -> [Char]
forall string. ToString string => string -> [Char]
toCharListSub ([Word8] -> [Char])
-> (ByteString -> [Word8]) -> ByteString -> [Char]
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 ([Word8] -> ByteString)
-> ([Char] -> [Word8]) -> [Char] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Word8]
forall string. FromString string => [Char] -> string
fromCharList

instance StringSuperset LBS.ByteString where
  substituteString :: ByteString -> ByteString
substituteString = (Word8 -> Word8) -> ByteString -> ByteString
LBS.map Word8 -> Word8
forall char. CharSuperset char => char -> char
substituteChar
  mapCharsUnsafe :: (Char -> Char) -> ByteString -> ByteString
mapCharsUnsafe Char -> Char
f = (Word8 -> Word8) -> ByteString -> ByteString
LBS.map ((Char -> Char) -> Word8 -> Word8
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 (Case -> Word8 -> Word8
forall char. CharSuperset char => Case -> char -> char
toCaseChar Case
c)

instance KnownCase letterCase => ToCasefulString letterCase LBS.ByteString where
  toCasefulString :: [CaselessChar] -> ByteString
toCasefulString = [Char] -> ByteString
forall string. FromString string => [Char] -> string
fromCharList ([Char] -> ByteString)
-> ([CaselessChar] -> [Char]) -> [CaselessChar] -> ByteString
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 = ByteString -> Bool
forall string. ToCaselessString string => string -> Bool
isAsciiCaselessString (ByteString -> Bool) -> (Builder -> ByteString) -> Builder -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString
  toCaselessCharListUnsafe :: Builder -> [CaselessChar]
toCaselessCharListUnsafe = ByteString -> [CaselessChar]
forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListUnsafe (ByteString -> [CaselessChar])
-> (Builder -> ByteString) -> Builder -> [CaselessChar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString
  toCaselessCharListSub :: Builder -> [CaselessChar]
toCaselessCharListSub = ByteString -> [CaselessChar]
forall string. ToCaselessString string => string -> [CaselessChar]
toCaselessCharListSub (ByteString -> [CaselessChar])
-> (Builder -> ByteString) -> Builder -> [CaselessChar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString

instance ToString BSB.Builder where
  isAsciiString :: Builder -> Bool
isAsciiString = ByteString -> Bool
forall string. ToString string => string -> Bool
isAsciiString (ByteString -> Bool) -> (Builder -> ByteString) -> Builder -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString
  toCharListUnsafe :: Builder -> [Char]
toCharListUnsafe = ByteString -> [Char]
forall string. ToString string => string -> [Char]
toCharListUnsafe (ByteString -> [Char])
-> (Builder -> ByteString) -> Builder -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString
  toCharListSub :: Builder -> [Char]
toCharListSub = ByteString -> [Char]
forall string. ToString string => string -> [Char]
toCharListSub (ByteString -> [Char])
-> (Builder -> ByteString) -> Builder -> [Char]
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 (ByteString -> Builder)
-> ([Char] -> ByteString) -> [Char] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
forall string. FromString string => [Char] -> string
fromCharList

instance StringSuperset BSB.Builder where
  substituteString :: Builder -> Builder
substituteString = ByteString -> Builder
BSB.lazyByteString (ByteString -> Builder)
-> (Builder -> ByteString) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall string. StringSuperset string => string -> string
substituteString (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
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 (ByteString -> Builder)
-> (Builder -> ByteString) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ByteString -> ByteString
forall string.
StringSuperset string =>
(Char -> Char) -> string -> string
mapCharsUnsafe Char -> Char
f (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
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 (ByteString -> Builder)
-> (Builder -> ByteString) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Case -> ByteString -> ByteString
forall string. StringSuperset string => Case -> string -> string
toCaseString Case
c (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
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 = [Char] -> Builder
forall string. FromString string => [Char] -> string
fromCharList ([Char] -> Builder)
-> ([CaselessChar] -> [Char]) -> [CaselessChar] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (letterCase :: Case) string.
ToCasefulString letterCase string =>
[CaselessChar] -> string
toCasefulString @letterCase