| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Poker.Game
Description
Representation of a game of holdem, including table structure, positioning, pot and betting state.
Synopsis
- newtype Position = Position Word8
- data NumPlayers
- numPlayersToWord8 :: NumPlayers -> Word8
- numPlayersFromWord8 :: Word8 -> Maybe NumPlayers
- mkNumPlayers :: Integral a => a -> Maybe NumPlayers
- allPositions :: NumPlayers -> [Position]
- positionToTxt :: NumPlayers -> Position -> Text
- getPreflopOrder :: NumPlayers -> [Position]
- buttonPosition :: NumPlayers -> Position
- bigBlindPosition :: NumPlayers -> Position
- getPostFlopOrder :: NumPlayers -> [Position]
- sortPostflop :: NumPlayers -> [Position] -> [Position]
- newtype Seat = Seat {}
- newtype Pot b = Pot {
- _pot :: b
- newtype Stack b = Stack {
- _stack :: b
- newtype Stake b = Stake {
- _stake :: b
Documentation
A player's Position in a game of poker.
Positions 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 :)
Instances
| Bounded Position Source # | |
| Enum Position Source # | |
| Eq Position Source # | |
| Data Position Source # | |
Defined in Poker.Game Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Position -> c Position # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Position # toConstr :: Position -> Constr # dataTypeOf :: Position -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Position) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Position) # gmapT :: (forall b. Data b => b -> b) -> Position -> Position # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Position -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Position -> r # gmapQ :: (forall d. Data d => d -> u) -> Position -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Position -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Position -> m Position # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Position -> m Position # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Position -> m Position # | |
| Ord Position Source # | |
Defined in Poker.Game | |
| Read Position Source # | |
| Show Position Source # | |
| Pretty Position Source # | |
Defined in Poker.Game | |
data NumPlayers Source #
Number of active players at a poker table. Players sitting out do not count, as
they do not contribute to the number of Positions.
Constructors
| TwoPlayers | |
| ThreePlayers | |
| FourPlayers | |
| FivePlayers | |
| SixPlayers | |
| SevenPlayers | |
| EightPlayers | |
| NinePlayers |
Instances
| Enum NumPlayers Source # | |
Defined in Poker.Game Methods succ :: NumPlayers -> NumPlayers # pred :: NumPlayers -> NumPlayers # toEnum :: Int -> NumPlayers # fromEnum :: NumPlayers -> Int # enumFrom :: NumPlayers -> [NumPlayers] # enumFromThen :: NumPlayers -> NumPlayers -> [NumPlayers] # enumFromTo :: NumPlayers -> NumPlayers -> [NumPlayers] # enumFromThenTo :: NumPlayers -> NumPlayers -> NumPlayers -> [NumPlayers] # | |
| Eq NumPlayers Source # | |
Defined in Poker.Game | |
| Ord NumPlayers Source # | |
Defined in Poker.Game Methods compare :: NumPlayers -> NumPlayers -> Ordering # (<) :: NumPlayers -> NumPlayers -> Bool # (<=) :: NumPlayers -> NumPlayers -> Bool # (>) :: NumPlayers -> NumPlayers -> Bool # (>=) :: NumPlayers -> NumPlayers -> Bool # max :: NumPlayers -> NumPlayers -> NumPlayers # min :: NumPlayers -> NumPlayers -> NumPlayers # | |
numPlayersToWord8 :: NumPlayers -> Word8 Source #
Convert a NumPlayers to a Word8.
numPlayersFromWord8 :: Word8 -> Maybe NumPlayers Source #
Convert a Word8 to a NumPlayers.
mkNumPlayers :: Integral a => a -> Maybe NumPlayers Source #
allPositions :: NumPlayers -> [Position] Source #
>>>allPositions SixPlayers[Position 0,Position 1,Position 2,Position 3,Position 4,Position 5]
positionToTxt :: NumPlayers -> Position -> Text Source #
>>>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"]
getPreflopOrder :: NumPlayers -> [Position] Source #
>>>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"]
buttonPosition :: NumPlayers -> Position Source #
>>>buttonPosition TwoPlayersPosition 0>>>(\numPlayers -> positionToTxt numPlayers $ buttonPosition numPlayers) <$> enumFromTo TwoPlayers NinePlayers["BU","BU","BU","BU","BU","BU","BU","BU"]
bigBlindPosition :: NumPlayers -> Position Source #
>>>bigBlindPosition TwoPlayersPosition 1>>>(\numPlayers -> positionToTxt numPlayers $ bigBlindPosition numPlayers) <$> enumFromTo TwoPlayers NinePlayers["BB","BB","BB","BB","BB","BB","BB","BB"]
getPostFlopOrder :: NumPlayers -> [Position] Source #
>>>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"]
sortPostflop :: NumPlayers -> [Position] -> [Position] Source #
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"]
A player's seat number at a poker table.
Total amount of money in the Pot.
Amount of money in a player's stack (not having been bet).