{-# LANGUAGE OverloadedStrings #-}

-- | Representation of a game of holdem, including table structure, positioning, pot and betting state.
module Poker.Game
  ( Position (..),
    NumPlayers (..),
    numPlayersToWord8,
    numPlayersFromWord8,
    mkNumPlayers,
    allPositions,
    positionToTxt,
    getPreflopOrder,
    buttonPosition,
    bigBlindPosition,
    getPostFlopOrder,
    sortPostflop,
    Seat (..),
    Pot (..),
    Stack (..),
    Stake (..),
  )
where

import Data.Data
import Data.Text (Text)
import Data.Word (Word8)
import Poker.Cards
import Prettyprinter

-- | A player's 'Position' in a game of poker.
--
-- 'Position's are ordered by table order (clockwise). The smallest 'Position', @Position 0@,
-- is the first player to act preflop. The largest 'Position' is always the big blind.
--
-- >>> allPositions SixPlayers
-- [Position 0,Position 1,Position 2,Position 3,Position 4,Position 5]
-- >>> positionToTxt SixPlayers <$> allPositions SixPlayers
-- ["LJ","HJ","CO","BU","SB","BB"]
-- >>> positionToTxt NinePlayers <$> allPositions NinePlayers
-- ["UTG","UTG1","UTG2","LJ","HJ","CO","BU","SB","BB"]
--
-- The API for 'Position' is unstable. We are open to better ideas :)
newtype Position = Position Word8
  deriving (ReadPrec [Position]
ReadPrec Position
Int -> ReadS Position
ReadS [Position]
(Int -> ReadS Position)
-> ReadS [Position]
-> ReadPrec Position
-> ReadPrec [Position]
-> Read Position
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Position]
$creadListPrec :: ReadPrec [Position]
readPrec :: ReadPrec Position
$creadPrec :: ReadPrec Position
readList :: ReadS [Position]
$creadList :: ReadS [Position]
readsPrec :: Int -> ReadS Position
$creadsPrec :: Int -> ReadS Position
Read, Int -> Position -> ShowS
[Position] -> ShowS
Position -> String
(Int -> Position -> ShowS)
-> (Position -> String) -> ([Position] -> ShowS) -> Show Position
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Position] -> ShowS
$cshowList :: [Position] -> ShowS
show :: Position -> String
$cshow :: Position -> String
showsPrec :: Int -> Position -> ShowS
$cshowsPrec :: Int -> Position -> ShowS
Show, Int -> Position
Position -> Int
Position -> [Position]
Position -> Position
Position -> Position -> [Position]
Position -> Position -> Position -> [Position]
(Position -> Position)
-> (Position -> Position)
-> (Int -> Position)
-> (Position -> Int)
-> (Position -> [Position])
-> (Position -> Position -> [Position])
-> (Position -> Position -> [Position])
-> (Position -> Position -> Position -> [Position])
-> Enum Position
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Position -> Position -> Position -> [Position]
$cenumFromThenTo :: Position -> Position -> Position -> [Position]
enumFromTo :: Position -> Position -> [Position]
$cenumFromTo :: Position -> Position -> [Position]
enumFromThen :: Position -> Position -> [Position]
$cenumFromThen :: Position -> Position -> [Position]
enumFrom :: Position -> [Position]
$cenumFrom :: Position -> [Position]
fromEnum :: Position -> Int
$cfromEnum :: Position -> Int
toEnum :: Int -> Position
$ctoEnum :: Int -> Position
pred :: Position -> Position
$cpred :: Position -> Position
succ :: Position -> Position
$csucc :: Position -> Position
Enum, Position
Position -> Position -> Bounded Position
forall a. a -> a -> Bounded a
maxBound :: Position
$cmaxBound :: Position
minBound :: Position
$cminBound :: Position
Bounded, Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c== :: Position -> Position -> Bool
Eq, Eq Position
Eq Position
-> (Position -> Position -> Ordering)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Position)
-> (Position -> Position -> Position)
-> Ord Position
Position -> Position -> Bool
Position -> Position -> Ordering
Position -> Position -> Position
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmax :: Position -> Position -> Position
>= :: Position -> Position -> Bool
$c>= :: Position -> Position -> Bool
> :: Position -> Position -> Bool
$c> :: Position -> Position -> Bool
<= :: Position -> Position -> Bool
$c<= :: Position -> Position -> Bool
< :: Position -> Position -> Bool
$c< :: Position -> Position -> Bool
compare :: Position -> Position -> Ordering
$ccompare :: Position -> Position -> Ordering
$cp1Ord :: Eq Position
Ord, Typeable Position
DataType
Constr
Typeable Position
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Position -> c Position)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Position)
-> (Position -> Constr)
-> (Position -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Position))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Position))
-> ((forall b. Data b => b -> b) -> Position -> Position)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Position -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Position -> r)
-> (forall u. (forall d. Data d => d -> u) -> Position -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Position -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Position -> m Position)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Position -> m Position)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Position -> m Position)
-> Data Position
Position -> DataType
Position -> Constr
(forall b. Data b => b -> b) -> Position -> Position
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Position -> c Position
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Position
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Position -> u
forall u. (forall d. Data d => d -> u) -> Position -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Position -> m Position
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Position -> m Position
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Position
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Position -> c Position
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Position)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Position)
$cPosition :: Constr
$tPosition :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Position -> m Position
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Position -> m Position
gmapMp :: (forall d. Data d => d -> m d) -> Position -> m Position
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Position -> m Position
gmapM :: (forall d. Data d => d -> m d) -> Position -> m Position
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Position -> m Position
gmapQi :: Int -> (forall d. Data d => d -> u) -> Position -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Position -> u
gmapQ :: (forall d. Data d => d -> u) -> Position -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Position -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
gmapT :: (forall b. Data b => b -> b) -> Position -> Position
$cgmapT :: (forall b. Data b => b -> b) -> Position -> Position
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Position)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Position)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Position)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Position)
dataTypeOf :: Position -> DataType
$cdataTypeOf :: Position -> DataType
toConstr :: Position -> Constr
$ctoConstr :: Position -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Position
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Position
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Position -> c Position
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Position -> c Position
$cp1Data :: Typeable Position
Data, Typeable)

instance Pretty Position where
  pretty :: Position -> Doc ann
pretty = Position -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow

