Tile.md

Some basic properties of Tiles

• They are separate by their type (Character, Circle, Bamboo, Wind, Dragon).
• Simples (Character, Circle, Bamboo) will always have a number from 1 to 9 associated with them.
• TNum, Wind, and Dragons are (basically) values that are associated with the suit and have the same properties, but different bounds.

-- | Basic functions of a Tile. Minimum completion is `honor` and `terminal`.
class Tileable a where
  suit :: a -> Bool
  suit = not . honor

  honor :: a -> Bool

  simple :: a -> Bool
  simple = not . terminal

  terminal :: a -> Bool

  end :: a -> Bool
  end a | honor a || terminal a = True
        | otherwise = False

-- | Simple function to test if something is at either bound of a Bounded object
isBounds :: (Eq a, Bounded a) => a -> Bool
isBounds a | a == minBound || a == maxBound = True
           | otherwise = False

-- | If a type has `Eq` and `Bounded`, then you can use this function as the
-- definition of `terminal`.
terminal' :: (Eq a, Bounded a, Tileable a) => a -> Bool
terminal' a | suit a = isBounds a
            | otherwise = False

-- | Enum and Bounded have a law that states that if succ a is equal to the
-- maxBound return an error and thus it's never a good idea to abuse these laws
-- for the type. Cycle on the other hand creates repeating infinite loops, which
-- is useful in the game of Mahjong for things like determining the dora or next
-- seat to be dealer.
class Cycle a where
  -- | The next tile in the cycle.
  next :: a -> a

  -- | The previous tile in the cycle
  prev :: a -> a

next' :: (Eq a, Enum a, Bounded a) => a -> a
next' a | a == maxBound = minBound
        | otherwise = succ a

prev' :: (Eq a, Enum a, Bounded a) => a -> a
prev' a | a == minBound = maxBound
        | otherwise = pred a

-- | TNum represents the values with simple tiles like Character, Circle, and
-- Bamboo.
data TNum
  = One
  | Two
  | Three
  | Four
  | Five
  | Six
  | Seven
  | Eight
  | Nine
  deriving (Eq, Ord, Enum, Bounded, Show)

instance Cycle TNum where
  next = next'
  prev = prev'

-- | Wind represent the cardinal directions that can be found on Wind tiles, and
-- their inherent ordering.
data Wind
  = East
  | South
  | West
  | North
  deriving (Eq, Ord, Enum, Bounded, Show)

instance Cycle Wind where
  next = next'
  prev = prev'

-- | Dragon represent the colors that can be found on Dragon tiles, and their
-- inherent ordering.
data Dragon
  = Red
  | White
  | Green
  deriving (Eq, Ord, Enum, Bounded, Show)

instance Cycle Dragon where
  next = next'
  prev = prev'

-- | @Tile@ is the monster of a data structure representing the loosely
-- connected sets of tiles in mahjong. Due to the complexity of this structure
-- if a variant of mahjong requires has different tiles in it. I recommend that
-- you make a new type including constructors for those tiles and making them a
-- part of @Tileable@.
data Tile
  = Character TNum
  | CharacterDora -- ^ Has a value of Character Five
  | Circle    TNum
  | CircleDora -- ^ Has a value of Circle Five
  | Bamboo    TNum
  | BambooDora -- ^ Has a value of Bamboo Five
  | Wind      Wind
  | Dragon    Dragon
  deriving (Eq, Show)

instance Tileable Tile where
  honor (Wind _)   = True
  honor (Dragon _) = True
  honor _          = False

  terminal (Character ct)  = isBounds ct
  terminal (Circle ct)     = isBounds ct
  terminal (Bamboo bt)     = isBounds bt
  terminal (Wind _)        = True
  terminal (Dragon _)      = True
  terminal _               = False

-- TODO: Should look for a way to break down this boilerplate This is also
-- fairly equivalent to instance (Cycle a) => Cycle (Tile a) assuming that the types
-- were transparent through Tile.
instance Cycle Tile where
  next (Character tn)  = Character (next tn)
  next (CharacterDora) = Character Six
  next (Circle tn)     = Circle (next tn)
  next (CircleDora)    = Circle Six
  next (Bamboo tn)     = Bamboo (next tn)
  next (BambooDora)    = Bamboo Six
  next (Wind w)        = Wind (next w)
  next (Dragon d)      = Dragon (next d)

  prev (Character tn)  = Character (prev tn)
  prev (CharacterDora) = Character Six
  prev (Circle tn)     = Circle (prev tn)
  prev (CircleDora)    = Circle Six
  prev (Bamboo tn)     = Bamboo (prev tn)
  prev (BambooDora)    = Bamboo Six
  prev (Wind w)        = Wind (prev w)
  prev (Dragon d)      = Dragon (prev d)

Wait that last bit is ugly as hell. What if Tile was done like a Functor instead?

data CharacterTile
  = CharacterT TNum
  | CharacterTDora

instance Cycle CharacterTile where
  next (CharacterT tn)  = CharacterT (next tn)
  next (CharacterTDora) = CharacterT (next Five)

  prev (CharacterT tn)  = CharacterT (prev tn)
  prev (CharacterTDora) = CharacterT (next Five)

data CircleTile
  = CircleT TNum
  | CircleTDora

instance Cycle CircleTile where
  next (CircleT tn)  = CircleT (next tn)
  next (CircleTDora) = CircleT (next Five)

  prev (CircleT tn)  = CircleT (prev tn)
  prev (CircleTDora) = CircleT (next Five)

data BambooTile
  = BambooT TNum
  | BambooTDora

instance Cycle BambooTile where
  next (BambooT tn)  = BambooT (next tn)
  next (BambooTDora) = BambooT (next Five)

  prev (BambooT tn)  = BambooT (prev tn)
  prev (BambooTDora) = BambooT (next Five)

data WindTile
  = WindT Wind

instance Cycle WindTile where
  next (WindT w) = WindT (next w)

  prev (WindT w) = WindT (prev w)

data DragonTile
  = DragonT Dragon

instance Cycle DragonTile where
  next (DragonT d) = DragonT (next d)

  prev (DragonT d) = DragonT (prev d)

data TileF a = TileF a

instance Functor TileF where
  fmap fn (TileF a) = TileF (fn a)

instance (Cycle a) => Cycle (TileF a) where
  next (TileF a) = TileF (next a)

  prev (TileF a) = TileF (prev a)

But now all the specific tiles are pretty much Functors without any of the usability of the original :/

What do.