blob: b0895745792aec0e54dc362a39bd7b8357f9683f (
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
43
44
45
46
47
48
49
50
51
52
53
54
55
|
{-# LANGUAGE RecordWildCards #-}
{-# 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, listToMaybe)
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
data CardSets = CardSets
{ csDefault :: Maybe Deck
, csCards :: HMS.HashMap Deck Cards
} deriving (Show)
data RawCardSet = RawCardSet
{ rcsDefault :: Maybe Bool
, rcsEnabled :: Maybe Bool
, rcsInclude :: Maybe (V.Vector T.Text)
, rcsBlack :: V.Vector T.Text
, rcsWhite :: V.Vector T.Text
} deriving (Show)
Aeson.deriveFromJSON (defaultOptionsDropLower 3) ''RawCardSet
fromRawCardSets :: HMS.HashMap Deck RawCardSet -> CardSets
fromRawCardSets raws =
CardSets {..}
where
csDefault = listToMaybe
[ deck
| (deck, RawCardSet {..}) <- HMS.toList raws
, fromMaybe False rcsDefault
]
csCards =
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
|
