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

-- |
-- Module      : Data.Char.Emoji.Hand
-- Description : A module that provides Emojis about hands and fingers.
-- Maintainer  : hapytexeu+gh@gmail.com
-- Stability   : experimental
-- Portability : POSIX
--
-- Unicode has emoji's for hands. In this module we make it more convenient
-- to render hand gestures with a specific skin color.
module Data.Char.Emoji.Hand
  ( SingleCharHandGesture
      ( WavingHand,
        RaisedBackOfHand,
        RaisedHand,
        VulcanSalute,
        OkHandSign,
        PinchedFingers,
        PinchingHand,
        CrossedFingers,
        LoveYouGesture,
        SignOfTheHorns,
        CallMeHand
      ),
    MultiCharHandGesture,
    pattern FingersCrossed,
    pattern SpockHand,
    pattern HornsSign,
  )
where

import Control.DeepSeq (NFData)
import Data.Char.Core (UnicodeCharacter (fromUnicodeChar, isInCharRange, toUnicodeChar), UnicodeText (fromUnicodeText, isInTextRange, toUnicodeText), generateIsInTextRange')
import Data.Char.Emoji.SkinColor (WithSkinColorModifierUnicodeText)
import Data.Data (Data)
import Data.Hashable (Hashable)
import GHC.Generics (Generic)
import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary), arbitraryBoundedEnum)

-- | A datatype that constructs /hand gestures/ that correspond with a /single/ 'Char'acter.
data SingleCharHandGesture
  = -- | A waving hand, this is denoted with 👋.
    WavingHand
  | -- | The raised back of a hand, this is denoted with 🤚.
    RaisedBackOfHand
  | -- | A raised hand, this is denoted with ✋.
    RaisedHand
  | -- | The /Vulcan/ salute, this is denoted with 🖖.
    VulcanSalute
  | -- | The okay hand sign, this is denoted with 👌.
    OkHandSign
  | -- |  The /pinched fingers/ gesture, this is denoted with 🤌.
    PinchedFingers
  | -- | The /pinching hand/ gesture, this is denoted with 🤏.
    PinchingHand
  | -- | The /crossed fingers/ gesture, this is denoted with 🤞.
    CrossedFingers
  | -- | The /love you/ gesture, this is denoted with 🤟.
    LoveYouGesture
  | -- | The sign of the horns, this is denoted with 🤘.
    SignOfTheHorns
  | -- | The /call me/ hand sign, this is denoted with 🤙.
    CallMeHand
  | -- | A middle finger pointing up, this is denoted with 🖕.
    MiddleFinger
  | -- | An emoji where the thumb is pointing upwards, this is denoted with 👍.
    ThumbsUp
  | -- | An emoji where the thumb is pointing downwards, this is denoted with 👎.
    ThumbsDown
  | -- | An emoji where the fist is rased, this is denoted with ✊.
    RaisedFist
  | -- | An emoji of a fisted hand, this is denoted with 👊.
    FistedHand
  deriving (SingleCharHandGesture
SingleCharHandGesture
-> SingleCharHandGesture -> Bounded SingleCharHandGesture
forall a. a -> a -> Bounded a
$cminBound :: SingleCharHandGesture
minBound :: SingleCharHandGesture
$cmaxBound :: SingleCharHandGesture
maxBound :: SingleCharHandGesture
Bounded, Typeable SingleCharHandGesture
Typeable SingleCharHandGesture
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> SingleCharHandGesture
    -> c SingleCharHandGesture)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SingleCharHandGesture)
