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

-- |
-- Module      : Data.Char.Emoji.Moon
-- Description : A module that defines moon emoji.
-- Maintainer  : hapytexeu+gh@gmail.com
-- Stability   : experimental
-- Portability : POSIX
--
-- Unicode has two types of emoji for the moon: it contains eight emoji for the moonphase, and four
-- emoji where the moon has a face.
module Data.Char.Emoji.Moon
  ( -- * Moon phase emoji
    MoonPhase (NewMoon, WaxingCrescent, FirstQuarter, WaxingGibbous, FullMoon, WaningGibbous, ThirdQuarter, WaningCrescent),

    -- * Moon faces emoji
    MoonFace (NewMoonFace, FirstQuarterFace, FullMoonFace, ThirdQuarterFace),
    moonPhaseForDay,
  )
where

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

_moonPhaseOffset :: Int
_moonPhaseOffset :: Int
_moonPhaseOffset = Int
0x1f311

-- | A data type that defines the eight different moon phases, and is an
-- instance of 'UnicodeCharacter' to convert these to the corresponding Unicode
-- character.
data MoonPhase
  = -- | The /new moon/, the first phase of the moon represented by 🌑.
    NewMoon
  | -- | The /waxing crescent/, the second phase of the moon represented by 🌒.
    WaxingCrescent
  | -- | The /first quarter/, the third phase of the moon represented by 🌓.
    FirstQuarter
  | -- | The /waxing gibbous/, the fourth phase of the moon represented by 🌔.
    WaxingGibbous
  | -- | The /full moon/, the fifth phase of the moon represented by 🌕.
    FullMoon
  | -- | The /waning gibbous/, the sixth phase of the moon represented by 🌖.
    WaningGibbous
  | -- | The /third quarter/, the seventh phase of the moon represented by 🌗.
    ThirdQuarter
  | -- | The /waning crescent/, the eighth phase of the moon represented by 🌘.
    WaningCrescent
  deriving (MoonPhase
MoonPhase -> MoonPhase -> Bounded MoonPhase
forall a. a -> a -> Bounded a
$cminBound :: MoonPhase
minBound :: MoonPhase
$cmaxBound :: MoonPhase
maxBound :: MoonPhase
Bounded, Typeable MoonPhase
Typeable MoonPhase
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> MoonPhase -> c MoonPhase)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MoonPhase)
-> (MoonPhase -> Constr)
-> (MoonPhase -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c MoonPhase))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MoonPhase))
-> ((forall b. Data b => b -> b) -> MoonPhase -> MoonPhase)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> MoonPhase -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> MoonPhase -> r)
-> (forall u. (forall d. Data d => d -> u) -> MoonPhase -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> MoonPhase -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> MoonPhase -> m MoonPhase)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MoonPhase -> m MoonPhase)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MoonPhase -> m MoonPhase)
-> Data MoonPhase
MoonPhase -> Constr
MoonPhase -> DataType
(forall b. Data b => b -> b) -> MoonPhase -> MoonPhase
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) -> MoonPhase -> u
forall u. (forall d. Data d => d -> u) -> MoonPhase -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MoonPhase -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MoonPhase -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MoonPhase -> m MoonPhase
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MoonPhase -> m MoonPhase
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MoonPhase
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MoonPhase -> c MoonPhase
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MoonPhase)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MoonPhase)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MoonPhase -> c MoonPhase
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MoonPhase -> c MoonPhase
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MoonPhase
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MoonPhase
$ctoConstr :: MoonPhase -> Constr
toConstr :: MoonPhase -> Constr
$cdataTypeOf :: MoonPhase -> DataType
dataTypeOf :: MoonPhase -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MoonPhase)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MoonPhase)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MoonPhase)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MoonPhase)
$cgmapT :: (forall b. Data b => b -> b) -> MoonPhase -> MoonPhase
gmapT :: (forall b. Data b => b -> b) -> MoonPhase -> MoonPhase
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MoonPhase -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MoonPhase -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MoonPhase -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MoonPhase -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MoonPhase -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> MoonPhase -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MoonPhase -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MoonPhase -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MoonPhase -> m MoonPhase
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MoonPhase -> m MoonPhase
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MoonPhase -> m MoonPhase
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MoonPhase -> m MoonPhase
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MoonPhase -> m MoonPhase
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MoonPhase -> m MoonPhase
Data, Int -> MoonPhase
MoonPhase -> Int
MoonPhase -> [MoonPhase]
MoonPhase -> MoonPhase
MoonPhase -> MoonPhase -> [MoonPhase]
MoonPhase -> MoonPhase -> MoonPhase -> [MoonPhase]
(MoonPhase -> MoonPhase)
-> (MoonPhase -> MoonPhase)
-> (Int -> MoonPhase)
-> (MoonPhase -> Int)
-> (MoonPhase -> [MoonPhase])
-> (MoonPhase -> MoonPhase -> [MoonPhase])
-> (MoonPhase -> MoonPhase -> [MoonPhase])
-> (MoonPhase -> MoonPhase -> MoonPhase -> [MoonPhase])
-> Enum MoonPhase
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 :: MoonPhase -> MoonPhase
succ :: MoonPhase -> MoonPhase
$cpred :: MoonPhase -> MoonPhase
pred :: MoonPhase -> MoonPhase
$ctoEnum :: Int -> MoonPhase
toEnum :: Int -> MoonPhase
$cfromEnum :: MoonPhase -> Int
fromEnum :: MoonPhase -> Int
$cenumFrom :: MoonPhase -> [MoonPhase]
enumFrom :: MoonPhase -> [MoonPhase]
$cenumFromThen :: MoonPhase -> MoonPhase -> [MoonPhase]
enumFromThen :: MoonPhase -> MoonPhase -> [MoonPhase]
$cenumFromTo :: MoonPhase -> MoonPhase -> [MoonPhase]
enumFromTo :: MoonPhase -> MoonPhase -> [MoonPhase]
$cenumFromThenTo :: MoonPhase -> MoonPhase -> MoonPhase -> [MoonPhase]
enumFromThenTo :: MoonPhase -> MoonPhase -> MoonPhase -> [MoonPhase]
Enum, MoonPhase -> MoonPhase -> Bool
(MoonPhase -> MoonPhase -> Bool)
-> (MoonPhase -> MoonPhase -> Bool) -> Eq MoonPhase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MoonPhase -> MoonPhase -> Bool
== :: MoonPhase -> MoonPhase -> Bool
$c/= :: MoonPhase -> MoonPhase -> Bool
/= :: MoonPhase -> MoonPhase -> Bool
Eq, (forall x. MoonPhase -> Rep MoonPhase x)
-> (forall x. Rep MoonPhase x -> MoonPhase) -> Generic MoonPhase
forall x. Rep MoonPhase x -> MoonPhase
forall x. MoonPhase -> Rep MoonPhase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MoonPhase -> Rep MoonPhase x
from :: forall x. MoonPhase -> Rep MoonPhase x
$cto :: forall x. Rep MoonPhase x -> MoonPhase
to :: forall x. Rep MoonPhase x -> MoonPhase
Generic, Eq MoonPhase
Eq MoonPhase
-> (MoonPhase -> MoonPhase -> Ordering)
-> (MoonPhase -> MoonPhase -> Bool)
-> (MoonPhase -> MoonPhase -> Bool)
-> (MoonPhase -> MoonPhase -> Bool)
-> (MoonPhase -> MoonPhase -> Bool)
-> (MoonPhase -> MoonPhase -> MoonPhase)
-> (MoonPhase -> MoonPhase -> MoonPhase)
-> Ord MoonPhase
MoonPhase -> MoonPhase -> Bool
MoonPhase -> MoonPhase -> Ordering
MoonPhase -> MoonPhase -> MoonPhase
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 :: MoonPhase -> MoonPhase -> Ordering
compare :: MoonPhase -> MoonPhase -> Ordering
$c< :: MoonPhase -> MoonPhase -> Bool
< :: MoonPhase -> MoonPhase -> Bool
$c<= :: MoonPhase -> MoonPhase -> Bool
<= :: MoonPhase -> MoonPhase -> Bool
$c> :: MoonPhase -> MoonPhase -> Bool
> :: MoonPhase -> MoonPhase -> Bool
$c>= :: MoonPhase -> MoonPhase -> Bool
>= :: MoonPhase -> MoonPhase -> Bool
$cmax :: MoonPhase -> MoonPhase -> MoonPhase
max :: MoonPhase -> MoonPhase -> MoonPhase
$cmin :: MoonPhase -> MoonPhase -> MoonPhase
min :: MoonPhase -> MoonPhase -> MoonPhase
Ord, ReadPrec [MoonPhase]
ReadPrec MoonPhase
Int -> ReadS MoonPhase
ReadS [MoonPhase]
(Int -> ReadS MoonPhase)
-> ReadS [MoonPhase]
-> ReadPrec MoonPhase
-> ReadPrec [MoonPhase]
-> Read MoonPhase
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MoonPhase
readsPrec :: Int -> ReadS MoonPhase
$creadList :: ReadS [MoonPhase]
readList :: ReadS [MoonPhase]
$creadPrec :: ReadPrec MoonPhase
readPrec :: ReadPrec MoonPhase
$creadListPrec :: ReadPrec [MoonPhase]
readListPrec :: ReadPrec [MoonPhase]
Read, Int -> MoonPhase -> ShowS
[MoonPhase] -> ShowS
MoonPhase -> String
(Int -> MoonPhase -> ShowS)
-> (MoonPhase -> String)
-> ([MoonPhase] -> ShowS)
-> Show MoonPhase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MoonPhase -> ShowS
showsPrec :: Int -> MoonPhase -> ShowS
$cshow :: MoonPhase -> String
show :: MoonPhase -> String
$cshowList :: [MoonPhase] -> ShowS
showList :: [MoonPhase] -> ShowS
Show)

