{-# LINE 1 "src/Data/Poker/Interface.hsc" #-}
-- | Interface to the bit-flicking in C.
{-# LINE 2 "src/Data/Poker/Interface.hsc" #-}
{-# LANGUAGE BangPatterns #-}
module Data.Poker.Interface where

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

import Data.Poker.Deck


{-# LINE 12 "src/Data/Poker/Interface.hsc" #-}

{-# LINE 13 "src/Data/Poker/Interface.hsc" #-}

{-# LINE 14 "src/Data/Poker/Interface.hsc" #-}


--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 = 24
{-# LINE 36 "src/Data/Poker/Interface.hsc" #-}

handValue_cardMask :: Word
handValue_cardMask = 15
{-# LINE 39 "src/Data/Poker/Interface.hsc" #-}

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

topCardShift :: Int
topCardShift = 16
{-# LINE 46 "src/Data/Poker/Interface.hsc" #-}

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

secondCardShift :: Int
secondCardShift = 12
{-# LINE 53 "src/Data/Poker/Interface.hsc" #-}

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

thirdCardShift :: Int
thirdCardShift = 8
{-# LINE 60 "src/Data/Poker/Interface.hsc" #-}

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

fourthCardShift :: Int
fourthCardShift = 4
{-# LINE 67 "src/Data/Poker/Interface.hsc" #-}

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

fifthCardShift :: Int
fifthCardShift = 0
{-# LINE 74 "src/Data/Poker/Interface.hsc" #-}

-- 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 = 0
{-# LINE 87 "src/Data/Poker/Interface.hsc" #-}
rankToWord Three = 1
{-# LINE 88 "src/Data/Poker/Interface.hsc" #-}
rankToWord Four = 2
{-# LINE 89 "src/Data/Poker/Interface.hsc" #-}
rankToWord Five = 3
{-# LINE 90 "src/Data/Poker/Interface.hsc" #-}
rankToWord Six = 4
{-# LINE 91 "src/Data/Poker/Interface.hsc" #-}
rankToWord Seven = 5
{-# LINE 92 "src/Data/Poker/Interface.hsc" #-}
rankToWord Eight = 6
{-# LINE 93 "src/Data/Poker/Interface.hsc" #-}
rankToWord Nine = 7
{-# LINE 94 "src/Data/Poker/Interface.hsc" #-}
rankToWord Ten = 8
{-# LINE 95 "src/Data/Poker/Interface.hsc" #-}
rankToWord Jack = 9
{-# LINE 96 "src/Data/Poker/Interface.hsc" #-}
rankToWord Queen = 10
{-# LINE 97 "src/Data/Poker/Interface.hsc" #-}
rankToWord King = 11
{-# LINE 98 "src/Data/Poker/Interface.hsc" #-}
rankToWord Ace = 12
{-# LINE 99 "src/Data/Poker/Interface.hsc" #-}

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

wordToRank :: Word -> Rank
wordToRank 0 = Two
{-# LINE 105 "src/Data/Poker/Interface.hsc" #-}
wordToRank 1 = Three
{-# LINE 106 "src/Data/Poker/Interface.hsc" #-}
wordToRank 2 = Four
{-# LINE 107 "src/Data/Poker/Interface.hsc" #-}
wordToRank 3 = Five
{-# LINE 108 "src/Data/Poker/Interface.hsc" #-}
wordToRank 4 = Six
{-# LINE 109 "src/Data/Poker/Interface.hsc" #-}
wordToRank 5 = Seven
{-# LINE 110 "src/Data/Poker/Interface.hsc" #-}
wordToRank 6 = Eight
{-# LINE 111 "src/Data/Poker/Interface.hsc" #-}
wordToRank 7 = Nine
{-# LINE 112 "src/Data/Poker/Interface.hsc" #-}
wordToRank 8 = Ten
{-# LINE 113 "src/Data/Poker/Interface.hsc" #-}
wordToRank 9 = Jack
{-# LINE 114 "src/Data/Poker/Interface.hsc" #-}
wordToRank 10 = Queen
{-# LINE 115 "src/Data/Poker/Interface.hsc" #-}
wordToRank 11 = King
{-# LINE 116 "src/Data/Poker/Interface.hsc" #-}
wordToRank 12 = Ace
{-# LINE 117 "src/Data/Poker/Interface.hsc" #-}
wordToRank _ = error "wordToRank: Cannot happen."

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

suitToWord :: Suit -> Word
suitToWord Hearts = 0
{-# LINE 124 "src/Data/Poker/Interface.hsc" #-}
suitToWord Diamonds = 1
{-# LINE 125 "src/Data/Poker/Interface.hsc" #-}
suitToWord Clubs = 2
{-# LINE 126 "src/Data/Poker/Interface.hsc" #-}
suitToWord Spades = 3
{-# LINE 127 "src/Data/Poker/Interface.hsc" #-}

{-
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