-- | Number of active players at a poker table. Players sitting out do not count, as
-- they do not contribute to the number of 'Position's.
data NumPlayers
  = TwoPlayers
  | ThreePlayers
  | FourPlayers
  | FivePlayers
  | SixPlayers
  | SevenPlayers
  | EightPlayers
  | NinePlayers
  deriving (Int -> NumPlayers
NumPlayers -> Int
NumPlayers -> [NumPlayers]
NumPlayers -> NumPlayers
NumPlayers -> NumPlayers -> [NumPlayers]
NumPlayers -> NumPlayers -> NumPlayers -> [NumPlayers]
(NumPlayers -> NumPlayers)
-> (NumPlayers -> NumPlayers)
-> (Int -> NumPlayers)
-> (NumPlayers -> Int)
-> (NumPlayers -> [NumPlayers])
-> (NumPlayers -> NumPlayers -> [NumPlayers])
-> (NumPlayers -> NumPlayers -> [NumPlayers])
-> (NumPlayers -> NumPlayers -> NumPlayers -> [NumPlayers])
-> Enum NumPlayers
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NumPlayers -> NumPlayers -> NumPlayers -> [NumPlayers]
$cenumFromThenTo :: NumPlayers -> NumPlayers -> NumPlayers -> [NumPlayers]
enumFromTo :: NumPlayers -> NumPlayers -> [NumPlayers]
$cenumFromTo :: NumPlayers -> NumPlayers -> [NumPlayers]
enumFromThen :: NumPlayers -> NumPlayers -> [NumPlayers]
$cenumFromThen :: NumPlayers -> NumPlayers -> [NumPlayers]
enumFrom :: NumPlayers -> [NumPlayers]
$cenumFrom :: NumPlayers -> [NumPlayers]
fromEnum :: NumPlayers -> Int
$cfromEnum :: NumPlayers -> Int
toEnum :: Int -> NumPlayers
$ctoEnum :: Int -> NumPlayers
pred :: NumPlayers -> NumPlayers
$cpred :: NumPlayers -> NumPlayers
succ :: NumPlayers -> NumPlayers
$csucc :: NumPlayers -> NumPlayers
Enum, NumPlayers -> NumPlayers -> Bool
(NumPlayers -> NumPlayers -> Bool)
-> (NumPlayers -> NumPlayers -> Bool) -> Eq NumPlayers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumPlayers -> NumPlayers -> Bool
$c/= :: NumPlayers -> NumPlayers -> Bool
== :: NumPlayers -> NumPlayers -> Bool
$c== :: NumPlayers -> NumPlayers -> Bool
Eq, Eq NumPlayers
Eq NumPlayers
-> (NumPlayers -> NumPlayers -> Ordering)
-> (NumPlayers -> NumPlayers -> Bool)
-> (NumPlayers -> NumPlayers -> Bool)
-> (NumPlayers -> NumPlayers -> Bool)
-> (NumPlayers -> NumPlayers -> Bool)
-> (NumPlayers -> NumPlayers -> NumPlayers)
-> (NumPlayers -> NumPlayers -> NumPlayers)
-> Ord NumPlayers
NumPlayers -> NumPlayers -> Bool
NumPlayers -> NumPlayers -> Ordering
NumPlayers -> NumPlayers -> NumPlayers
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NumPlayers -> NumPlayers -> NumPlayers
$cmin :: NumPlayers -> NumPlayers -> NumPlayers
max :: NumPlayers -> NumPlayers -> NumPlayers
$cmax :: NumPlayers -> NumPlayers -> NumPlayers
>= :: NumPlayers -> NumPlayers -> Bool
$c>= :: NumPlayers -> NumPlayers -> Bool
> :: NumPlayers -> NumPlayers -> Bool
$c> :: NumPlayers -> NumPlayers -> Bool
<= :: NumPlayers -> NumPlayers -> Bool
$c<= :: NumPlayers -> NumPlayers -> Bool
< :: NumPlayers -> NumPlayers -> Bool
$c< :: NumPlayers -> NumPlayers -> Bool
compare :: NumPlayers -> NumPlayers -> Ordering
$ccompare :: NumPlayers -> NumPlayers -> Ordering
$cp1Ord :: Eq NumPlayers
Ord)

-- | Convert a 'NumPlayers' to a 'Word8'.
numPlayersToWord8 :: NumPlayers -> Word8
numPlayersToWord8 :: NumPlayers -> Word8
numPlayersToWord8 NumPlayers
TwoPlayers = Word8
2
numPlayersToWord8 NumPlayers
ThreePlayers = Word8
3
numPlayersToWord8 NumPlayers
FourPlayers = Word8
4
numPlayersToWord8 NumPlayers
FivePlayers = Word8
5
numPlayersToWord8 NumPlayers
SixPlayers = Word8
6
numPlayersToWord8 NumPlayers
SevenPlayers = Word8
7
numPlayersToWord8 NumPlayers
EightPlayers = Word8
8
numPlayersToWord8 NumPlayers
NinePlayers = Word8
9

-- | Convert a 'Word8' to a 'NumPlayers'.
numPlayersFromWord8 :: Word8 -> Maybe NumPlayers
numPlayersFromWord8 :: Word8 -> Maybe NumPlayers
numPlayersFromWord8 Word8
2 = NumPlayers -> Maybe NumPlayers
forall a. a -> Maybe a
Just NumPlayers
TwoPlayers
numPlayersFromWord8 Word8
3 = NumPlayers -> Maybe NumPlayers
forall a. a -> Maybe a
Just NumPlayers
ThreePlayers
numPlayersFromWord8 Word8
4 = NumPlayers -> Maybe NumPlayers
forall a. a -> Maybe a
Just NumPlayers
FourPlayers
numPlayersFromWord8 Word8
5 = NumPlayers -> Maybe NumPlayers
forall a. a -> Maybe a
Just NumPlayers
FivePlayers
numPlayersFromWord8 Word8
6 = NumPlayers -> Maybe NumPlayers
forall a. a -> Maybe a
Just NumPlayers
SixPlayers
numPlayersFromWord8 Word8
7 = NumPlayers -> Maybe NumPlayers
forall a. a -> Maybe a
Just NumPlayers
SevenPlayers
numPlayersFromWord8 Word8
8 = NumPlayers -> Maybe NumPlayers
forall a. a -> Maybe a
Just NumPlayers
EightPlayers
numPlayersFromWord8 Word8
9 = NumPlayers -> Maybe NumPlayers
forall a. a -> Maybe a
Just NumPlayers
NinePlayers
numPlayersFromWord8 Word8
_ = Maybe NumPlayers
forall a. Maybe a
Nothing

-- | WARNING: The incoming 'Integral' is downcast to a 'Word8'
mkNumPlayers :: Integral a => a -> Maybe NumPlayers
mkNumPlayers :: a -> Maybe NumPlayers
mkNumPlayers a
num | a
num a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
2 Bool -> Bool -> Bool
&& a
num a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
9 = Word8 -> Maybe NumPlayers
numPlayersFromWord8 (Word8 -> Maybe NumPlayers) -> Word8 -> Maybe NumPlayers
forall a b. (a -> b) -> a -> b
$ a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
num
mkNumPlayers a
_ = Maybe NumPlayers
forall a. Maybe a
Nothing

-- | >>> allPositions SixPlayers
-- [Position 0,Position 1,Position 2,Position 3,Position 4,Position 5]
allPositions :: NumPlayers -> [Position]
allPositions :: NumPlayers -> [Position]
allPositions (NumPlayers -> Word8
numPlayersToWord8 -> Word8
num) = Word8 -> Position
Position (Word8 -> Position) -> [Word8] -> [Position]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word8
0 .. Word8
num Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
1]

-- | >>> positionToTxt TwoPlayers <$> allPositions TwoPlayers
-- ["BU","BB"]
-- >>> positionToTxt SixPlayers <$> allPositions SixPlayers
-- ["LJ","HJ","CO","BU","SB","BB"]
-- >>> positionToTxt NinePlayers <$> allPositions NinePlayers
-- ["UTG","UTG1","UTG2","LJ","HJ","CO","BU","SB","BB"]
positionToTxt :: NumPlayers -> Position -> Text
positionToTxt :: NumPlayers -> Position -> Text
positionToTxt (NumPlayers -> Word8
numPlayersToWord8 -> Word8
num) (Position Word8
pos) =
  let allPositionTexts :: [Text]
allPositionTexts = [Text
"UTG", Text
"UTG1", Text
"UTG2", Text
"LJ", Text
"HJ", Text
"CO", Text
"BU", Text
"SB", Text
"BB"]
      positionTexts :: [Text]
positionTexts = case Word8
num of
        Word8
2 -> [Text
"BU", Text
"BB"]
        Word8
