import Data.List
import Data.Maybe 
import Control.Monad
import Test.QuickCheck
import Control.Applicative


offerToAssistant :: (Card, Card, Card, Card, Card) ->
	(Card, Card, Card, Card)
offerToAssistant (a,b,c,d,e) = head $ do
	[a,b,c,d,e] <- permutations [a,b,c,d,e]
	guard $ magicianAnswers (a,b,c,d) == e
	return (a,b,c,d)

magicianAnswers :: (Card, Card, Card, Card) -> Card
magicianAnswers (Card r s,b,c,d) = Card (addRank r (decodeDelta (b,c,d))) s 

data Suit = Clubs | Diamonds | Hearts | Spades deriving (Eq,Ord,Show,Read,Bounded,Enum)

data Rank = Ace | Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten | Jack | Queen | King deriving (Eq,Ord,Show,Read,Bounded,Enum)

instance Arbitrary Suit where 
	arbitrary =  elements [minBound.. maxBound]

instance Arbitrary Rank where 
	arbitrary = elements [minBound.. maxBound]

instance Arbitrary Card where 
	arbitrary = Card <$> arbitrary <*> arbitrary 

instance Applicative Gen where
	pure = return
	(<*>) = ap

instance Arbitrary Hand where 
	arbitrary = Hand <$> pick 5 []  
            where pick 0 hand = return hand 
	 	  pick i hand = do
			card <- arbitrary 
			if elem card hand then pick i hand
			 else pick (i-1) $ card:hand 

prop_cardTrickWorks (Hand abcde@[a,b,c,d,e]) = 
	sort abcde == sort [a',b',c',d',e'] where
	abcd'@(a',b',c',d') = offerToAssistant (a,b,c,d,e)
	e' = magicianAnswers abcd'

data Hand = Hand [Card] deriving (Eq,Ord,Show,Read)

data Card = Card { rank :: Rank, suit :: Suit } deriving (Eq,Ord,Show,Read,Bounded)

deck :: [Card]
deck = [Card r s | r <- [minBound..maxBound], s <- [minBound..maxBound]]

data Size = S | M | L deriving (Eq,Ord,Show,Read,Enum)

addRank :: Rank -> Int -> Rank
addRank r i = toEnum $ (fromEnum r + i) `mod` (fromEnum (maxBound :: Rank) + 1)

encodings :: [(Size,Size,Size)]
encodings = [(S,M,L),(S,L,M),(M,S,L),(M,L,S),(L,S,M),(L,M,S)]

map3 :: (a -> b) -> (a,a,a) -> (b,b,b)
map3 f (a,b,c) = (f a, f b, f c)

decodeDelta :: (Card,Card,Card) -> Int
decodeDelta abc@(a,b,c) = (1+) . fromJust $ elemIndex encoding encodings
  where
    encoding = map3 (\x -> fromJust $ lookup x table) abc
    table = zip (sort [a,b,c]) [S,M,L]