-- | Determine the corresponding MoonPhase emoji for a given day. The algorithm is based on
-- upon a subsystems publication <https://www.subsystems.us/uploads/9/8/9/4/98948044/moonphase.pdf>
moonPhaseForDay ::
  -- | The 'Day' for which we want to deterime the moon phase.
  Day ->
  -- | The corresponding 'MoonPhase' icon
  MoonPhase
moonPhaseForDay :: Day -> MoonPhase
moonPhaseForDay Day
d = Int -> MoonPhase
forall a. Enum a => Int -> a
toEnum (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (((Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Day -> Integer
toModifiedJulianDay Day
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
57812) :: Double) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.845625) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3.69125) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8)

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

instance Hashable MoonPhase

instance MirrorVertical MoonPhase where
  mirrorVertical :: MoonPhase -> MoonPhase
mirrorVertical = Int -> MoonPhase
forall a. Enum a => Int -> a
toEnum (Int -> MoonPhase) -> (MoonPhase -> Int) -> MoonPhase -> MoonPhase
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8) (Int -> Int) -> (MoonPhase -> Int) -> MoonPhase -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
-) (Int -> Int) -> (MoonPhase -> Int) -> MoonPhase -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MoonPhase -> Int
forall a. Enum a => a -> Int
fromEnum

