{-# LANGUAGE BangPatterns #-}
module Data.Poker.Enumerate
    ( foldlSevenCards
    , foldlFiveCards
    , foldlFourCards
    , foldlThreeCards
    , foldlTwoCards
    , foldlOneCard
    , enumerateFiveCards
    ) where

import Data.Poker.Deck

import Data.Bits


-- | Strict left-fold over all 7 card combinations excluding the dead cards.
foldlSevenCards  :: (CardSet -> a -> a)
                -> a
                -> CardSet -- ^ Dead cards.
                -> a
foldlSevenCards fn !st deadCards = simpleIteratee deadCards maxSingleCardSet st (next_1 st) (step_1 st)
  where
    next_1 !acc !i1 = simpleIteratee deadCards (p i1) acc (next_1 acc) (step_1 acc)
    step_1 !acc !i1 =
      let next_2 !acc !i2 = simpleIteratee deadCards (p i2) (next_1 acc i1) (next_2 acc) (step_2 acc)
          step_2 !acc !i2 =
            let next_3 !acc !i3 = simpleIteratee deadCards (p i3) (next_2 acc i2) (next_3 acc) (step_3 acc)
                step_3 !acc !i3 =
                  let next_4 !acc !i4 = simpleIteratee deadCards (p i4) (next_3 acc i3) (next_4 acc) (step_4 acc)
                      step_4 !acc !i4 =
                        let next_5 !acc !i5 = simpleIteratee deadCards (p i5) (next_4 acc i4) (next_5 acc) (step_5 acc)
                            step_5 !acc !i5 =
                              let next_6 !acc !i6 = simpleIteratee deadCards (p i5) (next_5 acc i5) (next_6 acc) (step_6 acc)
                                  step_6 !acc !i6 =
                                    let next_7 !acc !i7 = simpleIteratee deadCards (p i5) (next_6 acc i6) (next_7 acc) (step_7 acc)
                                        step_7 !acc !i7 =
                                          let !newMask = i1 `union` i2 `union` i3 `union` i4 `union` i5 `union` i6 `union` i7 in
                                          next_7 (fn newMask acc) i7
                                    in simpleIteratee deadCards (p i4) (next_5 acc i3) (next_7 acc) (step_7 acc)
                              in simpleIteratee deadCards (p i4) (next_4 acc i3) (next_6 acc) (step_6 acc)
                        in simpleIteratee deadCards (p i4) (next_3 acc i3) (next_5 acc) (step_5 acc)
                  in simpleIteratee deadCards (p i3) (next_2 acc i2) (next_4 acc) (step_4 acc)
            in simpleIteratee deadCards (p i2) (next_1 acc i1) (next_3 acc) (step_3 acc)
      in simpleIteratee deadCards (p i1) acc (next_2 acc) (step_2 acc)
{-# INLINE foldlSevenCards #-}

-- | Strict left-fold over all 5 card combinations excluding the dead cards.
foldlFiveCards  :: (CardSet -> a -> a)
                -> a
                -> CardSet -- ^ Dead cards.
                -> a
foldlFiveCards fn !st deadCards = simpleIteratee deadCards maxSingleCardSet st (next_1 st) (step_1 st)
  where
    next_1 !acc !i1 = simpleIteratee deadCards (p i1) acc (next_1 acc) (step_1 acc)
    step_1 !acc !i1 =
      let next_2 !acc !i2 = simpleIteratee deadCards (p i2) (next_1 acc i1) (next_2 acc) (step_2 acc)
          step_2 !acc !i2 =
            let next_3 !acc !i3 = simpleIteratee deadCards (p i3) (next_2 acc i2) (next_3 acc) (step_3 acc)
                step_3 !acc !i3 =
                  let next_4 !acc !i4 = simpleIteratee deadCards (p i4) (next_3 acc i3) (next_4 acc) (step_4 acc)
                      step_4 !acc !i4 =
                        let next_5 !acc !i5 =
                              simpleIteratee deadCards (p i5) (next_4 acc i4) (next_5 acc) (step_5 acc)
                            step_5 !acc !i5 =
                              let !newMask = i1 `union` i2 `union` i3 `union` i4 `union` i5 in
                              next_5 (fn newMask acc) i5
                        in simpleIteratee deadCards (p i4) (next_3 acc i3) (next_5 acc) (step_5 acc)
                  in simpleIteratee deadCards (p i3) (next_2 acc i2) (next_4 acc) (step_4 acc)
            in simpleIteratee deadCards (p i2) (next_1 acc i1) (next_3 acc) (step_3 acc)
      in simpleIteratee deadCards (p i1) acc (next_2 acc) (step_2 acc)
{-# INLINE foldlFiveCards #-}

-- | Strict left-fold over all 4 card combinations excluding the dead cards.
foldlFourCards  :: (CardSet -> a -> a)
                -> a
                -> CardSet -- ^ Dead cards.
                -> a
foldlFourCards fn !st deadCards = simpleIteratee deadCards maxSingleCardSet st (next_1 st) (step_1 st)
  where
    next_1 !acc !i1 = simpleIteratee deadCards (p i1) acc (next_1 acc) (step_1 acc)
    step_1 !acc !i1 =
      let next_2 !acc !i2 = simpleIteratee deadCards (p i2) (next_1 acc i1) (next_2 acc) (step_2 acc)
          step_2 !acc !i2 =
            let next_3 !acc !i3 = simpleIteratee deadCards (p i3) (next_2 acc i2) (next_3 acc) (step_3 acc)
                step_3 !acc !i3 =
                  let next_4 !acc !i4 = simpleIteratee deadCards (p i4) (next_3 acc i3) (next_4 acc) (step_4 acc)
                      step_4 !acc !i4 =
                        let !newMask = i1 `union` i2 `union` i3 `union` i4 in
                        next_4 (fn newMask acc) i4
                  in simpleIteratee deadCards (p i3) (next_2 acc i2) (next_4 acc) (step_4 acc)
            in simpleIteratee deadCards (p i2) (next_1 acc i1) (next_3 acc) (step_3 acc)
      in simpleIteratee deadCards (p i1) acc (next_2 acc) (step_2 acc)
{-# INLINE foldlFourCards #-}

-- | Strict left-fold over all 3 card combinations excluding the dead cards.
foldlThreeCards  :: (CardSet -> a -> a)
                -> a
                -> CardSet -- ^ Dead cards.
                -> a
foldlThreeCards fn !st deadCards = simpleIteratee deadCards maxSingleCardSet st (next_1 st) (step_1 st)
  where
    next_1 !acc !i1 = simpleIteratee deadCards (p i1) acc (next_1 acc) (step_1 acc)
    step_1 !acc !i1 =
      let next_2 !acc !i2 = simpleIteratee deadCards (p i2) (next_1 acc i1) (next_2 acc) (step_2 acc)
          step_2 !acc !i2 =
            let next_3 !acc !i3 = simpleIteratee deadCards (p i3) (next_2 acc i2) (next_3 acc) (step_3 acc)
                step_3 !acc !i3 =
                  let !newMask = i1 `union` i2 `union` i3 in
                  next_3 (fn newMask acc) i3
            in simpleIteratee deadCards (p i2) (next_1 acc i1) (next_3 acc) (step_3 acc)
      in simpleIteratee deadCards (p i1) acc (next_2 acc) (step_2 acc)
{-# INLINE foldlThreeCards #-}

-- | Strict left-fold over all 2 card combinations excluding the dead cards.
foldlTwoCards  :: (CardSet -> a -> a)
                -> a
                -> CardSet -- ^ Dead cards.
                -> a
foldlTwoCards fn !st deadCards = simpleIteratee deadCards maxSingleCardSet st (next_1 st) (step_1 st)
  where
    next_1 !acc !i1 = simpleIteratee deadCards (p i1) acc (next_1 acc) (step_1 acc)
    step_1 !acc !i1 =
      let next_2 !acc !i2 = simpleIteratee deadCards (p i2) (next_1 acc i1) (next_2 acc) (step_2 acc)
          step_2 !acc !i2 =
            let !newMask = i1 `union` i2 in
            next_2 (fn newMask acc) i2
      in simpleIteratee deadCards (p i1) acc (next_2 acc) (step_2 acc)
{-# INLINE foldlTwoCards #-}

-- | Strict left-fold over all 1 card combinations excluding the dead cards.
foldlOneCard  :: (CardSet -> a -> a)
                -> a
                -> CardSet -- ^ Dead cards.
                -> a
foldlOneCard fn !st deadCards = simpleIteratee deadCards maxSingleCardSet st (next_1 st) (step_1 st)
  where
    next_1 !acc !i1 = simpleIteratee deadCards (p i1) acc (next_1 acc) (step_1 acc)
    step_1 !acc !i1 =
      next_1 (fn i1 acc) i1
{-# INLINE foldlOneCard #-}

  --simpleFive deadCards id step st
  --where
  --  step !i1 !i2 !i3 !i4 !i5 continue !n =
  --    let !newMask = i1 `union` i2 `union` i3 `union` i4 `union` i5 in
  --    continue $! fn newMask n


-- | Given a set of dead cards, enumerate over all possible selections of five cards.
--   The generated card sets do not contain the dead cards.
enumerateFiveCards :: Monad m => CardSet -> (CardSet -> m ()) -> m ()
enumerateFiveCards !deadCards action = foldrFive deadCards done step
  where
    done = return ()
    step !i1 !i2 !i3 !i4 !i5 continue = do
      let !newMask = i1 `union` i2 `union` i3 `union` i4 `union` i5
      action newMask
      continue
{-# INLINE enumerateFiveCards #-}

foldrFive :: CardSet -> t -> (CardSet -> CardSet -> CardSet -> CardSet -> CardSet -> t -> t) -> t
foldrFive !deadCards done step = simpleIteratee deadCards maxSingleCardSet done next_1 step_1
  where
    next_1 !i1 = simpleIteratee deadCards (p i1) done next_1 step_1
    step_1 !i1 = simpleIteratee deadCards (p i1) done (next_2 i1) (step_2 i1)

    next_2 !i1 !i2 = simpleIteratee deadCards (p i2) (next_1 i1) (next_2 i1) (step_2 i1)
    step_2 !i1 !i2 = simpleIteratee deadCards (p i2) (next_1 i1) (next_3 i1 i2) (step_3 i1 i2)

    next_3 !i1 !i2 !i3 = simpleIteratee deadCards (p i3) (next_2 i1 i2) (next_3 i1 i2) (step_3 i1 i2)
    step_3 !i1 !i2 !i3 = simpleIteratee deadCards (p i3) (next_2 i1 i2) (next_4 i1 i2 i3) (step_4 i1 i2 i3)

    next_4 !i1 !i2 !i3 !i4 = simpleIteratee deadCards (p i4) (next_3 i1 i2 i3) (next_4 i1 i2 i3) (step_4 i1 i2 i3)
    step_4 !i1 !i2 !i3 !i4 = simpleIteratee deadCards (p i4) (next_3 i1 i2 i3) (next_5 i1 i2 i3 i4) (step_5 i1 i2 i3 i4)

    next_5 !i1 !i2 !i3 !i4 !i5 =
      simpleIteratee deadCards (p i5) (next_4 i1 i2 i3 i4) (next_5 i1 i2 i3 i4) (step_5 i1 i2 i3 i4)
    step_5 !i1 !i2 !i3 !i4 !i5 = step i1 i2 i3 i4 i5 (next_5 i1 i2 i3 i4 i5)

{-# INLINE foldrFive #-}

simpleIteratee :: CardSet -> CardSet -> t -> (CardSet -> t) -> (CardSet -> t) -> t
simpleIteratee !deadCards !i1 done next step
    | isEmpty i1           = done
    | overlap i1 deadCards = next i1
    | otherwise            = step i1

overlap :: CardSet -> CardSet -> Bool
overlap a b = not (isEmpty (a `intersection` b))

maxSingleCardSet :: CardSet
maxSingleCardSet = CardSet 0x1000000000000000

p :: CardSet -> CardSet
p = predCardSet
predCardSet :: CardSet -> CardSet
predCardSet (CardSet 0x10000) = CardSet 0x1000
predCardSet (CardSet 0x100000000) = CardSet 0x10000000
predCardSet (CardSet 0x1000000000000) = CardSet 0x100000000000
predCardSet (CardSet mask) = CardSet (mask `unsafeShiftR` 1)