{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
module HalfTile
( HalfTile(..)
, tileRep
, isLD
, isRD
, isLK
, isRK
, isDart
, isKite
, HalfTileLabel
, tileLabel
, isMatched
) where
import Diagrams.Prelude (V,N, Transformable(..))
data HalfTile rep = LD rep
| RD rep
| LK rep
| RK rep
deriving (Int -> HalfTile rep -> ShowS
[HalfTile rep] -> ShowS
HalfTile rep -> String
(Int -> HalfTile rep -> ShowS)
-> (HalfTile rep -> String)
-> ([HalfTile rep] -> ShowS)
-> Show (HalfTile rep)
forall rep. Show rep => Int -> HalfTile rep -> ShowS
forall rep. Show rep => [HalfTile rep] -> ShowS
forall rep. Show rep => HalfTile rep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall rep. Show rep => Int -> HalfTile rep -> ShowS
showsPrec :: Int -> HalfTile rep -> ShowS
$cshow :: forall rep. Show rep => HalfTile rep -> String
show :: HalfTile rep -> String
$cshowList :: forall rep. Show rep => [HalfTile rep] -> ShowS
showList :: [HalfTile rep] -> ShowS
Show,HalfTile rep -> HalfTile rep -> Bool
(HalfTile rep -> HalfTile rep -> Bool)
-> (HalfTile rep -> HalfTile rep -> Bool) -> Eq (HalfTile rep)
forall rep. Eq rep => HalfTile rep -> HalfTile rep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall rep. Eq rep => HalfTile rep -> HalfTile rep -> Bool
== :: HalfTile rep -> HalfTile rep -> Bool
$c/= :: forall rep. Eq rep => HalfTile rep -> HalfTile rep -> Bool
/= :: HalfTile rep -> HalfTile rep -> Bool
Eq)
instance Ord rep => Ord (HalfTile rep) where
compare :: HalfTile rep -> HalfTile rep -> Ordering
compare HalfTile rep
t1 HalfTile rep
t2 = rep -> rep -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (HalfTile rep -> rep
forall rep. HalfTile rep -> rep
tileRep HalfTile rep
t1) (HalfTile rep -> rep
forall rep. HalfTile rep -> rep
tileRep HalfTile rep
t2)
instance Functor HalfTile where
fmap :: forall a b. (a -> b) -> HalfTile a -> HalfTile b
fmap a -> b
f (LD a
rep) = b -> HalfTile b
forall rep. rep -> HalfTile rep
LD (a -> b
f a
rep)
fmap a -> b
f (RD a
rep) = b -> HalfTile b
forall rep. rep -> HalfTile rep
RD (a -> b
f a
rep)
fmap a -> b
f (LK a
rep) = b -> HalfTile b
forall rep. rep -> HalfTile rep
LK (a -> b
f a
rep)
fmap a -> b
f (RK a
rep) = b -> HalfTile b
forall rep. rep -> HalfTile rep
RK (a -> b
f a
rep)
type instance N (HalfTile a) = N a
type instance V (HalfTile a) = V a
instance Transformable a => Transformable (HalfTile a) where
transform :: Transformation (V (HalfTile a)) (N (HalfTile a))
-> HalfTile a -> HalfTile a
transform Transformation (V (HalfTile a)) (N (HalfTile a))
t = (a -> a) -> HalfTile a -> HalfTile a
forall a b. (a -> b) -> HalfTile a -> HalfTile b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Transformation (V a) (N a) -> a -> a
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation (V a) (N a)
Transformation (V (HalfTile a)) (N (HalfTile a))
t)
{-# INLINE tileRep #-}
tileRep:: HalfTile rep -> rep
tileRep :: forall rep. HalfTile rep -> rep
tileRep (LD rep
r) = rep
r
tileRep (RD rep
r) = rep
r
tileRep (LK rep
r) = rep
r
tileRep (RK rep
r) = rep
r
isLD,isRD,isLK,isRK,isDart,isKite :: HalfTile rep -> Bool
isLD :: forall rep. HalfTile rep -> Bool
isLD (LD rep
_) = Bool
True
isLD HalfTile rep
_ = Bool
False
isRD :: forall rep. HalfTile rep -> Bool
isRD (RD rep
_) = Bool
True
isRD HalfTile rep
_ = Bool
False
isLK :: forall rep. HalfTile rep -> Bool
isLK (LK rep
_) = Bool
True
isLK HalfTile rep
_ = Bool
False
isRK :: forall rep. HalfTile rep -> Bool
isRK (RK rep
_) = Bool
True
isRK HalfTile rep
_ = Bool
False
isDart :: forall rep. HalfTile rep -> Bool
isDart HalfTile rep
x = HalfTile rep -> Bool
forall rep. HalfTile rep -> Bool
isLD HalfTile rep
x Bool -> Bool -> Bool
|| HalfTile rep -> Bool
forall rep. HalfTile rep -> Bool
isRD HalfTile rep
x
isKite :: forall rep. HalfTile rep -> Bool
isKite HalfTile rep
x = HalfTile rep -> Bool
forall rep. HalfTile rep -> Bool
isLK HalfTile rep
x Bool -> Bool -> Bool
|| HalfTile rep -> Bool
forall rep. HalfTile rep -> Bool
isRK HalfTile rep
x
type HalfTileLabel = HalfTile ()
tileLabel :: HalfTile a -> HalfTileLabel
tileLabel :: forall a. HalfTile a -> HalfTileLabel
tileLabel = (a -> ()) -> HalfTile a -> HalfTileLabel
forall a b. (a -> b) -> HalfTile a -> HalfTile b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> ()) -> HalfTile a -> HalfTileLabel)
-> (a -> ()) -> HalfTile a -> HalfTileLabel
forall a b. (a -> b) -> a -> b
$ () -> a -> ()
forall a b. a -> b -> a
const ()
isMatched :: HalfTile rep1 -> HalfTile rep2 -> Bool
isMatched :: forall rep1 rep2. HalfTile rep1 -> HalfTile rep2 -> Bool
isMatched HalfTile rep1
t1 HalfTile rep2
t2 = HalfTile rep1 -> HalfTileLabel
forall a. HalfTile a -> HalfTileLabel
tileLabel HalfTile rep1
t1 HalfTileLabel -> HalfTileLabel -> Bool
forall a. Eq a => a -> a -> Bool
== HalfTile rep2 -> HalfTileLabel
forall a. HalfTile a -> HalfTileLabel
tileLabel HalfTile rep2
t2