-- | Predicates for 'Text' and 'String'.
--
-- @since 0.1.0.0
module Refined.Extras.Predicates.Text
  ( -- * Symbol Equality
    SymEqualTo,

    -- * Char Predicates
    -- $char

    -- ** Unicode
    -- $unicode
    Space,
    Lower,
    Upper,
    Alpha,
    AlphaNum,
    Letter,
    Mark,
    Number,
    Punctuation,
    Symbol,
    Separator,

    -- ** Ascii/Latin1
    -- $ascii
    Control,
    Digit,
    OctDigit,
    HexDigit,
    Ascii,
    Latin1,
    AsciiUpper,
    AsciiLower,
    AsciiAlpha,
    AsciiAlphaNum,
  )
where

import Data.ByteString.Internal qualified as BS
import Data.Char qualified as C
import Data.Kind (Type)
import Data.Proxy (Proxy (Proxy))
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Lazy qualified as LT
import Data.Typeable qualified as Ty
import Data.Word (Word8)
import GHC.Generics (Generic)
import GHC.TypeLits (KnownSymbol)
import GHC.TypeLits qualified as TL
import Refined (Predicate (validate), RefineException (RefineOtherException))

-- $setup
-- >>> import Data.ByteString qualified as BS
-- >>> import Data.Either (isRight)
-- >>> import Refined (refine)
-- >>> import Refined.Extras.Predicates.Foldable (All)
-- >>> import Refined.Extras.Utils (showRefineException)
-- >>> import Data.Text.Encoding (encodeUtf8)
-- >>> let ch = C.chr 0x0266
-- >>> :{
--   instance Predicate Alpha Word8 where
--     validate proxy w
--       | C.isAlpha c = Nothing
--       | otherwise = Just $ RefineOtherException (Ty.typeRep proxy) err
--       where
--         c = BS.w2c w
--         err = T.singleton c <> " is not an alphabetic character"
-- :}

-- | Predicate equality for symbols.
--
-- ==== __Examples__
-- >>> validate @(SymEqualTo "c") Proxy 'c'
-- Nothing
--
-- >>> showRefineException <$> validate @(SymEqualTo "abc") Proxy 'c'
-- Just "RefineOtherException (SymEqualTo \"abc\") \"c is not a single Char\""
--
-- >>> validate @(SymEqualTo "abc") Proxy "abc"
-- Nothing
--
-- >>> showRefineException <$> validate @(SymEqualTo "123") @Text Proxy "abc"
-- Just "RefineOtherException (SymEqualTo \"123\") \"abc does not equal the predicate\""
--
-- @since 0.1.0.0
type SymEqualTo :: TL.Symbol -> Type
data SymEqualTo c
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. SymEqualTo c -> Rep (SymEqualTo c) x)
-> (forall x. Rep (SymEqualTo c) x -> SymEqualTo c)
-> Generic (SymEqualTo c)
forall x. Rep (SymEqualTo c) x -> SymEqualTo c
forall x. SymEqualTo c -> Rep (SymEqualTo c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (c :: Symbol) x. Rep (SymEqualTo c) x -> SymEqualTo c
forall (c :: Symbol) x. SymEqualTo c -> Rep (SymEqualTo c) x
$cfrom :: forall (c :: Symbol) x. SymEqualTo c -> Rep (SymEqualTo c) x
from :: forall x. SymEqualTo c -> Rep (SymEqualTo c) x
$cto :: forall (c :: Symbol) x. Rep (SymEqualTo c) x -> SymEqualTo c
to :: forall x. Rep (SymEqualTo c) x -> SymEqualTo c
Generic
    )

-- | @since 0.1.0.0
instance (KnownSymbol c) => Predicate (SymEqualTo c) Char where
  validate :: Proxy (SymEqualTo c) -> Char -> Maybe RefineException
validate Proxy (SymEqualTo c)
proxy Char
x = case String
sym of
    [Char
y] ->
      if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
y
        then Maybe RefineException
forall a. Maybe a
Nothing
        else RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy (SymEqualTo c) -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy (SymEqualTo c)
proxy) Text
eqErr
    String
_ -> RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy (SymEqualTo c) -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy (SymEqualTo c)
proxy) Text
nonCharErr
    where
      sym :: String
sym = forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
TL.symbolVal @c Proxy c
forall {k} (t :: k). Proxy t
Proxy
      eqErr :: Text
eqErr = Char -> Text
T.singleton Char
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" does not equal the predicate"
      nonCharErr :: Text
nonCharErr = Char -> Text
T.singleton Char
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a single Char"

-- | @since 0.1.0.0
instance (KnownSymbol c) => Predicate (SymEqualTo c) String where
  validate :: Proxy (SymEqualTo c) -> String -> Maybe RefineException
validate Proxy (SymEqualTo c)
proxy String
txt
    | String
txt String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
sym = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy (SymEqualTo c) -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy (SymEqualTo c)
proxy) Text
err
    where
      sym :: String
sym = forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
TL.symbolVal @c Proxy c
forall {k} (t :: k). Proxy t
Proxy
      err :: Text
err = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
txt String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" does not equal the predicate"

