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

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

instance Hashable MoonPhase

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

instance NFData MoonPhase

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

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

instance Hashable MoonFace

instance MirrorVertical MoonFace where
  mirrorVertical :: MoonFace -> MoonFace
mirrorVertical = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
3 forall a. Num a => a -> a -> a
-) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' = forall a. a -> Maybe a
Just MoonFace
NewMoonFace
  fromUnicodeChar Char
'\x1f31b' = forall a. a -> Maybe a
Just MoonFace
FirstQuarterFace
  fromUnicodeChar Char
'\x1f31d' = forall a. a -> Maybe a
Just MoonFace
FullMoonFace
  fromUnicodeChar Char
'\x1f31c' = forall a. a -> Maybe a
Just MoonFace
ThirdQuarterFace
  fromUnicodeChar Char
_ = forall a. Maybe a
Nothing
  isInCharRange :: Char -> Bool
isInCharRange Char
c = Char
'\x1f31a' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c 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