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

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

instance Hashable Zodiac

instance NFData Zodiac

instance UnicodeCharacter Zodiac where
    toUnicodeChar :: Zodiac -> Char
toUnicodeChar = forall a. Enum a => Int -> a -> Char
mapFromEnum Int
_zodiacOffset
    fromUnicodeChar :: Char -> Maybe Zodiac
fromUnicodeChar = forall a. (Bounded a, Enum a) => Int -> Char -> Maybe a
mapToEnumSafe Int
_zodiacOffset
    fromUnicodeChar' :: Char -> Zodiac
fromUnicodeChar' = forall a. Enum a => Int -> Char -> a
mapToEnum Int
_zodiacOffset
    isInCharRange :: Char -> Bool
isInCharRange Char
c = Char
'\x2648' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c 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 $bRam :: Zodiac
$mRam :: forall {r}. Zodiac -> ((# #) -> r) -> ((# #) -> r) -> r
Ram = Aries

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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