-> (SingleCharHandGesture -> Constr)
-> (SingleCharHandGesture -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SingleCharHandGesture))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SingleCharHandGesture))
-> ((forall b. Data b => b -> b)
    -> SingleCharHandGesture -> SingleCharHandGesture)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SingleCharHandGesture
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SingleCharHandGesture
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SingleCharHandGesture -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SingleCharHandGesture -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SingleCharHandGesture -> m SingleCharHandGesture)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SingleCharHandGesture -> m SingleCharHandGesture)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SingleCharHandGesture -> m SingleCharHandGesture)
-> Data SingleCharHandGesture
SingleCharHandGesture -> Constr
SingleCharHandGesture -> DataType
(forall b. Data b => b -> b)
-> SingleCharHandGesture -> SingleCharHandGesture
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) -> SingleCharHandGesture -> u
forall u.
(forall d. Data d => d -> u) -> SingleCharHandGesture -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SingleCharHandGesture -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SingleCharHandGesture -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SingleCharHandGesture -> m SingleCharHandGesture
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SingleCharHandGesture -> m SingleCharHandGesture
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SingleCharHandGesture
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SingleCharHandGesture
-> c SingleCharHandGesture
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SingleCharHandGesture)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SingleCharHandGesture)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SingleCharHandGesture
-> c SingleCharHandGesture
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SingleCharHandGesture
-> c SingleCharHandGesture
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SingleCharHandGesture
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SingleCharHandGesture
$ctoConstr :: SingleCharHandGesture -> Constr
toConstr :: SingleCharHandGesture -> Constr
$cdataTypeOf :: SingleCharHandGesture -> DataType
dataTypeOf :: SingleCharHandGesture -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SingleCharHandGesture)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SingleCharHandGesture)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SingleCharHandGesture)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SingleCharHandGesture)
$cgmapT :: (forall b. Data b => b -> b)
-> SingleCharHandGesture -> SingleCharHandGesture
gmapT :: (forall b. Data b => b -> b)
-> SingleCharHandGesture -> SingleCharHandGesture
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SingleCharHandGesture -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SingleCharHandGesture -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SingleCharHandGesture -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SingleCharHandGesture -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> SingleCharHandGesture -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> SingleCharHandGesture -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SingleCharHandGesture -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SingleCharHandGesture -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SingleCharHandGesture -> m SingleCharHandGesture
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SingleCharHandGesture -> m SingleCharHandGesture
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SingleCharHandGesture -> m SingleCharHandGesture
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SingleCharHandGesture -> m SingleCharHandGesture
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SingleCharHandGesture -> m SingleCharHandGesture
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SingleCharHandGesture -> m SingleCharHandGesture
Data, Int -> SingleCharHandGesture
SingleCharHandGesture -> Int
SingleCharHandGesture -> [SingleCharHandGesture]
SingleCharHandGesture -> SingleCharHandGesture
SingleCharHandGesture
-> SingleCharHandGesture -> [SingleCharHandGesture]
SingleCharHandGesture
-> SingleCharHandGesture
-> SingleCharHandGesture
-> [SingleCharHandGesture]
(SingleCharHandGesture -> SingleCharHandGesture)
-> (SingleCharHandGesture -> SingleCharHandGesture)
-> (Int -> SingleCharHandGesture)
-> (SingleCharHandGesture -> Int)
-> (SingleCharHandGesture -> [SingleCharHandGesture])
-> (SingleCharHandGesture
    -> SingleCharHandGesture -> [SingleCharHandGesture])
-> (SingleCharHandGesture
    -> SingleCharHandGesture -> [SingleCharHandGesture])
-> (SingleCharHandGesture
    -> SingleCharHandGesture
    -> SingleCharHandGesture
    -> [SingleCharHandGesture])
