{-# LANGUAGE LambdaCase      #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns    #-}

{-|

Module      : Cards
Description : Examples of pattern synonyms using playing cards.
Copyright   : © Frank Jung, 2021-2023
License     : GPL-3.0-only

From Tweag YouTube channel [Introduction to Pattern
Synonyms](https://youtu.be/SPC_R5nwFqo) where Richard introduces GHC's
feature of Pattern Synonyms, allowing programmers to abstract over a
pattern.

-}

module Cards
  ( -- * Types
    Card (.., CJack, CQueen, CKing, CAce)
  , Honor (..)
    -- * Functions
  , checkEven
  , numCardsToPlay
  ) where

import           Numeric.Natural (Natural)

-- | Enumerated Cards including 'Honor' cards.
data Card = C2 | C3 | C4 | C5 | C6 | C7 | C8 | C9 | C10 | CHonor Honor
  deriving (Card -> Card -> Bool
(Card -> Card -> Bool) -> (Card -> Card -> Bool) -> Eq Card
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Card -> Card -> Bool
== :: Card -> Card -> Bool
$c/= :: Card -> Card -> Bool
/= :: Card -> Card -> Bool
Eq, Eq Card
Eq Card
-> (Card -> Card -> Ordering)
-> (Card -> Card -> Bool)
-> (Card -> Card -> Bool)
-> (Card -> Card -> Bool)
-> (Card -> Card -> Bool)
-> (Card -> Card -> Card)
-> (Card -> Card -> Card)
-> Ord Card
Card -> Card -> Bool
Card -> Card -> Ordering
Card -> Card -> Card
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
$ccompare :: Card -> Card -> Ordering
compare :: Card -> Card -> Ordering
$c< :: Card -> Card -> Bool
< :: Card -> Card -> Bool
$c<= :: Card -> Card -> Bool
<= :: Card -> Card -> Bool
$c> :: Card -> Card -> Bool
> :: Card -> Card -> Bool
$c>= :: Card -> Card -> Bool
>= :: Card -> Card -> Bool
$cmax :: Card -> Card -> Card
max :: Card -> Card -> Card
$cmin :: Card -> Card -> Card
min :: Card -> Card -> Card
Ord)

-- | Honor cards.
data Honor = HJack | HQueen | HKing | HAce
  deriving (Honor -> Honor -> Bool
(Honor -> Honor -> Bool) -> (Honor -> Honor -> Bool) -> Eq Honor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Honor -> Honor -> Bool
== :: Honor -> Honor -> Bool
$c/= :: Honor -> Honor -> Bool
/= :: Honor -> Honor -> Bool
Eq, Eq Honor
Eq Honor
-> (Honor -> Honor -> Ordering)
-> (Honor -> Honor -> Bool)
-> (Honor -> Honor -> Bool)
-> (Honor -> Honor -> Bool)
-> (Honor -> Honor -> Bool)
-> (Honor -> Honor -> Honor)
-> (Honor -> Honor -> Honor)
-> Ord Honor
Honor -> Honor -> Bool
Honor -> Honor -> Ordering
Honor -> Honor -> Honor
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
$ccompare :: Honor -> Honor -> Ordering
compare :: Honor -> Honor -> Ordering
$c< :: Honor -> Honor -> Bool
< :: Honor -> Honor -> Bool
$c<= :: Honor -> Honor -> Bool
<= :: Honor -> Honor -> Bool
$c> :: Honor -> Honor -> Bool
> :: Honor -> Honor -> Bool
$c>= :: Honor -> Honor -> Bool
>= :: Honor -> Honor -> Bool
$cmax :: Honor -> Honor -> Honor
max :: Honor -> Honor -> Honor
$cmin :: Honor -> Honor -> Honor
min :: Honor -> Honor -> Honor
Ord)

-- | Show instance for 'Card' type.
-- >>> show [CJack, CQueen, CKing, CAce, C7]
-- "[J,Q,K,A,7]"
-- >>> show [CHonor HJack, CHonor HQueen, CHonor HKing, CHonor HAce, C7]
-- "[J,Q,K,A,7]"
-- Here we want to keep show instance with 'Card's even though the 'Card type
-- uses 'Honor' cards.
instance Show Card where
  show :: Card -> String
show = \case
    Card
C2     -> String
"2"
    Card
C3     -> String
"3"
    Card
C4     -> String
"4"
    Card
C5     -> String
"5"
    Card
C6     -> String
"6"
    Card
C7     -> String
"7"
    Card
C8     -> String
"8"
    Card
C9     -> String
"9"
    Card
C10    -> String
"10"
    Card
CJack  -> String
"J"
    Card
CQueen -> String
"Q"
    Card
CKing  -> String
"K"
    Card
CAce   -> String
"A"

-- Used to tell GHC that we have included all possible patterns.
{-# COMPLETE C2, C3, C4, C5, C6, C7, C8, C9, C10, CJack, CQueen, CKing, CAce #-}

-- | Pattern synonyms can be "bundled" into exported 'Card' type description.
pattern CJack :: Card
pattern $mCJack :: forall {r}. Card -> ((# #) -> r) -> ((# #) -> r) -> r
$bCJack :: Card
CJack = CHonor HJack

pattern CQueen :: Card
pattern $mCQueen :: forall {r}. Card -> ((# #) -> r) -> ((# #) -> r) -> r
$bCQueen :: Card
CQueen = CHonor HQueen

pattern CKing :: Card
pattern $mCKing :: forall {r}. Card -> ((# #) -> r) -> ((# #) -> r) -> r
$bCKing :: Card
CKing = CHonor HKing

pattern CAce :: Card
pattern $mCAce :: forall {r}. Card -> ((# #) -> r) -> ((# #) -> r) -> r
$bCAce :: Card
CAce = CHonor HAce

-- | Have provided all patterns (see COMPLETE above).
numCardsToPlay :: Honor -> Natural
numCardsToPlay :: Honor -> Natural
numCardsToPlay Honor
HJack  = Natural
1
numCardsToPlay Honor
HQueen = Natural
2
numCardsToPlay Honor
HKing  = Natural
3
numCardsToPlay Honor
HAce   = Natural
4

-- | Another Example is to use a function to evaluate a pattern:
pattern Even :: Integral a => a
pattern $mEven :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
Even <- (even -> True)

-- | Check if a integer value is or odd.
--
-- >>> checkEven 42
-- True
-- >>> checkEven 11
-- False
checkEven :: Int -> Bool
checkEven :: Int -> Bool
checkEven Int
Even = Bool
True
checkEven Int
_    = Bool
False