{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE Safe #-}

-- |
-- Module      : Data.Char.Emoji.BloodType
-- Description : A module that defines the emoji for /blood types/.
-- Maintainer  : hapytexeu+gh@gmail.com
-- Stability   : experimental
-- Portability : POSIX
--
-- The Unicode standard defines four emoji for the 'O', 'B', 'A', and 'AB' blood type.
module Data.Char.Emoji.BloodType
  ( -- * Blood type emoji
    BloodType (O, B, A, AB),

    -- * Drop of blood emoji
    pattern DropOfBlood,
  )
where

import Control.DeepSeq (NFData)
import Data.Bits (Bits (bit, bitSize, bitSizeMaybe, complement, isSigned, popCount, rotate, shift, testBit, xor, (.&.), (.|.)))
import Data.Char.Core (UnicodeText (fromUnicodeText, isInTextRange, toUnicodeText))
import Data.Char.Emoji.Core (pattern EmojiSuffix)
import Data.Data (Data)
import Data.Function (on)
import Data.Hashable (Hashable)
import Data.Text (unpack)
import GHC.Generics (Generic)
import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary), arbitraryBoundedEnum)

-- | A emoji that depicts a drop of blood. This looks like 🩸.
pattern DropOfBlood :: Char
pattern $bDropOfBlood :: Char
$mDropOfBlood :: forall {r}. Char -> ((# #) -> r) -> ((# #) -> r) -> r
DropOfBlood = '\x1fa78'

-- | A 'BloodType' object used to convert to its unicode equivalent. The
-- 'BloodType' is also seen as a 2-bit value with the leftmost bit representing
-- the presence of /A antigens/ and the rightmost the presence of /B antigens/.
data BloodType
  = -- | The /O blood type/, with no presence of A and B antigens, denoted by 🅾️.
    O
  | -- | The /B blood type/, with presence of the B antigen, denoted by 🅱️.
    B
  | -- | The /A blood type/, with presence of the A antigen, denoted by 🅰️.
    A
  | -- | The /AB blood type/, with presence of the A and B antigens, denoted by 🆎.
    AB
  deriving (BloodType
forall a. a -> a -> Bounded a
maxBound :: BloodType
$cmaxBound :: BloodType
minBound :: BloodType
$cminBound :: BloodType
Bounded, Typeable BloodType
BloodType -> DataType
BloodType -> Constr
(forall b. Data b => b -> b) -> BloodType -> BloodType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> BloodType -> u
forall u. (forall d. Data d => d -> u) -> BloodType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BloodType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BloodType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BloodType -> m BloodType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BloodType -> m BloodType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BloodType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BloodType -> c BloodType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BloodType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BloodType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BloodType -> m BloodType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BloodType -> m BloodType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BloodType -> m BloodType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BloodType -> m BloodType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BloodType -> m BloodType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BloodType -> m BloodType
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BloodType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BloodType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> BloodType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BloodType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BloodType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BloodType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BloodType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BloodType -> r
gmapT :: (forall b. Data b => b -> b) -> BloodType -> BloodType
$cgmapT :: (forall b. Data b => b -> b) -> BloodType -> BloodType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BloodType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BloodType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BloodType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BloodType)
dataTypeOf :: BloodType -> DataType
$cdataTypeOf :: BloodType -> DataType
toConstr :: BloodType -> Constr
$ctoConstr :: BloodType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BloodType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BloodType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BloodType -> c BloodType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BloodType -> c BloodType
Data, Int -> BloodType
BloodType -> Int
BloodType -> [BloodType]
BloodType -> BloodType
BloodType -> BloodType -> [BloodType]
BloodType -> BloodType -> BloodType -> [BloodType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BloodType -> BloodType -> BloodType -> [BloodType]
$cenumFromThenTo :: BloodType -> BloodType -> BloodType -> [BloodType]
enumFromTo :: BloodType -> BloodType -> [BloodType]
$cenumFromTo :: BloodType -> BloodType -> [BloodType]
enumFromThen :: BloodType -> BloodType -> [BloodType]
$cenumFromThen :: BloodType -> BloodType -> [BloodType]
enumFrom :: BloodType -> [BloodType]
$cenumFrom :: BloodType -> [BloodType]
fromEnum :: BloodType -> Int
$cfromEnum :: BloodType -> Int
toEnum :: Int -> BloodType
$ctoEnum :: Int -> BloodType
pred :: BloodType -> BloodType
$cpred :: BloodType -> BloodType
succ :: BloodType -> BloodType
$csucc :: BloodType -> BloodType
Enum, BloodType -> BloodType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BloodType -> BloodType -> Bool
$c/= :: BloodType -> BloodType -> Bool
== :: BloodType -> BloodType -> Bool
$c== :: BloodType -> BloodType -> Bool
Eq, forall x. Rep BloodType x -> BloodType
forall x. BloodType -> Rep BloodType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BloodType x -> BloodType
$cfrom :: forall x. BloodType -> Rep BloodType x
Generic, Eq BloodType
BloodType -> BloodType -> Bool
BloodType -> BloodType -> Ordering
BloodType -> BloodType -> BloodType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BloodType -> BloodType -> BloodType
$cmin :: BloodType -> BloodType -> BloodType
max :: BloodType -> BloodType -> BloodType
$cmax :: BloodType -> BloodType -> BloodType
>= :: BloodType -> BloodType -> Bool
$c>= :: BloodType -> BloodType -> Bool
> :: BloodType -> BloodType -> Bool
$c> :: BloodType -> BloodType -> Bool
<= :: BloodType -> BloodType -> Bool
$c<= :: BloodType -> BloodType -> Bool
< :: BloodType -> BloodType -> Bool
$c< :: BloodType -> BloodType -> Bool
compare :: BloodType -> BloodType -> Ordering
$ccompare :: BloodType -> BloodType -> Ordering
Ord, ReadPrec [BloodType]
ReadPrec BloodType
Int -> ReadS BloodType
ReadS [BloodType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BloodType]
$creadListPrec :: ReadPrec [BloodType]
readPrec :: ReadPrec BloodType
$creadPrec :: ReadPrec BloodType
readList :: ReadS [BloodType]
$creadList :: ReadS [BloodType]
readsPrec :: Int -> ReadS BloodType
$creadsPrec :: Int -> ReadS BloodType
Read, Int -> BloodType -> ShowS
[BloodType] -> ShowS
BloodType -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [BloodType] -> ShowS
$cshowList :: [BloodType] -> ShowS
show :: BloodType -> [Char]
$cshow :: BloodType -> [Char]
showsPrec :: Int -> BloodType -> ShowS
$cshowsPrec :: Int -> BloodType -> ShowS
Show)

instance Arbitrary BloodType where
  arbitrary :: Gen BloodType
arbitrary = forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

_overEnumMask :: Enum a => Int -> (Int -> Int) -> a -> a
_overEnumMask :: forall a. Enum a => Int -> (Int -> Int) -> a -> a
_overEnumMask Int
m Int -> Int
f = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
m forall a. Bits a => a -> a -> a
.&.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

_overEnum2 :: Enum a => (Int -> Int -> Int) -> a -> a -> a
_overEnum2 :: forall a. Enum a => (Int -> Int -> Int) -> a -> a -> a
_overEnum2 Int -> Int -> Int
f a
x a
y = forall a. Enum a => Int -> a
toEnum (forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Int
f forall a. Enum a => a -> Int
fromEnum a
x a
y)

_overEnumMask2 :: Enum a => Int -> (Int -> Int -> Int) -> a -> a -> a
_overEnumMask2 :: forall a. Enum a => Int -> (Int -> Int -> Int) -> a -> a -> a
_overEnumMask2 Int
m Int -> Int -> Int
f a
x a
y = forall a. Enum a => Int -> a
toEnum (Int
m forall a. Bits a => a -> a -> a
.&. forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Int
f forall a. Enum a => a -> Int
fromEnum a
x a
y)

instance Bits BloodType where
  .&. :: BloodType -> BloodType -> BloodType
(.&.) = forall a. Enum a => (Int -> Int -> Int) -> a -> a -> a
_overEnum2 forall a. Bits a => a -> a -> a
(.&.)
  .|. :: BloodType -> BloodType -> BloodType
(.|.) = forall a. Enum a => (Int -> Int -> Int) -> a -> a -> a
_overEnum2 forall a. Bits a => a -> a -> a
(.|.)
  xor :: BloodType -> BloodType -> BloodType
xor = forall a. Enum a => Int -> (Int -> Int -> Int) -> a -> a -> a
_overEnumMask2 Int
0x03 forall a. Bits a => a -> a -> a
xor
  complement :: BloodType -> BloodType
complement BloodType
O = BloodType
AB
  complement BloodType
A = BloodType
B
  complement BloodType
B = BloodType
A
  complement BloodType
AB = BloodType
O
  shift :: BloodType -> Int -> BloodType
shift BloodType
abo Int
n = forall a. Enum a => Int -> (Int -> Int) -> a -> a
_overEnumMask Int
0x03 (forall a. Bits a => a -> Int -> a
`shift` Int
n) BloodType
abo
  rotate :: BloodType -> Int -> BloodType
rotate = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall {a}. (Eq a, Num a) => a -> BloodType -> BloodType
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
0x01 forall a. Bits a => a -> a -> a
.&.))
    where
      go :: a -> BloodType -> BloodType
