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.Superset as S
import qualified ASCII.Isomorphism as I

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, showString, showsPrec, showParen, showList )

{- | 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

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