{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      : Data.Char.Domino
-- Description : A module that defines domino values, and their unicode equivalent.
-- Maintainer  : hapytexeu+gh@gmail.com
-- Stability   : experimental
-- Portability : POSIX
--
-- A module that defines values for domino pieces, and converts these to unicode characters of the <https://www.unicode.org/charts/PDF/U1F030.pdf 1F030 unicode block>.
module Data.Char.Domino
  ( -- * Data types to represent domino values
    Domino (Domino, Back, leftTop, rightBottom),
    pattern (:|),
    OrientedDomino,
    SimpleDomino,
    ComplexDomino,

    -- * Render domino values
    dominoH,
    dominoH',
    dominoV,
    dominoV',
    domino,
    domino',

    -- * Convert from 'Char'acters
    fromDomino,
    fromDomino',
  )
where

import Control.DeepSeq (NFData, NFData1)
import Control.Monad ((>=>))
import Data.Char (chr, ord)
import Data.Char.Core (MirrorHorizontal (mirrorHorizontal), MirrorVertical (mirrorVertical), Orientation (Horizontal, Vertical), Oriented (Oriented), UnicodeCharacter (fromUnicodeChar, fromUnicodeChar', isInCharRange, toUnicodeChar), UnicodeText (isInTextRange), generateIsInTextRange')
import Data.Char.Dice (DieValue)
import Data.Data (Data)
import Data.Function (on)
import Data.Functor.Classes (Eq1 (liftEq), Ord1 (liftCompare))
import Data.Hashable (Hashable)
import Data.Hashable.Lifted (Hashable1)
#if __GLASGOW_HASKELL__ < 803
import Data.Semigroup((<>))
#endif

import GHC.Generics (Generic, Generic1)
import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary), Arbitrary1 (liftArbitrary), arbitrary1)
import Test.QuickCheck.Gen (frequency)

