module ASCII.Refinement
  (
    {- * ASCII type constructor -} ASCII, lift, asciiUnsafe,
    {- * Character functions -} validateChar, fromChar, toChar, substituteChar, asChar,
    {- * String functions -} validateString, fromCharList, toCharList, substituteString, mapChars
  )
  where

import qualified ASCII.Char as ASCII
import qualified ASCII.Isomorphism as I
import qualified ASCII.Superset as S

import Data.Data (Data)
import Data.Eq (Eq)
import Data.Function (id, ($), (.))
import Data.Hashable (Hashable)
import Data.List (map)
import Data.Maybe (Maybe (..))
import Data.Monoid (Monoid)
import Data.Ord (Ord, (>))
import Data.Semigroup (Semigroup)
import GHC.Generics (Generic)
import Prelude (succ)

import qualified Data.Bool as Bool
import qualified Text.Show as Show

{-| This type constructor indicates that a value from some ASCII superset is
valid ASCII. The type parameter is the ASCII superset, which should be a type
with an instance of either 'CharSuperset' or 'StringSuperset'.

For example, whereas a 'Data.Text.Text' value may contain a combination of ASCII
and non-ASCII characters, a value of type @'ASCII' 'Data.Text.Text'@ may contain
only ASCII characters. -}
newtype ASCII superset = ASCII_Unsafe { ASCII superset -> superset
lift :: superset }

deriving stock instance Eq superset => Eq (ASCII superset)

deriving stock instance Ord superset => Ord (ASCII superset)

deriving newtype instance Hashable superset => Hashable (ASCII superset)

deriving newtype instance Semigroup superset => Semigroup (ASCII superset)

deriving newtype instance Monoid superset => Monoid (ASCII superset)

deriving stock instance Data superset => Data (ASCII superset)

deriving stock instance Generic (ASCII superset)

instance Show.Show superset => Show.Show (ASCII superset) where
    showsPrec :: Int -> ASCII superset -> ShowS
showsPrec Int
d ASCII superset
x = Bool -> ShowS -> ShowS
Show.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
Show.showString String
"asciiUnsafe " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> superset -> ShowS
forall a. Show a => Int -> a -> ShowS
Show.showsPrec (Int -> Int
forall a. Enum a => a -> a
succ Int
app_prec) (ASCII superset -> superset
forall superset. ASCII superset -> superset
lift ASCII superset
x)
      where app_prec :: Int
app_prec = Int
10

    showList :: [ASCII superset] -> ShowS
showList [ASCII superset]
x = String -> ShowS
Show.showString String
"asciiUnsafe " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [superset] -> ShowS
forall a. Show a => [a] -> ShowS
Show.showList ((ASCII superset -> superset) -> [ASCII superset] -> [superset]
forall a b. (a -> b) -> [a] -> [b]
map ASCII superset -> superset
forall superset. ASCII superset -> superset
lift [ASCII superset]
x)

instance S.ToCaselessChar char => S.ToCaselessChar (ASCII char) where
    isAsciiCaselessChar :: ASCII char -> Bool
isAsciiCaselessChar ASCII char
_ = Bool
Bool.True
    toCaselessCharUnsafe :: ASCII char -> CaselessChar
toCaselessCharUnsafe = char -> CaselessChar
forall char. ToCaselessChar char => char -> CaselessChar
S.toCaselessCharUnsafe (char -> CaselessChar)
-> (ASCII char -> char) -> ASCII char -> CaselessChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII char -> char
forall superset. ASCII superset -> superset
lift

instance S.CharSuperset char => S.ToChar (ASCII char) where
    isAsciiChar :: ASCII char -> Bool
isAsciiChar ASCII char
_ = Bool
Bool.True
    toCharUnsafe :: ASCII char -> Char
toCharUnsafe = char -> Char
forall char. ToChar char => char -> Char
S.toCharUnsafe (char -> Char) -> (ASCII char -> char) -> ASCII char -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII char -> char
forall superset. ASCII superset -> superset
lift

instance S.CharSuperset char => S.FromChar (ASCII char) where
    fromChar :: Char -> ASCII char
fromChar = char -> ASCII char
forall superset. superset -> ASCII superset
asciiUnsafe (char -> ASCII char) -> (Char -> char) -> Char -> ASCII char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> char
forall char. FromChar char => Char -> char
S.fromChar

instance S.CharSuperset char => S.CharSuperset (ASCII char)

instance S.CharSuperset char => I.CharIso (ASCII char) where
    toChar :: ASCII char -> Char
toChar = ASCII char -> Char
forall char. ToChar char => char -> Char
S.toCharUnsafe