num' | Word8
num' Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
2 Bool -> Bool -> Bool
&& Word8
num' Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
9 -> Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop (Int
9 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
num') [Text]
allPositionTexts
        Word8
_ -> String -> [Text]
forall a. HasCallStack => String -> a
error (String -> [Text]) -> String -> [Text]
forall a b. (a -> b) -> a -> b
$ String
"Unexpected NumPlayers value: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
num
   in [Text]
positionTexts [Text] -> Int -> Text
forall a. [a] -> Int -> a
!! Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
pos

-- | >>> positionToTxt TwoPlayers <$> getPreflopOrder TwoPlayers
-- ["BU","BB"]
-- >>> positionToTxt SixPlayers <$> getPreflopOrder SixPlayers
-- ["LJ","HJ","CO","BU","SB","BB"]
-- >>> positionToTxt NinePlayers <$> getPreflopOrder NinePlayers
-- ["UTG","UTG1","UTG2","LJ","HJ","CO","BU","SB","BB"]
getPreflopOrder :: NumPlayers -> [Position]
getPreflopOrder :: NumPlayers -> [Position]
getPreflopOrder = NumPlayers -> [Position]
allPositions

-- | >>> buttonPosition TwoPlayers
-- Position 0
-- >>> (\numPlayers -> positionToTxt numPlayers $ buttonPosition numPlayers) <$> enumFromTo TwoPlayers NinePlayers
-- ["BU","BU","BU","BU","BU","BU","BU","BU"]
buttonPosition :: NumPlayers -> Position
buttonPosition :: NumPlayers -> Position
buttonPosition (NumPlayers -> Word8
numPlayersToWord8 -> Word8
num) = case Word8
num of
  Word8
2 -> Word8 -> Position
Position Word8
0
  Word8
_ -> Word8 -> Position
Position (Word8
num Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
3)

-- | >>> bigBlindPosition TwoPlayers
-- Position 1
-- >>> (\numPlayers -> positionToTxt numPlayers $ bigBlindPosition numPlayers) <$> enumFromTo TwoPlayers NinePlayers
-- ["BB","BB","BB","BB","BB","BB","BB","BB"]
bigBlindPosition :: NumPlayers -> Position
bigBlindPosition :: NumPlayers -> Position
bigBlindPosition (NumPlayers -> Word8
numPlayersToWord8 -> Word8
num) = Word8 -> Position
Position (Word8
num Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
1)

-- | >>> positionToTxt TwoPlayers <$> getPostFlopOrder TwoPlayers
-- ["BB","BU"]
-- >>> positionToTxt ThreePlayers <$> getPostFlopOrder ThreePlayers
-- ["SB","BB","BU"]
-- >>> positionToTxt SixPlayers <$> getPostFlopOrder SixPlayers
-- ["SB","BB","LJ","HJ","CO","BU"]
-- >>> positionToTxt NinePlayers <$> getPostFlopOrder NinePlayers
-- ["SB","BB","UTG","UTG1","UTG2","LJ","HJ","CO","BU"]
getPostFlopOrder :: NumPlayers -> [Position]
getPostFlopOrder :: NumPlayers -> [Position]
getPostFlopOrder numPlayers :: NumPlayers
numPlayers@(Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> (NumPlayers -> Word8) -> NumPlayers -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumPlayers -> Word8
numPlayersToWord8 -> Int
num) =
  Int -> [Position] -> [Position]
forall a. Int -> [a] -> [a]
take Int
num
    ([Position] -> [Position])
-> ([Position] -> [Position]) -> [Position] -> [Position]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Position] -> [Position]
forall a. Int -> [a] -> [a]
drop Int
1
    ([Position] -> [Position])
-> ([Position] -> [Position]) -> [Position] -> [Position]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> Bool) -> [Position] -> [Position]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
/= NumPlayers -> Position
buttonPosition NumPlayers
numPlayers)
    ([Position] -> [Position])
-> ([Position] -> [Position]) -> [Position] -> [Position]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Position] -> [Position]
forall a. [a] -> [a]
cycle
    ([Position] -> [Position]) -> [Position] -> [Position]
forall a b. (a -> b) -> a -> b
$ NumPlayers -> [Position]
allPositions NumPlayers
numPlayers

-- | Sort a list of positions acccording to postflop ordering
--
-- >>> positionToTxt TwoPlayers <$> sortPostflop TwoPlayers (allPositions TwoPlayers)
-- ["BB","BU"]
-- >>> positionToTxt ThreePlayers <$> sortPostflop ThreePlayers (allPositions ThreePlayers)
-- ["SB","BB","BU"]
-- >>> positionToTxt SixPlayers <$> sortPostflop SixPlayers (allPositions SixPlayers)
-- ["SB","BB","LJ","HJ","CO","BU"]
-- >>> positionToTxt NinePlayers <$> sortPostflop NinePlayers (allPositions NinePlayers)
-- ["SB","BB","UTG","UTG1","UTG2","LJ","HJ","CO","BU"]
sortPostflop :: NumPlayers -> [Position] -> [Position]
sortPostflop :: NumPlayers -> [Position] -> [Position]
sortPostflop NumPlayers
num [Position]
ps = (Position -> Bool) -> [Position] -> [Position]
forall a. (a -> Bool) -> [a] -> [a]
filter (Position -> [Position] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Position]
ps) ([Position] -> [Position]) -> [Position] -> [Position]
forall a b. (a -> b) -> a -> b
$ NumPlayers -> [Position]
getPostFlopOrder NumPlayers
num

