-- | ...
-- Module      : Poker.Holdem
-- Description : Texas Hold'em module
-- Copyright   : (c) Ghais Issa 2021
--
-- A variant of poker where two cards, known as hole cards, are dealt face down to each player,
-- and then five community cards are dealt face up in three stages. The stages consist of a series
-- of three cards ("the flop"), later an additional single card ("the turn" or "fourth street"),
-- and a final card ("the river" or "fifth street"). Each player seeks the best five card poker hand
-- from any combination of the seven cards; the five community cards and their two hole cards.
-- ...
module Poker.Holdem
  (
    Hole(..)
  , Flop(..)
  , Turn(..)
  , Street(..)
  , Community(..)
  , Hand(..)
  , randomHand
  ) where

import           Data.Random.RVar (RVar)
import           Poker.Deck (Card, draw1_, shuffle, stdDeck)

-- | Player's 2 cards.
data Hole = Hole !Card !Card deriving stock (Int -> Hole -> ShowS
[Hole] -> ShowS
Hole -> String
(Int -> Hole -> ShowS)
-> (Hole -> String) -> ([Hole] -> ShowS) -> Show Hole
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hole] -> ShowS
$cshowList :: [Hole] -> ShowS
show :: Hole -> String
$cshow :: Hole -> String
showsPrec :: Int -> Hole -> ShowS
$cshowsPrec :: Int -> Hole -> ShowS
Show, Hole -> Hole -> Bool
(Hole -> Hole -> Bool) -> (Hole -> Hole -> Bool) -> Eq Hole
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hole -> Hole -> Bool
$c/= :: Hole -> Hole -> Bool
== :: Hole -> Hole -> Bool
$c== :: Hole -> Hole -> Bool
Eq)

-- | First three community cards
data Flop = Flop !Card !Card !Card deriving stock (Int -> Flop -> ShowS
[Flop] -> ShowS
Flop -> String
(Int -> Flop -> ShowS)
-> (Flop -> String) -> ([Flop] -> ShowS) -> Show Flop
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flop] -> ShowS
$cshowList :: [Flop] -> ShowS
show :: Flop -> String
$cshow :: Flop -> String
showsPrec :: Int -> Flop -> ShowS
$cshowsPrec :: Int -> Flop -> ShowS
Show, Flop -> Flop -> Bool
(Flop -> Flop -> Bool) -> (Flop -> Flop -> Bool) -> Eq Flop
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flop -> Flop -> Bool
$c/= :: Flop -> Flop -> Bool
== :: Flop -> Flop -> Bool
$c== :: Flop -> Flop -> Bool
Eq)

-- | Fourth community card.
newtype Turn = Turn Card deriving stock (Int -> Turn -> ShowS
[Turn] -> ShowS
Turn -> String
(Int -> Turn -> ShowS)
-> (Turn -> String) -> ([Turn] -> ShowS) -> Show Turn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Turn] -> ShowS
$cshowList :: [Turn] -> ShowS
show :: Turn -> String
$cshow :: Turn -> String
showsPrec :: Int -> Turn -> ShowS
$cshowsPrec :: Int -> Turn -> ShowS
Show, Turn -> Turn -> Bool
(Turn -> Turn -> Bool) -> (Turn -> Turn -> Bool) -> Eq Turn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Turn -> Turn -> Bool
$c/= :: Turn -> Turn -> Bool
== :: Turn -> Turn -> Bool
$c== :: Turn -> Turn -> Bool
Eq)

-- | Fifth and last community card.
newtype Street = Street Card deriving stock (Int -> Street -> ShowS
[Street] -> ShowS
Street -> String
(Int -> Street -> ShowS)
-> (Street -> String) -> ([Street] -> ShowS) -> Show Street
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Street] -> ShowS
$cshowList :: [Street] -> ShowS
show :: Street -> String
$cshow :: Street -> String
showsPrec :: Int -> Street -> ShowS
$cshowsPrec :: Int -> Street -> ShowS
Show, Street -> Street -> Bool
(Street -> Street -> Bool)
-> (Street -> Street -> Bool) -> Eq Street
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Street -> Street -> Bool
$c/= :: Street -> Street -> Bool
== :: Street -> Street -> Bool
$c== :: Street -> Street -> Bool
Eq)

-- | All community cards.
data Community = Community !Flop !Turn !Street deriving stock (Int -> Community -> ShowS
[Community] -> ShowS
Community -> String
(Int -> Community -> ShowS)
-> (Community -> String)
-> ([Community] -> ShowS)
-> Show Community
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Community] -> ShowS
$cshowList :: [Community] -> ShowS
show :: Community -> String
$cshow :: Community -> String
showsPrec :: Int -> Community -> ShowS
$cshowsPrec :: Int -> Community -> ShowS
Show, Community -> Community -> Bool
(Community -> Community -> Bool)
-> (Community -> Community -> Bool) -> Eq Community
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Community -> Community -> Bool
$c/= :: Community -> Community -> Bool
== :: Community -> Community -> Bool
$c== :: Community -> Community -> Bool
Eq)

-- | A 7-card hand is made from a hole and community cards.
data Hand = Hand !Hole !Community deriving stock (Int -> Hand -> ShowS
[Hand] -> ShowS
Hand -> String
(Int -> Hand -> ShowS)
-> (Hand -> String) -> ([Hand] -> ShowS) -> Show Hand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hand] -> ShowS
$cshowList :: [Hand] -> ShowS
show :: Hand -> String
$cshow :: Hand -> String
showsPrec :: Int -> Hand -> ShowS
$cshowsPrec :: Int -> Hand -> ShowS
Show, Hand -> Hand -> Bool
(Hand -> Hand -> Bool) -> (Hand -> Hand -> Bool) -> Eq Hand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hand -> Hand -> Bool
$c/= :: Hand -> Hand -> Bool
== :: Hand -> Hand -> Bool
$c== :: Hand -> Hand -> Bool
Eq)


-- | A random hand
randomHand :: RVar Hand
randomHand :: RVar Hand
randomHand = do
  Maybe [Card]
cards <- Int -> Deck -> Maybe [Card]
draw1_ Int
7 (Deck -> Maybe [Card])
-> RVarT Identity Deck -> RVarT Identity (Maybe [Card])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Deck -> RVarT Identity Deck
shuffle Deck
stdDeck
  case Maybe [Card]
cards of
    (Just [Card
c1, Card
c2, Card
c3, Card
c4, Card
c5, Card
c6, Card
c7]) -> Hand -> RVar Hand
forall (m :: * -> *) a. Monad m => a -> m a
return (Hand -> RVar Hand) -> Hand -> RVar Hand
forall a b. (a -> b) -> a -> b
$ Hole -> Community -> Hand
Hand (Card -> Card -> Hole
Hole Card
c1 Card
c2) (Flop -> Turn -> Street -> Community
Community (Card -> Card -> Card -> Flop
Flop Card
c3 Card
c4 Card
c5) (Card -> Turn
Turn Card
c6) (Card -> Street
Street Card
c7))
    Maybe [Card]
_                                   -> RVar Hand
forall a. HasCallStack => a
undefined