-- | @since 0.1.0.0
instance (KnownSymbol c) => Predicate (SymEqualTo c) Text where
  validate :: Proxy (SymEqualTo c) -> Text -> Maybe RefineException
validate Proxy (SymEqualTo c)
proxy Text
txt
    | Text
txt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
sym = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy (SymEqualTo c) -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy (SymEqualTo c)
proxy) Text
err
    where
      sym :: Text
sym = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
TL.symbolVal @c Proxy c
forall {k} (t :: k). Proxy t
Proxy
      err :: Text
err = Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" does not equal the predicate"

-- | @since 0.1.0.0
instance (KnownSymbol c) => Predicate (SymEqualTo c) LT.Text where
  validate :: Proxy (SymEqualTo c) -> Text -> Maybe RefineException
validate Proxy (SymEqualTo c)
proxy Text
txt
    | Text
txt' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
sym = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy (SymEqualTo c) -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy (SymEqualTo c)
proxy) Text
err
    where
      txt' :: Text
txt' = Text -> Text
LT.toStrict Text
txt
      sym :: Text
sym = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
TL.symbolVal @c Proxy c
forall {k} (t :: k). Proxy t
Proxy
      err :: Text
err = Text
txt' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" does not equal the predicate"

-- $char
-- This section models the boolean functions defined in "Data.Char". See
-- that module for more information regarding these definitions.
--
-- These instances are defined for 'Char' and 'Word8', though they can be
-- extended to 'String', 'Text', and 'Data.ByteString.ByteString' via
-- 'Refined.Extra.Predicates.Foldable.All'.
--
-- Note: Although 'Char' has instances for all of these predicates, some are
-- missing for 'Word8' (and by extension 'Data.ByteString.ByteString').
-- This is due to 'Word8'\'s size restriction, i.e., a single byte
-- @0 <= b <= 255@. Thus, predicates that extend over the entirety of the
-- unicode range (e.g. 'Alpha') do not have 'Word8' instances, as this could be
-- misleading. For instance, consider the unicode character "ɦ" (U+0266):
--
-- >>> :{
--   let txt = T.singleton ch -- ch == 0x0266 i.e. ɦ
--    in isRight $ refine @(All Alpha) txt
-- :}
-- True
--
-- This 'Char' is part of the alpha unicode category, so the refinement
-- succeeds. On the other hand, suppose we have a 'Word8' instance that
-- performs the obvious @'C.isAlpha' . 'BS.w2c'@:
--
-- >>> :{
--   let bs = encodeUtf8 $ T.singleton ch
--    in isRight $ refine @(All Alpha) bs
-- :}
-- False
--
-- The problem is that we are checking the underlying bytes if they satisfy
-- 'C.isAlpha', but this is only true for Ascii alpha characters. Morally, our
-- bytestring is this structure:
--
-- >>> BS.foldr (:) [] (encodeUtf8 $ T.singleton ch)
-- [201,166]
--
-- Our 'Alpha' refinement fails because the individual byte components of
-- "ɦ" are not themselves considered "alpha" characters (indeed this will only
-- occur due to chance). These are the options:
--
-- 1. Outlaw 'Word8'/'Data.ByteString.ByteString' instances completely.
-- 2. Provide the naive @'C.isAlpha' . 'BS.w2c'@ implementation for 'Word8'.
-- 3. Implement 'Data.ByteString.ByteString' instances by first converting to
--    'Text', i.e., do not use its underlying fold.
-- 4. Provide 'Word8' instances only when they coincide with 'Char' (i.e.
--    ascii/latin1 predicates). In this case, 'Data.ByteString.ByteString'
--    works as expected; that is, we can make assertions based on the
--    underlying bytes, but nothing that requires a specific encoding, and we
--    do not get surprised by 'Text'/'Data.ByteString.ByteString' mismatches.
--
-- Of these, only one and four are reasonable. Two is out because it can have
-- confusing semantics (illustrated above).
--
-- Three is rejected because the API is no longer consistent, and we
-- have to arbitrarily assume the 'Data.ByteString.ByteString' shares its
-- 'Text' encoding (i.e. UTF-8).
--
-- One is defensible, but we choose option four, reasoning that it could be
-- useful to assert that a given bytestring contains only ascii numbers or
-- alpha characters while avoiding the pitfalls of reusing predicates intended
-- for arbitrary unicode.

-- $unicode
-- These predicates are for unicode code points, hence they are available for
-- 'Char' (thus 'String', 'Text').

-- | Predicate for a 'C.isSpace'.
--
-- ==== __Examples__
-- >>> validate @Space Proxy ' '
-- Nothing
-- >>> validate @Space Proxy '\r'
-- Nothing
--
-- >>> showRefineException <$> validate @Space Proxy 'a'
-- Just "RefineOtherException (Space) \"a is not a space character\""
--
-- @since 0.1.0.0
type Space :: Type
data Space
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. Space -> Rep Space x)
-> (forall x. Rep Space x -> Space) -> Generic Space
forall x. Rep Space x -> Space
forall x. Space -> Rep Space x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Space -> Rep Space x
from :: forall x. Space -> Rep Space x
$cto :: forall x. Rep Space x -> Space
to :: forall x. Rep Space x -> Space
Generic
    )

