module ASCII.CaseRefinement
  (
    {- * ASCII'case type constructor -} ASCII'case, lift, asciiCaseUnsafe,
    {- ** Aliases -} {- $aliases -} ASCII'upper, ASCII'lower,
    {- * Character functions -} validateChar, fromCaselessChar,
          toCaselessChar, substituteChar, asCaselessChar,
    {- * String functions -} validateString, fromCaselessCharList,
          toCaselessCharList, substituteString, mapChars,
  )
  where

import ASCII.Case (Case (..))
import ASCII.Caseless (CaselessChar)
import ASCII.Superset (CharSuperset, StringSuperset)

import qualified ASCII.Case as Case
import qualified ASCII.Caseless as Caseless
import qualified ASCII.Char as ASCII
import qualified ASCII.Superset as Superset

import Control.Monad (guard)
import Data.Bool (Bool (..))
import Data.Data (Data, Typeable)
import Data.Eq (Eq)
import Data.Foldable (any)
import Data.Function (id, ($), (.))
import Data.Hashable (Hashable)
import Data.Maybe (Maybe (..))
import Data.Monoid (Monoid)
import Data.Ord (Ord, (>))
import Data.Semigroup (Semigroup)
import Data.Traversable (traverse)
import GHC.Generics (Generic)
import Prelude (succ)
import Text.Show (Show, showList, showParen, showString, showsPrec)

import qualified Data.Bool as Bool
import qualified Data.List as List

{- | This type constructor indicates that a value from some ASCII superset is
valid ASCII, and also that any letters belong to a particular 'Case' indicated
by the @letterCase@ type parameter.

The @superset@ 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'case' ''ASCII.Case.UpperCase'
'Data.Text.Text'@ may contain only uppercase ASCII letters and ASCII
non-letters. -}
newtype ASCII'case (letterCase :: Case) superset = ASCII'case_Unsafe
  { ASCII'case letterCase superset -> superset
lift :: superset
      {- ^ Discard the evidence that the value is known to consist
           entirely of ASCII characters in a particular case -}
  }

deriving stock instance Eq superset =>
    Eq (ASCII'case letterCase superset)

deriving stock instance Ord superset =>
    Ord (ASCII'case letterCase superset)

deriving newtype instance Hashable superset =>
    Hashable (ASCII'case letterCase superset)

deriving newtype instance Semigroup superset =>
    Semigroup (ASCII'case letterCase superset)

deriving newtype instance Monoid superset =>
    Monoid (ASCII'case letterCase superset)

deriving stock instance (Data superset, Typeable letterCase) =>
    Data (ASCII'case letterCase superset)

deriving stock instance Generic (ASCII'case letterCase superset)

instance Show superset => Show (ASCII'case letterCase superset) where
    showsPrec :: Int -> ASCII'case letterCase superset -> ShowS
showsPrec Int
d ASCII'case letterCase 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
"asciiCaseUnsafe " 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'case letterCase superset -> superset
forall (letterCase :: Case) superset.
ASCII'case letterCase superset -> superset
lift ASCII'case letterCase superset
x)
      where app_prec :: Int
app_prec = Int
10

    showList :: [ASCII'case letterCase superset] -> ShowS
showList [ASCII'case letterCase superset]
x = String -> ShowS
showString String
"asciiCaseUnsafe " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [superset] -> ShowS
forall a. Show a => [a] -> ShowS
showList ((ASCII'case letterCase superset -> superset)
-> [ASCII'case letterCase superset] -> [superset]
forall a b. (a -> b) -> [a] -> [b]
List.map ASCII'case letterCase superset -> superset
forall (letterCase :: Case) superset.
ASCII'case letterCase superset -> superset
lift [ASCII'case letterCase superset]
x)

{-| Change the type of an ASCII superset value that is known to be valid ASCII where
letters are restricted to the 'Case' designated by the @letterCase@ type variable.

This is "unsafe" because this assertion is unchecked, so this function is capable
of producing an invalid 'ASCII'case' value. -}
asciiCaseUnsafe :: superset -> ASCII'case letterCase superset
asciiCaseUnsafe :: superset -> ASCII'case letterCase superset
asciiCaseUnsafe = superset -> ASCII'case letterCase superset
forall (letterCase :: Case) superset.
superset -> ASCII'case letterCase superset
ASCII'case_Unsafe

---

{- $aliases

The 'ASCII'upper' and 'ASCII'lower' type aliases exist primarily so that you can
use 'ASCII'case' without the DataKinds language extension.

-}

type ASCII'upper superset = ASCII'case 'UpperCase superset

type ASCII'lower superset = ASCII'case 'LowerCase superset

---

class KnownCase (letterCase :: Case) where theCase :: Case
instance KnownCase 'UpperCase where theCase :: Case
theCase = Case
UpperCase
instance KnownCase 'LowerCase where theCase :: Case
theCase = Case
LowerCase

---

{-| Return 'Just' an 'ASCII'case' character if the input is an ASCII character
in the proper case, or 'Nothing' otherwise -}
validateChar :: forall letterCase superset. KnownCase letterCase => CharSuperset superset =>
    superset {- ^ Character which may or may not be in the ASCII character set;
                  if a letter, may be in any case -}
    -> Maybe (ASCII'case letterCase superset)
validateChar :: superset -> Maybe (ASCII'case letterCase superset)
validateChar superset
x = do
    Char
c <- superset -> Maybe Char
forall char. ToChar char => char -> Maybe Char
Superset.toCharMaybe superset
x
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
Bool.not (Case -> Char -> Bool
Case.isCase (Case -> Case
Case.opposite (KnownCase letterCase => Case
forall (letterCase :: Case). KnownCase letterCase => Case
theCase @letterCase)) Char
c))
    ASCII'case letterCase superset
-> Maybe (ASCII'case letterCase superset)
forall a. a -> Maybe a
Just (superset -> ASCII'case letterCase superset
forall superset (letterCase :: Case).
superset -> ASCII'case letterCase superset
asciiCaseUnsafe superset
x)

{- | Return an 'ASCII'case' character if the input is an ASCII character in the
proper case, or 'ASCII.Substitute' otherwise -}
substituteChar :: forall letterCase superset. KnownCase letterCase => CharSuperset superset =>
    superset
    -> ASCII'case letterCase superset
substituteChar :: superset -> ASCII'case letterCase superset
substituteChar superset
x = case superset -> Maybe (ASCII'case letterCase superset)
forall (letterCase :: Case) superset.
(KnownCase letterCase, CharSuperset superset) =>
superset -> Maybe (ASCII'case letterCase superset)
validateChar superset
x of
    Maybe (ASCII'case letterCase superset)
Nothing -> superset -> ASCII'case letterCase superset
forall superset (letterCase :: Case).
superset -> ASCII'case letterCase superset
asciiCaseUnsafe (Char -> superset
forall char. FromChar char => Char -> char
Superset.fromChar Char
ASCII.Substitute)
    Just ASCII'case letterCase superset
c -> ASCII'case letterCase superset
c

{-| Lift a 'CaselessChar' into a superset type, wrapped in the 'ASCII'case'
refinement to save the evidence that it is ASCII in a particular case -}
fromCaselessChar :: forall letterCase superset. KnownCase letterCase => CharSuperset superset =>
    CaselessChar -- ^ Character which, if it is a letter, does not have a specified case
    -> ASCII'case letterCase superset
fromCaselessChar :: CaselessChar -> ASCII'case letterCase superset
fromCaselessChar = superset -> ASCII'case letterCase superset
forall superset (letterCase :: Case).
superset -> ASCII'case letterCase superset
asciiCaseUnsafe (superset -> ASCII'case letterCase superset)
-> (CaselessChar -> superset)
-> CaselessChar
-> ASCII'case letterCase superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> superset
forall char. FromChar char => Char -> char
Superset.fromChar (Char -> superset)
-> (CaselessChar -> Char) -> CaselessChar -> superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Case -> CaselessChar -> Char
Caseless.toCase (KnownCase letterCase => Case
forall (letterCase :: Case). KnownCase letterCase => Case
theCase @letterCase)

{-| Given a character from some type that is known to represent an ASCII
character in a particular case, obtain the caseless ASCII character it
represents -}
toCaselessChar :: CharSuperset superset =>
    ASCII'case letterCase superset {- ^ Character that is known to be ASCII, and
                                        in the particular case if it is a letter -}
    -> CaselessChar
toCaselessChar :: ASCII'case letterCase superset -> CaselessChar
toCaselessChar =  Char -> CaselessChar
Caseless.disregardCase (Char -> CaselessChar)
-> (ASCII'case letterCase superset -> Char)
-> ASCII'case letterCase superset
-> CaselessChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. superset -> Char
forall char. ToChar char => char -> Char
Superset.toCharUnsafe (superset -> Char)
-> (ASCII'case letterCase superset -> superset)
-> ASCII'case letterCase superset
-> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII'case letterCase superset -> superset
forall (letterCase :: Case) superset.
ASCII'case letterCase superset -> superset
lift

{-| Given a character from a larger set that is known to represent an ASCII
character, manipulate it as if it were an ASCII character -}
asCaselessChar :: forall letterCase superset. KnownCase letterCase => CharSuperset superset =>
    (CaselessChar -> CaselessChar) -- ^ Case-insensitive function over ASCII characters
    -> ASCII'case letterCase superset {- ^ Character that is known to be ASCII, and
                                           in the particular case if it is a letter -}
    -> ASCII'case letterCase superset
asCaselessChar :: (CaselessChar -> CaselessChar)
-> ASCII'case letterCase superset -> ASCII'case letterCase superset
asCaselessChar CaselessChar -> CaselessChar
f = superset -> ASCII'case letterCase superset
forall superset (letterCase :: Case).
superset -> ASCII'case letterCase superset
asciiCaseUnsafe (superset -> ASCII'case letterCase superset)
-> (ASCII'case letterCase superset -> superset)
-> ASCII'case letterCase superset
-> ASCII'case letterCase superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> superset -> superset
forall char. CharSuperset char => (Char -> Char) -> char -> char
Superset.asCharUnsafe Char -> Char
g (superset -> superset)
-> (ASCII'case letterCase superset -> superset)
-> ASCII'case letterCase superset
-> superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII'case letterCase superset -> superset
forall (letterCase :: Case) superset.
ASCII'case letterCase superset -> superset
lift
  where
    g :: Char -> Char
g = Case -> CaselessChar -> Char
Caseless.toCase (KnownCase letterCase => Case
forall (letterCase :: Case). KnownCase letterCase => Case
theCase @letterCase) (CaselessChar -> Char) -> (Char -> CaselessChar) -> Char -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CaselessChar -> CaselessChar
f (CaselessChar -> CaselessChar)
-> (Char -> CaselessChar) -> Char -> CaselessChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Case -> Char -> CaselessChar
Caseless.assumeCaseUnsafe (KnownCase letterCase => Case
forall (letterCase :: Case). KnownCase letterCase => Case
theCase @letterCase)

---

{-| Return 'Just' an 'ASCII'case' string if the input consists entirely of ASCII
characters in the proper case, or 'Nothing' otherwise -}
validateString :: forall letterCase superset. KnownCase letterCase => StringSuperset superset =>
    superset -- ^ String which may or may not be valid ASCII, where letters may be in any case
    -> Maybe (ASCII'case letterCase superset)
validateString :: superset -> Maybe (ASCII'case letterCase superset)
validateString superset
x = do
    [Char]
s <- superset -> Maybe [Char]
forall string. ToString string => string -> Maybe [Char]
Superset.toCharListMaybe superset
x
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
Bool.not ((Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Case -> Char -> Bool
Case.isCase (Case -> Case
Case.opposite (KnownCase letterCase => Case
forall (letterCase :: Case). KnownCase letterCase => Case
theCase @letterCase))) [Char]
s))
    ASCII'case letterCase superset
-> Maybe (ASCII'case letterCase superset)
forall a. a -> Maybe a
Just (superset -> ASCII'case letterCase superset
forall superset (letterCase :: Case).
superset -> ASCII'case letterCase superset
asciiCaseUnsafe superset
x)

{-| Lift a list of 'CaselessChar' into a superset string type, wrapped in the
'ASCII'case' refinement to save the evidence that all of the characters in the
string are ASCII in a particular case. -}
fromCaselessCharList :: forall letterCase superset. KnownCase letterCase => StringSuperset superset =>
    [CaselessChar] -- ^ Case-insensitive ASCII string represented as a list of caseless characters
    -> ASCII'case letterCase superset
fromCaselessCharList :: [CaselessChar] -> ASCII'case letterCase superset
fromCaselessCharList = superset -> ASCII'case letterCase superset
forall superset (letterCase :: Case).
superset -> ASCII'case letterCase superset
asciiCaseUnsafe (superset -> ASCII'case letterCase superset)
-> ([CaselessChar] -> superset)
-> [CaselessChar]
-> ASCII'case letterCase superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> superset
forall string. FromString string => [Char] -> string
Superset.fromCharList ([Char] -> superset)
-> ([CaselessChar] -> [Char]) -> [CaselessChar] -> superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CaselessChar -> Char) -> [CaselessChar] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
List.map (Case -> CaselessChar -> Char
Caseless.toCase (KnownCase letterCase => Case
forall (letterCase :: Case). KnownCase letterCase => Case
theCase @letterCase))

{-| Given a string from some type that is known to represent only ASCII
characters in a particular case, obtain the caseless characters it represents -}
toCaselessCharList :: forall letterCase superset. KnownCase letterCase => StringSuperset superset =>
    ASCII'case letterCase superset -- ^ String that is known to be valid ASCII in a particular case
    -> [CaselessChar]
toCaselessCharList :: ASCII'case letterCase superset -> [CaselessChar]
toCaselessCharList = (Char -> CaselessChar) -> [Char] -> [CaselessChar]
forall a b. (a -> b) -> [a] -> [b]
List.map (Case -> Char -> CaselessChar
Caseless.assumeCaseUnsafe (KnownCase letterCase => Case
forall (letterCase :: Case). KnownCase letterCase => Case
theCase @letterCase)) ([Char] -> [CaselessChar])
-> (ASCII'case letterCase superset -> [Char])
-> ASCII'case letterCase superset
-> [CaselessChar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. superset -> [Char]
forall string. ToString string => string -> [Char]
Superset.toCharListUnsafe (superset -> [Char])
-> (ASCII'case letterCase superset -> superset)
-> ASCII'case letterCase superset
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII'case letterCase superset -> superset
forall (letterCase :: Case) superset.
ASCII'case letterCase superset -> superset
lift

{-| Forces a string from a larger character set into cased ASCII by using the
'ASCII.Substitute' character in place of any unacceptable characters. -}
substituteString :: forall letterCase superset. KnownCase letterCase => StringSuperset superset =>
    superset -- ^ String which may or may not be valid ASCII, where letters may be in any case
    -> ASCII'case letterCase superset
substituteString :: superset -> ASCII'case letterCase superset
substituteString = superset -> ASCII'case letterCase superset
forall superset (letterCase :: Case).
superset -> ASCII'case letterCase superset
asciiCaseUnsafe (superset -> ASCII'case letterCase superset)
-> (superset -> superset)
-> superset
-> ASCII'case letterCase superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> superset
forall string. FromString string => [Char] -> string
Superset.fromCharList ([Char] -> superset)
-> (superset -> [Char]) -> superset -> superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
List.map Char -> Char
f ([Char] -> [Char]) -> (superset -> [Char]) -> superset -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. superset -> [Char]
forall string. ToString string => string -> [Char]
Superset.toCharListSub
  where
    f :: Char -> Char
f Char
x = if Case -> Char -> Bool
Case.isCase (Case -> Case
Case.opposite (KnownCase letterCase => Case
forall (letterCase :: Case). KnownCase letterCase => Case
theCase @letterCase)) Char
x
          then Char
ASCII.Substitute
          else Char
x

{-| Given a string from a larger set that is known to consist entirely of ASCII
characters in a particular case, map over the characters in the string as if
they were caseless ASCII characters -}
mapChars :: forall letterCase superset. KnownCase letterCase => StringSuperset superset =>
    (CaselessChar -> CaselessChar) -- ^ Case-insensitive function over ASCII characters
    -> ASCII'case letterCase superset -- ^ String that is known to be valid ASCII in a particular case
    -> ASCII'case letterCase superset
mapChars :: (CaselessChar -> CaselessChar)
-> ASCII'case letterCase superset -> ASCII'case letterCase superset
mapChars CaselessChar -> CaselessChar
f = superset -> ASCII'case letterCase superset
forall superset (letterCase :: Case).
superset -> ASCII'case letterCase superset
asciiCaseUnsafe (superset -> ASCII'case letterCase superset)
-> (ASCII'case letterCase superset -> superset)
-> ASCII'case letterCase superset
-> ASCII'case letterCase superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> superset -> superset
forall string.
StringSuperset string =>
(Char -> Char) -> string -> string
Superset.mapCharsUnsafe Char -> Char
g (superset -> superset)
-> (ASCII'case letterCase superset -> superset)
-> ASCII'case letterCase superset
-> superset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII'case letterCase superset -> superset
forall (letterCase :: Case) superset.
ASCII'case letterCase superset -> superset
lift
  where
    g :: Char -> Char
g = Case -> CaselessChar -> Char
Caseless.toCase (KnownCase letterCase => Case
forall (letterCase :: Case). KnownCase letterCase => Case
theCase @letterCase) (CaselessChar -> Char) -> (Char -> CaselessChar) -> Char -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CaselessChar -> CaselessChar
f (CaselessChar -> CaselessChar)
-> (Char -> CaselessChar) -> Char -> CaselessChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Case -> Char -> CaselessChar
Caseless.assumeCaseUnsafe (KnownCase letterCase => Case
forall (letterCase :: Case). KnownCase letterCase => Case
theCase @letterCase)