aboutsummaryrefslogtreecommitdiff
path: root/server
diff options
context:
space:
mode:
authorJasper Van der Jeugt2020-09-08 16:58:29 +0200
committerJasper Van der Jeugt2020-09-08 16:58:29 +0200
commit0282c8da11f71851855eaa433bfd1fe5fe52898e (patch)
tree0cbae1e16f7c9d1b9031f75798d5f072484e8ee0 /server
parent0a42cfc16ac413951866fe353759defb6599fb3b (diff)
Build a little include feature
Diffstat (limited to '')
-rw-r--r--server/lib/Uplcg/Cards.hs27
1 files changed, 26 insertions, 1 deletions
diff --git a/server/lib/Uplcg/Cards.hs b/server/lib/Uplcg/Cards.hs
index 27d5240..d7d7659 100644
--- a/server/lib/Uplcg/Cards.hs
+++ b/server/lib/Uplcg/Cards.hs
@@ -1,17 +1,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 = Yaml.decodeFileThrow path
+loadCardSets path = fromRawCardSets <$> Yaml.decodeFileThrow path