{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Representation of money, and bet quantities.
module Poker.Amount
  ( Amount (..),
    unsafeAmount,
    IsBet (..),
    mkAmount,
    bigBlindToDense,
    BigBlind (..),
  )
where

import GHC.Generics (Generic)
import GHC.TypeLits
  ( KnownSymbol,
    Symbol,
  )
import Money

#if MIN_VERSION_prettyprinter(1,7,0)
import Prettyprinter (Pretty (pretty), viaShow)
#else
import Data.Text.Prettyprint.Doc (Pretty (pretty), viaShow)
#endif

-- $setup
-- >>> :set -XDataKinds
-- >>> import Prettyprinter

-- | 'Amount' is the type used to represent amounts of money during a game of poker.
-- The internal representation of 'Amount' is a @Discrete\'@ from the
-- <https://hackage.haskell.org/package/safe-money safe-money> package.
-- The exposed constructors for 'Amount' ensure that no 'Amount' can have a negative value.
--
-- The use of the @safe-money@ package allows for lossless conversion between currencies with
-- well-maintained support for type safety, serialisation, and currency conversions.
--
-- @
-- \{\-\# Language TypeApplications \#\-\}
--
-- case 'unsafeAmount' @\"USD\" ('discrete' 100) of
--   'UnsafeAmount' x -> x     -- x == discrete 100
-- @
data Amount (b :: Symbol) where
  UnsafeAmount :: (GoodScale (CurrencyScale b), KnownSymbol b) => {Amount b -> Discrete' b (CurrencyScale b)
unAmount :: Discrete' b (CurrencyScale b)} -> Amount b

deriving instance Show (Amount b)

deriving instance Eq (Amount b)

deriving instance Ord (Amount b)

instance Pretty (Amount b) where
  pretty :: Amount b -> Doc ann
pretty = Amount b -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow

-- |
-- Returns an 'Amount' from a @Discrete\'@ so long as the given @Discrete\'@ is non-negative.
--
-- >>> mkAmount @"USD" 0
-- Just (UnsafeAmount {unAmount = Discrete "USD" 100%1 0})
-- >>> mkAmount @"USD" (-1)
-- Nothing
mkAmount ::
  (GoodScale (CurrencyScale b), KnownSymbol b) =>
  Discrete' b (CurrencyScale b) ->
  Maybe (Amount b)
mkAmount :: Discrete' b (CurrencyScale b) -> Maybe (Amount b)
mkAmount (SomeDiscrete -> Integer
someDiscreteAmount (SomeDiscrete -> Integer)
-> (Discrete' b (CurrencyScale b) -> SomeDiscrete)
-> Discrete' b (CurrencyScale b)
-> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Discrete' b (CurrencyScale b) -> SomeDiscrete
forall (currency :: Symbol) (scale :: (Nat, Nat)).
(KnownSymbol currency, GoodScale scale) =>
Discrete' currency scale -> SomeDiscrete
toSomeDiscrete -> Integer
amt)
  | Integer
amt Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 = Amount b -> Maybe (Amount b)
forall a. a -> Maybe a
Just (Amount b -> Maybe (Amount b)) -> Amount b -> Maybe (Amount b)
forall a b. (a -> b) -> a -> b
$ Discrete' b (CurrencyScale b) -> Amount b
forall (b :: Symbol).
(GoodScale (CurrencyScale b), KnownSymbol b) =>
Discrete' b (CurrencyScale b) -> Amount b
UnsafeAmount (Discrete' b (CurrencyScale b) -> Amount b)
-> Discrete' b (CurrencyScale b) -> Amount b
forall a b. (a -> b) -> a -> b
$ Integer -> Discrete' b (CurrencyScale b)
forall (scale :: (Nat, Nat)) (currency :: Symbol).
GoodScale scale =>
Integer -> Discrete' currency scale
discrete Integer
amt
  | Bool
otherwise = Maybe (Amount b)
forall a. Maybe a
Nothing

-- | Make an 'Amount' from a @Discrete'@. Only use when you are certain that your @Discrete'@ value
-- is positive, since most usages of 'Amount' will break for negative quantities.
unsafeAmount ::
  (GoodScale (CurrencyScale b), KnownSymbol b) =>
  Discrete' b (CurrencyScale b) ->
  Amount b
unsafeAmount :: Discrete' b (CurrencyScale b) -> Amount b
unsafeAmount = Discrete' b (CurrencyScale b) -> Amount b
forall (b :: Symbol).
(GoodScale (CurrencyScale b), KnownSymbol b) =>
Discrete' b (CurrencyScale b) -> Amount b
UnsafeAmount

-- |
-- A type @b@ satisfies 'IsBet' if we know:
--
--   * A 'Monoid' instance for @b@. This allows us to construct a zero amount of @b@ and
--     to 'add' two amounts of @b@ together.
--
--   * the smallest non-zero currency unit for @b@ ('smallestAmount'). For example, for USD the minimum currency amount
--     is $0.01.
--
--   * how to 'add' two @b@s. By default, this is the 'Monoid' instance's append for @b@.
--
--   * how to 'minus' two @b@s, which may fail (returning 'Nothing'), if the resulting 'Amount' is negative.
--
-- Types that satisfy 'IsBet' are expected to have both 'Ord' and 'Show' instances, so that packages such as @poker-game@
-- can handle arbitrary new user bet types.
--
-- For an example instance of the 'IsBet' class, see "Poker.BigBlind".
class (Monoid b, Show b, Ord b) => IsBet b where
  smallestAmount :: b
  minus :: b -> b -> Maybe b
  add :: b -> b -> b
  add = b -> b -> b
forall a. Semigroup a => a -> a -> a
(<>)

-- TODO There's probably some way to avoid repeating the Constraints in the typeclasses,
-- since they are implied by the constructor of Amount. However this might require some
-- work from Richard Eisenberg first...
instance (GoodScale (CurrencyScale b), KnownSymbol b) => Semigroup (Amount b) where
  (UnsafeAmount Discrete' b (CurrencyScale b)
dis) <> :: Amount b -> Amount b -> Amount b
<> (UnsafeAmount Discrete' b (CurrencyScale b)
dis') = Discrete' b (CurrencyScale b) -> Amount b
forall (b :: Symbol).
(GoodScale (CurrencyScale b), KnownSymbol b) =>
Discrete' b (CurrencyScale b) -> Amount b
UnsafeAmount (Discrete' b (CurrencyScale b) -> Amount b)
-> Discrete' b (CurrencyScale b) -> Amount b
forall a b. (a -> b) -> a -> b
$ Discrete' b (CurrencyScale b)
dis Discrete' b (CurrencyScale b)
-> Discrete' b (CurrencyScale b) -> Discrete' b (CurrencyScale b)
forall a. Num a => a -> a -> a
+ Discrete' b (CurrencyScale b)
dis'

instance (GoodScale (CurrencyScale b), KnownSymbol b) => Monoid (Amount b) where
  mempty :: Amount b
mempty = Discrete' b (CurrencyScale b) -> Amount b
forall (b :: Symbol).
(GoodScale (CurrencyScale b), KnownSymbol b) =>
Discrete' b (CurrencyScale b) -> Amount b
UnsafeAmount (Discrete' b (CurrencyScale b) -> Amount b)
-> Discrete' b (CurrencyScale b) -> Amount b
forall a b. (a -> b) -> a -> b
$ Integer -> Discrete' b (CurrencyScale b)
forall (scale :: (Nat, Nat)) (currency :: Symbol).
GoodScale scale =>
Integer -> Discrete' currency scale
discrete Integer
0

instance (GoodScale (CurrencyScale b), KnownSymbol b) => IsBet (Amount b) where
  smallestAmount :: Amount b
smallestAmount = Discrete' b (CurrencyScale b) -> Amount b
forall (b :: Symbol).
(GoodScale (CurrencyScale b), KnownSymbol b) =>
Discrete' b (CurrencyScale b) -> Amount b
UnsafeAmount (Discrete' b (CurrencyScale b) -> Amount b)
-> Discrete' b (CurrencyScale b) -> Amount b
forall a b. (a -> b) -> a -> b
$ Integer -> Discrete' b (CurrencyScale b)
forall (scale :: (Nat, Nat)) (currency :: Symbol).
GoodScale scale =>
Integer -> Discrete' currency scale
discrete Integer
1 :: Amount b
  UnsafeAmount Discrete' b (CurrencyScale b)
l minus :: Amount b -> Amount b -> Maybe (Amount b)
`minus` UnsafeAmount Discrete' b (CurrencyScale b)
r
    | Discrete' b (CurrencyScale b)
r Discrete' b (CurrencyScale b)
-> Discrete' b (CurrencyScale b) -> Bool
forall a. Ord a => a -> a -> Bool
> Discrete' b (CurrencyScale b)
l = Maybe (Amount b)
forall a. Maybe a
Nothing
    | Bool
otherwise = Amount b -> Maybe (Amount b)
forall a. a -> Maybe a
Just (Amount b -> Maybe (Amount b)) -> Amount b -> Maybe (Amount b)
forall a b. (a -> b) -> a -> b
$ Discrete' b (CurrencyScale b) -> Amount b
forall (b :: Symbol).
(GoodScale (CurrencyScale b), KnownSymbol b) =>
Discrete' b (CurrencyScale b) -> Amount b
UnsafeAmount (Discrete' b (CurrencyScale b) -> Amount b)
-> Discrete' b (CurrencyScale b) -> Amount b
forall a b. (a -> b) -> a -> b
$ Discrete' b (CurrencyScale b)
l Discrete' b (CurrencyScale b)
-> Discrete' b (CurrencyScale b) -> Discrete' b (CurrencyScale b)
forall a. Num a => a -> a -> a
- Discrete' b (CurrencyScale b)
r
  UnsafeAmount Discrete' b (CurrencyScale b)
l add :: Amount b -> Amount b -> Amount b
`add` UnsafeAmount Discrete' b (CurrencyScale b)
r = Discrete' b (CurrencyScale b) -> Amount b
forall (b :: Symbol).
(GoodScale (CurrencyScale b), KnownSymbol b) =>
Discrete' b (CurrencyScale b) -> Amount b
UnsafeAmount (Discrete' b (CurrencyScale b) -> Amount b)
-> Discrete' b (CurrencyScale b) -> Amount b
forall a b. (a -> b) -> a -> b
$ Discrete' b (CurrencyScale b)
l Discrete' b (CurrencyScale b)
-> Discrete' b (CurrencyScale b) -> Discrete' b (CurrencyScale b)
forall a. Num a => a -> a -> a
+ Discrete' b (CurrencyScale b)
r

-- | 'BigBlind' is the type describing poker chip amounts that are measured in big blinds.
--
-- The internal representation of 'BigBlind' is @'Amount' "BB"@. This module introduces
-- a new instance of 'CurrencyScale' (from the
-- <https://hackage.haskell.org/package/safe-money safe-money> package), which allows
-- translation from BigBlind to any valid currency in a lossless manner.
--
-- The small unit of a \"BB\" is a \"bb\", with 100 \"bb\"s in a \"BB\".
--
-- TODO include an API for translating from BigBlind to any safe-money currency, given
-- a 'Poker.Game.Stake'.
--
-- Calculations in the safe-money package are done with Discrete and Dense
-- types. Discrete values are used to describe a regular BigBlind value,
-- such as 1.30bb. Dense values are used when calculating some complex
-- (non-discrete) value such as one third of a big blind. When using the BigBlind
-- type, it is best to do all calculation with Dense "BB" values and then
-- convert back to a Discrete "BB" "bb" after all calculation has been completed:
newtype BigBlind = BigBlind {BigBlind -> Amount "BB"
unBigBlind :: Amount "BB"}
  deriving (Int -> BigBlind -> ShowS
[BigBlind] -> ShowS
BigBlind -> String
(Int -> BigBlind -> ShowS)
-> (BigBlind -> String) -> ([BigBlind] -> ShowS) -> Show BigBlind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BigBlind] -> ShowS
$cshowList :: [BigBlind] -> ShowS
show :: BigBlind -> String
$cshow :: BigBlind -> String
showsPrec :: Int -> BigBlind -> ShowS
$cshowsPrec :: Int -> BigBlind -> ShowS
Show, (forall x. BigBlind -> Rep BigBlind x)
-> (forall x. Rep BigBlind x -> BigBlind) -> Generic BigBlind
forall x. Rep BigBlind x -> BigBlind
forall x. BigBlind -> Rep BigBlind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BigBlind x -> BigBlind
$cfrom :: forall x. BigBlind -> Rep BigBlind x
Generic, BigBlind -> BigBlind -> Bool
(BigBlind -> BigBlind -> Bool)
-> (BigBlind -> BigBlind -> Bool) -> Eq BigBlind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BigBlind -> BigBlind -> Bool
$c/= :: BigBlind -> BigBlind -> Bool
== :: BigBlind -> BigBlind -> Bool
$c== :: BigBlind -> BigBlind -> Bool
Eq, Eq BigBlind
Eq BigBlind
-> (BigBlind -> BigBlind -> Ordering)
-> (BigBlind -> BigBlind -> Bool)
-> (BigBlind -> BigBlind -> Bool)
-> (BigBlind -> BigBlind -> Bool)
-> (BigBlind -> BigBlind -> Bool)
-> (BigBlind -> BigBlind -> BigBlind)
-> (BigBlind -> BigBlind -> BigBlind)
-> Ord BigBlind
BigBlind -> BigBlind -> Bool
BigBlind -> BigBlind -> Ordering
BigBlind -> BigBlind -> BigBlind
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 :: BigBlind -> BigBlind -> BigBlind
$cmin :: BigBlind -> BigBlind -> BigBlind
max :: BigBlind -> BigBlind -> BigBlind
$cmax :: BigBlind -> BigBlind -> BigBlind
>= :: BigBlind -> BigBlind -> Bool
$c>= :: BigBlind -> BigBlind -> Bool
> :: BigBlind -> BigBlind -> Bool
$c> :: BigBlind -> BigBlind -> Bool
<= :: BigBlind -> BigBlind -> Bool
$c<= :: BigBlind -> BigBlind -> Bool
< :: BigBlind -> BigBlind -> Bool
$c< :: BigBlind -> BigBlind -> Bool
compare :: BigBlind -> BigBlind -> Ordering
$ccompare :: BigBlind -> BigBlind -> Ordering
$cp1Ord :: Eq BigBlind
Ord, Ord BigBlind
Show BigBlind
Monoid BigBlind
BigBlind
Monoid BigBlind
-> Show BigBlind
-> Ord BigBlind
-> BigBlind
-> (BigBlind -> BigBlind -> Maybe BigBlind)
-> (BigBlind -> BigBlind -> BigBlind)
-> IsBet BigBlind
BigBlind -> BigBlind -> Maybe BigBlind
BigBlind -> BigBlind -> BigBlind
forall b.
Monoid b
-> Show b
-> Ord b
-> b
-> (b -> b -> Maybe b)
-> (b -> b -> b)
-> IsBet b
add :: BigBlind -> BigBlind -> BigBlind
$cadd :: BigBlind -> BigBlind -> BigBlind
minus :: BigBlind -> BigBlind -> Maybe BigBlind
$cminus :: BigBlind -> BigBlind -> Maybe BigBlind
smallestAmount :: BigBlind
$csmallestAmount :: BigBlind
$cp3IsBet :: Ord BigBlind
$cp2IsBet :: Show BigBlind
$cp1IsBet :: Monoid BigBlind
IsBet, b -> BigBlind -> BigBlind
NonEmpty BigBlind -> BigBlind
BigBlind -> BigBlind -> BigBlind
(BigBlind -> BigBlind -> BigBlind)
-> (NonEmpty BigBlind -> BigBlind)
-> (forall b. Integral b => b -> BigBlind -> BigBlind)
-> Semigroup BigBlind
forall b. Integral b => b -> BigBlind -> BigBlind
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> BigBlind -> BigBlind
$cstimes :: forall b. Integral b => b -> BigBlind -> BigBlind
sconcat :: NonEmpty BigBlind -> BigBlind
$csconcat :: NonEmpty BigBlind -> BigBlind
<> :: BigBlind -> BigBlind -> BigBlind
$c<> :: BigBlind -> BigBlind -> BigBlind
Semigroup, Semigroup BigBlind
BigBlind
Semigroup BigBlind
-> BigBlind
-> (BigBlind -> BigBlind -> BigBlind)
-> ([BigBlind] -> BigBlind)
-> Monoid BigBlind
[BigBlind] -> BigBlind
BigBlind -> BigBlind -> BigBlind
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [BigBlind] -> BigBlind
$cmconcat :: [BigBlind] -> BigBlind
mappend :: BigBlind -> BigBlind -> BigBlind
$cmappend :: BigBlind -> BigBlind -> BigBlind
mempty :: BigBlind
$cmempty :: BigBlind
$cp1Monoid :: Semigroup BigBlind
Monoid)

type instance
  UnitScale "BB" "bb" =
    '(100, 1)

type instance CurrencyScale "BB" = UnitScale "BB" "bb"

-- | When working with a 'BigBlind' you might want to (cautiously) retain losslessness
-- when using functions such as % calculations or division. A 'Dense' allows you to do so.
bigBlindToDense :: BigBlind -> Dense "BB"
bigBlindToDense :: BigBlind -> Dense "BB"
bigBlindToDense = Discrete' "BB" '(100, 1) -> Dense "BB"
forall (scale :: (Nat, Nat)) (currency :: Symbol).
GoodScale scale =>
Discrete' currency scale -> Dense currency
denseFromDiscrete (Discrete' "BB" '(100, 1) -> Dense "BB")
-> (BigBlind -> Discrete' "BB" '(100, 1)) -> BigBlind -> Dense "BB"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount "BB" -> Discrete' "BB" '(100, 1)
forall (b :: Symbol). Amount b -> Discrete' b (CurrencyScale b)
unAmount (Amount "BB" -> Discrete' "BB" '(100, 1))
-> (BigBlind -> Amount "BB")
-> BigBlind
-> Discrete' "BB" '(100, 1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BigBlind -> Amount "BB"
unBigBlind