-- | Is a player hero or villain. Hero in poker means that the hand is from
-- the hero player's perspective.
data IsHero = Hero | Villain
  deriving (ReadPrec [IsHero]
ReadPrec IsHero
Int -> ReadS IsHero
ReadS [IsHero]
(Int -> ReadS IsHero)
-> ReadS [IsHero]
-> ReadPrec IsHero
-> ReadPrec [IsHero]
-> Read IsHero
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IsHero]
$creadListPrec :: ReadPrec [IsHero]
readPrec :: ReadPrec IsHero
$creadPrec :: ReadPrec IsHero
readList :: ReadS [IsHero]
$creadList :: ReadS [IsHero]
readsPrec :: Int -> ReadS IsHero
$creadsPrec :: Int -> ReadS IsHero
Read, Int -> IsHero -> ShowS
[IsHero] -> ShowS
IsHero -> String
(Int -> IsHero -> ShowS)
-> (IsHero -> String) -> ([IsHero] -> ShowS) -> Show IsHero
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsHero] -> ShowS
$cshowList :: [IsHero] -> ShowS
show :: IsHero -> String
$cshow :: IsHero -> String
showsPrec :: Int -> IsHero -> ShowS
$cshowsPrec :: Int -> IsHero -> ShowS
Show, IsHero -> IsHero -> Bool
(IsHero -> IsHero -> Bool)
-> (IsHero -> IsHero -> Bool) -> Eq IsHero
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsHero -> IsHero -> Bool
$c/= :: IsHero -> IsHero -> Bool
== :: IsHero -> IsHero -> Bool
$c== :: IsHero -> IsHero -> Bool
Eq, Eq IsHero
Eq IsHero
-> (IsHero -> IsHero -> Ordering)
-> (IsHero -> IsHero -> Bool)
-> (IsHero -> IsHero -> Bool)
-> (IsHero -> IsHero -> Bool)
-> (IsHero -> IsHero -> Bool)
-> (IsHero -> IsHero -> IsHero)
-> (IsHero -> IsHero -> IsHero)
-> Ord IsHero
IsHero -> IsHero -> Bool
IsHero -> IsHero -> Ordering
IsHero -> IsHero -> IsHero
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IsHero -> IsHero -> IsHero
$cmin :: IsHero -> IsHero -> IsHero
max :: IsHero -> IsHero -> IsHero
$cmax :: IsHero -> IsHero -> IsHero
>= :: IsHero -> IsHero -> Bool
$c>= :: IsHero -> IsHero -> Bool
> :: IsHero -> IsHero -> Bool
$c> :: IsHero -> IsHero -> Bool
<= :: IsHero -> IsHero -> Bool
$c<= :: IsHero -> IsHero -> Bool
< :: IsHero -> IsHero -> Bool
$c< :: IsHero -> IsHero -> Bool
compare :: IsHero -> IsHero -> Ordering
$ccompare :: IsHero -> IsHero -> Ordering
$cp1Ord :: Eq IsHero
Ord, Int -> IsHero
IsHero -> Int
IsHero -> [IsHero]
IsHero -> IsHero
IsHero -> IsHero -> [IsHero]
IsHero -> IsHero -> IsHero -> [IsHero]
(IsHero -> IsHero)
-> (IsHero -> IsHero)
-> (Int -> IsHero)
-> (IsHero -> Int)
-> (IsHero -> [IsHero])
-> (IsHero -> IsHero -> [IsHero])
-> (IsHero -> IsHero -> [IsHero])
-> (IsHero -> IsHero -> IsHero -> [IsHero])
-> Enum IsHero
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: IsHero -> IsHero -> IsHero -> [IsHero]
$cenumFromThenTo :: IsHero -> IsHero -> IsHero -> [IsHero]
enumFromTo :: IsHero -> IsHero -> [IsHero]
$cenumFromTo :: IsHero -> IsHero -> [IsHero]
enumFromThen :: IsHero -> IsHero -> [IsHero]
$cenumFromThen :: IsHero -> IsHero -> [IsHero]
enumFrom :: IsHero -> [IsHero]
$cenumFrom :: IsHero -> [IsHero]
fromEnum :: IsHero -> Int
$cfromEnum :: IsHero -> Int
toEnum :: Int -> IsHero
$ctoEnum :: Int -> IsHero
pred :: IsHero -> IsHero
$cpred :: IsHero -> IsHero
succ :: IsHero -> IsHero
$csucc :: IsHero -> IsHero
Enum, IsHero
IsHero -> IsHero -> Bounded IsHero
forall a. a -> a -> Bounded a
maxBound :: IsHero
$cmaxBound :: IsHero
minBound :: IsHero
$cminBound :: IsHero
Bounded)

-- | A player's seat number at a poker table.
newtype Seat = Seat {Seat -> Int
_seat :: Int} deriving (ReadPrec [Seat]
ReadPrec Seat
Int -> ReadS Seat
ReadS [Seat]
(Int -> ReadS Seat)
-> ReadS [Seat] -> ReadPrec Seat -> ReadPrec [Seat] -> Read Seat
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Seat]
$creadListPrec :: ReadPrec [Seat]
readPrec :: ReadPrec Seat
$creadPrec :: ReadPrec Seat
readList :: ReadS [Seat]
$creadList :: ReadS [Seat]
readsPrec :: Int -> ReadS Seat
$creadsPrec :: Int -> ReadS Seat
Read, Int -> Seat -> ShowS
[Seat] -> ShowS
Seat -> String
(Int -> Seat -> ShowS)
-> (Seat -> String) -> ([Seat] -> ShowS) -> Show Seat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Seat] -> ShowS
$cshowList :: [Seat] -> ShowS
show :: Seat -> String
$cshow :: Seat -> String
showsPrec :: Int -> Seat -> ShowS
$cshowsPrec :: Int -> Seat -> ShowS
Show, Seat -> Seat -> Bool
(Seat -> Seat -> Bool) -> (Seat -> Seat -> Bool) -> Eq Seat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Seat -> Seat -> Bool
$c/= :: Seat -> Seat -> Bool
== :: Seat -> Seat -> Bool
$c== :: Seat -> Seat -> Bool
Eq, Eq Seat
Eq Seat
-> (Seat -> Seat -> Ordering)
-> (Seat -> Seat -> Bool)
-> (Seat -> Seat -> Bool)
-> (Seat -> Seat -> Bool)
-> (Seat -> Seat -> Bool)
-> (Seat -> Seat -> Seat)
-> (Seat -> Seat -> Seat)
-> Ord Seat
Seat -> Seat -> Bool
Seat -> Seat -> Ordering
Seat -> Seat -> Seat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Seat -> Seat -> Seat
$cmin :: Seat -> Seat -> Seat
max :: Seat -> Seat -> Seat
$cmax :: Seat -> Seat -> Seat
>= :: Seat -> Seat -> Bool
$c>= :: Seat -> Seat -> Bool
> :: Seat -> Seat -> Bool
$c> :: Seat -> Seat -> Bool
<= :: Seat -> Seat -> Bool
$c<= :: Seat -> Seat -> Bool
< :: Seat -> Seat -> Bool
$c< :: Seat -> Seat -> Bool
compare :: Seat -> Seat -> Ordering
$ccompare :: Seat -> Seat -> Ordering
$cp1Ord :: Eq Seat
Ord, Integer -> Seat
Seat -> Seat
Seat -> Seat -> Seat
(Seat -> Seat -> Seat)
-> (Seat -> Seat -> Seat)
-> (Seat -> Seat -> Seat)
-> (Seat -> Seat)
-> (Seat -> Seat)
-> (Seat -> Seat)
-> (Integer -> Seat)
-> Num Seat
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Seat
$cfromInteger :: Integer -> Seat
signum :: Seat -> Seat
$csignum :: Seat -> Seat
abs :: Seat -> Seat
$cabs :: Seat -> Seat
negate :: Seat -> Seat
$cnegate :: Seat -> Seat
* :: Seat -> Seat -> Seat
$c* :: Seat -> Seat -> Seat
- :: Seat -> Seat -> Seat
$c- :: Seat -> Seat -> Seat
+ :: Seat -> Seat -> Seat
$c+ :: Seat -> Seat -> Seat
Num)