instance NFData MoonPhase

instance UnicodeCharacter MoonPhase where
  toUnicodeChar :: MoonPhase -> Char
toUnicodeChar = Int -> MoonPhase -> Char
forall a. Enum a => Int -> a -> Char
mapFromEnum Int
_moonPhaseOffset
  fromUnicodeChar :: Char -> Maybe MoonPhase
fromUnicodeChar = Int -> Char -> Maybe MoonPhase
forall a. (Bounded a, Enum a) => Int -> Char -> Maybe a
mapToEnumSafe Int
_moonPhaseOffset
  fromUnicodeChar' :: Char -> MoonPhase
fromUnicodeChar' = Int -> Char -> MoonPhase
forall a. Enum a => Int -> Char -> a
mapToEnum Int
_moonPhaseOffset
  isInCharRange :: Char -> Bool
isInCharRange Char
c = Char
'\x1f311' 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
'\x1f318'

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

-- | A data type that defines the four different moon faces (not to be confused with
-- phases). This data type is an instance of the 'UnicodeCharacter' type class
-- to convert these to the corresponding Unicode character.
data MoonFace
  = -- | The /new moon/, the first phase of the moon faces represented by 🌚.
    NewMoonFace
  | -- | The /first quarter/, the second phase of the moon faces represented by 🌛.
    FirstQuarterFace
  | -- | The /full moon/, the third phase of the moon faces represented by 🌝.
    FullMoonFace
  | -- | The /third quarter/, the fourth phase of the moon faces represented by 🌜.
    ThirdQuarterFace
  deriving (MoonFace
MoonFace -> MoonFace -> Bounded MoonFace
forall a. a -> a -> Bounded a
$cminBound :: MoonFace
minBound :: MoonFace
$cmaxBound :: MoonFace
maxBound :: MoonFace
Bounded, Typeable MoonFace
Typeable MoonFace
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> MoonFace -> c MoonFace)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MoonFace)
-> (MoonFace -> Constr)
-> (MoonFace -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c MoonFace))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MoonFace))
-> ((forall b. Data b => b -> b) -> MoonFace -> MoonFace)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> MoonFace -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> MoonFace -> r)
-> (forall u. (forall d. Data d => d -> u) -> MoonFace -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> MoonFace -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> MoonFace -> m MoonFace)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MoonFace -> m MoonFace)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MoonFace -> m MoonFace)
-> Data MoonFace
MoonFace -> Constr
MoonFace -> DataType
(forall b. Data b => b -> b) -> MoonFace -> MoonFace
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) -> MoonFace -> u
forall u. (forall d. Data d => d -> u) -> MoonFace -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MoonFace -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MoonFace -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MoonFace -> m MoonFace
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MoonFace -> m MoonFace
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MoonFace
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MoonFace -> c MoonFace
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MoonFace)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MoonFace)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MoonFace -> c MoonFace
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MoonFace -> c MoonFace
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MoonFace
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MoonFace
$ctoConstr :: MoonFace -> Constr
toConstr :: MoonFace -> Constr
$cdataTypeOf :: MoonFace -> DataType
dataTypeOf :: MoonFace -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MoonFace)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MoonFace)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MoonFace)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MoonFace)
$cgmapT :: (forall b. Data b => b -> b) -> MoonFace -> MoonFace
gmapT :: (forall b. Data b => b -> b) -> MoonFace -> MoonFace
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MoonFace -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MoonFace -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MoonFace -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MoonFace -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MoonFace -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> MoonFace -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MoonFace -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MoonFace -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MoonFace -> m MoonFace
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MoonFace -> m MoonFace
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MoonFace -> m MoonFace
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MoonFace -> m MoonFace
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MoonFace -> m MoonFace
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MoonFace -> m MoonFace
Data, Int -> MoonFace
MoonFace -> Int
MoonFace -> [MoonFace]
MoonFace -> MoonFace
MoonFace -> MoonFace -> [MoonFace]
MoonFace -> MoonFace -> MoonFace -> [MoonFace]
(MoonFace -> MoonFace)
-> (MoonFace -> MoonFace)
-> (Int -> MoonFace)
-> (MoonFace -> Int)
-> (MoonFace -> [MoonFace])
-> (MoonFace -> MoonFace -> [MoonFace])
-> (MoonFace -> MoonFace -> [MoonFace])
-> (MoonFace -> MoonFace -> MoonFace -> [MoonFace])
-> Enum MoonFace
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 :: MoonFace -> MoonFace
succ :: MoonFace -> MoonFace
$cpred :: MoonFace -> MoonFace
pred :: MoonFace -> MoonFace
$ctoEnum :: Int -> MoonFace
toEnum :: Int -> MoonFace
$cfromEnum :: MoonFace -> Int
fromEnum :: MoonFace -> Int
$cenumFrom :: MoonFace -> [MoonFace]
enumFrom :: MoonFace -> [MoonFace]
$cenumFromThen :: MoonFace -> MoonFace -> [MoonFace]
enumFromThen :: MoonFace -> MoonFace -> [MoonFace]
$cenumFromTo :: MoonFace -> MoonFace -> [MoonFace]
enumFromTo :: MoonFace -> MoonFace -> [MoonFace]
$cenumFromThenTo :: MoonFace -> MoonFace -> MoonFace -> [MoonFace]
enumFromThenTo :: MoonFace -> MoonFace -> MoonFace -> [MoonFace]
Enum, MoonFace -> MoonFace -> Bool
(MoonFace -> MoonFace -> Bool)
-> (MoonFace -> MoonFace -> Bool) -> Eq MoonFace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MoonFace -> MoonFace -> Bool
== :: MoonFace -> MoonFace -> Bool
$c/= :: MoonFace -> MoonFace -> Bool
/= :: MoonFace -> MoonFace -> Bool
Eq, (forall x. MoonFace -> Rep MoonFace x)
-> (forall x. Rep MoonFace x -> MoonFace) -> Generic MoonFace
forall x. Rep MoonFace x -> MoonFace
forall x. MoonFace -> Rep MoonFace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MoonFace -> Rep MoonFace x
from :: forall x. MoonFace -> Rep MoonFace x
$cto :: forall x. Rep MoonFace x -> MoonFace
to :: forall x. Rep MoonFace x -> MoonFace
Generic, Eq MoonFace
Eq MoonFace
-> (MoonFace -> MoonFace -> Ordering)
-> (MoonFace -> MoonFace -> Bool)
-> (MoonFace -> MoonFace -> Bool)
-> (MoonFace -> MoonFace -> Bool)
-> (MoonFace -> MoonFace -> Bool)
-> (MoonFace -> MoonFace -> MoonFace)
-> (MoonFace -> MoonFace -> MoonFace)
-> Ord MoonFace
MoonFace -> MoonFace -> Bool
MoonFace -> MoonFace -> Ordering
MoonFace -> MoonFace -> MoonFace
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 :: MoonFace -> MoonFace -> Ordering
compare :: MoonFace -> MoonFace -> Ordering
$c< :: MoonFace -> MoonFace -> Bool
< :: MoonFace -> MoonFace -> Bool
$c<= :: MoonFace -> MoonFace -> Bool
<= :: MoonFace -> MoonFace -> Bool
$c> :: MoonFace -> MoonFace -> Bool
> :: MoonFace -> MoonFace -> Bool
$c>= :: MoonFace -> MoonFace -> Bool
>= :: MoonFace -> MoonFace -> Bool
$cmax :: MoonFace -> MoonFace -> MoonFace
max :: MoonFace -> MoonFace -> MoonFace
$cmin :: MoonFace -> MoonFace -> MoonFace
min :: MoonFace -> MoonFace -> MoonFace
Ord, ReadPrec [MoonFace]
ReadPrec MoonFace
Int -> ReadS MoonFace
ReadS [MoonFace]
(Int -> ReadS MoonFace)
-> ReadS [MoonFace]
-> ReadPrec MoonFace
-> ReadPrec [MoonFace]
-> Read MoonFace
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MoonFace
readsPrec :: Int -> ReadS MoonFace
$creadList :: ReadS [MoonFace]
readList :: ReadS [MoonFace]
$creadPrec :: ReadPrec MoonFace
readPrec :: ReadPrec MoonFace
$creadListPrec :: ReadPrec [MoonFace]
readListPrec :: ReadPrec [MoonFace]
Read, Int -> MoonFace -> ShowS
[MoonFace] -> ShowS
MoonFace -> String
(Int -> MoonFace -> ShowS)
-> (MoonFace -> String) -> ([MoonFace] -> ShowS) -> Show MoonFace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MoonFace -> ShowS
showsPrec :: Int -> MoonFace -> ShowS
$cshow :: MoonFace -> String
show :: MoonFace -> String
$cshowList :: [MoonFace] -> ShowS
showList :: [MoonFace] -> ShowS
Show)

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

