module Data.Char.GeneralCategory.Predicates
  ( Predicates (..)
  , predicates
  , mkPredicates
  )
where

import Data.Char (GeneralCategory (..))
import Data.Functor.Contravariant

gcIsLetter :: GeneralCategory -> Bool
gcIsLetter :: GeneralCategory -> Bool
gcIsLetter GeneralCategory
c = case GeneralCategory
c of
  GeneralCategory
UppercaseLetter -> Bool
True
  GeneralCategory
LowercaseLetter -> Bool
True
  GeneralCategory
TitlecaseLetter -> Bool
True
  GeneralCategory
ModifierLetter -> Bool
True
  GeneralCategory
OtherLetter -> Bool
True
  GeneralCategory
_ -> Bool
False

gcIsMark :: GeneralCategory -> Bool
gcIsMark :: GeneralCategory -> Bool
gcIsMark GeneralCategory
c = case GeneralCategory
c of
  GeneralCategory
NonSpacingMark -> Bool
True
  GeneralCategory
SpacingCombiningMark -> Bool
True
  GeneralCategory
EnclosingMark -> Bool
True
  GeneralCategory
_ -> Bool
False

gcIsNumber :: GeneralCategory -> Bool
gcIsNumber :: GeneralCategory -> Bool
gcIsNumber GeneralCategory
c = case GeneralCategory
c of
  GeneralCategory
DecimalNumber -> Bool
True
  GeneralCategory
LetterNumber -> Bool
True
  GeneralCategory
OtherNumber -> Bool
True
  GeneralCategory
_ -> Bool
False

gcIsPunctuation :: GeneralCategory -> Bool
gcIsPunctuation :: GeneralCategory -> Bool
gcIsPunctuation GeneralCategory
c = case GeneralCategory
c of
  GeneralCategory
ConnectorPunctuation -> Bool
True
  GeneralCategory
DashPunctuation -> Bool
True
  GeneralCategory
OpenPunctuation -> Bool
True
  GeneralCategory
ClosePunctuation -> Bool
True
  GeneralCategory
InitialQuote -> Bool
True
  GeneralCategory
FinalQuote -> Bool
True
  GeneralCategory
OtherPunctuation -> Bool
True
  GeneralCategory
_ -> Bool
False

gcIsSymbol :: GeneralCategory -> Bool
gcIsSymbol :: GeneralCategory -> Bool
gcIsSymbol GeneralCategory
c = case GeneralCategory
c of
  GeneralCategory
MathSymbol -> Bool
True
  GeneralCategory
CurrencySymbol -> Bool
True
  GeneralCategory
ModifierSymbol -> Bool
True
  GeneralCategory
OtherSymbol -> Bool
True
  GeneralCategory
_ -> Bool
False

gcIsSeparator :: GeneralCategory -> Bool
gcIsSeparator :: GeneralCategory -> Bool
gcIsSeparator GeneralCategory
c = case GeneralCategory
c of
  GeneralCategory
Space -> Bool
True
  GeneralCategory
LineSeparator -> Bool
True
  GeneralCategory
ParagraphSeparator -> Bool
True
  GeneralCategory
_ -> Bool
False

-- | A set of predicate functions related to `GeneralCategory` queries.
--   You can either destruct at top level or locally to get access to each of them.
data Predicates i = Predicates
  { -- | Counterpart of 'Data.Char.generalCategory'
    Predicates i -> i -> GeneralCategory
generalCategory :: i -> GeneralCategory
  , -- | Counterpart of 'Data.Char.isLetter'
    Predicates i -> i -> Bool
isLetter :: i -> Bool
  , -- | Counterpart of 'Data.Char.isMark'
    Predicates i -> i -> Bool
isMark :: i -> Bool
  , -- | Counterpart of 'Data.Char.isNumber'
    Predicates i -> i -> Bool
isNumber :: i -> Bool
  , -- | Counterpart of 'Data.Char.isPunctuation'
    Predicates i -> i -> Bool
isPunctuation :: i -> Bool
  , -- | Counterpart of 'Data.Char.isSymbol'
    Predicates i -> i -> Bool
isSymbol :: i -> Bool
  , -- | Counterpart of 'Data.Char.isSeparator'
    Predicates i -> i -> Bool
isSeparator :: i -> Bool
  }

instance Contravariant Predicates where
  contramap :: (a -> b) -> Predicates b -> Predicates a
contramap a -> b
f (Predicates b -> GeneralCategory
g b -> Bool
l b -> Bool
m b -> Bool
n b -> Bool
p b -> Bool
sy b -> Bool
se) =
    (a -> GeneralCategory)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> Predicates a
forall i.
(i -> GeneralCategory)
-> (i -> Bool)
-> (i -> Bool)
-> (i -> Bool)
-> (i -> Bool)
-> (i -> Bool)
-> (i -> Bool)
-> Predicates i
Predicates
      (b -> GeneralCategory
g (b -> GeneralCategory) -> (a -> b) -> a -> GeneralCategory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
      (b -> Bool
l (b -> Bool) -> (a -> b) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
      (b -> Bool
m (b -> Bool) -> (a -> b) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
      (b -> Bool
n (b -> Bool) -> (a -> b) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
      (b -> Bool
p (b -> Bool) -> (a -> b) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
      (b -> Bool
sy (b -> Bool) -> (a -> b) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
      (b -> Bool
se (b -> Bool) -> (a -> b) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

-- | A set of functions similiar to their counterparts found in "Data.Char"
--   but takes 'GeneralCategory' as argument.
predicates :: Predicates GeneralCategory
predicates :: Predicates GeneralCategory
predicates =
  Predicates :: forall i.
(i -> GeneralCategory)
-> (i -> Bool)
-> (i -> Bool)
-> (i -> Bool)
-> (i -> Bool)
-> (i -> Bool)
-> (i -> Bool)
-> Predicates i
Predicates
    { isLetter :: GeneralCategory -> Bool
isLetter = GeneralCategory -> Bool
gcIsLetter
    , isMark :: GeneralCategory -> Bool
isMark = GeneralCategory -> Bool
gcIsMark
    , isNumber :: GeneralCategory -> Bool
isNumber = GeneralCategory -> Bool
gcIsNumber
    , isPunctuation :: GeneralCategory -> Bool
isPunctuation = GeneralCategory -> Bool
gcIsPunctuation
    , isSymbol :: GeneralCategory -> Bool
isSymbol = GeneralCategory -> Bool
gcIsSymbol
    , isSeparator :: GeneralCategory -> Bool
isSeparator = GeneralCategory -> Bool
gcIsSeparator
    , generalCategory :: GeneralCategory -> GeneralCategory
generalCategory = GeneralCategory -> GeneralCategory
forall a. a -> a
id
    }

-- | Takes a function that is equivalent to 'Data.Char.generalCategory'
--   and returns the set of functions equivalent to those found in "Data.Char",
--   but with the argument function serving instead.
mkPredicates :: (Char -> GeneralCategory) -> Predicates Char
mkPredicates :: (Char -> GeneralCategory) -> Predicates Char
mkPredicates = ((Char -> GeneralCategory)
-> Predicates GeneralCategory -> Predicates Char
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Predicates GeneralCategory
predicates)