go a
1 BloodType
A = BloodType
B
      go a
1 BloodType
B = BloodType
B
      go a
_ BloodType
x = BloodType
x
  bitSize :: BloodType -> Int
bitSize = forall a b. a -> b -> a
const Int
2
  bitSizeMaybe :: BloodType -> Maybe Int
bitSizeMaybe = forall a b. a -> b -> a
const (forall a. a -> Maybe a
Just Int
2)
  isSigned :: BloodType -> Bool
isSigned = forall a b. a -> b -> a
const Bool
False
  testBit :: BloodType -> Int -> Bool
testBit = forall a. Bits a => a -> Int -> Bool
testBit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum
  bit :: Int -> BloodType
bit Int
0 = BloodType
B
  bit Int
1 = BloodType
A
  bit Int
_ = BloodType
O
  popCount :: BloodType -> Int
popCount BloodType
O = Int
0
  popCount BloodType
A = Int
1
  popCount BloodType
B = Int
1
  popCount BloodType
AB = Int
2

instance Hashable BloodType

instance NFData BloodType

instance UnicodeText BloodType where
  toUnicodeText :: BloodType -> Text
toUnicodeText BloodType
AB = Text
"\x1f18e"
  toUnicodeText BloodType
A = Text
"\x1f170\xfe0f"
  toUnicodeText BloodType