instance S.ToCaselessString string => S.ToCaselessString (ASCII string) where
    isAsciiCaselessString :: ASCII string -> Bool
isAsciiCaselessString ASCII string
_ = Bool
Bool.True
    toCaselessCharListUnsafe :: ASCII string -> [CaselessChar]
toCaselessCharListUnsafe = string -> [CaselessChar]
forall string. ToCaselessString string => string -> [CaselessChar]
S.toCaselessCharListUnsafe (string -> [CaselessChar])
-> (ASCII string -> string) -> ASCII string -> [CaselessChar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII string -> string
forall superset. ASCII superset -> superset
lift
    toCaselessCharListSub :: ASCII string -> [CaselessChar]
toCaselessCharListSub = string -> [CaselessChar]
forall string. ToCaselessString string => string -> [CaselessChar]
S.toCaselessCharListSub (string -> [CaselessChar])
-> (ASCII string -> string) -> ASCII string -> [CaselessChar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII string -> string
forall superset. ASCII superset -> superset
lift

instance S.ToString string => S.ToString (ASCII string) where
    isAsciiString :: ASCII string -> Bool
isAsciiString ASCII string
_ = Bool
Bool.True
    toCharListUnsafe :: ASCII string -> [Char]
toCharListUnsafe = string -> [Char]
forall string. ToString string => string -> [Char]
S.toCharListUnsafe (string -> [Char])
-> (ASCII string -> string) -> ASCII string -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII string -> string
forall superset. ASCII superset -> superset
lift
    toCharListSub :: ASCII string -> [Char]
toCharListSub = string -> [Char]
forall string. ToString string => string -> [Char]
S.toCharListUnsafe (string -> [Char])
-> (ASCII string -> string) -> ASCII string -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII string -> string
forall superset. ASCII superset -> superset
lift

instance S.FromString string => S.FromString (ASCII string) where
    fromCharList :: [Char] -> ASCII string
fromCharList = string -> ASCII string
forall superset. superset -> ASCII superset
asciiUnsafe (string -> ASCII string)
-> ([Char] -> string) -> [Char] -> ASCII string
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> string
forall string. FromString string => [Char] -> string
S.fromCharList

instance S.StringSuperset string => S.StringSuperset (ASCII string) where
    substituteString :: ASCII string -> ASCII string
substituteString = ASCII string -> ASCII string
forall a. a -> a
id

instance S.StringSuperset string => I.StringIso (ASCII string) where
    toCharList :: ASCII string -> [Char]
toCharList = ASCII string -> [Char]
forall string. ToString string => string -> [Char]
S.toCharListUnsafe
    mapChars :: (Char -> Char) -> ASCII string -> ASCII string
mapChars = (Char -> Char) -> ASCII string -> ASCII string
forall string.
StringSuperset string =>
(Char -> Char) -> string -> string
S.mapCharsUnsafe

{-| Change the type of an ASCII superset value that is known to be valid ASCII

This is "unsafe" because this assertion is unchecked, so this function is capable
of producing an invalid 'ASCII' value. -}
asciiUnsafe :: superset -> ASCII superset
asciiUnsafe :: superset -> ASCII superset
asciiUnsafe = superset -> ASCII superset
forall superset. superset -> ASCII superset
ASCII_Unsafe

{-|
>>> map validateChar [-1, 65, 97, 128] :: [Maybe (ASCII Int)]
[Nothing,Just (asciiUnsafe 65),Just (asciiUnsafe 97),Nothing]
-}
validateChar :: S.CharSuperset superset => superset -> Maybe (ASCII superset)
validateChar :: superset -> Maybe (ASCII superset)
validateChar superset
x = if superset -> Bool
forall char. ToChar char => char -> Bool
S.isAsciiChar superset
x then ASCII superset -> Maybe (ASCII superset)
forall a. a -> Maybe a
Just (superset -> ASCII superset
forall superset. superset -> ASCII superset
asciiUnsafe superset
x) else Maybe (ASCII superset)
forall a. Maybe a
Nothing

substituteChar :: S.CharSuperset superset => superset -> ASCII superset
substituteChar :: superset -> ASCII superset
substituteChar superset
x = if superset -> Bool
forall char. ToChar char => char -> Bool
S.isAsciiChar superset
x then superset -> ASCII superset
forall superset. superset -> ASCII superset
asciiUnsafe superset
x else Char -> ASCII superset
forall char. CharSuperset char => Char -> ASCII char
fromChar Char
ASCII.Substitute

fromChar :: S.CharSuperset superset => ASCII.Char -> ASCII superset
fromChar :: Char -> ASCII superset
fromChar = superset -> ASCII superset
forall superset. superset -> ASCII superset
asciiUnsafe (superset -> ASCII superset)
-> (Char -> superset) -> Char -> ASCII superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> superset
forall char. FromChar char => Char -> char
S.fromChar

toChar :: S.CharSuperset superset => ASCII superset -> ASCII.Char
toChar :: ASCII superset -> Char
toChar = superset -> Char
forall char. ToChar char => char -> Char
S.toCharUnsafe (superset -> Char)
-> (ASCII superset -> superset) -> ASCII superset -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII superset -> superset
forall superset. ASCII superset -> superset
lift

{-|
>>> fromCharList [CapitalLetterH,SmallLetterI,ExclamationMark] :: ASCII Text
asciiUnsafe "Hi!"
-}
fromCharList :: S.StringSuperset superset => [ASCII.Char] -> ASCII superset
fromCharList :: [Char] -> ASCII superset
fromCharList = superset -> ASCII superset
forall superset. superset -> ASCII superset
asciiUnsafe (superset -> ASCII superset)
-> ([Char] -> superset) -> [Char] -> ASCII superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> superset
forall string. FromString string => [Char] -> string
S.fromCharList

{-|
>>> toCharList (substituteString "Piñata" :: ASCII Text)
[CapitalLetterP,SmallLetterI,Substitute,SmallLetterA,SmallLetterT,SmallLetterA]
-}
toCharList :: S.StringSuperset superset => ASCII superset -> [ASCII.Char]
toCharList :: ASCII superset -> [Char]
toCharList = superset -> [Char]
forall string. ToString string => string -> [Char]
S.toCharListUnsafe (superset -> [Char])
-> (ASCII superset -> superset) -> ASCII superset -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII superset -> superset
forall superset. ASCII superset -> superset
lift

{-| Forces a string from a larger character set into ASCII by using the
'ASCII.Substitute' character in place of any non-ASCII characters

>>> substituteString "Cristóbal" :: ASCII Text
asciiUnsafe "Crist\SUBbal"
-}
substituteString :: S.StringSuperset superset => superset -> ASCII superset
substituteString :: superset -> ASCII superset
substituteString = superset -> ASCII superset
forall superset. superset -> ASCII superset
asciiUnsafe (superset -> ASCII superset)
-> (superset -> superset) -> superset -> ASCII superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. superset -> superset
forall string. StringSuperset string => string -> string
S.substituteString

{-|
>>> map validateString ["Hello", "Cristóbal"] :: [Maybe (ASCII Text)]
[Just (asciiUnsafe "Hello"),Nothing]

>>> map validateString ["Hello", "Cristóbal"] :: [Maybe (ASCII String)]
[Just (asciiUnsafe "Hello"),Nothing]
-}
validateString :: S.StringSuperset superset => superset -> Maybe (ASCII superset)
validateString :: superset -> Maybe (ASCII superset)
validateString superset
x = if superset -> Bool
forall string. ToString string => string -> Bool
S.isAsciiString superset
x then ASCII superset -> Maybe (ASCII superset)
forall a. a -> Maybe a
Just (superset -> ASCII superset
forall superset. superset -> ASCII superset
asciiUnsafe superset
x) else Maybe (ASCII superset)
forall a. Maybe a
Nothing

asChar :: S.CharSuperset superset => (ASCII.Char -> ASCII.Char) -> ASCII superset -> ASCII superset
asChar :: (Char -> Char) -> ASCII superset -> ASCII superset
asChar Char -> Char
f = superset -> ASCII superset
forall superset. superset -> ASCII superset
asciiUnsafe (superset -> ASCII superset)
-> (ASCII superset -> superset) -> ASCII superset -> ASCII superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> superset -> superset
forall char. CharSuperset char => (Char -> Char) -> char -> char
S.asCharUnsafe Char -> Char
f (superset -> superset)
-> (ASCII superset -> superset) -> ASCII superset -> superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII superset -> superset
forall superset. ASCII superset -> superset
lift

mapChars :: S.StringSuperset superset => (ASCII.Char -> ASCII.Char) -> ASCII superset -> ASCII superset
mapChars :: (Char -> Char) -> ASCII superset -> ASCII superset
mapChars Char -> Char
f = superset -> ASCII superset
forall superset. superset -> ASCII superset
asciiUnsafe (superset -> ASCII superset)
-> (ASCII superset -> superset) -> ASCII superset -> ASCII superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> superset -> superset
forall string.
StringSuperset string =>
(Char -> Char) -> string -> string
S.mapCharsUnsafe Char -> Char
f (superset -> superset)
-> (ASCII superset -> superset) -> ASCII superset -> superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII superset -> superset
forall superset. ASCII superset -> superset
lift