{-# 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
forall a. a -> a -> Bounded a
maxBound :: SingleCharHandGesture
$cmaxBound :: SingleCharHandGesture
minBound :: SingleCharHandGesture
$cminBound :: SingleCharHandGesture
Bounded, Typeable SingleCharHandGesture
SingleCharHandGesture -> DataType
SingleCharHandGesture -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SingleCharHandGesture -> m SingleCharHandGesture
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SingleCharHandGesture -> m SingleCharHandGesture
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SingleCharHandGesture -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SingleCharHandGesture -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> SingleCharHandGesture -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> SingleCharHandGesture -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SingleCharHandGesture -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SingleCharHandGesture -> r
gmapT :: (forall b. Data b => b -> b)
-> SingleCharHandGesture -> SingleCharHandGesture
$cgmapT :: (forall b. Data b => b -> b)
-> SingleCharHandGesture -> SingleCharHandGesture
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SingleCharHandGesture)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SingleCharHandGesture)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SingleCharHandGesture)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SingleCharHandGesture)
dataTypeOf :: SingleCharHandGesture -> DataType
$cdataTypeOf :: SingleCharHandGesture -> DataType
toConstr :: SingleCharHandGesture -> Constr
$ctoConstr :: SingleCharHandGesture -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SingleCharHandGesture
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SingleCharHandGesture
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SingleCharHandGesture
-> c SingleCharHandGesture
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SingleCharHandGesture
-> c SingleCharHandGesture
Data, Int -> SingleCharHandGesture
SingleCharHandGesture -> Int
SingleCharHandGesture -> [SingleCharHandGesture]
SingleCharHandGesture -> SingleCharHandGesture
SingleCharHandGesture
-> SingleCharHandGesture -> [SingleCharHandGesture]
SingleCharHandGesture
-> SingleCharHandGesture
-> SingleCharHandGesture
-> [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
enumFromThenTo :: SingleCharHandGesture
-> SingleCharHandGesture
-> SingleCharHandGesture
-> [SingleCharHandGesture]
$cenumFromThenTo :: SingleCharHandGesture
-> SingleCharHandGesture
-> SingleCharHandGesture
-> [SingleCharHandGesture]
enumFromTo :: SingleCharHandGesture
-> SingleCharHandGesture -> [SingleCharHandGesture]
$cenumFromTo :: SingleCharHandGesture
-> SingleCharHandGesture -> [SingleCharHandGesture]
enumFromThen :: SingleCharHandGesture
-> SingleCharHandGesture -> [SingleCharHandGesture]
$cenumFromThen :: SingleCharHandGesture
-> SingleCharHandGesture -> [SingleCharHandGesture]
enumFrom :: SingleCharHandGesture -> [SingleCharHandGesture]
$cenumFrom :: SingleCharHandGesture -> [SingleCharHandGesture]
fromEnum :: SingleCharHandGesture -> Int
$cfromEnum :: SingleCharHandGesture -> Int
toEnum :: Int -> SingleCharHandGesture
$ctoEnum :: Int -> SingleCharHandGesture
pred :: SingleCharHandGesture -> SingleCharHandGesture
$cpred :: SingleCharHandGesture -> SingleCharHandGesture
succ :: SingleCharHandGesture -> SingleCharHandGesture
$csucc :: SingleCharHandGesture -> SingleCharHandGesture
Enum, SingleCharHandGesture -> SingleCharHandGesture -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SingleCharHandGesture -> SingleCharHandGesture -> Bool
$c/= :: SingleCharHandGesture -> SingleCharHandGesture -> Bool
== :: SingleCharHandGesture -> SingleCharHandGesture -> Bool
$c== :: SingleCharHandGesture -> SingleCharHandGesture -> Bool
Eq, 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
$cto :: forall x. Rep SingleCharHandGesture x -> SingleCharHandGesture
$cfrom :: forall x. SingleCharHandGesture -> Rep SingleCharHandGesture x
Generic, Eq 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
min :: SingleCharHandGesture
-> SingleCharHandGesture -> SingleCharHandGesture
$cmin :: SingleCharHandGesture
-> SingleCharHandGesture -> SingleCharHandGesture
max :: SingleCharHandGesture
-> SingleCharHandGesture -> SingleCharHandGesture
$cmax :: SingleCharHandGesture
-> SingleCharHandGesture -> SingleCharHandGesture
>= :: SingleCharHandGesture -> SingleCharHandGesture -> Bool
$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
compare :: SingleCharHandGesture -> SingleCharHandGesture -> Ordering
$ccompare :: SingleCharHandGesture -> SingleCharHandGesture -> Ordering
Ord, ReadPrec [SingleCharHandGesture]
ReadPrec SingleCharHandGesture
Int -> ReadS SingleCharHandGesture
ReadS [SingleCharHandGesture]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SingleCharHandGesture]
$creadListPrec :: ReadPrec [SingleCharHandGesture]
readPrec :: ReadPrec SingleCharHandGesture
$creadPrec :: ReadPrec SingleCharHandGesture
readList :: ReadS [SingleCharHandGesture]
$creadList :: ReadS [SingleCharHandGesture]
readsPrec :: Int -> ReadS SingleCharHandGesture
$creadsPrec :: Int -> ReadS SingleCharHandGesture
Read, Int -> SingleCharHandGesture -> ShowS
[SingleCharHandGesture] -> ShowS
SingleCharHandGesture -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SingleCharHandGesture] -> ShowS
$cshowList :: [SingleCharHandGesture] -> ShowS
show :: SingleCharHandGesture -> [Char]
$cshow :: SingleCharHandGesture -> [Char]
showsPrec :: Int -> SingleCharHandGesture -> ShowS
$cshowsPrec :: Int -> SingleCharHandGesture -> ShowS
Show)

