blob: d7d76590387f8403523a0aa071d9cdac48f6fa50 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
|
{-# LANGUAGE TemplateHaskell #-}
module Uplcg.Cards
( Deck
, CardSets
, loadCardSets
) where
import qualified Data.Aeson.TH as Aeson
import qualified Data.HashMap.Strict as HMS
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.Yaml as Yaml
import Elm.Derive (defaultOptionsDropLower)
import Uplcg.Messages
type Deck = T.Text
type CardSets = HMS.HashMap Deck Cards
data RawCardSet = RawCardSet
{ rcsEnabled :: Maybe Bool
, rcsInclude :: Maybe (V.Vector T.Text)
, rcsBlack :: V.Vector T.Text
, rcsWhite :: V.Vector T.Text
}
Aeson.deriveFromJSON (defaultOptionsDropLower 3) ''RawCardSet
fromRawCardSets :: HMS.HashMap Deck RawCardSet -> CardSets
fromRawCardSets raws =
HMS.map (\rcs ->
let includes = V.mapMaybe (`HMS.lookup` raws) $
fromMaybe V.empty $ rcsInclude rcs in
Cards
{ cardsBlack = rcsBlack rcs <> V.concatMap rcsBlack includes
, cardsWhite = rcsWhite rcs <> V.concatMap rcsWhite includes
}) $
HMS.filter (fromMaybe True . rcsEnabled) raws
loadCardSets :: FilePath -> IO CardSets
loadCardSets path = fromRawCardSets <$> Yaml.decodeFileThrow path
|
