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

-- |
-- Module      : Data.Char.Emoji.Zodiac
-- Description : A module that defines zodiac emoji together with the English names as pattern synonyms.
-- Maintainer  : hapytexeu+gh@gmail.com
-- Stability   : experimental
-- Portability : POSIX
--
-- Unicode has emojis for the twelve zodiac signs. In this module a data type is used to present the zodiac
-- emoji and also defines pattern synonyms for these.
module Data.Char.Emoji.Zodiac
  ( -- * Zodiac datatype
    Zodiac (Aries, Taurus, Gemini, Cancer, Leo, Virgo, Libra, Scorpio, Sagittarius, Capricorn, Aquarius, Pisces),

    -- * Pattern aliasses
    pattern Ram,
    pattern Bull,
    pattern Twins,
    pattern Crab,
    pattern Lion,
    pattern Maiden,
    pattern Scales,
    pattern Scorpius,
    pattern Scorpion,
    pattern Centaur,
    pattern Archer,
    pattern Capricornus,
    pattern MountainGoat,
    pattern GoatHorned,
    pattern SeaGoat,
    pattern WaterBearer,
    pattern Fish,
  )
where

import Control.DeepSeq (NFData)
import Data.Char.Core (UnicodeCharacter (fromUnicodeChar, fromUnicodeChar', isInCharRange, toUnicodeChar), UnicodeText (isInTextRange), generateIsInTextRange', mapFromEnum, mapToEnum, mapToEnumSafe)
import Data.Data (Data)
import Data.Hashable (Hashable)
import GHC.Generics (Generic)
import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary), arbitraryBoundedEnum)

_zodiacOffset :: Int
_zodiacOffset :: Int
_zodiacOffset = Int
0x2648

