aboutsummaryrefslogtreecommitdiff
path: root/server
diff options
context:
space:
mode:
Diffstat (limited to 'server')
-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