    --------------------------------------------------------------------------------
    --------------------------------------------------------------------------------
    -- |
    --Module       : Cribbage
    --Author       : Joe Fredette
    --License      : BSD3
    --Copyright    : Joe Fredette
    --
    --Maintainer   : Joe Fredette <jfredett.at.gmail.dot.com>
    --Stability    : Unstable
    --Portability  : portable
    --
    --------------------------------------------------------------------------------
    --Description  : A simple cribbage score counter (minus the "his heels" and
    -- "nobs" rules). Example of how to use the library.
    --------------------------------------------------------------------------------
    --------------------------------------------------------------------------------

    module Data.HCard.Examples.Cribbage where

    import Data.HCard
    import Data.HCard.Instances
    import Data.List
    import Data.Function

    score h = cribbageScore cut hand
            where (cut, hand) = (\(Hand x) -> (head x, Hand . tail $ x)) ((parse h)::ClassicHand)

    cribbageScore :: Classic -> ClassicHand -> Int
    cribbageScore cut hand = sum $ map (\f -> f cut hand)
                           [ countFifteens
                           , countPairs
                           , countRuns
                           , countFlush
                           --, countHeels
                           ]

    toValue :: Classic -> Int
    toValue c = case index c of
            Ace  -> 1
            V x  -> x
            _    -> 10

    -- countFifteens, countPairs, countRuns, countFlush, countHeels :: Classic -> ClassicHand -> [Int]
    countFifteens cut (Hand hand) = 2 * (length $ filter (==15) $ map valSum extHand)
                            where extHand = allKTups $ hand ++ [cut]
                                  valSum xs = sum $ map toValue xs

    countPairs cut (Hand hand) = 2 * (length $ filter isPair extHand)
                    where extHand = uniqPairs $ hand ++ [cut]
                          isPair (x,y) = index x == index y

    countRuns cut (Hand hand) = sum
                              $ map length
                              $ filter (\x -> length x >= 3)
                              $ filter isRun
                              $ map (map toValue) extHand
            where extHand = map (sortBy (compare `on` index)) $ allKTups (hand ++ [cut])

    countFlush cut (Hand hand) = getMax $ filter (>=4) $ map (length . (\(Hand h) -> h)) $ filterSuits extHand
            where extHand = Hand $ hand ++ [cut]
                  getMax [] = 0
                  getMax ls = maximum ls

    countHeels cut (Hand hand) = case index cut of
            Jack    -> if (suit cut) `elem` (map suit hand) then 1 else 0
            _       -> if Jack `elem` suited then 2 else 0
                    where suited = map index $ filter (\x -> suit x == suit cut) hand

    isRun []  = True
    isRun [x] = True
    isRun (x:y:xs) = (abs $ x - y) == 1 && isRun (y:xs)

    hand1 = (parse "5-H 5-S 6-D 7-S" ) :: ClassicHand
    hand2 = (parse "5-H 6-H 7-S 10-H") :: ClassicHand
    cut = parse "Q-H" :: Classic

    filterSuits :: ClassicHand -> [ClassicHand]
    filterSuits (Hand hand) = map Hand $ groupBy matchSuit (sort hand)
                    where matchSuit c1 c2 = suit c1 == suit c2

    allKTups :: [a] -> [[a]]
    allKTups []     = []
    allKTups (x:xs) = ([x] : (map (x:) (allKTups xs))) ++ allKTups xs

    uniqPairs :: Eq a => [a] -> [(a,a)]
    uniqPairs xs = map (\(x:y:_) -> (x,y))
                 $ filter (\x -> length x == 2) (allKTups xs)