-- | @since 0.1.0.0
instance Predicate Space Char where
  validate :: Proxy Space -> Char -> Maybe RefineException
validate Proxy Space
proxy Char
c
    | Char -> Bool
C.isSpace Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy Space -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy Space
proxy) Text
err
    where
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a space character"

-- | Predicate for 'C.isLower'.
--
-- ==== __Examples__
-- >>> validate @Lower Proxy 'c'
-- Nothing
--
-- >>> showRefineException <$> validate @Lower Proxy 'C'
-- Just "RefineOtherException (Lower) \"C is not lowercase\""
--
-- @since 0.1.0.0
type Lower :: Type
data Lower
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. Lower -> Rep Lower x)
-> (forall x. Rep Lower x -> Lower) -> Generic Lower
forall x. Rep Lower x -> Lower
forall x. Lower -> Rep Lower x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Lower -> Rep Lower x
from :: forall x. Lower -> Rep Lower x
$cto :: forall x. Rep Lower x -> Lower
to :: forall x. Rep Lower x -> Lower
Generic
    )

-- | @since 0.1.0.0
instance Predicate Lower Char where
  validate :: Proxy Lower -> Char -> Maybe RefineException
validate Proxy Lower
proxy Char
c
    | Char -> Bool
C.isLower Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy Lower -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy Lower
proxy) Text
err
    where
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not lowercase"

-- | Predicate for 'C.isUpper'.
--
-- ==== __Examples__
-- >>> validate @Upper Proxy 'C'
-- Nothing
--
-- >>> showRefineException <$> validate @Upper Proxy 'c'
-- Just "RefineOtherException (Upper) \"c is not uppercase\""
--
-- @since 0.1.0.0
type Upper :: Type
data Upper
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. Upper -> Rep Upper x)
-> (forall x. Rep Upper x -> Upper) -> Generic Upper
forall x. Rep Upper x -> Upper
forall x. Upper -> Rep Upper x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Upper -> Rep Upper x
from :: forall x. Upper -> Rep Upper x
$cto :: forall x. Rep Upper x -> Upper
to :: forall x. Rep Upper x -> Upper
Generic
    )

-- | @since 0.1.0.0
instance Predicate Upper Char where
  validate :: Proxy Upper -> Char -> Maybe RefineException
validate Proxy Upper
proxy Char
c
    | Char -> Bool
C.isUpper Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy Upper -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy Upper
proxy) Text
err
    where
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not uppercase"

-- | Predicate for 'C.isAlpha'.
--
-- ==== __Examples__
-- >>> validate @Alpha Proxy 'c'
-- Nothing
--
-- >>> validate @Alpha Proxy 'ɦ'
-- Nothing
--
-- >>> showRefineException <$> validate @Alpha Proxy '7'
-- Just "RefineOtherException (Alpha) \"7 is not an alphabetic character\""
--
-- @since 0.1.0.0
type Alpha :: Type
data Alpha
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. Alpha -> Rep Alpha x)
-> (forall x. Rep Alpha x -> Alpha) -> Generic Alpha
forall x. Rep Alpha x -> Alpha
forall x. Alpha -> Rep Alpha x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Alpha -> Rep Alpha x
from :: forall x. Alpha -> Rep Alpha x
$cto :: forall x. Rep Alpha x -> Alpha
to :: forall x. Rep Alpha x -> Alpha
Generic
    )

-- | @since 0.1.0.0
instance Predicate Alpha Char where
  validate :: Proxy Alpha -> Char -> Maybe RefineException
validate Proxy Alpha
proxy Char
c
    | Char -> Bool
C.isAlpha Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy Alpha -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy Alpha
proxy) Text
err
    where
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not an alphabetic character"

-- | Predicate for 'C.isAlphaNum'.
--
-- ==== __Examples__
-- >>> validate @AlphaNum Proxy 'a'
-- Nothing
--
-- >>> validate @AlphaNum Proxy '1'
-- Nothing
--
-- >>> showRefineException <$> validate @AlphaNum Proxy '!'
-- Just "RefineOtherException (AlphaNum) \"! is not an alpha-numeric character\""
--
-- @since 0.1.0.0
type AlphaNum :: Type
data AlphaNum
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. AlphaNum -> Rep AlphaNum x)
-> (forall x. Rep AlphaNum x -> AlphaNum) -> Generic AlphaNum
forall x. Rep AlphaNum x -> AlphaNum
forall x. AlphaNum -> Rep AlphaNum x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AlphaNum -> Rep AlphaNum x
from :: forall x. AlphaNum -> Rep AlphaNum x
$cto :: forall x. Rep AlphaNum x -> AlphaNum
to :: forall x. Rep AlphaNum x -> AlphaNum
Generic
    )

-- | @since 0.1.0.0
instance Predicate AlphaNum Char where
  validate :: Proxy AlphaNum -> Char -> Maybe RefineException
validate Proxy AlphaNum
proxy Char
c
    | Char -> Bool
C.isAlphaNum Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy AlphaNum -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy AlphaNum
proxy) Text
err
    where
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not an alpha-numeric character"