-- | A data type to deal with the /zodiac sign/ emoji. The data type lists the
-- different zodiac signs as data constructors, and the instance of the
-- 'UnicodeCharacter' allows to convert it from and to a 'Char'acter.
data Zodiac
  = -- | The /aries/ zodiac sign, /ram/ in English, is denoted as ♈.
    Aries
  | -- | The /taurus/ zodiac sign, /bull/ in English, is denoted as ♉.
    Taurus
  | -- | The /gemini/ zodiac sign, /twins/ in English, is denoted as ♊.
    Gemini
  | -- | The /cancer/ zodiac sign, /crab/ in English, is denoted as ♋.
    Cancer
  | -- | The /leo/ zodiac sign, /lion/ in English, is denoted as ♌.
    Leo
  | -- | The /virgo/ zodiac sign, /maiden/ in English, is denoted as ♍.
    Virgo
  | -- | The /libra/ zodiac sign, /scales/ in English, is denoted as ♎.
    Libra
  | -- | The /scorpio/ zodiac sign, /scorpion/ in English, is denoted as ♏.
    Scorpio
  | -- | The /saggitarius/ zodiac sign, /archer/ in English, is denoted as ♐.
    Sagittarius
  | -- | The /capricorn/ zodiac sign, /sea-goat/ in English, is denoted as ♑.
    Capricorn
  | -- | The /aquarius/ zodiac sign, /water-bearer/ in English, is denoted as ♒.
    Aquarius
  | -- | The /pices/ zodiac sign, /fish/ in English, is denoted as ♓.
    Pisces
  deriving (Zodiac
Zodiac -> Zodiac -> Bounded Zodiac
forall a. a -> a -> Bounded a
$cminBound :: Zodiac
minBound :: Zodiac
$cmaxBound :: Zodiac
maxBound :: Zodiac
Bounded, Typeable Zodiac
Typeable Zodiac
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Zodiac -> c Zodiac)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Zodiac)
-> (Zodiac -> Constr)
-> (Zodiac -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Zodiac))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Zodiac))
-> ((forall b. Data b => b -> b) -> Zodiac -> Zodiac)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Zodiac -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Zodiac -> r)
-> (forall u. (forall d. Data d => d -> u) -> Zodiac -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Zodiac -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Zodiac -> m Zodiac)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Zodiac -> m Zodiac)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Zodiac -> m Zodiac)
-> Data Zodiac
Zodiac -> Constr
Zodiac -> DataType
(forall b. Data b => b -> b) -> Zodiac -> Zodiac
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) -> Zodiac -> u
forall u. (forall d. Data d => d -> u) -> Zodiac -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Zodiac -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Zodiac -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Zodiac -> m Zodiac
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Zodiac -> m Zodiac
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Zodiac
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Zodiac -> c Zodiac
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Zodiac)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Zodiac)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Zodiac -> c Zodiac
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Zodiac -> c Zodiac
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Zodiac
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Zodiac
$ctoConstr :: Zodiac -> Constr
toConstr :: Zodiac -> Constr
$cdataTypeOf :: Zodiac -> DataType
dataTypeOf :: Zodiac -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Zodiac)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Zodiac)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Zodiac)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Zodiac)
$cgmapT :: (forall b. Data b => b -> b) -> Zodiac -> Zodiac
gmapT :: (forall b. Data b => b -> b) -> Zodiac -> Zodiac
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Zodiac -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Zodiac -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Zodiac -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Zodiac -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Zodiac -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Zodiac -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Zodiac -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Zodiac -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Zodiac -> m Zodiac
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Zodiac -> m Zodiac
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Zodiac -> m Zodiac
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Zodiac -> m Zodiac
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Zodiac -> m Zodiac
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Zodiac -> m Zodiac
Data, Int -> Zodiac
Zodiac -> Int
Zodiac -> [Zodiac]
Zodiac -> Zodiac
Zodiac -> Zodiac -> [Zodiac]
Zodiac -> Zodiac -> Zodiac -> [Zodiac]
(Zodiac -> Zodiac)
-> (Zodiac -> Zodiac)
-> (Int -> Zodiac)
-> (Zodiac -> Int)
-> (Zodiac -> [Zodiac])
-> (Zodiac -> Zodiac -> [Zodiac])
-> (Zodiac -> Zodiac -> [Zodiac])
-> (Zodiac -> Zodiac -> Zodiac -> [Zodiac])
-> Enum Zodiac
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 :: Zodiac -> Zodiac
succ :: Zodiac -> Zodiac
$cpred :: Zodiac -> Zodiac
pred :: Zodiac -> Zodiac
$ctoEnum :: Int -> Zodiac
toEnum :: Int -> Zodiac
$cfromEnum :: Zodiac -> Int
fromEnum :: Zodiac -> Int
$cenumFrom :: Zodiac -> [Zodiac]
enumFrom :: Zodiac -> [Zodiac]
$cenumFromThen :: Zodiac -> Zodiac -> [Zodiac]
enumFromThen :: Zodiac -> Zodiac -> [Zodiac]
$cenumFromTo :: Zodiac -> Zodiac -> [Zodiac]
enumFromTo :: Zodiac -> Zodiac -> [Zodiac]
$cenumFromThenTo :: Zodiac -> Zodiac -> Zodiac -> [Zodiac]
enumFromThenTo :: Zodiac -> Zodiac -> Zodiac -> [Zodiac]
Enum, Zodiac -> Zodiac -> Bool
(Zodiac -> Zodiac -> Bool)
-> (Zodiac -> Zodiac -> Bool) -> Eq Zodiac
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Zodiac -> Zodiac -> Bool
== :: Zodiac -> Zodiac -> Bool
$c/= :: Zodiac -> Zodiac -> Bool
/= :: Zodiac -> Zodiac -> Bool
Eq, (forall x. Zodiac -> Rep Zodiac x)
-> (forall x. Rep Zodiac x -> Zodiac) -> Generic Zodiac
forall x. Rep Zodiac x -> Zodiac
forall x. Zodiac -> Rep Zodiac x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Zodiac -> Rep Zodiac x
from :: forall x. Zodiac -> Rep Zodiac x
$cto :: forall x. Rep Zodiac x -> Zodiac
to :: forall x. Rep Zodiac x -> Zodiac
Generic, Eq Zodiac
Eq Zodiac
-> (Zodiac -> Zodiac -> Ordering)
-> (Zodiac -> Zodiac -> Bool)
-> (Zodiac -> Zodiac -> Bool)
-> (Zodiac -> Zodiac -> Bool)
-> (Zodiac -> Zodiac -> Bool)
-> (Zodiac -> Zodiac -> Zodiac)
-> (Zodiac -> Zodiac -> Zodiac)
-> Ord Zodiac
Zodiac -> Zodiac -> Bool
Zodiac -> Zodiac -> Ordering
Zodiac -> Zodiac -> Zodiac
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 :: Zodiac -> Zodiac -> Ordering
compare :: Zodiac -> Zodiac -> Ordering
$c< :: Zodiac -> Zodiac -> Bool
< :: Zodiac -> Zodiac -> Bool
$c<= :: Zodiac -> Zodiac -> Bool
<= :: Zodiac -> Zodiac -> Bool
$c> :: Zodiac -> Zodiac -> Bool
> :: Zodiac -> Zodiac -> Bool
$c>= :: Zodiac -> Zodiac -> Bool
>= :: Zodiac -> Zodiac -> Bool
$cmax :: Zodiac -> Zodiac -> Zodiac
max :: Zodiac -> Zodiac -> Zodiac
$cmin :: Zodiac -> Zodiac -> Zodiac
min :: Zodiac -> Zodiac -> Zodiac
Ord, ReadPrec [Zodiac]
ReadPrec Zodiac
Int -> ReadS Zodiac
ReadS [Zodiac]
(Int -> ReadS Zodiac)
-> ReadS [Zodiac]
-> ReadPrec Zodiac
-> ReadPrec [Zodiac]
-> Read Zodiac
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Zodiac
readsPrec :: Int -> ReadS Zodiac
$creadList :: ReadS [Zodiac]
readList :: ReadS [Zodiac]
$creadPrec :: ReadPrec Zodiac
readPrec :: ReadPrec Zodiac
$creadListPrec :: ReadPrec [Zodiac]
readListPrec :: ReadPrec [Zodiac]
Read, Int -> Zodiac -> ShowS
[Zodiac] -> ShowS
Zodiac -> String
(Int -> Zodiac -> ShowS)
-> (Zodiac -> String) -> ([Zodiac] -> ShowS) -> Show Zodiac
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Zodiac -> ShowS
showsPrec :: Int -> Zodiac -> ShowS
$cshow :: Zodiac -> String
show :: Zodiac -> String
$cshowList :: [Zodiac] -> ShowS
showList :: [Zodiac] -> ShowS
Show)

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

