{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
module Deck.Deck (
Card (..),
DeckList,
CardName,
PositiveNumber (..),
NonEmptyText (..),
CategoryName,
Copies,
mainboard,
sideboard,
insert,
delete,
runDeckList,
partialEqCard,
find,
mkCard,
categories,
name,
) where
import Data.Map (Map)
import qualified Data.Map as Map
import Data.NanoID
import Data.Text (Text)
import Control.Lens
import System.Random.MWC
import Refined
import Deck.Category (Category (..), CategoryName, Copies)
import Util
type CardName = NonEmptyText
data Card = Card
{ _internalName :: !CardName
, _categories :: Map Text Category
}
deriving (Show, Eq, Ord)
makeLenses ''Card
name :: Getter Card NonEmptyText
name = to (^. internalName)
mainboard, sideboard :: CategoryName
mainboard = NonEmptyText $$(refineTH "Mainboard")
sideboard = NonEmptyText $$(refineTH "Sideboard")
mkCard :: CardName -> CategoryName -> Copies -> Card
mkCard cardName primary copies =
let categoryName = toText primary
in Card
{ _internalName = cardName
, _categories = Map.singleton categoryName (Category primary copies)
}
newtype DeckList = DeckList {runDeckList :: Map Text Card}
deriving (Show, Eq, Ord)
insert :: Card -> DeckList -> DeckList
insert a b =
let key = toText $ a ^. name
in DeckList . Map.insert key a . runDeckList $ b
delete :: CardName -> DeckList -> DeckList
delete x =
let cardName = unrefine . runText $ x
in DeckList . Map.delete cardName . runDeckList
find :: CardName -> DeckList -> Maybe Card
find cname xs =
let cname' = unrefine . runText $ cname
in (Map.lookup cname' . runDeckList $ xs)
partialEqCard :: (Eq a) => (Card -> a) -> Card -> Card -> Bool
partialEqCard f x y = f x == f y