instance Arbitrary SingleCharHandGesture where
  arbitrary :: Gen SingleCharHandGesture
arbitrary = 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' = forall a. a -> Maybe a
Just SingleCharHandGesture
WavingHand
  fromUnicodeChar Char
'\x1f91a' = forall a. a -> Maybe a
Just SingleCharHandGesture
RaisedBackOfHand
  fromUnicodeChar Char
'\x270b' = forall a. a -> Maybe a
Just SingleCharHandGesture
RaisedHand
  fromUnicodeChar Char
'\x1f596' = forall a. a -> Maybe a
Just SingleCharHandGesture
VulcanSalute
  fromUnicodeChar Char
'\x1f44c' = forall a. a -> Maybe a
Just SingleCharHandGesture
OkHandSign
  fromUnicodeChar Char
'\x1f90c' = forall a. a -> Maybe a
Just SingleCharHandGesture
PinchedFingers
  fromUnicodeChar Char
'\x1f90f' = forall a. a -> Maybe a
Just SingleCharHandGesture
PinchingHand
  fromUnicodeChar Char
'\x1f91e' = forall a. a -> Maybe a
Just SingleCharHandGesture
CrossedFingers
  fromUnicodeChar Char
'\x1f91f' = forall a. a -> Maybe a
Just SingleCharHandGesture
LoveYouGesture
  fromUnicodeChar Char
'\x1f918' = forall a. a -> Maybe a
Just SingleCharHandGesture
SignOfTheHorns
  fromUnicodeChar Char
'\x1f919' = forall a. a -> Maybe a
Just SingleCharHandGesture
CallMeHand
  fromUnicodeChar Char
'\x1f595' = forall a. a -> Maybe a
Just SingleCharHandGesture
MiddleFinger
  fromUnicodeChar Char
'\x1f44d' = forall a. a -> Maybe a
Just SingleCharHandGesture
ThumbsUp
  fromUnicodeChar Char
'\x1f44e' = forall a. a -> Maybe a
Just SingleCharHandGesture
ThumbsDown
  fromUnicodeChar Char
'\x270a' = forall a. a -> Maybe a
Just SingleCharHandGesture
RaisedFist
  fromUnicodeChar Char
'\x1f44a' = forall a. a -> Maybe a
Just SingleCharHandGesture
FistedHand
  fromUnicodeChar Char
