module ASCII.CaseRefinement
(
ASCII'case, lift, asciiCaseUnsafe,
ASCII'upper, ASCII'lower,
validateChar, fromCaselessChar,
toCaselessChar, substituteChar, asCaselessChar,
validateString, fromCaselessCharList,
toCaselessCharList, substituteString, mapChars,
)
where
import ASCII.Case (Case (..))
import ASCII.Caseless (CaselessChar)
import ASCII.Superset (CharSuperset, StringSuperset)
import qualified ASCII.Case as Case
import qualified ASCII.Caseless as Caseless
import qualified ASCII.Char as ASCII
import qualified ASCII.Superset as Superset
import Control.Monad (guard)
import Data.Bool (Bool (..))
import Data.Data (Data, Typeable)
import Data.Eq (Eq)
import Data.Foldable (any)
import Data.Function (id, ($), (.))
import Data.Hashable (Hashable)
import Data.Maybe (Maybe (..))
import Data.Monoid (Monoid)
import Data.Ord (Ord, (>))
import Data.Semigroup (Semigroup)
import Data.Traversable (traverse)
import GHC.Generics (Generic)
import Prelude (succ)
import Text.Show (Show, showList, showParen, showString, showsPrec)
import qualified Data.Bool as Bool
import qualified Data.List as List
newtype ASCII'case (letterCase :: Case) superset = ASCII'case_Unsafe
{ ASCII'case letterCase superset -> superset
lift :: superset
}
deriving stock instance Eq superset =>
Eq (ASCII'case letterCase superset)
deriving stock instance Ord superset =>
Ord (ASCII'case letterCase superset)
deriving newtype instance Hashable superset =>
Hashable (ASCII'case letterCase superset)
deriving newtype instance Semigroup superset =>
Semigroup (ASCII'case letterCase superset)
deriving newtype instance Monoid superset =>
Monoid (ASCII'case letterCase superset)
deriving stock instance (Data superset, Typeable letterCase) =>
Data (ASCII'case letterCase superset)
deriving stock instance Generic (ASCII'case letterCase superset)
instance Show superset => Show (ASCII'case letterCase superset) where
showsPrec :: Int -> ASCII'case letterCase superset -> ShowS
showsPrec Int
d ASCII'case letterCase superset
x = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"asciiCaseUnsafe " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> superset -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int -> Int
forall a. Enum a => a -> a
succ Int
app_prec) (ASCII'case letterCase superset -> superset
forall (letterCase :: Case) superset.
ASCII'case letterCase superset -> superset
lift ASCII'case letterCase superset
x)
where app_prec :: Int
app_prec = Int
10
showList :: [ASCII'case letterCase superset] -> ShowS
showList [ASCII'case letterCase superset]
x = String -> ShowS
showString String
"asciiCaseUnsafe " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [superset] -> ShowS
forall a. Show a => [a] -> ShowS
showList ((ASCII'case letterCase superset -> superset)
-> [ASCII'case letterCase superset] -> [superset]
forall a b. (a -> b) -> [a] -> [b]
List.map ASCII'case letterCase superset -> superset
forall (letterCase :: Case) superset.
ASCII'case letterCase superset -> superset
lift [ASCII'case letterCase superset]
x)
asciiCaseUnsafe :: superset -> ASCII'case letterCase superset
asciiCaseUnsafe :: superset -> ASCII'case letterCase superset
asciiCaseUnsafe = superset -> ASCII'case letterCase superset
forall (letterCase :: Case) superset.
superset -> ASCII'case letterCase superset
ASCII'case_Unsafe
type ASCII'upper superset = ASCII'case 'UpperCase superset
type ASCII'lower superset = ASCII'case 'LowerCase superset
class KnownCase (letterCase :: Case) where theCase :: Case
instance KnownCase 'UpperCase where theCase :: Case
theCase = Case
UpperCase
instance KnownCase 'LowerCase where theCase :: Case
theCase = Case
LowerCase
validateChar :: forall letterCase superset. KnownCase letterCase => CharSuperset superset =>
superset
-> Maybe (ASCII'case letterCase superset)
validateChar :: superset -> Maybe (ASCII'case letterCase superset)
validateChar superset
x = do
Char
c <- superset -> Maybe Char
forall char. ToChar char => char -> Maybe Char
Superset.toCharMaybe superset
x
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
Bool.not (Case -> Char -> Bool
Case.isCase (Case -> Case
Case.opposite (KnownCase letterCase => Case
forall (letterCase :: Case). KnownCase letterCase => Case
theCase @letterCase)) Char
c))
ASCII'case letterCase superset
-> Maybe (ASCII'case letterCase superset)
forall a. a -> Maybe a
Just (superset -> ASCII'case letterCase superset
forall superset (letterCase :: Case).
superset -> ASCII'case letterCase superset
asciiCaseUnsafe superset
x)
substituteChar :: forall letterCase superset. KnownCase letterCase => CharSuperset superset =>
superset
-> ASCII'case letterCase superset
substituteChar :: superset -> ASCII'case letterCase superset
substituteChar superset
x = case superset -> Maybe (ASCII'case letterCase superset)
forall (letterCase :: Case) superset.
(KnownCase letterCase, CharSuperset superset) =>
superset -> Maybe (ASCII'case letterCase superset)
validateChar superset
x of
Maybe (ASCII'case letterCase superset)
Nothing -> superset -> ASCII'case letterCase superset
forall superset (letterCase :: Case).
superset -> ASCII'case letterCase superset
asciiCaseUnsafe (Char -> superset
forall char. FromChar char => Char -> char
Superset.fromChar Char
ASCII.Substitute)
Just ASCII'case letterCase superset
c -> ASCII'case letterCase superset
c
fromCaselessChar :: forall letterCase superset. KnownCase letterCase => CharSuperset superset =>
CaselessChar
-> ASCII'case letterCase superset
fromCaselessChar :: CaselessChar -> ASCII'case letterCase superset
fromCaselessChar = superset -> ASCII'case letterCase superset
forall superset (letterCase :: Case).
superset -> ASCII'case letterCase superset
asciiCaseUnsafe (superset -> ASCII'case letterCase superset)
-> (CaselessChar -> superset)
-> CaselessChar
-> ASCII'case letterCase superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> superset
forall char. FromChar char => Char -> char
Superset.fromChar (Char -> superset)
-> (CaselessChar -> Char) -> CaselessChar -> superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Case -> CaselessChar -> Char
Caseless.toCase (KnownCase letterCase => Case
forall (letterCase :: Case). KnownCase letterCase => Case
theCase @letterCase)
toCaselessChar :: CharSuperset superset =>
ASCII'case letterCase superset
-> CaselessChar
toCaselessChar :: ASCII'case letterCase superset -> CaselessChar
toCaselessChar = Char -> CaselessChar
Caseless.disregardCase (Char -> CaselessChar)
-> (ASCII'case letterCase superset -> Char)
-> ASCII'case letterCase superset
-> CaselessChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. superset -> Char
forall char. ToChar char => char -> Char
Superset.toCharUnsafe (superset -> Char)
-> (ASCII'case letterCase superset -> superset)
-> ASCII'case letterCase superset
-> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII'case letterCase superset -> superset
forall (letterCase :: Case) superset.
ASCII'case letterCase superset -> superset
lift
asCaselessChar :: forall letterCase superset. KnownCase letterCase => CharSuperset superset =>
(CaselessChar -> CaselessChar)
-> ASCII'case letterCase superset
-> ASCII'case letterCase superset
asCaselessChar :: (CaselessChar -> CaselessChar)
-> ASCII'case letterCase superset -> ASCII'case letterCase superset
asCaselessChar CaselessChar -> CaselessChar
f = superset -> ASCII'case letterCase superset
forall superset (letterCase :: Case).
superset -> ASCII'case letterCase superset
asciiCaseUnsafe (superset -> ASCII'case letterCase superset)
-> (ASCII'case letterCase superset -> superset)
-> ASCII'case letterCase superset
-> ASCII'case letterCase superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> superset -> superset
forall char. CharSuperset char => (Char -> Char) -> char -> char
Superset.asCharUnsafe Char -> Char
g (superset -> superset)
-> (ASCII'case letterCase superset -> superset)
-> ASCII'case letterCase superset
-> superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII'case letterCase superset -> superset
forall (letterCase :: Case) superset.
ASCII'case letterCase superset -> superset
lift
where
g :: Char -> Char
g = Case -> CaselessChar -> Char
Caseless.toCase (KnownCase letterCase => Case
forall (letterCase :: Case). KnownCase letterCase => Case
theCase @letterCase) (CaselessChar -> Char) -> (Char -> CaselessChar) -> Char -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CaselessChar -> CaselessChar
f (CaselessChar -> CaselessChar)
-> (Char -> CaselessChar) -> Char -> CaselessChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Case -> Char -> CaselessChar
Caseless.assumeCaseUnsafe (KnownCase letterCase => Case
forall (letterCase :: Case). KnownCase letterCase => Case
theCase @letterCase)
validateString :: forall letterCase superset. KnownCase letterCase => StringSuperset superset =>
superset
-> Maybe (ASCII'case letterCase superset)
validateString :: superset -> Maybe (ASCII'case letterCase superset)
validateString superset
x = do
[Char]
s <- superset -> Maybe [Char]
forall string. ToString string => string -> Maybe [Char]
Superset.toCharListMaybe superset
x
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
Bool.not ((Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Case -> Char -> Bool
Case.isCase (Case -> Case
Case.opposite (KnownCase letterCase => Case
forall (letterCase :: Case). KnownCase letterCase => Case
theCase @letterCase))) [Char]
s))
ASCII'case letterCase superset
-> Maybe (ASCII'case letterCase superset)
forall a. a -> Maybe a
Just (superset -> ASCII'case letterCase superset
forall superset (letterCase :: Case).
superset -> ASCII'case letterCase superset
asciiCaseUnsafe superset
x)
fromCaselessCharList :: forall letterCase superset. KnownCase letterCase => StringSuperset superset =>
[CaselessChar]
-> ASCII'case letterCase superset
fromCaselessCharList :: [CaselessChar] -> ASCII'case letterCase superset
fromCaselessCharList = superset -> ASCII'case letterCase superset
forall superset (letterCase :: Case).
superset -> ASCII'case letterCase superset
asciiCaseUnsafe (superset -> ASCII'case letterCase superset)
-> ([CaselessChar] -> superset)
-> [CaselessChar]
-> ASCII'case letterCase superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> superset
forall string. FromString string => [Char] -> string
Superset.fromCharList ([Char] -> superset)
-> ([CaselessChar] -> [Char]) -> [CaselessChar] -> superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CaselessChar -> Char) -> [CaselessChar] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
List.map (Case -> CaselessChar -> Char
Caseless.toCase (KnownCase letterCase => Case
forall (letterCase :: Case). KnownCase letterCase => Case
theCase @letterCase))
toCaselessCharList :: forall letterCase superset. KnownCase letterCase => StringSuperset superset =>
ASCII'case letterCase superset
-> [CaselessChar]
toCaselessCharList :: ASCII'case letterCase superset -> [CaselessChar]
toCaselessCharList = (Char -> CaselessChar) -> [Char] -> [CaselessChar]
forall a b. (a -> b) -> [a] -> [b]
List.map (Case -> Char -> CaselessChar
Caseless.assumeCaseUnsafe (KnownCase letterCase => Case
forall (letterCase :: Case). KnownCase letterCase => Case
theCase @letterCase)) ([Char] -> [CaselessChar])
-> (ASCII'case letterCase superset -> [Char])
-> ASCII'case letterCase superset
-> [CaselessChar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. superset -> [Char]
forall string. ToString string => string -> [Char]
Superset.toCharListUnsafe (superset -> [Char])
-> (ASCII'case letterCase superset -> superset)
-> ASCII'case letterCase superset
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII'case letterCase superset -> superset
forall (letterCase :: Case) superset.
ASCII'case letterCase superset -> superset
lift
substituteString :: forall letterCase superset. KnownCase letterCase => StringSuperset superset =>
superset
-> ASCII'case letterCase superset
substituteString :: superset -> ASCII'case letterCase superset
substituteString = superset -> ASCII'case letterCase superset
forall superset (letterCase :: Case).
superset -> ASCII'case letterCase superset
asciiCaseUnsafe (superset -> ASCII'case letterCase superset)
-> (superset -> superset)
-> superset
-> ASCII'case letterCase superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> superset
forall string. FromString string => [Char] -> string
Superset.fromCharList ([Char] -> superset)
-> (superset -> [Char]) -> superset -> superset
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]) -> (superset -> [Char]) -> superset -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. superset -> [Char]
forall string. ToString string => string -> [Char]
Superset.toCharListSub
where
f :: Char -> Char
f Char
x = if Case -> Char -> Bool
Case.isCase (Case -> Case
Case.opposite (KnownCase letterCase => Case
forall (letterCase :: Case). KnownCase letterCase => Case
theCase @letterCase)) Char
x
then Char
ASCII.Substitute
else Char
x
mapChars :: forall letterCase superset. KnownCase letterCase => StringSuperset superset =>
(CaselessChar -> CaselessChar)
-> ASCII'case letterCase superset
-> ASCII'case letterCase superset
mapChars :: (CaselessChar -> CaselessChar)
-> ASCII'case letterCase superset -> ASCII'case letterCase superset
mapChars CaselessChar -> CaselessChar
f = superset -> ASCII'case letterCase superset
forall superset (letterCase :: Case).
superset -> ASCII'case letterCase superset
asciiCaseUnsafe (superset -> ASCII'case letterCase superset)
-> (ASCII'case letterCase superset -> superset)
-> ASCII'case letterCase superset
-> ASCII'case letterCase superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> superset -> superset
forall string.
StringSuperset string =>
(Char -> Char) -> string -> string
Superset.mapCharsUnsafe Char -> Char
g (superset -> superset)
-> (ASCII'case letterCase superset -> superset)
-> ASCII'case letterCase superset
-> superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII'case letterCase superset -> superset
forall (letterCase :: Case) superset.
ASCII'case letterCase superset -> superset
lift
where
g :: Char -> Char
g = Case -> CaselessChar -> Char
Caseless.toCase (KnownCase letterCase => Case
forall (letterCase :: Case). KnownCase letterCase => Case
theCase @letterCase) (CaselessChar -> Char) -> (Char -> CaselessChar) -> Char -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CaselessChar -> CaselessChar
f (CaselessChar -> CaselessChar)
-> (Char -> CaselessChar) -> Char -> CaselessChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Case -> Char -> CaselessChar
Caseless.assumeCaseUnsafe (KnownCase letterCase => Case
forall (letterCase :: Case). KnownCase letterCase => Case
theCase @letterCase)