-> Enum SingleCharHandGesture
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SingleCharHandGesture -> SingleCharHandGesture
succ :: SingleCharHandGesture -> SingleCharHandGesture
$cpred :: SingleCharHandGesture -> SingleCharHandGesture
pred :: SingleCharHandGesture -> SingleCharHandGesture
$ctoEnum :: Int -> SingleCharHandGesture
toEnum :: Int -> SingleCharHandGesture
$cfromEnum :: SingleCharHandGesture -> Int
fromEnum :: SingleCharHandGesture -> Int
$cenumFrom :: SingleCharHandGesture -> [SingleCharHandGesture]
enumFrom :: SingleCharHandGesture -> [SingleCharHandGesture]
$cenumFromThen :: SingleCharHandGesture
-> SingleCharHandGesture -> [SingleCharHandGesture]
enumFromThen :: SingleCharHandGesture
-> SingleCharHandGesture -> [SingleCharHandGesture]
$cenumFromTo :: SingleCharHandGesture
-> SingleCharHandGesture -> [SingleCharHandGesture]
enumFromTo :: SingleCharHandGesture
-> SingleCharHandGesture -> [SingleCharHandGesture]
$cenumFromThenTo :: SingleCharHandGesture
-> SingleCharHandGesture
-> SingleCharHandGesture
-> [SingleCharHandGesture]
enumFromThenTo :: SingleCharHandGesture
-> SingleCharHandGesture
-> SingleCharHandGesture
-> [SingleCharHandGesture]
Enum, SingleCharHandGesture -> SingleCharHandGesture -> Bool
(SingleCharHandGesture -> SingleCharHandGesture -> Bool)
-> (SingleCharHandGesture -> SingleCharHandGesture -> Bool)
-> Eq SingleCharHandGesture
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SingleCharHandGesture -> SingleCharHandGesture -> Bool
== :: SingleCharHandGesture -> SingleCharHandGesture -> Bool
$c/= :: SingleCharHandGesture -> SingleCharHandGesture -> Bool
/= :: SingleCharHandGesture -> SingleCharHandGesture -> Bool
Eq, (forall x. SingleCharHandGesture -> Rep SingleCharHandGesture x)
-> (forall x. Rep SingleCharHandGesture x -> SingleCharHandGesture)
-> Generic SingleCharHandGesture
forall x. Rep SingleCharHandGesture x -> SingleCharHandGesture
forall x. SingleCharHandGesture -> Rep SingleCharHandGesture x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SingleCharHandGesture -> Rep SingleCharHandGesture x
from :: forall x. SingleCharHandGesture -> Rep SingleCharHandGesture x
$cto :: forall x. Rep SingleCharHandGesture x -> SingleCharHandGesture
to :: forall x. Rep SingleCharHandGesture x -> SingleCharHandGesture
Generic, Eq SingleCharHandGesture
Eq SingleCharHandGesture
-> (SingleCharHandGesture -> SingleCharHandGesture -> Ordering)
-> (SingleCharHandGesture -> SingleCharHandGesture -> Bool)
-> (SingleCharHandGesture -> SingleCharHandGesture -> Bool)
-> (SingleCharHandGesture -> SingleCharHandGesture -> Bool)
-> (SingleCharHandGesture -> SingleCharHandGesture -> Bool)
-> (SingleCharHandGesture
    -> SingleCharHandGesture -> SingleCharHandGesture)
-> (SingleCharHandGesture
    -> SingleCharHandGesture -> SingleCharHandGesture)
-> Ord SingleCharHandGesture
SingleCharHandGesture -> SingleCharHandGesture -> Bool
SingleCharHandGesture -> SingleCharHandGesture -> Ordering
SingleCharHandGesture
-> SingleCharHandGesture -> SingleCharHandGesture
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
$ccompare :: SingleCharHandGesture -> SingleCharHandGesture -> Ordering
compare :: SingleCharHandGesture -> SingleCharHandGesture -> Ordering
$c< :: SingleCharHandGesture -> SingleCharHandGesture -> Bool
< :: SingleCharHandGesture -> SingleCharHandGesture -> Bool
$c<= :: SingleCharHandGesture -> SingleCharHandGesture -> Bool
<= :: SingleCharHandGesture -> SingleCharHandGesture -> Bool
$c> :: SingleCharHandGesture -> SingleCharHandGesture -> Bool
> :: SingleCharHandGesture -> SingleCharHandGesture -> Bool
$c>= :: SingleCharHandGesture -> SingleCharHandGesture -> Bool
>= :: SingleCharHandGesture -> SingleCharHandGesture -> Bool
$cmax :: SingleCharHandGesture
-> SingleCharHandGesture -> SingleCharHandGesture
max :: SingleCharHandGesture
-> SingleCharHandGesture -> SingleCharHandGesture
$cmin :: SingleCharHandGesture
-> SingleCharHandGesture -> SingleCharHandGesture
min :: SingleCharHandGesture
-> SingleCharHandGesture -> SingleCharHandGesture
Ord, ReadPrec [SingleCharHandGesture]
ReadPrec SingleCharHandGesture
Int -> ReadS SingleCharHandGesture
ReadS [SingleCharHandGesture]
(Int -> ReadS SingleCharHandGesture)
-> ReadS [SingleCharHandGesture]
-> ReadPrec SingleCharHandGesture
-> ReadPrec [SingleCharHandGesture]
-> Read SingleCharHandGesture
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SingleCharHandGesture
readsPrec :: Int -> ReadS SingleCharHandGesture
$creadList :: ReadS [SingleCharHandGesture]
readList :: ReadS [SingleCharHandGesture]
$creadPrec :: ReadPrec SingleCharHandGesture
readPrec :: ReadPrec SingleCharHandGesture
$creadListPrec :: ReadPrec [SingleCharHandGesture]
readListPrec :: ReadPrec [SingleCharHandGesture]
Read, Int -> SingleCharHandGesture -> ShowS
[SingleCharHandGesture] -> ShowS
SingleCharHandGesture -> [Char]
(Int -> SingleCharHandGesture -> ShowS)
-> (SingleCharHandGesture -> [Char])
-> ([SingleCharHandGesture] -> ShowS)
-> Show SingleCharHandGesture
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SingleCharHandGesture -> ShowS
showsPrec :: Int -> SingleCharHandGesture -> ShowS
$cshow :: SingleCharHandGesture -> [Char]
show :: SingleCharHandGesture -> [Char]
$cshowList :: [SingleCharHandGesture] -> ShowS
showList :: [SingleCharHandGesture] -> ShowS
Show)

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