_ = 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
forall a. a -> a -> Bounded a
maxBound :: MultiCharHandGesture
$cmaxBound :: MultiCharHandGesture
minBound :: MultiCharHandGesture
$cminBound :: MultiCharHandGesture
Bounded, Typeable MultiCharHandGesture
MultiCharHandGesture -> DataType
MultiCharHandGesture -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MultiCharHandGesture -> m MultiCharHandGesture
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MultiCharHandGesture -> m MultiCharHandGesture
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> MultiCharHandGesture -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> MultiCharHandGesture -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> MultiCharHandGesture -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> MultiCharHandGesture -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MultiCharHandGesture -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MultiCharHandGesture -> r
gmapT :: (forall b. Data b => b -> b)
-> MultiCharHandGesture -> MultiCharHandGesture
$cgmapT :: (forall b. Data b => b -> b)
-> MultiCharHandGesture -> MultiCharHandGesture
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MultiCharHandGesture)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MultiCharHandGesture)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MultiCharHandGesture)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MultiCharHandGesture)
dataTypeOf :: MultiCharHandGesture -> DataType
$cdataTypeOf :: MultiCharHandGesture -> DataType
toConstr :: MultiCharHandGesture -> Constr
$ctoConstr :: MultiCharHandGesture -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MultiCharHandGesture
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MultiCharHandGesture
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MultiCharHandGesture
-> c MultiCharHandGesture
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MultiCharHandGesture
-> c MultiCharHandGesture
Data, Int -> MultiCharHandGesture
MultiCharHandGesture -> Int
MultiCharHandGesture -> [MultiCharHandGesture]
MultiCharHandGesture -> MultiCharHandGesture
MultiCharHandGesture
-> MultiCharHandGesture -> [MultiCharHandGesture]
MultiCharHandGesture
-> MultiCharHandGesture
-> MultiCharHandGesture
-> [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
enumFromThenTo :: MultiCharHandGesture
-> MultiCharHandGesture
-> MultiCharHandGesture
-> [MultiCharHandGesture]
$cenumFromThenTo :: MultiCharHandGesture
-> MultiCharHandGesture
-> MultiCharHandGesture
-> [MultiCharHandGesture]
enumFromTo :: MultiCharHandGesture
-> MultiCharHandGesture -> [MultiCharHandGesture]
$cenumFromTo :: MultiCharHandGesture
-> MultiCharHandGesture -> [MultiCharHandGesture]
enumFromThen :: MultiCharHandGesture
-> MultiCharHandGesture -> [MultiCharHandGesture]
$cenumFromThen :: MultiCharHandGesture
-> MultiCharHandGesture -> [MultiCharHandGesture]
enumFrom :: MultiCharHandGesture -> [MultiCharHandGesture]
$cenumFrom :: MultiCharHandGesture -> [MultiCharHandGesture]
fromEnum :: MultiCharHandGesture -> Int
$cfromEnum :: MultiCharHandGesture -> Int
toEnum :: Int -> MultiCharHandGesture
$ctoEnum :: Int -> MultiCharHandGesture
pred :: MultiCharHandGesture -> MultiCharHandGesture
$cpred :: MultiCharHandGesture -> MultiCharHandGesture
succ :: MultiCharHandGesture -> MultiCharHandGesture
$csucc :: MultiCharHandGesture -> MultiCharHandGesture
Enum, MultiCharHandGesture -> MultiCharHandGesture -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultiCharHandGesture -> MultiCharHandGesture -> Bool
$c/= :: MultiCharHandGesture -> MultiCharHandGesture -> Bool
== :: MultiCharHandGesture -> MultiCharHandGesture -> Bool
$c== :: MultiCharHandGesture -> MultiCharHandGesture -> Bool
Eq, 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
$cto :: forall x. Rep MultiCharHandGesture x -> MultiCharHandGesture
$cfrom :: forall x. MultiCharHandGesture -> Rep MultiCharHandGesture x
Generic, Eq 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
min :: MultiCharHandGesture
-> MultiCharHandGesture -> MultiCharHandGesture
$cmin :: MultiCharHandGesture
-> MultiCharHandGesture -> MultiCharHandGesture
max :: MultiCharHandGesture
-> MultiCharHandGesture -> MultiCharHandGesture
$cmax :: MultiCharHandGesture
-> MultiCharHandGesture -> MultiCharHandGesture
>= :: MultiCharHandGesture -> MultiCharHandGesture -> Bool
$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
compare :: MultiCharHandGesture -> MultiCharHandGesture -> Ordering
$ccompare :: MultiCharHandGesture -> MultiCharHandGesture -> Ordering
Ord, ReadPrec [MultiCharHandGesture]
ReadPrec MultiCharHandGesture
Int -> ReadS MultiCharHandGesture
ReadS [MultiCharHandGesture]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MultiCharHandGesture]
$creadListPrec :: ReadPrec [MultiCharHandGesture]
readPrec :: ReadPrec MultiCharHandGesture
$creadPrec :: ReadPrec MultiCharHandGesture
readList :: ReadS [MultiCharHandGesture]
$creadList :: ReadS [MultiCharHandGesture]
readsPrec :: Int -> ReadS MultiCharHandGesture
$creadsPrec :: Int -> ReadS MultiCharHandGesture
Read, Int -> MultiCharHandGesture -> ShowS
[MultiCharHandGesture] -> ShowS
MultiCharHandGesture -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MultiCharHandGesture] -> ShowS
$cshowList :: [MultiCharHandGesture] -> ShowS
show :: MultiCharHandGesture -> [Char]
$cshow :: MultiCharHandGesture -> [Char]
showsPrec :: Int -> MultiCharHandGesture -> ShowS
$cshowsPrec :: Int -> MultiCharHandGesture -> ShowS
Show)

instance Arbitrary MultiCharHandGesture where
  arbitrary :: Gen MultiCharHandGesture
arbitrary = 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" = forall a. a -> Maybe a
Just MultiCharHandGesture
RaisedHandWithFingersSplayed
  fromUnicodeText Text
"\x270c\xfe0f" = forall a. a -> Maybe a
Just MultiCharHandGesture
VictoryHand
  fromUnicodeText Text
_ = 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 $bFingersCrossed :: SingleCharHandGesture
$mFingersCrossed :: forall {r}.
SingleCharHandGesture -> ((# #) -> r) -> ((# #) -> r) -> r
FingersCrossed = CrossedFingers

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

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