diff options
Diffstat (limited to 'server/lib/Uplcg')
| -rw-r--r-- | server/lib/Uplcg/Cards.hs | 27 |
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 |