instance Hashable SingleCharHandGesture

instance NFData SingleCharHandGesture

instance UnicodeCharacter SingleCharHandGesture where
  toUnicodeChar :: SingleCharHandGesture -> Char
toUnicodeChar SingleCharHandGesture
WavingHand = Char
'\x1f44b'
  toUnicodeChar SingleCharHandGesture
RaisedBackOfHand = Char
'\x1f91a'
  toUnicodeChar SingleCharHandGesture
RaisedHand = Char
'\x270b'
  toUnicodeChar SingleCharHandGesture
VulcanSalute = Char
'\x1f596'
  toUnicodeChar SingleCharHandGesture
OkHandSign = Char
'\x1f44c'
  toUnicodeChar SingleCharHandGesture
PinchedFingers = Char
'\x1f90c'
  toUnicodeChar SingleCharHandGesture
PinchingHand = Char
'\x1f90f'
  toUnicodeChar SingleCharHandGesture
CrossedFingers = Char
'\x1f91e'
  toUnicodeChar SingleCharHandGesture
LoveYouGesture = Char
'\x1f91f'
  toUnicodeChar SingleCharHandGesture
SignOfTheHorns = Char
'\x1f918'
  toUnicodeChar SingleCharHandGesture
CallMeHand = Char
'\x1f919'
  toUnicodeChar SingleCharHandGesture
MiddleFinger = Char
'\x1f595'
  toUnicodeChar SingleCharHandGesture
ThumbsUp = Char
'\x1f44d'
  toUnicodeChar SingleCharHandGesture
ThumbsDown = Char
'\x1f44e'
  toUnicodeChar SingleCharHandGesture
RaisedFist = Char
'\x270a'
  toUnicodeChar SingleCharHandGesture
FistedHand = Char
'\x1f44a'
  fromUnicodeChar :: Char -> Maybe SingleCharHandGesture
fromUnicodeChar Char
'\x1f44b' = SingleCharHandGesture -> Maybe SingleCharHandGesture
forall a. a -> Maybe a
Just SingleCharHandGesture
WavingHand
  fromUnicodeChar Char
'\x1f91a' = SingleCharHandGesture -> Maybe SingleCharHandGesture
forall a. a -> Maybe a
Just SingleCharHandGesture
RaisedBackOfHand
  fromUnicodeChar Char
'\x270b' = SingleCharHandGesture -> Maybe SingleCharHandGesture
forall a. a -> Maybe a
Just SingleCharHandGesture
RaisedHand
  fromUnicodeChar Char
'\x1f596' = SingleCharHandGesture -> Maybe SingleCharHandGesture
forall a. a -> Maybe a
Just SingleCharHandGesture
VulcanSalute
  fromUnicodeChar Char
'\x1f44c' = SingleCharHandGesture -> Maybe SingleCharHandGesture
forall a. a -> Maybe a
Just SingleCharHandGesture
OkHandSign
  fromUnicodeChar Char
'\x1f90c' = SingleCharHandGesture -> Maybe SingleCharHandGesture
forall a. a -> Maybe a
Just SingleCharHandGesture
PinchedFingers
  fromUnicodeChar Char