B = Text
"\x1f171\xfe0f"
  toUnicodeText BloodType
O = Text
"\x1f17e\xfe0f"
  fromUnicodeText :: Text -> Maybe BloodType
fromUnicodeText Text
"\x1f18e" = forall a. a -> Maybe a
Just BloodType
AB
  fromUnicodeText Text
t
    | [Char
c, Char
EmojiSuffix] <- Text -> [Char]
unpack Text
t = Char -> Maybe BloodType
go Char
c
    | Bool
otherwise = forall a. Maybe a
Nothing
    where
      go :: Char -> Maybe BloodType
go Char
'\x1f170' = forall a. a -> Maybe a
Just BloodType
A
      go Char
'\x1f171' = forall a. a -> Maybe a
Just BloodType
B
      go Char
'\x1f17e' = forall a. a -> Maybe a
Just BloodType
O
      go Char
_ = forall a. Maybe a
Nothing
  isInTextRange :: Text -> Bool
isInTextRange Text
"\x1f170\xfe0f" = Bool
True
  isInTextRange Text
"\x1f171\xfe0f" = Bool
True
  isInTextRange Text
"\x1f17e\xfe0f" = Bool
True
  isInTextRange Text
"\x1f18e" = Bool
True
  isInTextRange Text
_ = Bool
False