haskell moka II

{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE LambdaCase           #-}

import Data.List (elemIndex)
import Data.Maybe (fromJust)

data Rank = Ten | Jack | Knight | Queen | King deriving(Show,Enum, Eq)
data Value = I | II | III | IV | V | VI | VII | VIII | IX | X 
             | XI | XII | XIII | XIV | XV | XVI | XVII | XVIII | XIX | XX 
             | XXI | Skeench deriving (Show, Enum, Eq)
data Card = Clubs Rank 
            | Diamonds Rank 
            | Spades Rank 
            | Hearts Rank 
            | Tarock Value deriving (Show, Eq)


allCards :: [Card]
allCards = [f r | r <- [Ten .. King], f <- [Clubs, Diamonds, Spades, Hearts]]
           ++ [Tarock v | v <- [I .. Skeench]]

instance Enum Card where
  toEnum n = allCards !! n
  fromEnum c = fromJust $ elemIndex c allCards


type CardConstr = Rank -> Card


------------------------------------------------------------------------------
-- | Equality check on CardConstr. Two functions are equal if they are equal
-- for all input.
instance Eq CardConstr where
  a == b = let ranks = [Ten .. King] in map a ranks == map b ranks


------------------------------------------------------------------------------
-- | Converts a CardConstr function to a lambda case syntax string. We could
-- easily parse that - if we wanted to - returning a lambda, making possible
-- to read/write == serialize functions.
instance Show CardConstr where
  show f = "\\case { Ten -> " ++ (show $ f Ten)
           ++    "; Jack -> " ++ (show $ f Jack)
           ++    "; Knight -> " ++ (show $ f Knight)
           ++    "; Queen -> " ++ (show $ f Queen)
           ++    "; King -> " ++ (show $ f King) ++ " }"


instance Enum CardConstr where
  toEnum n =
    let f x = quotRem (fst x) (length allCards)
        outputs = map (toEnum . snd)
                  $ take (length [Ten .. King])
                  $ tail $ iterate f (n, 0)
    in \case
      Ten    -> outputs !! fromEnum Ten
      Jack   -> outputs !! fromEnum Jack
      Knight -> outputs !! fromEnum Knight
      Queen  -> outputs !! fromEnum Queen
      King   -> outputs !! fromEnum King

  fromEnum f = let conv a b = b * length allCards + a
               in foldr conv 0 [fromEnum (f r) | r <- [Ten .. King]]  


-- >>> fun
-- \case { Ten -> Tarock Skeench; Jack -> Hearts Queen; Knight -> Clubs Ten; Queen -> Spades Queen; King -> Spades Queen }
-- >>> fromEnum fun
-- 44601647
-- >>> (toEnum 44601647) :: CardConstr
-- \case { Ten -> Tarock Skeench; Jack -> Hearts Queen; Knight -> Clubs Ten; Queen -> Spades Queen; King -> Spades Queen }
fun :: Rank -> Card
fun Ten  = Tarock Skeench
fun Jack = Hearts Queen
fun Knight = Clubs Ten
fun Queen = Spades Queen
fun King = Spades Queen


-- >>> succ Clubs
-- \case { Ten -> Diamonds Ten; Jack -> Clubs Jack; Knight -> Clubs Knight; Queen -> Clubs Queen; King -> Clubs King }
-- >>> pred Clubs
-- \case { Ten -> Tarock Skeench; Jack -> Hearts Ten; Knight -> Clubs Knight; Queen -> Clubs Queen; King -> Clubs King }
-- >>> succ $ pred Clubs
-- \case { Ten -> Clubs Ten; Jack -> Clubs Jack; Knight -> Clubs Knight; Queen -> Clubs Queen; King -> Clubs King }


-- unfortunately this doesn't work as expected [Clubs .. Hearts] as between
-- Clubs and Diamonds there is a huge distance in our enumeration. Of course
-- we could alter the order so they go next too each other..