'\x1f90f' = SingleCharHandGesture -> Maybe SingleCharHandGesture
forall a. a -> Maybe a
Just SingleCharHandGesture
PinchingHand
  fromUnicodeChar Char
'\x1f91e' = SingleCharHandGesture -> Maybe SingleCharHandGesture
forall a. a -> Maybe a
Just SingleCharHandGesture
CrossedFingers
  fromUnicodeChar Char
'\x1f91f' = SingleCharHandGesture -> Maybe SingleCharHandGesture
forall a. a -> Maybe a
Just SingleCharHandGesture
LoveYouGesture
  fromUnicodeChar Char
'\x1f918' = SingleCharHandGesture -> Maybe SingleCharHandGesture
forall a. a -> Maybe a
Just SingleCharHandGesture
SignOfTheHorns
  fromUnicodeChar Char
'\x1f919' = SingleCharHandGesture -> Maybe SingleCharHandGesture
forall a. a -> Maybe a
Just SingleCharHandGesture
CallMeHand
  fromUnicodeChar Char
'\x1f595' = SingleCharHandGesture -> Maybe SingleCharHandGesture
forall a. a -> Maybe a
Just SingleCharHandGesture
MiddleFinger
  fromUnicodeChar Char
'\x1f44d' = SingleCharHandGesture -> Maybe SingleCharHandGesture
forall a. a -> Maybe a
Just SingleCharHandGesture
ThumbsUp
  fromUnicodeChar Char
'\x1f44e' = SingleCharHandGesture -> Maybe SingleCharHandGesture
forall a. a -> Maybe a
Just SingleCharHandGesture
ThumbsDown
  fromUnicodeChar Char
'\x270a' = SingleCharHandGesture -> Maybe SingleCharHandGesture
forall a. a -> Maybe a
Just SingleCharHandGesture
RaisedFist
  fromUnicodeChar Char
'\x1f44a' = SingleCharHandGesture -> Maybe SingleCharHandGesture
forall a. a -> Maybe a
Just SingleCharHandGesture
FistedHand
  fromUnicodeChar Char
_ = Maybe SingleCharHandGesture
forall a. Maybe a
Nothing
  isInCharRange :: Char -> Bool
isInCharRange Char
'\x1f44b' = Bool
True
  isInCharRange Char
'\x1f91a' = Bool
True
  isInCharRange Char
'\x270b' = Bool
True
  isInCharRange Char
'\x1f596' = Bool
True
  isInCharRange Char
'\x1f44c' = Bool
True
  isInCharRange Char
'\x1f90c' = Bool
True
  isInCharRange Char
'\x1f90f' = Bool
True
  isInCharRange Char
'\x1f91e' = Bool
True
  isInCharRange Char
'\x1f91f' = Bool
True
  isInCharRange Char
'\x1f918' = Bool
True
  isInCharRange Char
'\x1f919' = Bool
True
  isInCharRange Char
'\x1f595' = Bool
True
  isInCharRange Char
'\x1f44d' = Bool
True
  isInCharRange Char
'\x1f44e' = Bool
True
  isInCharRange Char
'\x270a' = Bool
True
  isInCharRange Char
'\x1f44a' = Bool
True
  isInCharRange Char
_ = Bool
False

instance UnicodeText SingleCharHandGesture where
  isInTextRange :: Text -> Bool
isInTextRange = forall a. UnicodeCharacter a => Text -> Bool
generateIsInTextRange' @SingleCharHandGesture

instance WithSkinColorModifierUnicodeText SingleCharHandGesture

-- | Emoji with hands that map on a /sequence/ of characters instead of one character.
data MultiCharHandGesture
  = -- | The raised hand with fingers splayed emoji, this is denoted as 🖐️.
    RaisedHandWithFingersSplayed
  | -- | The /victory hand/ emoji, this is denoted as ✌️.
    VictoryHand
  deriving (MultiCharHandGesture
MultiCharHandGesture
-> MultiCharHandGesture -> Bounded MultiCharHandGesture
forall a. a -> a -> Bounded a
$cminBound :: MultiCharHandGesture
minBound :: MultiCharHandGesture
$cmaxBound :: MultiCharHandGesture
maxBound :: MultiCharHandGesture
Bounded, Typeable MultiCharHandGesture
Typeable MultiCharHandGesture
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> MultiCharHandGesture
    -> c MultiCharHandGesture)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MultiCharHandGesture)