-- | Predicate for 'C.isPrint'.
--
-- ==== __Examples__
-- >>> validate @Print Proxy 'a'
-- Nothing
--
-- >>> showRefineException <$> validate @Print Proxy '\v'
-- Just "RefineOtherException (Print) \"\\v is not a printable character\""
--
-- @since 0.1.0.0
type Print :: Type
data Print
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. Print -> Rep Print x)
-> (forall x. Rep Print x -> Print) -> Generic Print
forall x. Rep Print x -> Print
forall x. Print -> Rep Print x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Print -> Rep Print x
from :: forall x. Print -> Rep Print x
$cto :: forall x. Rep Print x -> Print
to :: forall x. Rep Print x -> Print
Generic
    )

-- | @since 0.1.0.0
instance Predicate Print Char where
  validate :: Proxy Print -> Char -> Maybe RefineException
validate Proxy Print
proxy Char
c
    | Char -> Bool
C.isPrint Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy Print -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy Print
proxy) Text
err
    where
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a printable character"

-- | Predicate for 'C.isLetter'.
--
-- ==== __Examples__
-- >>> validate @Letter Proxy 'f'
-- Nothing
--
-- >>> showRefineException <$> validate @Letter Proxy '\r'
-- Just "RefineOtherException (Letter) \"\\r is not a letter\""
--
-- @since 0.1.0.0
type Letter :: Type
data Letter
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. Letter -> Rep Letter x)
-> (forall x. Rep Letter x -> Letter) -> Generic Letter
forall x. Rep Letter x -> Letter
forall x. Letter -> Rep Letter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Letter -> Rep Letter x
from :: forall x. Letter -> Rep Letter x
$cto :: forall x. Rep Letter x -> Letter
to :: forall x. Rep Letter x -> Letter
Generic
    )

-- | @since 0.1.0.0
instance Predicate Letter Char where
  validate :: Proxy Letter -> Char -> Maybe RefineException
validate Proxy Letter
proxy Char
c
    | Char -> Bool
C.isLetter Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy Letter -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy Letter
proxy) Text
err
    where
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a letter"

-- | Predicate for 'C.isMark'.
--
-- ==== __Examples__
-- >>> validate @Mark Proxy '\x20DD'
-- Nothing
--
-- >>> showRefineException <$> validate @Mark Proxy 'a'
-- Just "RefineOtherException (Mark) \"a is not a mark\""
--
-- @since 0.1.0.0
type Mark :: Type
data Mark
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. Mark -> Rep Mark x)
-> (forall x. Rep Mark x -> Mark) -> Generic Mark
forall x. Rep Mark x -> Mark
forall x. Mark -> Rep Mark x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Mark -> Rep Mark x
from :: forall x. Mark -> Rep Mark x
$cto :: forall x. Rep Mark x -> Mark
to :: forall x. Rep Mark x -> Mark
Generic
    )

-- | @since 0.1.0.0
instance Predicate Mark Char where
  validate :: Proxy Mark -> Char -> Maybe RefineException
validate Proxy Mark
proxy Char
c
    | Char -> Bool
C.isMark Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy Mark -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy Mark
proxy) Text
err
    where
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a mark"

-- | Predicate for 'C.isNumber'.
--
-- ==== __Examples__
-- >>> validate @Number Proxy '2'
-- Nothing
--
-- >>> showRefineException <$> validate @Number Proxy 'a'
-- Just "RefineOtherException (Number) \"a is not a number\""
--
-- @since 0.1.0.0
type Number :: Type
data Number
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. Number -> Rep Number x)
-> (forall x. Rep Number x -> Number) -> Generic Number
forall x. Rep Number x -> Number
forall x. Number -> Rep Number x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Number -> Rep Number x
from :: forall x. Number -> Rep Number x
$cto :: forall x. Rep Number x -> Number
to :: forall x. Rep Number x -> Number
Generic
    )

-- | @since 0.1.0.0
instance Predicate Number Char where
  validate :: Proxy Number -> Char -> Maybe RefineException
validate Proxy Number
proxy Char
c
    | Char -> Bool
C.isNumber Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy Number -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy Number
proxy) Text
err
    where
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a number"

-- | Predicate for 'C.isPunctuation'.
--
-- ==== __Examples__
-- >>> validate @Punctuation Proxy '!'
-- Nothing
--
-- >>> showRefineException <$> validate @Punctuation Proxy 'a'
-- Just "RefineOtherException (Punctuation) \"a is not punctuation\""
--
-- @since 0.1.0.0
type Punctuation :: Type
data Punctuation
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. Punctuation -> Rep Punctuation x)
-> (forall x. Rep Punctuation x -> Punctuation)
-> Generic Punctuation
forall x. Rep Punctuation x -> Punctuation
forall x. Punctuation -> Rep Punctuation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Punctuation -> Rep Punctuation x
from :: forall x. Punctuation -> Rep Punctuation x
$cto :: forall x. Rep Punctuation x -> Punctuation
to :: forall x. Rep Punctuation x -> Punctuation
Generic
    )

-- | @since 0.1.0.0
instance Predicate Punctuation Char where
  validate :: Proxy Punctuation -> Char -> Maybe RefineException