-- | Total amount of money in the 'Pot'.
newtype Pot b = Pot {Pot b -> b
_pot :: b}
  deriving (Int -> Pot b -> ShowS
[Pot b] -> ShowS
Pot b -> String
(Int -> Pot b -> ShowS)
-> (Pot b -> String) -> ([Pot b] -> ShowS) -> Show (Pot b)
forall b. Show b => Int -> Pot b -> ShowS
forall b. Show b => [Pot b] -> ShowS
forall b. Show b => Pot b -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pot b] -> ShowS
$cshowList :: forall b. Show b => [Pot b] -> ShowS
show :: Pot b -> String
$cshow :: forall b. Show b => Pot b -> String
showsPrec :: Int -> Pot b -> ShowS
$cshowsPrec :: forall b. Show b => Int -> Pot b -> ShowS
Show, Pot b -> Pot b -> Bool
(Pot b -> Pot b -> Bool) -> (Pot b -> Pot b -> Bool) -> Eq (Pot b)
forall b. Eq b => Pot b -> Pot b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pot b -> Pot b -> Bool
$c/= :: forall b. Eq b => Pot b -> Pot b -> Bool
== :: Pot b -> Pot b -> Bool
$c== :: forall b. Eq b => Pot b -> Pot b -> Bool
Eq, Eq (Pot b)
Eq (Pot b)
-> (Pot b -> Pot b -> Ordering)
-> (Pot b -> Pot b -> Bool)
-> (Pot b -> Pot b -> Bool)
-> (Pot b -> Pot b -> Bool)
-> (Pot b -> Pot b -> Bool)
-> (Pot b -> Pot b -> Pot b)
-> (Pot b -> Pot b -> Pot b)
-> Ord (Pot b)
Pot b -> Pot b -> Bool
Pot b -> Pot b -> Ordering
Pot b -> Pot b -> Pot b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall b. Ord b => Eq (Pot b)
forall b. Ord b => Pot b -> Pot b -> Bool
forall b. Ord b => Pot b -> Pot b -> Ordering
forall b. Ord b => Pot b -> Pot b -> Pot b
min :: Pot b -> Pot b -> Pot b
$cmin :: forall b. Ord b => Pot b -> Pot b -> Pot b
max :: Pot b -> Pot b -> Pot b
$cmax :: forall b. Ord b => Pot b -> Pot b -> Pot b
>= :: Pot b -> Pot b -> Bool
$c>= :: forall b. Ord b => Pot b -> Pot b -> Bool
> :: Pot b -> Pot b -> Bool
$c> :: forall b. Ord b => Pot b -> Pot b -> Bool
<= :: Pot b -> Pot b -> Bool
$c<= :: forall b. Ord b => Pot b -> Pot b -> Bool
< :: Pot b -> Pot b -> Bool
$c< :: forall b. Ord b => Pot b -> Pot b -> Bool
compare :: Pot b -> Pot b -> Ordering
$ccompare :: forall b. Ord b => Pot b -> Pot b -> Ordering
$cp1Ord :: forall b. Ord b => Eq (Pot b)
Ord, Integer -> Pot b
Pot b -> Pot b
Pot b -> Pot b -> Pot b
(Pot b -> Pot b -> Pot b)
-> (Pot b -> Pot b -> Pot b)
-> (Pot b -> Pot b -> Pot b)
-> (Pot b -> Pot b)
-> (Pot b -> Pot b)
-> (Pot b -> Pot b)
-> (Integer -> Pot b)
-> Num (Pot b)
forall b. Num b => Integer -> Pot b
forall b. Num b => Pot b -> Pot b
forall b. Num b => Pot b -> Pot b -> Pot b
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Pot b
$cfromInteger :: forall b. Num b => Integer -> Pot b
signum :: Pot b -> Pot b
$csignum :: forall b. Num b => Pot b -> Pot b
abs :: Pot b -> Pot b
$cabs :: forall b. Num b => Pot b -> Pot b
negate :: Pot b -> Pot b
$cnegate :: forall b. Num b => Pot b -> Pot b
* :: Pot b -> Pot b -> Pot b
$c* :: forall b. Num b => Pot b -> Pot b -> Pot b
- :: Pot b -> Pot b -> Pot b
$c- :: forall b. Num b => Pot b -> Pot b -> Pot b
+ :: Pot b -> Pot b -> Pot b
$c+ :: forall b. Num b => Pot b -> Pot b -> Pot b
Num, a -> Pot b -> Pot a
(a -> b) -> Pot a -> Pot b
(forall a b. (a -> b) -> Pot a -> Pot b)
-> (forall a b. a -> Pot b -> Pot a) -> Functor Pot
forall a b. a -> Pot b -> Pot a
forall a b. (a -> b) -> Pot a -> Pot b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Pot b -> Pot a
$c<$ :: forall a b. a -> Pot b -> Pot a
fmap :: (a -> b) -> Pot a -> Pot b
$cfmap :: forall a b. (a -> b) -> Pot a -> Pot b
Functor, [Pot b] -> Doc ann
Pot b -> Doc ann
(forall ann. Pot b -> Doc ann)
-> (forall ann. [Pot b] -> Doc ann) -> Pretty (Pot b)
forall ann. [Pot b] -> Doc ann
forall b ann. Pretty b => [Pot b] -> Doc ann
forall b ann. Pretty b => Pot b -> Doc ann
forall ann. Pot b -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: [Pot b] -> Doc ann
$cprettyList :: forall b ann. Pretty b => [Pot b] -> Doc ann
pretty :: Pot b -> Doc ann
$cpretty :: forall b ann. Pretty b => Pot b -> Doc ann
Pretty, b -> Pot b -> Pot b
NonEmpty (Pot b) -> Pot b
Pot b -> Pot b -> Pot b
(Pot b -> Pot b -> Pot b)
-> (NonEmpty (Pot b) -> Pot b)
-> (forall b. Integral b => b -> Pot b -> Pot b)
-> Semigroup (Pot b)
forall b. Integral b => b -> Pot b -> Pot b
forall b. Semigroup b => NonEmpty (Pot b) -> Pot b
forall b. Semigroup b => Pot b -> Pot b -> Pot b
forall b b. (Semigroup b, Integral b) => b -> Pot b -> Pot b
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Pot b -> Pot b
$cstimes :: forall b b. (Semigroup b, Integral b) => b -> Pot b -> Pot b
sconcat :: NonEmpty (Pot b) -> Pot b
$csconcat :: forall b. Semigroup b => NonEmpty (Pot b) -> Pot b
<> :: Pot b -> Pot b -> Pot b
$c<> :: forall b. Semigroup b => Pot b -> Pot b -> Pot b
Semigroup, Semigroup (Pot b)
Pot b
Semigroup (Pot b)
-> Pot b
-> (Pot b -> Pot b -> Pot b)
-> ([Pot b] -> Pot b)
-> Monoid (Pot b)
[Pot b] -> Pot b
Pot b -> Pot b -> Pot b
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall b. Monoid b => Semigroup (Pot b)
forall b. Monoid b => Pot b
forall b. Monoid b => [Pot b] -> Pot b
forall b. Monoid b => Pot b -> Pot b -> Pot b
mconcat :: [Pot b] -> Pot b
$cmconcat :: forall b. Monoid b => [Pot b] -> Pot b
mappend :: Pot b -> Pot b -> Pot b
$cmappend :: forall b. Monoid b => Pot b -> Pot b -> Pot b
mempty :: Pot b
$cmempty :: forall b. Monoid b => Pot b
$cp1Monoid :: forall b. Monoid b => Semigroup (Pot b)
Monoid)