-> (MultiCharHandGesture -> Constr)
-> (MultiCharHandGesture -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c MultiCharHandGesture))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c MultiCharHandGesture))
-> ((forall b. Data b => b -> b)
    -> MultiCharHandGesture -> MultiCharHandGesture)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> MultiCharHandGesture -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> MultiCharHandGesture -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> MultiCharHandGesture -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> MultiCharHandGesture -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> MultiCharHandGesture -> m MultiCharHandGesture)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MultiCharHandGesture -> m MultiCharHandGesture)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MultiCharHandGesture -> m MultiCharHandGesture)
-> Data MultiCharHandGesture
MultiCharHandGesture -> Constr
MultiCharHandGesture -> DataType
(forall b. Data b => b -> b)
-> MultiCharHandGesture -> MultiCharHandGesture
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) -> MultiCharHandGesture -> u
forall u.
(forall d. Data d => d -> u) -> MultiCharHandGesture -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MultiCharHandGesture -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MultiCharHandGesture -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MultiCharHandGesture -> m MultiCharHandGesture
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MultiCharHandGesture -> m MultiCharHandGesture
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MultiCharHandGesture
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MultiCharHandGesture
-> c MultiCharHandGesture
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MultiCharHandGesture)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MultiCharHandGesture)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MultiCharHandGesture
-> c MultiCharHandGesture
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MultiCharHandGesture
-> c MultiCharHandGesture
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MultiCharHandGesture
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MultiCharHandGesture
$ctoConstr :: MultiCharHandGesture -> Constr
toConstr :: MultiCharHandGesture -> Constr
$cdataTypeOf :: MultiCharHandGesture -> DataType
dataTypeOf :: MultiCharHandGesture -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MultiCharHandGesture)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MultiCharHandGesture)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MultiCharHandGesture)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MultiCharHandGesture)
$cgmapT :: (forall b. Data b => b -> b)
-> MultiCharHandGesture -> MultiCharHandGesture
gmapT :: (forall b. Data b => b -> b)
-> MultiCharHandGesture -> MultiCharHandGesture
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MultiCharHandGesture -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MultiCharHandGesture -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MultiCharHandGesture -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MultiCharHandGesture -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> MultiCharHandGesture -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> MultiCharHandGesture -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> MultiCharHandGesture -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> MultiCharHandGesture -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MultiCharHandGesture -> m MultiCharHandGesture
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MultiCharHandGesture -> m MultiCharHandGesture
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MultiCharHandGesture -> m MultiCharHandGesture
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MultiCharHandGesture -> m MultiCharHandGesture
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MultiCharHandGesture -> m MultiCharHandGesture
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MultiCharHandGesture -> m MultiCharHandGesture
Data, Int -> MultiCharHandGesture
MultiCharHandGesture -> Int
MultiCharHandGesture -> [MultiCharHandGesture]
MultiCharHandGesture -> MultiCharHandGesture
MultiCharHandGesture
-> MultiCharHandGesture -> [MultiCharHandGesture]
MultiCharHandGesture
-> MultiCharHandGesture
-> MultiCharHandGesture
-> [MultiCharHandGesture]
(MultiCharHandGesture -> MultiCharHandGesture)
-> (MultiCharHandGesture -> MultiCharHandGesture)
-> (Int -> MultiCharHandGesture)
-> (MultiCharHandGesture -> Int)
-> (MultiCharHandGesture -> [MultiCharHandGesture])
-> (MultiCharHandGesture
    -> MultiCharHandGesture -> [MultiCharHandGesture])
-> (MultiCharHandGesture
    -> MultiCharHandGesture -> [MultiCharHandGesture])
-> (MultiCharHandGesture
    -> MultiCharHandGesture
    -> MultiCharHandGesture
    -> [MultiCharHandGesture])