-- | A domino piece, which has two items. Depending on the orientation, the
-- items are located at the /top/ and /bottom/; or /left/ and /right/.
data Domino a
  = -- | The front side of the domino piece.
    Domino
      { -- | The part that is located at the /left/ side in case the piece is located /horizontally/, or at the /top/ in case the piece is located /vertically/.
        forall a. Domino a -> a
leftTop :: a,
        -- | The part that is located at the /right/ side in case the piece is located /horizontally/, or at the /bottom/ in case the piece is located /vertically/.
        forall a. Domino a -> a
rightBottom :: a
      }
  | -- | The back side of the domino piece.
    Back
  deriving (Domino a -> DataType
Domino a -> Constr
forall {a}. Data a => Typeable (Domino a)
forall a. Data a => Domino a -> DataType
forall a. Data a => Domino a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> Domino a -> Domino a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Domino a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Domino a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Domino a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Domino a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Domino a -> m (Domino a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Domino a -> m (Domino a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Domino a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Domino a -> c (Domino a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Domino a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Domino a))
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 (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Domino a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Domino a -> c (Domino a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Domino a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Domino a -> m (Domino a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Domino a -> m (Domino a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Domino a -> m (Domino a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Domino a -> m (Domino a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Domino a -> m (Domino a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Domino a -> m (Domino a)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Domino a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Domino a -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Domino a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Domino a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Domino a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Domino a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Domino a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Domino a -> r
gmapT :: (forall b. Data b => b -> b) -> Domino a -> Domino a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Domino a -> Domino a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Domino a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Domino a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Domino a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Domino a))
dataTypeOf :: Domino a -> DataType
$cdataTypeOf :: forall a. Data a => Domino a -> DataType
toConstr :: Domino a -> Constr
$ctoConstr :: forall a. Data a => Domino a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Domino a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Domino a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Domino a -> c (Domino a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Domino a -> c (Domino a)
Data, Domino a -> Domino a -> Bool
forall a. Eq a => Domino a -> Domino a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Domino a -> Domino a -> Bool
$c/= :: forall a. Eq a => Domino a -> Domino a -> Bool
== :: Domino a -> Domino a -> Bool
$c== :: forall a. Eq a => Domino a -> Domino a -> Bool
Eq, forall a. Eq a => a -> Domino a -> Bool
forall a. Num a => Domino a -> a
forall a. Ord a => Domino a -> a
forall m. Monoid m => Domino m -> m
forall a. Domino a -> Bool
forall a. Domino a -> Int
forall a. Domino a -> [a]
forall a. (a -> a -> a) -> Domino a -> a
forall m a. Monoid m => (a -> m) -> Domino a -> m
forall b a. (b -> a -> b) -> b -> Domino a -> b
forall a b. (a -> b -> b) -> b -> Domino a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Domino a -> a
$cproduct :: forall a. Num a => Domino a -> a
sum :: forall a. Num a => Domino a -> a
$csum :: forall a. Num a => Domino a -> a
minimum :: forall a. Ord a => Domino a -> a
$cminimum :: forall a. Ord a => Domino a -> a
maximum :: forall a. Ord a => Domino a -> a
$cmaximum :: forall a. Ord a => Domino a -> a
elem :: forall a. Eq a => a -> Domino a -> Bool
$celem :: forall a. Eq a => a -> Domino a -> Bool
length :: forall a. Domino a -> Int
$clength :: forall a. Domino a -> Int
null :: forall a. Domino a -> Bool
$cnull :: forall a. Domino a -> Bool
toList :: forall a. Domino a -> [a]
$ctoList :: forall a. Domino a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Domino a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Domino a -> a
foldr1 :: forall a. (a -> a -> a) -> Domino a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Domino a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Domino a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Domino a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Domino a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Domino a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Domino a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Domino a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Domino a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Domino a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Domino a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Domino a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Domino a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Domino a -> m
fold :: forall m. Monoid m => Domino m -> m
$cfold :: forall m. Monoid m => Domino m -> m
Foldable, forall a b. a -> Domino b -> Domino a
forall a b. (a -> b) -> Domino a -> Domino b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Domino b -> Domino a
$c<$ :: forall a b. a -> Domino b -> Domino a
fmap :: forall a b. (a -> b) -> Domino a -> Domino b
$cfmap :: forall a b. (a -> b) -> Domino a -> Domino b
Functor, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Domino a) x -> Domino a
forall a x. Domino a -> Rep (Domino a) x
$cto :: forall a x. Rep (Domino a) x -> Domino a
$cfrom :: forall a x. Domino a -> Rep (Domino a) x
Generic, forall a. Rep1 Domino a -> Domino a
forall a. Domino a -> Rep1 Domino a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Domino a -> Domino a
$cfrom1 :: forall a. Domino a -> Rep1 Domino a
Generic1, Domino a -> Domino a -> Bool
Domino a -> Domino a -> Ordering
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
forall {a}. Ord a => Eq (Domino a)
forall a. Ord a => Domino a -> Domino a -> Bool
forall a. Ord a => Domino a -> Domino a -> Ordering
forall a. Ord a => Domino a -> Domino a -> Domino a
min :: Domino a -> Domino a -> Domino a
$cmin :: forall a. Ord a => Domino a -> Domino a -> Domino a
max :: Domino a -> Domino a -> Domino a
$cmax :: forall a. Ord a => Domino a -> Domino a -> Domino a
>= :: Domino a -> Domino a -> Bool
$c>= :: forall a. Ord a => Domino a -> Domino a -> Bool
> :: Domino a -> Domino a -> Bool
$c> :: forall a. Ord a => Domino a -> Domino a -> Bool
<= :: Domino a -> Domino a -> Bool
$c<= :: forall a. Ord a => Domino a -> Domino a -> Bool
< :: Domino a -> Domino a -> Bool
$c< :: forall a. Ord a => Domino a -> Domino a -> Bool
compare :: Domino a -> Domino a -> Ordering
$ccompare :: forall a. Ord a => Domino a -> Domino a -> Ordering
Ord, ReadPrec [Domino a]
ReadPrec (Domino a)
ReadS [Domino a]
forall a. Read a => ReadPrec [Domino a]
forall a. Read a => ReadPrec (Domino a)
forall a. Read a => Int -> ReadS (Domino a)
forall a. Read a => ReadS [Domino a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Domino a]
$creadListPrec :: forall a. Read a => ReadPrec [Domino a]
readPrec :: ReadPrec (Domino a)
$creadPrec :: forall a. Read a => ReadPrec (Domino a)
readList :: ReadS [Domino a]
$creadList :: forall a. Read a => ReadS [Domino a]
readsPrec :: Int -> ReadS (Domino a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Domino a)
Read, Int -> Domino a -> ShowS
forall a. Show a => Int -> Domino a -> ShowS
forall a. Show a => [Domino a] -> ShowS
forall a. Show a => Domino a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Domino a] -> ShowS
$cshowList :: forall a. Show a => [Domino a] -> ShowS
show :: Domino a -> String
$cshow :: forall a. Show a => Domino a -> String
showsPrec :: Int -> Domino a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Domino a -> ShowS
Show, Functor Domino
Foldable Domino
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Domino (m a) -> m (Domino a)
forall (f :: * -> *) a.
Applicative f =>
Domino (f a) -> f (Domino a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Domino a -> m (Domino b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Domino a -> f (Domino b)
sequence :: forall (m :: * -> *) a. Monad m => Domino (m a) -> m (Domino a)
$csequence :: forall (m :: * -> *) a. Monad m => Domino (m a) -> m (Domino a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Domino a -> m (Domino b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Domino a -> m (Domino b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Domino (f a) -> f (Domino a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Domino (f a) -> f (Domino a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Domino a -> f (Domino b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Domino a -> f (Domino b)
Traversable)

instance Eq1 Domino where
  liftEq :: forall a b. (a -> b -> Bool) -> Domino a -> Domino b -> Bool
liftEq a -> b -> Bool
cmp (Domino a
lta a
rba) (Domino b
ltb b
rbb) = a -> b -> Bool
cmp a
lta b
ltb Bool -> Bool -> Bool
&& a -> b -> Bool
cmp a
rba b
rbb
  liftEq a -> b -> Bool
_ Domino a
Back Domino b
Back = Bool
True
  liftEq a -> b -> Bool
_ Domino a
_ Domino b
_ = Bool
False

instance Hashable1 Domino

instance Hashable a => Hashable (Domino a)

instance NFData a => NFData (Domino a)

instance NFData1 Domino

instance Ord1 Domino where
  liftCompare :: forall a b.
(a -> b -> Ordering) -> Domino a -> Domino b -> Ordering
liftCompare a -> b -> Ordering
cmp (Domino a
lta a
rba) (Domino b
ltb b
rbb) = a -> b -> Ordering
cmp a
lta b
ltb forall a. Semigroup a => a -> a -> a
<> a -> b -> Ordering
cmp a
rba b
rbb
  liftCompare a -> b -> Ordering
_ (Domino a
_ a
_) Domino b
Back = Ordering
LT
  liftCompare a -> b -> Ordering
_ Domino a
Back Domino b
Back = Ordering
EQ
  liftCompare a -> b -> Ordering
_ Domino a
Back (Domino b
_ b
_) = Ordering
GT

-- | A pattern synonym that makes it more convenient to write expressions that
-- look like domino's like for example @II :| IV@.
pattern (:|) ::
  -- | The item that is located at the left, or the top.
  a ->
  -- | The item that is located at the right, or the bottom.
  a ->
  -- | The domino that is constructed.
  Domino a
pattern $b:| :: forall a. a -> a -> Domino a
$m:| :: forall {r} {a}. Domino a -> (a -> a -> r) -> ((# #) -> r) -> r
(:|) x y = Domino x y

-- | A type alias that specifies that 'OrientedDomino' is an 'Oriented' type
-- that wraps a 'Domino' item.
type OrientedDomino a = Oriented (Domino a)

-- | A 'SimpleDomino' is a 'Domino' that contains 'DieValue' objects, it thus
-- can not have an "empty" value.
type SimpleDomino = Domino DieValue

-- | A 'ComplexDomino' is a 'Domino' that contains 'Maybe' values wrapping a
-- 'DieValue'. In case of a 'Nothing', that side is considered /empty/.
type ComplexDomino = Domino (Maybe DieValue)

instance Applicative Domino where
  pure :: forall a. a -> Domino a
pure a
x = forall a. a -> a -> Domino a
Domino a
x a
x
  Domino a -> b
fa a -> b
fb <*> :: forall a b. Domino (a -> b) -> Domino a -> Domino b
<*> Domino a
a a
b = forall a. a -> a -> Domino a
Domino (a -> b
fa a
a) (a -> b
fb a
b)
  Domino (a -> b)
_ <*> Domino a
_ = forall a. Domino a
Back

instance Arbitrary a => Arbitrary (Domino a) where
  arbitrary :: Gen (Domino a)
arbitrary = forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
arbitrary1

instance Arbitrary1 Domino where
  liftArbitrary :: forall a. Gen a -> Gen (Domino a)
liftArbitrary Gen a
arb = forall a. [(Int, Gen a)] -> Gen a
frequency [(Int
1, forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Domino a
Back), (Int
3, forall a. a -> a -> Domino a
Domino forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
arb forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
arb)]

instance Bounded a => Bounded (Domino a) where
  minBound :: Domino a
minBound = forall a. a -> a -> Domino a
Domino forall a. Bounded a => a
minBound forall a. Bounded a => a
minBound
  maxBound :: Domino a
maxBound = forall a. Domino a
Back

_offsetDominoHorizontal :: Int
_offsetDominoHorizontal :: Int
_offsetDominoHorizontal = Int
0x1f030

_offsetDominoVertical :: Int
_offsetDominoVertical :: Int
_offsetDominoVertical = Int
0x1f062

_domino :: Int -> ComplexDomino -> Char
_domino :: Int -> Domino (Maybe DieValue) -> Char
_domino Int
n = forall {a}. Enum a => Domino (Maybe a) -> Char
go
  where
    go :: Domino (Maybe a) -> Char
go Domino (Maybe a)
Back = Int -> Char
chr Int
n
    go (Domino Maybe a
a Maybe a
b) = Int -> Char
chr (Int
7 forall a. Num a => a -> a -> a
* forall {a}. Enum a => Maybe a -> Int
_val Maybe a
a forall a. Num a => a -> a -> a
+ forall {a}. Enum a => Maybe a -> Int
_val Maybe a
b forall a. Num a => a -> a -> a
+ Int
n forall a. Num a => a -> a -> a
+ Int
1)
    _val :: Maybe a -> Int
_val Maybe a
Nothing = Int
0
    _val (Just a
x) = Int
1 forall a. Num a => a -> a -> a
+ forall a. Enum a => a -> Int
fromEnum a
x

_fromDomino :: Int -> ComplexDomino
_fromDomino :: Int -> Domino (Maybe DieValue)
_fromDomino (-1) = forall a. Domino a
Back
_fromDomino Int
n = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. a -> a -> Domino a
Domino forall {a}. Enum a => Int -> Maybe a
go Int
a Int
b
  where
    (Int
a, Int
b) = forall a. Integral a => a -> a -> (a, a)
quotRem Int
n Int
7
    go :: Int -> Maybe a
go Int
0 = forall a. Maybe a
Nothing
    go Int
k = forall a. a -> Maybe a
Just (forall a. Enum a => Int -> a
toEnum (Int
k forall a. Num a => a -> a -> a
- Int
1))

-- | Convert the given 'Char'acter to an 'Oriented' 'ComplexDomino' object. If
-- the given 'Char'acter is not a valid domino character, the result is
-- unspecified.
fromDomino' ::
  -- | The given 'Char'acter to convert to an 'Oriented' 'ComplexDomino' object.
  Char ->
  -- | The equivalent 'Oriented' 'ComplexDomino' object for the given 'Char'acter.
  Oriented ComplexDomino
fromDomino' :: Char -> Oriented (Domino (Maybe DieValue))
fromDomino' = Int -> Oriented (Domino (Maybe DieValue))
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
  where
    go :: Int -> Oriented (Domino (Maybe DieValue))
go Int
n
      | Int
n forall a. Ord a => a -> a -> Bool
>= Int
_offsetDominoVertical = Int -> Int -> Orientation -> Oriented (Domino (Maybe DieValue))
go' Int
_offsetDominoVertical Int
n Orientation
Vertical
      | Bool
otherwise = Int -> Int -> Orientation -> Oriented (Domino (Maybe DieValue))
go' Int
_offsetDominoHorizontal Int
n Orientation
Horizontal
    go' :: Int -> Int -> Orientation -> Oriented (Domino (Maybe DieValue))
go' Int
k = forall a. a -> Orientation -> Oriented a
Oriented forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Domino (Maybe DieValue)
_fromDomino forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> a
pred forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a -> a
subtract Int
k

-- | Convert the given 'Char'acter to an 'Oriented' 'ComplexDomino' object. If
-- the given 'Char'acter wrapped in a 'Just' data constructor if the 'Char'acter
-- is a valid domino character; otherwise 'Nothing'.
fromDomino ::
  -- | The given 'Char'acter to convert to an 'Oriented' 'ComplexDomino' object.
  Char ->
  -- | The equivalent 'Oriented' 'ComplexDomino' object for the given 'Char'acter wrapped in a 'Just'; 'Nothing' if the character is not a domino character.
  Maybe (Oriented ComplexDomino)
fromDomino :: Char -> Maybe (Oriented (Domino (Maybe DieValue)))
fromDomino Char
c
  | Char
c forall a. Ord a => a -> a -> Bool
< Char
'\x1f030' Bool -> Bool -> Bool
|| Char
c forall a. Ord a => a -> a -> Bool
> Char
'\x1f093' = forall a. Maybe a
Nothing
  | Bool
otherwise = forall a. a -> Maybe a
Just (Char -> Oriented (Domino (Maybe DieValue))
fromDomino' Char
c)

toSimple :: Domino (Maybe a) -> Maybe (Domino a)
toSimple :: forall a. Domino (Maybe a) -> Maybe (Domino a)
toSimple Domino (Maybe a)
Back = forall a. a -> Maybe a
Just forall a. Domino a
Back
toSimple (Domino (Just a
a) (Just a
b)) = forall a. a -> Maybe a
Just (forall a. a -> a -> Domino a
Domino a
a a
b)
toSimple Domino (Maybe a)
_ = forall a. Maybe a
Nothing

-- | Convert a 'ComplexDomino' value to a unicode character rendering the domino
-- value /horizontally/.
dominoH ::
  -- | The 'ComplexDomino' object to render horizontally.
  ComplexDomino ->
  -- | The unicode character that represents the given 'ComplexDomino' value in a horizontal manner.
  Char
dominoH :: Domino (Maybe DieValue) -> Char
dominoH = Int -> Domino (Maybe DieValue) -> Char
_domino Int
_offsetDominoHorizontal

-- | Convert a 'SimpleDomino' value to a unicode character rendering the domino
-- value /horizontally/.
dominoH' ::
  -- | The 'SimpleDomino' object to render horizontally.
  SimpleDomino ->
  -- | The unicode character that represents the given 'SimpleDomino' value in a horizontal manner.
  Char
dominoH' :: Domino DieValue -> Char
dominoH' = Domino (Maybe DieValue) -> Char
dominoH forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just

-- | Convert a 'ComplexDomino' value to a unicode character rendering the domino
-- value /vertically/.
dominoV ::
  -- | The 'ComplexDomino' object to render vertically.
  ComplexDomino ->
  -- | The unicode character that represents the given 'ComplexDomino' value in a vertical manner.
  Char
dominoV :: Domino (Maybe DieValue) -> Char
dominoV = Int -> Domino (Maybe DieValue) -> Char
_domino Int
_offsetDominoVertical

-- | Convert a 'SimpleDomino' value to a unicode character rendering the domino
-- value /vertically/.
dominoV' ::
  -- | The 'SimpleDomino' object to render vertically.
  SimpleDomino ->
  -- | The unicode character that represents the given 'SimpleDomino' value in vertical manner.
  Char
dominoV' :: Domino DieValue -> Char
dominoV' = Domino (Maybe DieValue) -> Char
dominoV forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just

-- | Convert an 'OrientedDomino' to its unicode equivalent, where the sides of
-- the domino can be empty.
domino ::
  -- | The 'OrientedDomino' to render.
  OrientedDomino (Maybe DieValue) ->
  -- | The unicode characters that represents the 'OrientedDomino' value.
  Char
domino :: Oriented (Domino (Maybe DieValue)) -> Char
domino (Oriented Domino (Maybe DieValue)
d Orientation
Horizontal) = Domino (Maybe DieValue) -> Char
dominoH Domino (Maybe DieValue)
d
domino (Oriented Domino (Maybe DieValue)
d Orientation
Vertical) = Domino (Maybe DieValue) -> Char
dominoV Domino (Maybe DieValue)
d

-- | Convert an 'OrientedDomino' to its unicode equivalent, where the sides of
-- the domino can /not/ be empty.
domino' ::
  -- | The 'OrientedDomino' to render.
  OrientedDomino DieValue ->
  -- | The unicode characters that represents the 'OrientedDomino' value.
  Char
domino' :: Oriented (Domino DieValue) -> Char
domino' = Oriented (Domino (Maybe DieValue)) -> Char
domino forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just)

instance UnicodeCharacter (Oriented (Domino (Maybe DieValue))) where
  toUnicodeChar :: Oriented (Domino (Maybe DieValue)) -> Char
toUnicodeChar = Oriented (Domino (Maybe DieValue)) -> Char
domino
  fromUnicodeChar :: Char -> Maybe (Oriented (Domino (Maybe DieValue)))
fromUnicodeChar = Char -> Maybe (Oriented (Domino (Maybe DieValue)))
fromDomino
  fromUnicodeChar' :: Char -> Oriented (Domino (Maybe DieValue))
fromUnicodeChar' = Char -> Oriented (Domino (Maybe DieValue))
fromDomino'
  isInCharRange :: Char -> Bool
isInCharRange Char
c = Char
'\x1f030' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x1f093'

instance MirrorHorizontal (Oriented (Domino a)) where
  mirrorHorizontal :: Oriented (Domino a) -> Oriented (Domino a)
mirrorHorizontal (Oriented (Domino a
a a
b) Orientation
Vertical) = forall a. a -> Orientation -> Oriented a
Oriented (forall a. a -> a -> Domino a
Domino a
b a
a) Orientation
Vertical
  mirrorHorizontal o :: Oriented (Domino a)
o@(Oriented Domino a
Back Orientation
_) = Oriented (Domino a)
o
  mirrorHorizontal o :: Oriented (Domino a)
o@(Oriented Domino a
_ Orientation
Horizontal) = Oriented (Domino a)
o

instance MirrorVertical (Oriented (Domino a)) where
  mirrorVertical :: Oriented (Domino a) -> Oriented (Domino a)
mirrorVertical (Oriented (Domino a
a a
b) Orientation
Horizontal) = forall a. a -> Orientation -> Oriented a
Oriented (forall a. a -> a -> Domino a
Domino a
b a
a) Orientation
Horizontal
  mirrorVertical o :: Oriented (Domino a)
o@(Oriented Domino a
Back Orientation
_) = Oriented (Domino a)
o
  mirrorVertical o :: Oriented (Domino a)
o@(Oriented Domino a
_ Orientation
Vertical) = Oriented (Domino a)
o

instance UnicodeCharacter (Oriented (Domino DieValue)) where
  toUnicodeChar :: Oriented (Domino DieValue) -> Char
toUnicodeChar = Oriented (Domino DieValue) -> Char
domino'
  fromUnicodeChar :: Char -> Maybe (Oriented (Domino DieValue))
fromUnicodeChar = Char -> Maybe (Oriented (Domino (Maybe DieValue)))
fromDomino forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. Domino (Maybe a) -> Maybe (Domino a)
toSimple
  isInCharRange :: Char -> Bool
isInCharRange Char
c = Char
'\x1f030' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x1f093' Bool -> Bool -> Bool
&& Bool
go
    where
      x :: Int
x = Char -> Int
ord Char
c
      go :: Bool
go
        | Char
'\x1f031' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x1f038' = Bool
False
        | Char
'\x1f063' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x1f06a' = Bool
False
        | Int
x forall a. Integral a => a -> a -> a
`mod` Int
7 forall a. Eq a => a -> a -> Bool
== Int
3 Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x1f062' = Bool
False
        | Int
x forall a. Integral a => a -> a -> a
`mod` Int
7 forall a. Eq a => a -> a -> Bool
== Int
4 Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\x1f062' = Bool
False
        | Bool
otherwise = Bool
True

instance UnicodeText (Oriented (Domino (Maybe DieValue))) where
  isInTextRange :: Text -> Bool
isInTextRange = forall a. UnicodeCharacter a => Text -> Bool
generateIsInTextRange' @(Oriented (Domino (Maybe DieValue)))

instance UnicodeText (Oriented (Domino DieValue)) where
  isInTextRange :: Text -> Bool
isInTextRange = forall a. UnicodeCharacter a => Text -> Bool
generateIsInTextRange' @(Oriented (Domino DieValue))