module ASCII.Refinement.Internal where

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

import {-# source #-} ASCII.SupersetConversion (StringSupersetConversion)
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
import {-# source #-} qualified ASCII.SupersetConversion as SupersetConversion

{-| 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 { forall superset. 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 forall a. Ord a => a -> a -> Bool
> Int
app_prec) forall a b. (a -> b) -> a -> b
$
        String -> ShowS
Show.showString String
"asciiUnsafe " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
Show.showsPrec (forall a. Enum a => a -> a
succ Int
app_prec) (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 " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => [a] -> ShowS
Show.showList (forall a b. (a -> b) -> [a] -> [b]
map 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 = forall char. ToCaselessChar char => char -> CaselessChar
S.toCaselessCharUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall char. ToChar char => char -> Char
S.toCharUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall superset. ASCII superset -> superset
lift

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

instance S.CharSuperset char => S.CharSuperset (ASCII char) where
    toCaseChar :: Case -> ASCII char -> ASCII char
toCaseChar Case
c = forall superset. superset -> ASCII superset
asciiUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall char. CharSuperset char => Case -> char -> char
S.toCaseChar Case
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall superset. ASCII superset -> superset
lift

instance S.CharSuperset char => I.CharIso (ASCII char) where
    toChar :: ASCII char -> Char
toChar = 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 = forall string. ToCaselessString string => string -> [CaselessChar]
S.toCaselessCharListUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall superset. ASCII superset -> superset
lift
    toCaselessCharListSub :: ASCII string -> [CaselessChar]
toCaselessCharListSub = forall string. ToCaselessString string => string -> [CaselessChar]
S.toCaselessCharListSub forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall string. ToString string => string -> [Char]
S.toCharListUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall superset. ASCII superset -> superset
lift
    toCharListSub :: ASCII string -> [Char]
toCharListSub = forall string. ToString string => string -> [Char]
S.toCharListUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall superset. ASCII superset -> superset
lift

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

instance S.StringSuperset string => S.StringSuperset (ASCII string) where
    substituteString :: ASCII string -> ASCII string
substituteString = forall a. a -> a
id
    toCaseString :: Case -> ASCII string -> ASCII string
toCaseString Case
c = forall superset. superset -> ASCII superset
asciiUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall string. StringSuperset string => Case -> string -> string
S.toCaseString Case
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall superset. ASCII superset -> superset
lift

instance S.StringSuperset string => I.StringIso (ASCII string) where
    toCharList :: ASCII string -> [Char]
toCharList = forall string. ToString string => string -> [Char]
S.toCharListUnsafe
    mapChars :: (Char -> Char) -> ASCII string -> ASCII string
mapChars = 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 :: forall superset. superset -> ASCII superset
asciiUnsafe = 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 :: forall superset.
CharSuperset superset =>
superset -> Maybe (ASCII superset)
validateChar superset
x = if forall char. ToChar char => char -> Bool
S.isAsciiChar superset
x then forall a. a -> Maybe a
Just (forall superset. superset -> ASCII superset
asciiUnsafe superset
x) else forall a. Maybe a
Nothing

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

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

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

{-|

@
fromCharList [CapitalLetterH, SmallLetterI, ExclamationMark]
    == (asciiUnsafe "Hi!" :: ASCII Text)
@ -}
fromCharList :: S.StringSuperset superset => [ASCII.Char] -> ASCII superset
fromCharList :: forall superset.
StringSuperset superset =>
[Char] -> ASCII superset
fromCharList = forall superset. superset -> ASCII superset
asciiUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall string. StringSuperset string => ASCII string -> [Char]
toCharList = forall string. ToString string => string -> [Char]
S.toCharListUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall superset.
StringSuperset superset =>
superset -> ASCII superset
substituteString = forall superset. superset -> ASCII superset
asciiUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall superset.
StringSuperset superset =>
superset -> Maybe (ASCII superset)
validateString superset
x = if forall string. ToString string => string -> Bool
S.isAsciiString superset
x then forall a. a -> Maybe a
Just (forall superset. superset -> ASCII superset
asciiUnsafe superset
x) else forall a. Maybe a
Nothing

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

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

{-| For example, this function can convert @ASCII ByteString@ to @ASCII Text@ and vice versa -}
convertRefinedString :: StringSupersetConversion a b => ASCII a -> ASCII b
convertRefinedString :: forall a b. StringSupersetConversion a b => ASCII a -> ASCII b
convertRefinedString (ASCII_Unsafe a
x) = forall superset. superset -> ASCII superset
ASCII_Unsafe (forall a b. StringSupersetConversion a b => a -> b
SupersetConversion.convertStringUnsafe a
x)