-> Enum MultiCharHandGesture
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MultiCharHandGesture -> MultiCharHandGesture
succ :: MultiCharHandGesture -> MultiCharHandGesture
$cpred :: MultiCharHandGesture -> MultiCharHandGesture
pred :: MultiCharHandGesture -> MultiCharHandGesture
$ctoEnum :: Int -> MultiCharHandGesture
toEnum :: Int -> MultiCharHandGesture
$cfromEnum :: MultiCharHandGesture -> Int
fromEnum :: MultiCharHandGesture -> Int
$cenumFrom :: MultiCharHandGesture -> [MultiCharHandGesture]
enumFrom :: MultiCharHandGesture -> [MultiCharHandGesture]
$cenumFromThen :: MultiCharHandGesture
-> MultiCharHandGesture -> [MultiCharHandGesture]
enumFromThen :: MultiCharHandGesture
-> MultiCharHandGesture -> [MultiCharHandGesture]
$cenumFromTo :: MultiCharHandGesture
-> MultiCharHandGesture -> [MultiCharHandGesture]
enumFromTo :: MultiCharHandGesture
-> MultiCharHandGesture -> [MultiCharHandGesture]
$cenumFromThenTo :: MultiCharHandGesture
-> MultiCharHandGesture
-> MultiCharHandGesture
-> [MultiCharHandGesture]
enumFromThenTo :: MultiCharHandGesture
-> MultiCharHandGesture
-> MultiCharHandGesture
-> [MultiCharHandGesture]
Enum, MultiCharHandGesture -> MultiCharHandGesture -> Bool
(MultiCharHandGesture -> MultiCharHandGesture -> Bool)
-> (MultiCharHandGesture -> MultiCharHandGesture -> Bool)
-> Eq MultiCharHandGesture
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MultiCharHandGesture -> MultiCharHandGesture -> Bool
== :: MultiCharHandGesture -> MultiCharHandGesture -> Bool
$c/= :: MultiCharHandGesture -> MultiCharHandGesture -> Bool
/= :: MultiCharHandGesture -> MultiCharHandGesture -> Bool
Eq, (forall x. MultiCharHandGesture -> Rep MultiCharHandGesture x)
-> (forall x. Rep MultiCharHandGesture x -> MultiCharHandGesture)
-> Generic MultiCharHandGesture
forall x. Rep MultiCharHandGesture x -> MultiCharHandGesture
forall x. MultiCharHandGesture -> Rep MultiCharHandGesture x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MultiCharHandGesture -> Rep MultiCharHandGesture x
from :: forall x. MultiCharHandGesture -> Rep MultiCharHandGesture x
$cto :: forall x. Rep MultiCharHandGesture x -> MultiCharHandGesture
to :: forall x. Rep MultiCharHandGesture x -> MultiCharHandGesture
Generic, Eq MultiCharHandGesture
Eq MultiCharHandGesture
-> (MultiCharHandGesture -> MultiCharHandGesture -> Ordering)
-> (MultiCharHandGesture -> MultiCharHandGesture -> Bool)
-> (MultiCharHandGesture -> MultiCharHandGesture -> Bool)
-> (MultiCharHandGesture -> MultiCharHandGesture -> Bool)
-> (MultiCharHandGesture -> MultiCharHandGesture -> Bool)
-> (MultiCharHandGesture
    -> MultiCharHandGesture -> MultiCharHandGesture)
-> (MultiCharHandGesture
    -> MultiCharHandGesture -> MultiCharHandGesture)
