module Main ( main ) where

import Data.Poker
import Data.Poker.Internal

import Foreign.C
import Foreign.Marshal
import System.IO.Unsafe
import Control.Monad

import Test.Framework
import Test.Framework.Runners.Console
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2
import Test.HUnit
import Test.QuickCheck hiding (choose)

cardToString_unit :: Assertion
cardToString_unit = assertBool "Broken symmetry." $
    map show allCards == map cardToStringIO allCards

mkCard_unit :: Assertion
mkCard_unit = assertBool "Broken symmetry." $
    liftM2 mkCard allRanks allSuits == liftM2 mkCard_c allRanks allSuits

card_ReadShow_prop :: Card -> Bool
card_ReadShow_prop card = card == read (show card)

card_mk_prop :: Rank -> Suit -> Bool
card_mk_prop rank suit = cardRank card == rank && cardSuit card == suit
    where
        card = mkCard rank suit

cardset_ReadShow_prop :: CardSet -> Bool
cardset_ReadShow_prop mask = mask == read (show mask)

cardset_fromList_toList_prop :: CardSet -> Bool
cardset_fromList_toList_prop set = fromList (toList set) == set


test_foldl_count fn n cardsSeen =
    deckSize > n ==> (fn (\_ n -> n + 1) 0 cardsSeen == deckSize `choose` n)
  where
    deckSize = 52 - size cardsSeen

foldlOneCard_prop, foldlTwoCards_prop, foldlThreeCards_prop :: CardSet -> Property
foldlOneCard_prop = test_foldl_count foldlOneCard 1
foldlTwoCards_prop = test_foldl_count foldlTwoCards 2
foldlThreeCards_prop = test_foldl_count foldlThreeCards 3

foldlFourCards_prop, foldlFiveCards_prop :: CardSet -> Property
foldlFourCards_prop = test_foldl_count foldlFourCards 4
foldlFiveCards_prop = test_foldl_count foldlFiveCards 5

highHandCount, onePairCount :: Int
highHandCount  = 1302540
onePairCount   = 1098240
twoPairCount   =  123552
threeKindCount =   54912
straightCount  =   10200
flushCount     =    5108
fullHouseCount =    3744
fourKindCount  =     624
straightFlushCount =  40

-- Make sure I've entered the correct numbers above.
correctCount_unit :: Assertion
correctCount_unit = assertBool "Hand counts incorrectly entered" $
    sum [ highHandCount, onePairCount, twoPairCount, threeKindCount, straightCount
        , flushCount, fullHouseCount, fourKindCount, straightFlushCount ] == 52 `choose` 5

test_foldl_hand_count fn expectedValue = assertBool "Incorrect count" $
    foldlFiveCards worker 0 empty == expectedValue
  where
    worker community n
        | fn (handValue_n 5 community) = n + 1
        | otherwise                    = n

foldlHighHandCount_unit :: Assertion
foldlHighHandCount_unit = test_foldl_hand_count isNoPair highHandCount

foldlOnePairCount_unit :: Assertion
foldlOnePairCount_unit = test_foldl_hand_count isOnePair onePairCount

foldlTwoPairCount_unit :: Assertion
foldlTwoPairCount_unit = test_foldl_hand_count isTwoPair twoPairCount

foldlThreeKindCount_unit :: Assertion
foldlThreeKindCount_unit = test_foldl_hand_count isThreeOfAKind threeKindCount

foldlStraightCount_unit :: Assertion
foldlStraightCount_unit = test_foldl_hand_count isStraight straightCount

foldlFlushCount_unit :: Assertion
foldlFlushCount_unit = test_foldl_hand_count isFlush flushCount

foldlFourKindCount_unit :: Assertion
foldlFourKindCount_unit = test_foldl_hand_count isFourOfAKind fourKindCount

foldlFullHouseCount_unit :: Assertion
foldlFullHouseCount_unit = test_foldl_hand_count isFullHouse fullHouseCount

foldlStraightFlushCount_unit :: Assertion
foldlStraightFlushCount_unit = test_foldl_hand_count isStraightFlush straightFlushCount


main :: IO ()
main = defaultMain
    [ testGroup "Haskell/C equivalence"
        [ testCase "cardToString" cardToString_unit
        , testCase "mkCard"       mkCard_unit
        ]
    , testGroup "Invariants"
        [ testProperty "card_ReadShow" card_ReadShow_prop
        , testProperty "cardmask_ReadShow" cardset_ReadShow_prop
        , testProperty "foldlOneCard_count" foldlOneCard_prop
        , testProperty "foldlTwoCards_count" foldlTwoCards_prop
        , testProperty "foldlThreeCards_count" foldlThreeCards_prop
        , testProperty "foldlFourCards_count" foldlFourCards_prop
        , testProperty "foldlFiveCards_count" foldlFiveCards_prop
        , testProperty "FromList/ToList" cardset_fromList_toList_prop
        , testProperty "CardRankSuit" card_mk_prop
        , testCase "CorrectCount" correctCount_unit
        , testCase "HighHandCount" foldlHighHandCount_unit
        , testCase "OnePairCount" foldlOnePairCount_unit
        , testCase "TwoPairCount" foldlTwoPairCount_unit
        , testCase "ThreeKindCount" foldlThreeKindCount_unit
        , testCase "StraightCount" foldlStraightCount_unit
        , testCase "FlushCount" foldlFlushCount_unit
        , testCase "FourKindCount" foldlFourKindCount_unit
        , testCase "FullHouseCount" foldlFullHouseCount_unit
        , testCase "StraightFlushCount" foldlStraightFlushCount_unit
        ]
    ]



allCards :: [Card]
allCards = [minBound .. ]

allRanks :: [Rank]
allRanks = [minBound .. ]

allSuits :: [Suit]
allSuits = [minBound .. ]


instance Arbitrary Card where
    arbitrary = arbitraryBoundedRandom

instance Arbitrary CardSet where
    arbitrary = arbitraryBoundedRandom

instance Arbitrary Rank where
    arbitrary = arbitraryBoundedRandom

instance Arbitrary Suit where
    arbitrary = arbitraryBoundedRandom




foreign import ccall unsafe "StdDeck_cardToString" c_cardToString :: CInt -> CString -> IO CInt
cardToStringIO (Card idx)
    = unsafePerformIO $
      allocaBytes 3 $ \cstr ->
      do c_cardToString idx cstr
         peekCString cstr

foreign import ccall unsafe "hs_StdDeck_MAKE_CARD" c_makeCard :: CInt -> CInt -> CInt
mkCard_c :: Rank -> Suit -> Card
mkCard_c rank suit = Card (c_makeCard (f rank) (f suit))
    where
        f e = fromIntegral (fromEnum e)

factorial :: Integer -> Integer
factorial n | n < 0 = error "factorial: bad argument"
factorial 0 = 1
factorial n = n * factorial (n-1)

choose' :: Integer -> Integer -> Integer
n `choose'` k = factorial n `div` (factorial k * factorial (n-k))

choose :: Int -> Int -> Int
n `choose` k = fromIntegral (fromIntegral n `choose'` fromIntegral k)