-- | Amount of money in a player's stack (not having been bet).
newtype Stack b = Stack {Stack b -> b
_stack :: b}
  deriving (Int -> Stack b -> ShowS
[Stack b] -> ShowS
Stack b -> String
(Int -> Stack b -> ShowS)
-> (Stack b -> String) -> ([Stack b] -> ShowS) -> Show (Stack b)
forall b. Show b => Int -> Stack b -> ShowS
forall b. Show b => [Stack b] -> ShowS
forall b. Show b => Stack b -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stack b] -> ShowS
$cshowList :: forall b. Show b => [Stack b] -> ShowS
show :: Stack b -> String
$cshow :: forall b. Show b => Stack b -> String
showsPrec :: Int -> Stack b -> ShowS
$cshowsPrec :: forall b. Show b => Int -> Stack b -> ShowS
Show, Stack b -> Stack b -> Bool
(Stack b -> Stack b -> Bool)
-> (Stack b -> Stack b -> Bool) -> Eq (Stack b)
forall b. Eq b => Stack b -> Stack b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stack b -> Stack b -> Bool
$c/= :: forall b. Eq b => Stack b -> Stack b -> Bool
== :: Stack b -> Stack b -> Bool
$c== :: forall b. Eq b => Stack b -> Stack b -> Bool
Eq, Eq (Stack b)
Eq (Stack b)
-> (Stack b -> Stack b -> Ordering)
-> (Stack b -> Stack b -> Bool)
-> (Stack b -> Stack b -> Bool)
-> (Stack b -> Stack b -> Bool)
-> (Stack b -> Stack b -> Bool)
-> (Stack b -> Stack b -> Stack b)
-> (Stack b -> Stack b -> Stack b)
-> Ord (Stack b)
Stack b -> Stack b -> Bool
Stack b -> Stack b -> Ordering
Stack b -> Stack b -> Stack b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall b. Ord b => Eq (Stack b)
forall b. Ord b => Stack b -> Stack b -> Bool
forall b. Ord b => Stack b -> Stack b -> Ordering
forall b. Ord b => Stack b -> Stack b -> Stack b
min :: Stack b -> Stack b -> Stack b
$cmin :: forall b. Ord b => Stack b -> Stack b -> Stack b
max :: Stack b -> Stack b -> Stack b
$cmax :: forall b. Ord b => Stack b -> Stack b -> Stack b
>= :: Stack b -> Stack b -> Bool
$c>= :: forall b. Ord b => Stack b -> Stack b -> Bool
> :: Stack b -> Stack b -> Bool
$c> :: forall b. Ord b => Stack b -> Stack b -> Bool
<= :: Stack b -> Stack b -> Bool
$c<= :: forall b. Ord b => Stack b -> Stack b -> Bool
< :: Stack b -> Stack b -> Bool
$c< :: forall b. Ord b => Stack b -> Stack b -> Bool
compare :: Stack b -> Stack b -> Ordering
$ccompare :: forall b. Ord b => Stack b -> Stack b -> Ordering
$cp1Ord :: forall b. Ord b => Eq (Stack b)
Ord, Integer -> Stack b
Stack b -> Stack b
Stack b -> Stack b -> Stack b
(Stack b -> Stack b -> Stack b)
-> (Stack b -> Stack b -> Stack b)
-> (Stack b -> Stack b -> Stack b)
-> (Stack b -> Stack b)
-> (Stack b -> Stack b)
-> (Stack b -> Stack b)
-> (Integer -> Stack b)
-> Num (Stack b)
forall b. Num b => Integer -> Stack b
forall b. Num b => Stack b -> Stack b
forall b. Num b => Stack b -> Stack b -> Stack b
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Stack b
$cfromInteger :: forall b. Num b => Integer -> Stack b
signum :: Stack b -> Stack b
$csignum :: forall b. Num b => Stack b -> Stack b
abs :: Stack b -> Stack b
$cabs :: forall b. Num b => Stack b -> Stack b
negate :: Stack b -> Stack b
$cnegate :: forall b. Num b => Stack b -> Stack b
* :: Stack b -> Stack b -> Stack b
$c* :: forall b. Num b => Stack b -> Stack b -> Stack b
- :: Stack b -> Stack b -> Stack b
$c- :: forall b. Num b => Stack b -> Stack b -> Stack b
+ :: Stack b -> Stack b -> Stack b
$c+ :: forall b. Num b => Stack b -> Stack b -> Stack b
Num, a -> Stack b -> Stack a
(a -> b) -> Stack a -> Stack b
(forall a b. (a -> b) -> Stack a -> Stack b)
-> (forall a b. a -> Stack b -> Stack a) -> Functor Stack
forall a b. a -> Stack b -> Stack a
forall a b. (a -> b) -> Stack a -> Stack b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Stack b -> Stack a
$c<$ :: forall a b. a -> Stack b -> Stack a
fmap :: (a -> b) -> Stack a -> Stack b
$cfmap :: forall a b. (a -> b) -> Stack a -> Stack b
Functor, [Stack b] -> Doc ann
Stack b -> Doc ann
(forall ann. Stack b -> Doc ann)
-> (forall ann. [Stack b] -> Doc ann) -> Pretty (Stack b)
forall ann. [Stack b] -> Doc ann
forall b ann. Pretty b => [Stack b] -> Doc ann
forall b ann. Pretty b => Stack b -> Doc ann
forall ann. Stack b -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: [Stack b] -> Doc ann
$cprettyList :: forall b ann. Pretty b => [Stack b] -> Doc ann
pretty :: Stack b -> Doc ann
$cpretty :: forall b ann. Pretty b => Stack b -> Doc ann
Pretty, b -> Stack b -> Stack b
NonEmpty (Stack b) -> Stack b
Stack b -> Stack b -> Stack b
(Stack b -> Stack b -> Stack b)
-> (NonEmpty (Stack b) -> Stack b)
-> (forall b. Integral b => b -> Stack b -> Stack b)
-> Semigroup (Stack b)
forall b. Integral b => b -> Stack b -> Stack b
forall b. Semigroup b => NonEmpty (Stack b) -> Stack b
forall b. Semigroup b => Stack b -> Stack b -> Stack b
forall b b. (Semigroup b, Integral b) => b -> Stack b -> Stack b
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Stack b -> Stack b
$cstimes :: forall b b. (Semigroup b, Integral b) => b -> Stack b -> Stack b
sconcat :: NonEmpty (Stack b) -> Stack b
$csconcat :: forall b. Semigroup b => NonEmpty (Stack b) -> Stack b
<> :: Stack b -> Stack b -> Stack b
$c<> :: forall b. Semigroup b => Stack b -> Stack b -> Stack b
Semigroup)

-- | The state of a game with respect to cards turned and betting rounds.
data Board where
  RiverBoard :: !Card -> !Board -> Board
  TurnBoard :: !Card -> !Board -> Board
  FlopBoard :: (Card, Card, Card) -> !Board -> Board
  PreFlopBoard :: !Board -> Board
  InitialTable ::
    -- | Round where post actions occur.
    Board
  deriving (Board -> Board -> Bool
(Board -> Board -> Bool) -> (Board -> Board -> Bool) -> Eq Board
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Board -> Board -> Bool
$c/= :: Board -> Board -> Bool
== :: Board -> Board -> Bool
$c== :: Board -> Board -> Bool
Eq, Eq Board
Eq Board
-> (Board -> Board -> Ordering)
-> (Board -> Board -> Bool)
-> (Board -> Board -> Bool)
-> (Board -> Board -> Bool)
-> (Board -> Board -> Bool)
-> (Board -> Board -> Board)
-> (Board -> Board -> Board)
-> Ord Board
Board -> Board -> Bool
Board -> Board -> Ordering
Board -> Board -> Board
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Board -> Board -> Board
$cmin :: Board -> Board -> Board
max :: Board -> Board -> Board
$cmax :: Board -> Board -> Board
>= :: Board -> Board -> Bool
$c>= :: Board -> Board -> Bool
> :: Board -> Board -> Bool
$c> :: Board -> Board -> Bool
<= :: Board -> Board -> Bool
$c<= :: Board -> Board -> Bool
< :: Board -> Board -> Bool
$c< :: Board -> Board -> Bool
compare :: Board -> Board -> Ordering
$ccompare :: Board -> Board -> Ordering
$cp1Ord :: Eq Board
Ord, Int -> Board -> ShowS
[Board] -> ShowS
Board -> String
(Int -> Board -> ShowS)
-> (Board -> String) -> ([Board] -> ShowS) -> Show Board
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Board] -> ShowS
$cshowList :: [Board] -> ShowS
show :: Board -> String
$cshow :: Board -> String
showsPrec :: Int -> Board -> ShowS
$cshowsPrec :: Int -> Board -> ShowS
Show)