-> Ord MultiCharHandGesture
MultiCharHandGesture -> MultiCharHandGesture -> Bool
MultiCharHandGesture -> MultiCharHandGesture -> Ordering
MultiCharHandGesture
-> MultiCharHandGesture -> MultiCharHandGesture
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
$ccompare :: MultiCharHandGesture -> MultiCharHandGesture -> Ordering
compare :: MultiCharHandGesture -> MultiCharHandGesture -> Ordering
$c< :: MultiCharHandGesture -> MultiCharHandGesture -> Bool
< :: MultiCharHandGesture -> MultiCharHandGesture -> Bool
$c<= :: MultiCharHandGesture -> MultiCharHandGesture -> Bool
<= :: MultiCharHandGesture -> MultiCharHandGesture -> Bool
$c> :: MultiCharHandGesture -> MultiCharHandGesture -> Bool
> :: MultiCharHandGesture -> MultiCharHandGesture -> Bool
$c>= :: MultiCharHandGesture -> MultiCharHandGesture -> Bool
>= :: MultiCharHandGesture -> MultiCharHandGesture -> Bool
$cmax :: MultiCharHandGesture
-> MultiCharHandGesture -> MultiCharHandGesture
max :: MultiCharHandGesture
-> MultiCharHandGesture -> MultiCharHandGesture
$cmin :: MultiCharHandGesture
-> MultiCharHandGesture -> MultiCharHandGesture
min :: MultiCharHandGesture
-> MultiCharHandGesture -> MultiCharHandGesture
Ord, ReadPrec [MultiCharHandGesture]
ReadPrec MultiCharHandGesture
Int -> ReadS MultiCharHandGesture
ReadS [MultiCharHandGesture]
(Int -> ReadS MultiCharHandGesture)
-> ReadS [MultiCharHandGesture]
-> ReadPrec MultiCharHandGesture
-> ReadPrec [MultiCharHandGesture]
-> Read MultiCharHandGesture
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MultiCharHandGesture
readsPrec :: Int -> ReadS MultiCharHandGesture
$creadList :: ReadS [MultiCharHandGesture]
readList :: ReadS [MultiCharHandGesture]
$creadPrec :: ReadPrec MultiCharHandGesture
readPrec :: ReadPrec MultiCharHandGesture
$creadListPrec :: ReadPrec [MultiCharHandGesture]
readListPrec :: ReadPrec [MultiCharHandGesture]
Read, Int -> MultiCharHandGesture -> ShowS
[MultiCharHandGesture] -> ShowS
MultiCharHandGesture -> [Char]
(Int -> MultiCharHandGesture -> ShowS)
-> (MultiCharHandGesture -> [Char])
-> ([MultiCharHandGesture] -> ShowS)
-> Show MultiCharHandGesture
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MultiCharHandGesture -> ShowS
showsPrec :: Int -> MultiCharHandGesture -> ShowS
$cshow :: MultiCharHandGesture -> [Char]
show :: MultiCharHandGesture -> [Char]
$cshowList :: [MultiCharHandGesture] -> ShowS
showList :: [MultiCharHandGesture] -> ShowS
Show)

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

instance Hashable MultiCharHandGesture

instance NFData MultiCharHandGesture

instance UnicodeText MultiCharHandGesture where
  toUnicodeText :: MultiCharHandGesture -> Text
toUnicodeText MultiCharHandGesture
RaisedHandWithFingersSplayed = Text
"\x1f590\xfe0f"
  toUnicodeText MultiCharHandGesture
VictoryHand = Text
"\x270c\xfe0f"
  fromUnicodeText :: Text -> Maybe MultiCharHandGesture
fromUnicodeText Text
"\x1f590\xfe0f" = MultiCharHandGesture -> Maybe MultiCharHandGesture
forall a. a -> Maybe a
Just MultiCharHandGesture
RaisedHandWithFingersSplayed
  fromUnicodeText Text
"\x270c\xfe0f" = MultiCharHandGesture -> Maybe MultiCharHandGesture
forall a. a -> Maybe a
Just MultiCharHandGesture
VictoryHand
  fromUnicodeText Text
_ = Maybe MultiCharHandGesture
forall a. Maybe a
Nothing
  isInTextRange :: Text -> Bool
isInTextRange Text
"\x1f590\xfe0f" = Bool
True
  isInTextRange Text
"\x270c\xfe0f" = Bool
True
  isInTextRange Text
_ = Bool
False

instance WithSkinColorModifierUnicodeText MultiCharHandGesture

-- | A pattern synonym for 'CrossedFingers'.
pattern FingersCrossed :: SingleCharHandGesture
pattern $mFingersCrossed :: forall {r}.
SingleCharHandGesture -> ((# #) -> r) -> ((# #) -> r) -> r
$bFingersCrossed :: SingleCharHandGesture
FingersCrossed = CrossedFingers

-- | A pattern synonym for the 'VulcanSalute'.
pattern SpockHand :: SingleCharHandGesture
pattern $mSpockHand :: forall {r}.
SingleCharHandGesture -> ((# #) -> r) -> ((# #) -> r) -> r
$bSpockHand :: SingleCharHandGesture
SpockHand = VulcanSalute

-- | A pattern synonym for 'SignOfTheHorns'.
pattern HornsSign :: SingleCharHandGesture
pattern $mHornsSign :: forall {r}.
SingleCharHandGesture -> ((# #) -> r) -> ((# #) -> r) -> r
$bHornsSign :: SingleCharHandGesture
HornsSign = SignOfTheHorns