-- | Interface to the bit-flicking in C.
{-# LANGUAGE BangPatterns #-}
module Data.Poker.Interface where

import Foreign.C
import Data.Word
import Data.Bits

import Data.Poker.Deck

#include "poker_defs.h"
#include "enumdefs.h"
#include "inlines/eval.h"


--instance Storable EnumResult where
--    sizeOf _ = #{size enum_result_t}
--    alignment _ = 4
--    peek ptr = do samples <- #{peek enum_result_t, nsamples} ptr :: IO CUInt
--                  c_players <- #{peek enum_result_t, nplayers} ptr :: IO CUInt
--                  let players = fromIntegral c_players
--                  win <- peekArray players (#{ptr enum_result_t, nwinhi} ptr) :: IO [CUInt]
--                  tie <- peekArray players (#{ptr enum_result_t, ntiehi} ptr) :: IO [CUInt]
--                  lose <- peekArray players (#{ptr enum_result_t, nlosehi} ptr) :: IO [CUInt]
--                  ev <- peekArray players (#{ptr enum_result_t, ev} ptr) :: IO [CDouble]
--                  let mkPlayer a b c d = PlayerResult (fromIntegral a) (fromIntegral b) (fromIntegral c) (realToFrac d)
--                  return EnumResult{ resultSamples = fromIntegral samples
--                                   , resultPlayers = zipWith4 mkPlayer win tie lose ev }

getHandType :: NumericalHandValue -> Word
getHandType (NumericalHandValue handVal) =
  handVal `unsafeShiftR` handTypeShift

handTypeShift :: Int
handTypeShift = #{const HandVal_HANDTYPE_SHIFT}

handValue_cardMask :: Word
handValue_cardMask = #{const HandVal_CARD_MASK}

getTopCard :: NumericalHandValue -> Rank
getTopCard (NumericalHandValue handVal) =
  wordToRank ((handVal `unsafeShiftR` topCardShift) .&. handValue_cardMask)

topCardShift :: Int
topCardShift = #{const HandVal_TOP_CARD_SHIFT}

getSecondCard :: NumericalHandValue -> Rank
getSecondCard (NumericalHandValue handVal) =
  wordToRank ((handVal `unsafeShiftR` secondCardShift) .&. handValue_cardMask)

secondCardShift :: Int
secondCardShift = #{const HandVal_SECOND_CARD_SHIFT}

getThirdCard :: NumericalHandValue -> Rank
getThirdCard (NumericalHandValue handVal) =
  wordToRank ((handVal `unsafeShiftR` thirdCardShift) .&. handValue_cardMask)

thirdCardShift :: Int
thirdCardShift = #{const HandVal_THIRD_CARD_SHIFT}

getFourthCard :: NumericalHandValue -> Rank
getFourthCard (NumericalHandValue handVal) =
  wordToRank ((handVal `unsafeShiftR` fourthCardShift) .&. handValue_cardMask)

fourthCardShift :: Int
fourthCardShift = #{const HandVal_FOURTH_CARD_SHIFT}

getFifthCard :: NumericalHandValue -> Rank
getFifthCard (NumericalHandValue handVal) =
  wordToRank ((handVal `unsafeShiftR` fifthCardShift) .&. handValue_cardMask)

fifthCardShift :: Int
fifthCardShift = #{const HandVal_FIFTH_CARD_SHIFT}

-- Very important rules. They often eliminate heap allocations when consuming a HandValue.
{-# RULES "rankToWord/wordToRank" forall x. rankToWord (wordToRank x) = x #-}
{-# RULES "rankToInt/intToRank" forall x. rankToInt (intToRank x) = x #-}

rankToCInt :: Rank -> CInt
rankToCInt = fromIntegral . rankToWord

rankToInt :: Rank -> Int
rankToInt = fromIntegral . rankToWord

rankToWord :: Rank -> Word
rankToWord Two = #{const StdDeck_Rank_2}
rankToWord Three = #{const StdDeck_Rank_3}
rankToWord Four = #{const StdDeck_Rank_4}
rankToWord Five = #{const StdDeck_Rank_5}
rankToWord Six = #{const StdDeck_Rank_6}
rankToWord Seven = #{const StdDeck_Rank_7}
rankToWord Eight = #{const StdDeck_Rank_8}
rankToWord Nine = #{const StdDeck_Rank_9}
rankToWord Ten = #{const StdDeck_Rank_TEN}
rankToWord Jack = #{const StdDeck_Rank_JACK}
rankToWord Queen = #{const StdDeck_Rank_QUEEN}
rankToWord King = #{const StdDeck_Rank_KING}
rankToWord Ace = #{const StdDeck_Rank_ACE}

intToRank :: Int -> Rank
intToRank = wordToRank . fromIntegral

wordToRank :: Word -> Rank
wordToRank #{const StdDeck_Rank_2} = Two
wordToRank #{const StdDeck_Rank_3} = Three
wordToRank #{const StdDeck_Rank_4} = Four
wordToRank #{const StdDeck_Rank_5} = Five
wordToRank #{const StdDeck_Rank_6} = Six
wordToRank #{const StdDeck_Rank_7} = Seven
wordToRank #{const StdDeck_Rank_8} = Eight
wordToRank #{const StdDeck_Rank_9} = Nine
wordToRank #{const StdDeck_Rank_TEN} = Ten
wordToRank #{const StdDeck_Rank_JACK} = Jack
wordToRank #{const StdDeck_Rank_QUEEN} = Queen
wordToRank #{const StdDeck_Rank_KING} = King
wordToRank #{const StdDeck_Rank_ACE} = Ace
wordToRank _ = error "wordToRank: Cannot happen."

suitToInt :: Suit -> Int
suitToInt = fromIntegral . suitToWord

suitToWord :: Suit -> Word
suitToWord Hearts = #{const StdDeck_Suit_HEARTS}
suitToWord Diamonds = #{const StdDeck_Suit_DIAMONDS}
suitToWord Clubs = #{const StdDeck_Suit_CLUBS}
suitToWord Spades = #{const StdDeck_Suit_SPADES}

{-
cintToSuit :: CInt -> Suit
cintToSuit #{const StdDeck_Suit_HEARTS} = Hearts
cintToSuit #{const StdDeck_Suit_DIAMONDS} = Diamonds
cintToSuit #{const StdDeck_Suit_CLUBS} = Clubs
cintToSuit #{const StdDeck_Suit_SPADES} = Spades
-}



{-# INLINE numericalToHandValue #-}
numericalToHandValue :: NumericalHandValue -> HandValue
numericalToHandValue val =
  case handType of
    0 -> NoPair        topCard secondCard thirdCard fourthCard fifthCard
    1 -> OnePair       topCard secondCard thirdCard fourthCard
    2 -> TwoPair       topCard secondCard thirdCard
    3 -> ThreeOfAKind  topCard secondCard thirdCard
    4 -> Straight      topCard
    5 -> Flush         topCard secondCard thirdCard fourthCard fifthCard
    6 -> FullHouse     topCard secondCard
    7 -> FourOfAKind   topCard secondCard
    8 -> StraightFlush topCard
    _ -> error "Data.Poker.Interface.toHandValue: Invalid NumericalHandValue"
  where
    !handType  = getHandType val
    topCard    = getTopCard val
    secondCard = getSecondCard val
    thirdCard  = getThirdCard val
    fourthCard = getFourthCard val
    fifthCard  = getFifthCard val