-- | Amount of money needed to join a game.
newtype Stake b = Stake {Stake b -> b
_stake :: b}
  deriving (ReadPrec [Stake b]
ReadPrec (Stake b)
Int -> ReadS (Stake b)
ReadS [Stake b]
(Int -> ReadS (Stake b))
-> ReadS [Stake b]
-> ReadPrec (Stake b)
-> ReadPrec [Stake b]
-> Read (Stake b)
forall b. Read b => ReadPrec [Stake b]
forall b. Read b => ReadPrec (Stake b)
forall b. Read b => Int -> ReadS (Stake b)
forall b. Read b => ReadS [Stake b]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Stake b]
$creadListPrec :: forall b. Read b => ReadPrec [Stake b]
readPrec :: ReadPrec (Stake b)
$creadPrec :: forall b. Read b => ReadPrec (Stake b)
readList :: ReadS [Stake b]
$creadList :: forall b. Read b => ReadS [Stake b]
readsPrec :: Int -> ReadS (Stake b)
$creadsPrec :: forall b. Read b => Int -> ReadS (Stake b)
Read, Int -> Stake b -> ShowS
[Stake b] -> ShowS
Stake b -> String
(Int -> Stake b -> ShowS)
-> (Stake b -> String) -> ([Stake b] -> ShowS) -> Show (Stake b)
forall b. Show b => Int -> Stake b -> ShowS
forall b. Show b => [Stake b] -> ShowS
forall b. Show b => Stake b -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stake b] -> ShowS
$cshowList :: forall b. Show b => [Stake b] -> ShowS
show :: Stake b -> String
$cshow :: forall b. Show b => Stake b -> String
showsPrec :: Int -> Stake b -> ShowS
$cshowsPrec :: forall b. Show b => Int -> Stake b -> ShowS
Show, Stake b -> Stake b -> Bool
(Stake b -> Stake b -> Bool)
-> (Stake b -> Stake b -> Bool) -> Eq (Stake b)
forall b. Eq b => Stake b -> Stake b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stake b -> Stake b -> Bool
$c/= :: forall b. Eq b => Stake b -> Stake b -> Bool
== :: Stake b -> Stake b -> Bool
$c== :: forall b. Eq b => Stake b -> Stake b -> Bool
Eq, a -> Stake b -> Stake a
(a -> b) -> Stake a -> Stake b
(forall a b. (a -> b) -> Stake a -> Stake b)
-> (forall a b. a -> Stake b -> Stake a) -> Functor Stake
forall a b. a -> Stake b -> Stake a
forall a b. (a -> b) -> Stake a -> Stake b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Stake b -> Stake a
$c<$ :: forall a b. a -> Stake b -> Stake a
fmap :: (a -> b) -> Stake a -> Stake b
$cfmap :: forall a b. (a -> b) -> Stake a -> Stake b
Functor, Eq (Stake b)
Eq (Stake b)
-> (Stake b -> Stake b -> Ordering)
-> (Stake b -> Stake b -> Bool)
-> (Stake b -> Stake b -> Bool)
-> (Stake b -> Stake b -> Bool)
-> (Stake b -> Stake b -> Bool)
-> (Stake b -> Stake b -> Stake b)
-> (Stake b -> Stake b -> Stake b)
-> Ord (Stake b)
Stake b -> Stake b -> Bool
Stake b -> Stake b -> Ordering
Stake b -> Stake b -> Stake b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall b. Ord b => Eq (Stake b)
forall b. Ord b => Stake b -> Stake b -> Bool
forall b. Ord b => Stake b -> Stake b -> Ordering
forall b. Ord b => Stake b -> Stake b -> Stake b
min :: Stake b -> Stake b -> Stake b
$cmin :: forall b. Ord b => Stake b -> Stake b -> Stake b
max :: Stake b -> Stake b -> Stake b
$cmax :: forall b. Ord b => Stake b -> Stake b -> Stake b
>= :: Stake b -> Stake b -> Bool
$c>= :: forall b. Ord b => Stake b -> Stake b -> Bool
> :: Stake b -> Stake b -> Bool
$c> :: forall b. Ord b => Stake b -> Stake b -> Bool
<= :: Stake b -> Stake b -> Bool
$c<= :: forall b. Ord b => Stake b -> Stake b -> Bool
< :: Stake b -> Stake b -> Bool
$c< :: forall b. Ord b => Stake b -> Stake b -> Bool
compare :: Stake b -> Stake b -> Ordering
$ccompare :: forall b. Ord b => Stake b -> Stake b -> Ordering
$cp1Ord :: forall b. Ord b => Eq (Stake b)
Ord, [Stake b] -> Doc ann
Stake b -> Doc ann
(forall ann. Stake b -> Doc ann)
-> (forall ann. [Stake b] -> Doc ann) -> Pretty (Stake b)
forall ann. [Stake b] -> Doc ann
forall b ann. Pretty b => [Stake b] -> Doc ann
forall b ann. Pretty b => Stake b -> Doc ann
forall ann. Stake b -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: [Stake b] -> Doc ann
$cprettyList :: forall b ann. Pretty b => [Stake b] -> Doc ann
pretty :: Stake b -> Doc ann
$cpretty :: forall b ann. Pretty b => Stake b -> Doc ann
Pretty)

