module ASCII.Refinement.Internal where

import ASCII.Char qualified as ASCII
import ASCII.Isomorphism qualified as I
import ASCII.Superset qualified as S
import {-# SOURCE #-} ASCII.SupersetConversion (StringSupersetConversion)
import {-# SOURCE #-} ASCII.SupersetConversion qualified as SupersetConversion
import Data.Bool qualified as Bool
import Data.Data (Data)
import Data.Eq (Eq)
import Data.Function (id, ($), (.))
import Data.Hashable (Hashable)
import Data.Kind (Type)
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 Text.Show qualified as Show
import Prelude (succ)

-- | 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 :: Type) = 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 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) where
  toCaseChar :: Case -> ASCII char -> ASCII char
toCaseChar Case
c = char -> ASCII char
forall superset. superset -> ASCII superset
asciiUnsafe (char -> ASCII char)
-> (ASCII char -> char) -> ASCII char -> ASCII char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Case -> char -> char
forall char. CharSuperset char => Case -> char -> char
S.toCaseChar Case
c (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 => 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
  toCaseString :: Case -> ASCII string -> ASCII string
toCaseString Case
c = string -> ASCII string
forall superset. superset -> ASCII superset
asciiUnsafe (string -> ASCII string)
-> (ASCII string -> string) -> ASCII string -> ASCII string
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Case -> string -> string
forall string. StringSuperset string => Case -> string -> string
S.toCaseString Case
c (string -> string)
-> (ASCII string -> string) -> ASCII string -> string
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII string -> string
forall superset. ASCII superset -> superset
lift

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 :: forall superset. 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 :: forall superset.
CharSuperset superset =>
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 :: forall superset.
CharSuperset superset =>
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 :: forall char. CharSuperset char => Char -> ASCII char
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 :: forall char. CharSuperset char => ASCII char -> 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]
--     == (asciiUnsafe "Hi!" :: ASCII Text)
-- @
fromCharList :: S.StringSuperset superset => [ASCII.Char] -> ASCII superset
fromCharList :: forall superset.
StringSuperset superset =>
[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 :: forall string. StringSuperset string => ASCII string -> [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 :: forall superset.
StringSuperset superset =>
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 :: forall superset.
StringSuperset superset =>
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 :: forall superset.
CharSuperset superset =>
(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 :: forall string.
StringSuperset string =>
(Char -> Char) -> ASCII string -> ASCII string
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

-- | 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) = b -> ASCII b
forall superset. superset -> ASCII superset
ASCII_Unsafe (a -> b
forall a b. StringSupersetConversion a b => a -> b
SupersetConversion.convertStringUnsafe a
x)