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 ASCII.Superset (CharSuperset, StringSuperset)
import Data.Bool (Bool (..))
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 Text.Show (Show, showList, showParen, showString, showsPrec)

{-| 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 superset => Show (ASCII superset) where
    showsPrec :: Int -> ASCII superset -> ShowS
showsPrec Int
d ASCII 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
"asciiUnsafe " 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 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
showString String
"asciiUnsafe " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [superset] -> ShowS
forall a. Show a => [a] -> ShowS
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 CharSuperset char => CharSuperset (ASCII char) where
    isAsciiChar :: ASCII char -> Bool
isAsciiChar ASCII char
_ = Bool
True
    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. CharSuperset char => Char -> char
S.fromChar
    toCharUnsafe :: ASCII char -> Char
toCharUnsafe = char -> Char
forall char. CharSuperset 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 CharSuperset char => I.CharIso (ASCII char) where
    toChar :: ASCII char -> Char
toChar = ASCII char -> Char
forall char. CharSuperset char => char -> Char
S.toCharUnsafe

instance StringSuperset string => StringSuperset (ASCII string) where
    isAsciiString :: ASCII string -> Bool
isAsciiString ASCII string
_ = Bool
True
    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. StringSuperset string => [Char] -> string
S.fromCharList
    toCharListUnsafe :: ASCII string -> [Char]
toCharListUnsafe = string -> [Char]
forall string. StringSuperset 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. StringSuperset 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
    substituteString :: ASCII string -> ASCII string
substituteString = ASCII string -> ASCII string
forall a. a -> a
id

instance StringSuperset string => I.StringIso (ASCII string) where
    toCharList :: ASCII string -> [Char]
toCharList = ASCII string -> [Char]
forall string. StringSuperset 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 :: CharSuperset superset => superset -> Maybe (ASCII superset)
validateChar :: superset -> Maybe (ASCII superset)
validateChar superset
x = if superset -> Bool
forall char. CharSuperset 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 :: CharSuperset superset => superset -> ASCII superset
substituteChar :: superset -> ASCII superset
substituteChar superset
x = if superset -> Bool
forall char. CharSuperset 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 :: 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. CharSuperset char => Char -> char
S.fromChar

toChar :: CharSuperset superset => ASCII superset -> ASCII.Char
toChar :: ASCII superset -> Char
toChar = superset -> Char
forall char. CharSuperset 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 :: 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. StringSuperset string => [Char] -> string
S.fromCharList

{-|
>>> toCharList (substituteString "Piñata" :: ASCII Text)
[CapitalLetterP,SmallLetterI,Substitute,SmallLetterA,SmallLetterT,SmallLetterA]
-}
toCharList :: StringSuperset superset => ASCII superset -> [ASCII.Char]
toCharList :: ASCII superset -> [Char]
toCharList = superset -> [Char]
forall string. StringSuperset 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 :: 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 :: StringSuperset superset => superset -> Maybe (ASCII superset)
validateString :: superset -> Maybe (ASCII superset)
validateString superset
x = if superset -> Bool
forall string. StringSuperset 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 :: 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 :: 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