-- | A bet done a player pre- or post-flop.
--
-- WARNING: Unstable API
data BetAction t
  = Call !t
  | Raise
      { BetAction t -> t
raiseBy :: !t, -- TODO remove?
        BetAction t -> t
raiseTo :: !t
      }
  | -- TODO remove AllInRaise
    AllInRaise
      { BetAction t -> t
amountRaisedAI :: !t, -- TODO remove?
        BetAction t -> t
raisedAITo :: !t
      }
  | Bet !t
  | -- TODO remove AllIn
    AllIn !t
  | Fold
  | Check
  deriving (ReadPrec [BetAction t]
ReadPrec (BetAction t)
Int -> ReadS (BetAction t)
ReadS [BetAction t]
(Int -> ReadS (BetAction t))
-> ReadS [BetAction t]
-> ReadPrec (BetAction t)
-> ReadPrec [BetAction t]
-> Read (BetAction t)
forall t. Read t => ReadPrec [BetAction t]
forall t. Read t => ReadPrec (BetAction t)
forall t. Read t => Int -> ReadS (BetAction t)
forall t. Read t => ReadS [BetAction t]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BetAction t]
$creadListPrec :: forall t. Read t => ReadPrec [BetAction t]
readPrec :: ReadPrec (BetAction t)
$creadPrec :: forall t. Read t => ReadPrec (BetAction t)
readList :: ReadS [BetAction t]
$creadList :: forall t. Read t => ReadS [BetAction t]
readsPrec :: Int -> ReadS (BetAction t)
$creadsPrec :: forall t. Read t => Int -> ReadS (BetAction t)
Read, Int -> BetAction t -> ShowS
[BetAction t] -> ShowS
BetAction t -> String
(Int -> BetAction t -> ShowS)
-> (BetAction t -> String)
-> ([BetAction t] -> ShowS)
-> Show (BetAction t)
forall t. Show t => Int -> BetAction t -> ShowS
forall t. Show t => [BetAction t] -> ShowS
forall t. Show t => BetAction t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BetAction t] -> ShowS
$cshowList :: forall t. Show t => [BetAction t] -> ShowS
show :: BetAction t -> String
$cshow :: forall t. Show t => BetAction t -> String
showsPrec :: Int -> BetAction t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> BetAction t -> ShowS
Show, BetAction t -> BetAction t -> Bool
(BetAction t -> BetAction t -> Bool)
-> (BetAction t -> BetAction t -> Bool) -> Eq (BetAction t)
forall t. Eq t => BetAction t -> BetAction t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BetAction t -> BetAction t -> Bool
$c/= :: forall t. Eq t => BetAction t -> BetAction t -> Bool
== :: BetAction t -> BetAction t -> Bool
$c== :: forall t. Eq t => BetAction t -> BetAction t -> Bool
Eq, Eq (BetAction t)
Eq (BetAction t)
-> (BetAction t -> BetAction t -> Ordering)
-> (BetAction t -> BetAction t -> Bool)
-> (BetAction t -> BetAction t -> Bool)
-> (BetAction t -> BetAction t -> Bool)
-> (BetAction t -> BetAction t -> Bool)
-> (BetAction t -> BetAction t -> BetAction t)
-> (BetAction t -> BetAction t -> BetAction t)
-> Ord (BetAction t)
BetAction t -> BetAction t -> Bool
BetAction t -> BetAction t -> Ordering
BetAction t -> BetAction t -> BetAction t
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall t. Ord t => Eq (BetAction t)
forall t. Ord t => BetAction t -> BetAction t -> Bool
forall t. Ord t => BetAction t -> BetAction t -> Ordering
forall t. Ord t => BetAction t -> BetAction t -> BetAction t
min :: BetAction t -> BetAction t -> BetAction t
$cmin :: forall t. Ord t => BetAction t -> BetAction t -> BetAction t
max :: BetAction t -> BetAction t -> BetAction t
$cmax :: forall t. Ord t => BetAction t -> BetAction t -> BetAction t
>= :: BetAction t -> BetAction t -> Bool
$c>= :: forall t. Ord t => BetAction t -> BetAction t -> Bool
> :: BetAction t -> BetAction t -> Bool
$c> :: forall t. Ord t => BetAction t -> BetAction t -> Bool
<= :: BetAction t -> BetAction t -> Bool
$c<= :: forall t. Ord t => BetAction t -> BetAction t -> Bool
< :: BetAction t -> BetAction t -> Bool
$c< :: forall t. Ord t => BetAction t -> BetAction t -> Bool
compare :: BetAction t -> BetAction t -> Ordering
$ccompare :: forall t. Ord t => BetAction t -> BetAction t -> Ordering
$cp1Ord :: forall t. Ord t => Eq (BetAction t)
Ord, a -> BetAction b -> BetAction a
(a -> b) -> BetAction a -> BetAction b
(forall a b. (a -> b) -> BetAction a -> BetAction b)
-> (forall a b. a -> BetAction b -> BetAction a)
-> Functor BetAction
forall a b. a -> BetAction b -> BetAction a
forall a b. (a -> b) -> BetAction a -> BetAction b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> BetAction b -> BetAction a
$c<$ :: forall a b. a -> BetAction b -> BetAction a
fmap :: (a -> b) -> BetAction a -> BetAction b
$cfmap :: forall a b. (a -> b) -> BetAction a -> BetAction b
Functor, Typeable (BetAction t)
DataType
Constr
Typeable (BetAction t)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> BetAction t -> c (BetAction t))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (BetAction t))
-> (BetAction t -> Constr)
-> (BetAction t -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (BetAction t)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (BetAction t)))
-> ((forall b. Data b => b -> b) -> BetAction t -> BetAction t)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> BetAction t -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> BetAction t -> r)
-> (forall u. (forall d. Data d => d -> u) -> BetAction t -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> BetAction t -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> BetAction t -> m (BetAction t))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BetAction t -> m (BetAction t))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BetAction t -> m (BetAction t))
-> Data (BetAction t)
BetAction t -> DataType
BetAction t -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (BetAction t))
(forall b. Data b => b -> b) -> BetAction t -> BetAction t
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BetAction t -> c (BetAction t)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (BetAction t)
forall t. Data t => Typeable (BetAction t)
forall t. Data t => BetAction t -> DataType
forall t. Data t => BetAction t -> Constr
forall t.
Data t =>
(forall b. Data b => b -> b) -> BetAction t -> BetAction t
forall t u.
Data t =>
Int -> (forall d. Data d => d -> u) -> BetAction t -> u
forall t u.
Data t =>
(forall d. Data d => d -> u) -> BetAction t -> [u]
forall t r r'.
Data t =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BetAction t -> r
forall t r r'.
Data t =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BetAction t -> r
forall t (m :: * -> *).
(Data t, Monad m) =>
(forall d. Data d => d -> m d) -> BetAction t -> m (BetAction t)
forall t (m :: * -> *).
(Data t, MonadPlus m) =>
(forall d. Data d => d -> m d) -> BetAction t -> m (BetAction t)
forall t (c :: * -> *).
Data t =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (BetAction t)
forall t (c :: * -> *).
Data t =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BetAction t -> c (BetAction t)
forall t (t :: * -> *) (c :: * -> *).
(Data t, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (BetAction t))
forall t (t :: * -> * -> *) (c :: * -> *).
(Data t, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (BetAction t))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> BetAction t -> u
forall u. (forall d. Data d => d -> u) -> BetAction t -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BetAction t -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BetAction t -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BetAction t -> m (BetAction t)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BetAction t -> m (BetAction t)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (BetAction t)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BetAction t -> c (BetAction t)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (BetAction t))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (BetAction t))
$cCheck :: Constr
$cFold :: Constr
$cAllIn :: Constr
$cBet :: Constr
$cAllInRaise :: Constr
$cRaise :: Constr
$cCall :: Constr
$tBetAction :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> BetAction t -> m (BetAction t)
$cgmapMo :: forall t (m :: * -> *).
(Data t, MonadPlus m) =>
(forall d. Data d => d -> m d) -> BetAction t -> m (BetAction t)
gmapMp :: (forall d. Data d => d -> m d) -> BetAction t -> m (BetAction t)
$cgmapMp :: forall t (m :: * -> *).
(Data t, MonadPlus m) =>
(forall d. Data d => d -> m d) -> BetAction t -> m (BetAction t)
gmapM :: (forall d. Data d => d -> m d) -> BetAction t -> m (BetAction t)
$cgmapM :: forall t (m :: * -> *).
(Data t, Monad m) =>
(forall d. Data d => d -> m d) -> BetAction t -> m (BetAction t)
gmapQi :: Int -> (forall d. Data d => d -> u) -> BetAction t -> u
$cgmapQi :: forall t u.
Data t =>
Int -> (forall d. Data d => d -> u) -> BetAction t -> u
gmapQ :: (forall d. Data d => d -> u) -> BetAction t -> [u]
$cgmapQ :: forall t u.
Data t =>
(forall d. Data d => d -> u) -> BetAction t -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BetAction t -> r
$cgmapQr :: forall t r r'.
Data t =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BetAction t -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BetAction t -> r
$cgmapQl :: forall t r r'.
Data t =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BetAction t -> r
gmapT :: (forall b. Data b => b -> b) -> BetAction t -> BetAction t
$cgmapT :: forall t.
Data t =>
(forall b. Data b => b -> b) -> BetAction t -> BetAction t
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (BetAction t))
$cdataCast2 :: forall t (t :: * -> * -> *) (c :: * -> *).
(Data t, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (BetAction t))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (BetAction t))
$cdataCast1 :: forall t (t :: * -> *) (c :: * -> *).
(Data t, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (BetAction t))
dataTypeOf :: BetAction t -> DataType
$cdataTypeOf :: forall t. Data t => BetAction t -> DataType
toConstr :: BetAction t -> Constr
$ctoConstr :: forall t. Data t => BetAction t -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (BetAction t)
$cgunfold :: forall t (c :: * -> *).
Data t =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (BetAction t)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BetAction t -> c (BetAction t)
$cgfoldl :: forall t (c :: * -> *).
Data t =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BetAction t -> c (BetAction t)
$cp1Data :: forall t. Data t => Typeable (BetAction t)
Data, Typeable)