validate Proxy Punctuation
proxy Char
c
    | Char -> Bool
C.isPunctuation Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy Punctuation -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy Punctuation
proxy) Text
err
    where
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not punctuation"

-- | Predicate for 'C.isSymbol'.
--
-- ==== __Examples__
-- >>> validate @Symbol Proxy '$'
-- Nothing
--
-- >>> showRefineException <$> validate @Symbol Proxy 'a'
-- Just "RefineOtherException (Symbol) \"a is not a symbol\""
--
-- @since 0.1.0.0
type Symbol :: Type
data Symbol
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. Symbol -> Rep Symbol x)
-> (forall x. Rep Symbol x -> Symbol) -> Generic Symbol
forall x. Rep Symbol x -> Symbol
forall x. Symbol -> Rep Symbol x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Symbol -> Rep Symbol x
from :: forall x. Symbol -> Rep Symbol x
$cto :: forall x. Rep Symbol x -> Symbol
to :: forall x. Rep Symbol x -> Symbol
Generic
    )

-- | @since 0.1.0.0
instance Predicate Symbol Char where
  validate :: Proxy Symbol -> Char -> Maybe RefineException
validate Proxy Symbol
proxy Char
c
    | Char -> Bool
C.isSymbol Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy Symbol -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy Symbol
proxy) Text
err
    where
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a symbol"

-- | Predicate for 'C.isSeparator'.
--
-- ==== __Examples__
-- >>> validate @Separator Proxy ' '
-- Nothing
--
-- >>> showRefineException <$> validate @Separator Proxy 'a'
-- Just "RefineOtherException (Separator) \"a is not a separator\""
--
-- @since 0.1.0.0
type Separator :: Type
data Separator
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. Separator -> Rep Separator x)
-> (forall x. Rep Separator x -> Separator) -> Generic Separator
forall x. Rep Separator x -> Separator
forall x. Separator -> Rep Separator x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Separator -> Rep Separator x
from :: forall x. Separator -> Rep Separator x
$cto :: forall x. Rep Separator x -> Separator
to :: forall x. Rep Separator x -> Separator
Generic
    )

-- | @since 0.1.0.0
instance Predicate Separator Char where
  validate :: Proxy Separator -> Char -> Maybe RefineException
validate Proxy Separator
proxy Char
c
    | Char -> Bool
C.isSeparator Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy Separator -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy Separator
proxy) Text
err
    where
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a separator"

-- $ascii
-- These predicates are for ascii/latin1. Thus they will work for 'Char'
-- (and 'String', 'Text') /and/ 'Word8' (hence 'Data.ByteString.ByteString').

-- | Predicate for 'C.isControl'.
--
-- ==== __Examples__
-- >>> validate @Control Proxy '\r'
-- Nothing
--
-- >>> showRefineException <$> validate @Control Proxy 'a'
-- Just "RefineOtherException (Control) \"a is not a control character\""
--
-- @since 0.1.0.0
type Control :: Type
data Control
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. Control -> Rep Control x)
-> (forall x. Rep Control x -> Control) -> Generic Control
forall x. Rep Control x -> Control
forall x. Control -> Rep Control x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Control -> Rep Control x
from :: forall x. Control -> Rep Control x
$cto :: forall x. Rep Control x -> Control
to :: forall x. Rep Control x -> Control
Generic
    )

-- | @since 0.1.0.0
instance Predicate Control Char where
  validate :: Proxy Control -> Char -> Maybe RefineException
validate Proxy Control
proxy Char
c
    | Char -> Bool
C.isControl Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy Control -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy Control
proxy) Text
err
    where
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a control character"

-- | @since 0.1.0.0
instance Predicate Control Word8 where
  validate :: Proxy Control -> Word8 -> Maybe RefineException
validate Proxy Control
proxy Word8
w
    | Char -> Bool
C.isControl Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy Control -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy Control
proxy) Text
err
    where
      c :: Char
c = Word8 -> Char
BS.w2c Word8
w
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a control character"

-- | Predicate for 'C.isDigit'.
--
-- ==== __Examples__
-- >>> validate @Digit Proxy '1'
-- Nothing
--
-- >>> showRefineException <$> validate @Digit Proxy 'a'
-- Just "RefineOtherException (Digit) \"a is not a digit\""
--
-- @since 0.1.0.0
type Digit :: Type
data Digit
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. Digit -> Rep Digit x)
-> (forall x. Rep Digit x -> Digit) -> Generic Digit
forall x. Rep Digit x -> Digit
forall x. Digit -> Rep Digit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Digit -> Rep Digit x
from :: forall x. Digit -> Rep Digit x
$cto :: forall x. Rep Digit x -> Digit
to :: forall x. Rep Digit x -> Digit
Generic
    )

-- | @since 0.1.0.0
instance Predicate Digit Char where
  validate :: Proxy Digit -> Char -> Maybe RefineException
validate Proxy Digit
proxy Char
c
    | Char -> Bool
C.isDigit Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy Digit -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy Digit
proxy) Text
err
    where
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a digit"

-- | @since 0.1.0.0
instance Predicate Digit Word8 where
  validate :: Proxy Digit -> Word8 -> Maybe RefineException