instance Hashable Zodiac

instance NFData Zodiac

instance UnicodeCharacter Zodiac where
  toUnicodeChar :: Zodiac -> Char
toUnicodeChar = Int -> Zodiac -> Char
forall a. Enum a => Int -> a -> Char
mapFromEnum Int
_zodiacOffset
  fromUnicodeChar :: Char -> Maybe Zodiac
fromUnicodeChar = Int -> Char -> Maybe Zodiac
forall a. (Bounded a, Enum a) => Int -> Char -> Maybe a
mapToEnumSafe Int
_zodiacOffset
  fromUnicodeChar' :: Char -> Zodiac
fromUnicodeChar' = Int -> Char -> Zodiac
forall a. Enum a => Int -> Char -> a
mapToEnum Int
_zodiacOffset
  isInCharRange :: Char -> Bool
isInCharRange Char
c = Char
'\x2648' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2654'

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

-- | The English name for the 'Aries' zodiac sign.
pattern Ram :: Zodiac
pattern $mRam :: forall {r}. Zodiac -> ((# #) -> r) -> ((# #) -> r) -> r
$bRam :: Zodiac
Ram = Aries

-- | The English name for the 'Taurus' zodiac sign.
pattern Bull :: Zodiac
pattern $mBull :: forall {r}. Zodiac -> ((# #) -> r) -> ((# #) -> r) -> r
$bBull :: Zodiac
Bull = Taurus

-- | The English name for the 'Gemini' zodiac sign.
pattern Twins :: Zodiac
pattern $mTwins :: forall {r}. Zodiac -> ((# #) -> r) -> ((# #) -> r) -> r
$bTwins :: Zodiac
Twins = Gemini

-- | The English name for the 'Cancer' zodiac sign.
pattern Crab :: Zodiac
pattern $mCrab :: forall {r}. Zodiac -> ((# #) -> r) -> ((# #) -> r) -> r
$bCrab :: Zodiac
Crab = Cancer

-- | The English name for the 'Leo' zodiac sign.
pattern Lion :: Zodiac
pattern $mLion :: forall {r}. Zodiac -> ((# #) -> r) -> ((# #) -> r) -> r
$bLion :: Zodiac
Lion = Leo

-- | The English name for the 'Virgo' zodiac sign.
pattern Maiden :: Zodiac
pattern $mMaiden :: forall {r}. Zodiac -> ((# #) -> r) -> ((# #) -> r) -> r
$bMaiden :: Zodiac
Maiden = Virgo

-- | The English name for the 'Libra' zodiac sign.
pattern Scales :: Zodiac
pattern $mScales :: forall {r}. Zodiac -> ((# #) -> r) -> ((# #) -> r) -> r
$bScales :: Zodiac
Scales = Libra

-- | The name of the constellation of the 'Scorpio' zodiac sign.
pattern Scorpius :: Zodiac
pattern $mScorpius :: forall {r}. Zodiac -> ((# #) -> r) -> ((# #) -> r) -> r
$bScorpius :: Zodiac
Scorpius = Scorpio

-- | The English name for the 'Scorpio' zodiac sign.
pattern Scorpion :: Zodiac
pattern $mScorpion :: forall {r}. Zodiac -> ((# #) -> r) -> ((# #) -> r) -> r
$bScorpion :: Zodiac
Scorpion = Scorpio

-- | An English name for the 'Sagittarius' zodiac sign.
pattern Centaur :: Zodiac
pattern $mCentaur :: forall {r}. Zodiac -> ((# #) -> r) -> ((# #) -> r) -> r
$bCentaur :: Zodiac
Centaur = Sagittarius

-- | An English name for the 'Sagittarius' zodiac sign.
pattern Archer :: Zodiac
pattern $mArcher :: forall {r}. Zodiac -> ((# #) -> r) -> ((# #) -> r) -> r
$bArcher :: Zodiac
Archer = Sagittarius

-- | The name of the constellation of the 'Capricorn' zodiac sign.
pattern Capricornus :: Zodiac
pattern $mCapricornus :: forall {r}. Zodiac -> ((# #) -> r) -> ((# #) -> r) -> r
$bCapricornus :: Zodiac
Capricornus = Capricorn

-- | An English name for the 'Capricorn' zodiac sign.
pattern MountainGoat :: Zodiac
pattern $mMountainGoat :: forall {r}. Zodiac -> ((# #) -> r) -> ((# #) -> r) -> r
$bMountainGoat :: Zodiac
MountainGoat = Capricorn

-- | An English name for the 'Capricorn' zodiac sign.
pattern GoatHorned :: Zodiac
pattern $mGoatHorned :: forall {r}. Zodiac -> ((# #) -> r) -> ((# #) -> r) -> r
$bGoatHorned :: Zodiac
GoatHorned = Capricorn

-- | An English name for the 'Capricorn' zodiac sign.
pattern SeaGoat :: Zodiac
pattern $mSeaGoat :: forall {r}. Zodiac -> ((# #) -> r) -> ((# #) -> r) -> r
$bSeaGoat :: Zodiac
SeaGoat = Capricorn

-- | The English name for the 'Aquarius' zodiac sign.
pattern WaterBearer :: Zodiac
pattern $mWaterBearer :: forall {r}. Zodiac -> ((# #) -> r) -> ((# #) -> r) -> r
$bWaterBearer :: Zodiac
WaterBearer = Aquarius

-- | The English name for the 'Pisces' zodiac sign.
pattern Fish :: Zodiac
pattern $mFish :: forall {r}. Zodiac -> ((# #) -> r) -> ((# #) -> r) -> r
$bFish :: Zodiac
Fish = Pisces