{-|
Module      : HalfTile
Description : Introducing a generic type for half tiles of darts and kites
Copyright   : (c) Chris Reade, 2021
License     : BSD-style
Maintainer  : chrisreade@mac.com
Stability   : experimental

-}
{-# LANGUAGE TypeFamilies              #-} -- needed for Transformable Instance
{-# LANGUAGE FlexibleInstances         #-} -- needed for Transformable Instance

module HalfTile 
  ( HalfTile(..)
  , tileRep
  , isLD
  , isRD
  , isLK
  , isRK
  , isDart
  , isKite
  , HalfTileLabel
  , tileLabel
  , isMatched
  ) where
    
import Diagrams.Prelude (V,N, Transformable(..)) -- needed to make HalfTile a Transformable when a is Transformable

{-|
Representing Half Tile Pieces Polymorphicly.
Common code for both graphs and vector representations of tilings. 
For Pieces - rep is V2 Double
For TileFaces (in Tgraphs) rep is (Vertex,Vertex,Vertex)
-}
data HalfTile rep = LD rep -- ^ Left Dart
                  | RD rep -- ^ Right Dart
                  | LK rep -- ^ Left Kite
                  | RK rep -- ^ Right Kite
                  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)

-- | Note this ignores the tileLabels when comparing.
-- However we should never have 2 different HalfTiles with the same rep
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)

-- |Make Halftile a Functor
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)

-- |Needed for Transformable instance of HalfTile - requires TypeFamilies
type instance N (HalfTile a) = N a
-- |Needed for Transformable instance of HalfTile - requires TypeFamilies
type instance V (HalfTile a) = V a
-- |HalfTile inherits Transformable  - Requires FlexibleInstances
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 #-}
-- |return the representation of a half-tile
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

-- |half-tile predicate
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

-- |By having () as the half tile representation we treat the constructors as just labels
type HalfTileLabel = HalfTile ()
-- |convert a half tile to its label (HalfTileLabel can be compared for equality)
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 () -- functor HalfTile

-- | isMatched t1 t2 is True if t1 and t2 have the same HalfTileLabel 
-- (i.e. use the same constructor - both LD or both RD or both LK or both RK)
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