validate Proxy Digit
proxy Word8
w
    | Char -> Bool
C.isDigit Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy Digit -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy Digit
proxy) Text
err
    where
      c :: Char
c = Word8 -> Char
BS.w2c Word8
w
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a digit"

-- | Predicate for 'C.isOctDigit'.
--
-- ==== __Examples__
-- >>> validate @OctDigit Proxy '4'
-- Nothing
--
-- >>> showRefineException <$> validate @OctDigit Proxy '9'
-- Just "RefineOtherException (OctDigit) \"9 is not an octal digit\""
--
-- @since 0.1.0.0
type OctDigit :: Type
data OctDigit
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. OctDigit -> Rep OctDigit x)
-> (forall x. Rep OctDigit x -> OctDigit) -> Generic OctDigit
forall x. Rep OctDigit x -> OctDigit
forall x. OctDigit -> Rep OctDigit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OctDigit -> Rep OctDigit x
from :: forall x. OctDigit -> Rep OctDigit x
$cto :: forall x. Rep OctDigit x -> OctDigit
to :: forall x. Rep OctDigit x -> OctDigit
Generic
    )

-- | @since 0.1.0.0
instance Predicate OctDigit Char where
  validate :: Proxy OctDigit -> Char -> Maybe RefineException
validate Proxy OctDigit
proxy Char
c
    | Char -> Bool
C.isOctDigit Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy OctDigit -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy OctDigit
proxy) Text
err
    where
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not an octal digit"

-- | @since 0.1.0.0
instance Predicate OctDigit Word8 where
  validate :: Proxy OctDigit -> Word8 -> Maybe RefineException
validate Proxy OctDigit
proxy Word8
w
    | Char -> Bool
C.isOctDigit Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy OctDigit -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy OctDigit
proxy) Text
err
    where
      c :: Char
c = Word8 -> Char
BS.w2c Word8
w
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not an octal digit"

-- | Predicate for 'C.isHexDigit'.
--
-- ==== __Examples__
-- >>> validate @HexDigit Proxy '1'
-- Nothing
--
-- >>> validate @HexDigit Proxy 'f'
-- Nothing
--
-- >>> showRefineException <$> validate @HexDigit Proxy 'g'
-- Just "RefineOtherException (HexDigit) \"g is not a hexadecimal digit\""
--
-- @since 0.1.0.0
type HexDigit :: Type
data HexDigit
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. HexDigit -> Rep HexDigit x)
-> (forall x. Rep HexDigit x -> HexDigit) -> Generic HexDigit
forall x. Rep HexDigit x -> HexDigit
forall x. HexDigit -> Rep HexDigit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HexDigit -> Rep HexDigit x
from :: forall x. HexDigit -> Rep HexDigit x
$cto :: forall x. Rep HexDigit x -> HexDigit
to :: forall x. Rep HexDigit x -> HexDigit
Generic
    )

-- | @since 0.1.0.0
instance Predicate HexDigit Char where
  validate :: Proxy HexDigit -> Char -> Maybe RefineException
validate Proxy HexDigit
proxy Char
c
    | Char -> Bool
C.isHexDigit Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy HexDigit -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy HexDigit
proxy) Text
err
    where
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a hexadecimal digit"

-- | @since 0.1.0.0
instance Predicate HexDigit Word8 where
  validate :: Proxy HexDigit -> Word8 -> Maybe RefineException
validate Proxy HexDigit
proxy Word8
w
    | Char -> Bool
C.isHexDigit Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy HexDigit -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy HexDigit
proxy) Text
err
    where
      c :: Char
c = Word8 -> Char
BS.w2c Word8
w
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a hexadecimal digit"

-- | Predicate for 'C.isAscii'.
--
-- ==== __Examples__
-- >>> validate @Ascii Proxy 'a'
-- Nothing
--
-- >>> showRefineException <$> validate @Ascii Proxy '\x20DD'
-- Just "RefineOtherException (Ascii) \"\\8413 is not ascii\""
--
-- @since 0.1.0.0
type Ascii :: Type
data Ascii
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. Ascii -> Rep Ascii x)
-> (forall x. Rep Ascii x -> Ascii) -> Generic Ascii
forall x. Rep Ascii x -> Ascii
forall x. Ascii -> Rep Ascii x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Ascii -> Rep Ascii x
from :: forall x. Ascii -> Rep Ascii x
$cto :: forall x. Rep Ascii x -> Ascii
to :: forall x. Rep Ascii x -> Ascii
Generic
    )

-- | @since 0.1.0.0
instance Predicate Ascii Char where
  validate :: Proxy Ascii -> Char -> Maybe RefineException
validate Proxy Ascii
proxy Char
c
    | Char -> Bool
C.isAscii Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy Ascii -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy Ascii
proxy) Text
err
    where
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not ascii"

-- | @since 0.1.0.0
instance Predicate Ascii Word8 where
  validate :: Proxy Ascii -> Word8 -> Maybe RefineException
validate Proxy Ascii
proxy Word8
w
    | Char -> Bool
C.isAscii Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy Ascii -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy Ascii
proxy) Text
err
    where
      c :: Char
c = Word8 -> Char
BS.w2c Word8
w
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not ascii"