instance Hashable MoonFace

instance MirrorVertical MoonFace where
  mirrorVertical :: MoonFace -> MoonFace
mirrorVertical = Int -> MoonFace
forall a. Enum a => Int -> a
toEnum (Int -> MoonFace) -> (MoonFace -> Int) -> MoonFace -> MoonFace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
-) (Int -> Int) -> (MoonFace -> Int) -> MoonFace -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MoonFace -> Int
forall a. Enum a => a -> Int
fromEnum

instance NFData MoonFace

instance UnicodeCharacter MoonFace where
  toUnicodeChar :: MoonFace -> Char
toUnicodeChar MoonFace
NewMoonFace = Char
'\x1f31a'
  toUnicodeChar MoonFace
FirstQuarterFace = Char
'\x1f31b'
  toUnicodeChar MoonFace
FullMoonFace = Char
'\x1F31d'
  toUnicodeChar MoonFace
ThirdQuarterFace = Char
'\x1f31c'
  fromUnicodeChar :: Char -> Maybe MoonFace
fromUnicodeChar Char
'\x1f31a' = MoonFace -> Maybe MoonFace
forall a. a -> Maybe a
Just MoonFace
NewMoonFace
  fromUnicodeChar Char
'\x1f31b' = MoonFace -> Maybe MoonFace
forall a. a -> Maybe a
Just MoonFace
FirstQuarterFace
  fromUnicodeChar Char
'\x1f31d' = MoonFace -> Maybe MoonFace
forall a. a -> Maybe a
Just MoonFace
FullMoonFace
  fromUnicodeChar Char
'\x1f31c' = MoonFace -> Maybe MoonFace
forall a. a -> Maybe a
Just MoonFace
ThirdQuarterFace
  fromUnicodeChar Char
_ = Maybe MoonFace
forall a. Maybe a
Nothing
  isInCharRange :: Char -> Bool
isInCharRange Char
c = Char
'\x1f31a' 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
'\x1f31d'

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