-- | Predicate for 'C.Latin1'.
--
-- ==== __Examples__
-- >>> validate @Latin1 Proxy 'a'
-- Nothing
--
-- >>> showRefineException <$> validate @Latin1 Proxy '\x20DD'
-- Just "RefineOtherException (Latin1) \"\\8413 is not latin1\""
--
-- @since 0.1.0.0
type Latin1 :: Type
data Latin1
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. Latin1 -> Rep Latin1 x)
-> (forall x. Rep Latin1 x -> Latin1) -> Generic Latin1
forall x. Rep Latin1 x -> Latin1
forall x. Latin1 -> Rep Latin1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Latin1 -> Rep Latin1 x
from :: forall x. Latin1 -> Rep Latin1 x
$cto :: forall x. Rep Latin1 x -> Latin1
to :: forall x. Rep Latin1 x -> Latin1
Generic
    )

-- | @since 0.1.0.0
instance Predicate Latin1 Char where
  validate :: Proxy Latin1 -> Char -> Maybe RefineException
validate Proxy Latin1
proxy Char
c
    | Char -> Bool
C.isLatin1 Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy Latin1 -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy Latin1
proxy) Text
err
    where
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not latin1"

-- | @since 0.1.0.0
instance Predicate Latin1 Word8 where
  validate :: Proxy Latin1 -> Word8 -> Maybe RefineException
validate Proxy Latin1
proxy Word8
w
    | Char -> Bool
C.isLatin1 Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy Latin1 -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy Latin1
proxy) Text
err
    where
      c :: Char
c = Word8 -> Char
BS.w2c Word8
w
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not latin1"

-- | Predicate for 'C.isAsciiUpper'.
--
-- ==== __Examples__
-- >>> validate @AsciiUpper Proxy 'A'
-- Nothing
--
-- >>> showRefineException <$> validate @AsciiUpper Proxy 'a'
-- Just "RefineOtherException (AsciiUpper) \"a is not uppercase ascii\""
--
-- @since 0.1.0.0
type AsciiUpper :: Type
data AsciiUpper
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. AsciiUpper -> Rep AsciiUpper x)
-> (forall x. Rep AsciiUpper x -> AsciiUpper) -> Generic AsciiUpper
forall x. Rep AsciiUpper x -> AsciiUpper
forall x. AsciiUpper -> Rep AsciiUpper x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AsciiUpper -> Rep AsciiUpper x
from :: forall x. AsciiUpper -> Rep AsciiUpper x
$cto :: forall x. Rep AsciiUpper x -> AsciiUpper
to :: forall x. Rep AsciiUpper x -> AsciiUpper
Generic
    )

-- | @since 0.1.0.0
instance Predicate AsciiUpper Char where
  validate :: Proxy AsciiUpper -> Char -> Maybe RefineException
validate Proxy AsciiUpper
proxy Char
c
    | Char -> Bool
C.isAsciiUpper Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy AsciiUpper -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy AsciiUpper
proxy) Text
err
    where
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not uppercase ascii"

-- | @since 0.1.0.0
instance Predicate AsciiUpper Word8 where
  validate :: Proxy AsciiUpper -> Word8 -> Maybe RefineException
validate Proxy AsciiUpper
proxy Word8
w
    | Char -> Bool
C.isAsciiUpper Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy AsciiUpper -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy AsciiUpper
proxy) Text
err
    where
      c :: Char
c = Word8 -> Char
BS.w2c Word8
w
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not uppercase ascii"

-- | Predicate for 'C.isAsciiLower'.
--
-- ==== __Examples__
-- >>> validate @AsciiLower Proxy 'a'
-- Nothing
--
-- >>> showRefineException <$> validate @AsciiLower Proxy 'A'
-- Just "RefineOtherException (AsciiLower) \"A is not lowercase ascii\""
--
-- @since 0.1.0.0
type AsciiLower :: Type
data AsciiLower
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. AsciiLower -> Rep AsciiLower x)
-> (forall x. Rep AsciiLower x -> AsciiLower) -> Generic AsciiLower
forall x. Rep AsciiLower x -> AsciiLower
forall x. AsciiLower -> Rep AsciiLower x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AsciiLower -> Rep AsciiLower x
from :: forall x. AsciiLower -> Rep AsciiLower x
$cto :: forall x. Rep AsciiLower x -> AsciiLower
to :: forall x. Rep AsciiLower x -> AsciiLower
Generic
    )

-- | @since 0.1.0.0
instance Predicate AsciiLower Char where
  validate :: Proxy AsciiLower -> Char -> Maybe RefineException
validate Proxy AsciiLower
proxy Char
c
    | Char -> Bool
C.isAsciiLower Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy AsciiLower -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy AsciiLower
proxy) Text
err
    where
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not lowercase ascii"

-- | @since 0.1.0.0
instance Predicate AsciiLower Word8 where
  validate :: Proxy AsciiLower -> Word8 -> Maybe RefineException
validate Proxy AsciiLower
proxy Word8
w
    | Char -> Bool
C.isAsciiLower Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy AsciiLower -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy AsciiLower
proxy) Text
err
    where
      c :: Char
c = Word8 -> Char
BS.w2c Word8
w
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not lowercase ascii"

-- | Predicate for 'C.isAscii' and 'C.isAlpha', primarily intended for 'Word8'.
-- Redundant for 'Char', as this is equivalent to @(Ascii && Alpha)@, but we
-- include 'Char' for completeness.
--
-- ==== __Examples__
-- >>> validate @AsciiAlpha Proxy 'a'
-- Nothing
--
-- >>> showRefineException <$> validate @AsciiAlpha Proxy '1'
-- Just "RefineOtherException (AsciiAlpha) \"1 is not alpha ascii\""
--
-- >>> showRefineException <$> validate @AsciiAlpha Proxy 'ɦ'
-- Just "RefineOtherException (AsciiAlpha) \"\\614 is not alpha ascii\""
--
-- @since 0.1.0.0
type AsciiAlpha :: Type
data AsciiAlpha
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. AsciiAlpha -> Rep AsciiAlpha x)
-> (forall x. Rep AsciiAlpha x -> AsciiAlpha) -> Generic AsciiAlpha
forall x. Rep AsciiAlpha x -> AsciiAlpha
forall x. AsciiAlpha -> Rep AsciiAlpha x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AsciiAlpha -> Rep AsciiAlpha x
from :: forall x. AsciiAlpha -> Rep AsciiAlpha x
$cto :: forall x. Rep AsciiAlpha x -> AsciiAlpha
to :: forall x. Rep AsciiAlpha x -> AsciiAlpha
Generic
    )

-- | @since 0.1.0.0
instance Predicate AsciiAlpha Char where
  validate :: Proxy AsciiAlpha -> Char -> Maybe RefineException
validate Proxy AsciiAlpha
proxy Char
c
    | Char -> Bool
C.isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
C.isAlpha Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy AsciiAlpha -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy AsciiAlpha
proxy) Text
err
    where
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not alpha ascii"

-- | @since 0.1.0.0
instance Predicate AsciiAlpha Word8 where
  validate :: Proxy AsciiAlpha -> Word8 -> Maybe RefineException
validate Proxy AsciiAlpha
proxy Word8
w
    | Char -> Bool
C.isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
C.isAlpha Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy AsciiAlpha -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy AsciiAlpha
proxy) Text
err
    where
      c :: Char
c = Word8 -> Char
BS.w2c Word8
w
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not alpha ascii"

-- | Predicate for 'C.isAscii' and 'C.isAlphaNum', primarily intended for
-- 'Word8'. Redundant for 'Char', as this is equivalent to
-- @(Ascii && AlphaNum)@, but we include 'Char' for completeness.
--
-- ==== __Examples__
-- >>> validate @AsciiAlphaNum Proxy 'a'
-- Nothing
--
-- >>> validate @AsciiAlphaNum Proxy '1'
-- Nothing
--
-- >>> showRefineException <$> validate @AsciiAlphaNum Proxy '1'
-- Nothing
--
-- >>> showRefineException <$> validate @AsciiAlphaNum Proxy 'ɦ'
-- Just "RefineOtherException (AsciiAlphaNum) \"\\614 is not alpha-numeric ascii\""
--
-- @since 0.1.0.0
type AsciiAlphaNum :: Type
data AsciiAlphaNum
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. AsciiAlphaNum -> Rep AsciiAlphaNum x)
-> (forall x. Rep AsciiAlphaNum x -> AsciiAlphaNum)
-> Generic AsciiAlphaNum
forall x. Rep AsciiAlphaNum x -> AsciiAlphaNum
forall x. AsciiAlphaNum -> Rep AsciiAlphaNum x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AsciiAlphaNum -> Rep AsciiAlphaNum x
from :: forall x. AsciiAlphaNum -> Rep AsciiAlphaNum x
$cto :: forall x. Rep AsciiAlphaNum x -> AsciiAlphaNum
to :: forall x. Rep AsciiAlphaNum x -> AsciiAlphaNum
Generic
    )

-- | @since 0.1.0.0
instance Predicate AsciiAlphaNum Char where
  validate :: Proxy AsciiAlphaNum -> Char -> Maybe RefineException
validate Proxy AsciiAlphaNum
proxy Char
c
    | Char -> Bool
C.isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
C.isAlphaNum Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy AsciiAlphaNum -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy AsciiAlphaNum
proxy) Text
err
    where
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not alpha-numeric ascii"

-- | @since 0.1.0.0
instance Predicate AsciiAlphaNum Word8 where
  validate :: Proxy AsciiAlphaNum -> Word8 -> Maybe RefineException
validate Proxy AsciiAlphaNum
proxy Word8
w
    | Char -> Bool
C.isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
C.isAlphaNum Char
c = Maybe RefineException
forall a. Maybe a
Nothing
    | Bool
otherwise = RefineException -> Maybe RefineException
forall a. a -> Maybe a
Just (RefineException -> Maybe RefineException)
-> RefineException -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text -> RefineException
RefineOtherException (Proxy AsciiAlphaNum -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy AsciiAlphaNum
proxy) Text
err
    where
      c :: Char
c = Word8 -> Char
BS.w2c Word8
w
      err :: Text
err = Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not alpha-numeric ascii"