diff --git a/hanafudapi.cabal b/hanafuda-webapp.cabal similarity index 95% rename from hanafudapi.cabal rename to hanafuda-webapp.cabal index 5204ffc..8b3abb9 100644 --- a/hanafudapi.cabal +++ b/hanafuda-webapp.cabal @@ -1,7 +1,7 @@ -- Initial hanafudapi.cabal generated by cabal init. For further -- documentation, see http://haskell.org/cabal/users-guide/ -name: hanafudapi +name: hanafuda-webapp version: 0.1.1.0 synopsis: A webapp for the Haskell hanafuda library -- description: @@ -35,6 +35,7 @@ executable hanafudapi build-depends: base >=4.10 && <4.11 , bytestring , containers + , unordered-containers , hanafuda >= 0.3.0 , http-types , aeson diff --git a/src/Game.hs b/src/Game.hs index 36fd58b..d879f7d 100644 --- a/src/Game.hs +++ b/src/Game.hs @@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} module Game ( Key , View @@ -15,7 +16,8 @@ module Game ( import Data.Text (pack) import Data.Map (mapWithKey) -import Data.Aeson (FromJSON(..), ToJSON(..), ToJSON1(..), ToJSONKey(..), genericParseJSON, genericToEncoding, genericLiftToEncoding, toEncoding1, toJSON1) +import Data.HashMap.Strict (insert) +import Data.Aeson (FromJSON(..), ToJSON(..), ToJSON1(..), ToJSONKey(..), Value(..), genericParseJSON, genericToEncoding, genericLiftToEncoding, toEncoding1, toJSON1) import Data.Aeson.Types (toJSONKeyText) import qualified JSON (defaultOptions, singleLCField) import qualified Data (Key) @@ -90,16 +92,16 @@ new :: Player.Key -> Player.Key -> IO T new p1 p2 = do Hanafuda.KoiKoi.new [p1, p2] Hanafuda.KoiKoi.WholeYear -export :: Player.Key -> T -> T -export key on = on { - Hanafuda.KoiKoi.deck = [] - , Hanafuda.KoiKoi.players = Hanafuda.Player.Players $ mapWithKey maskOpponentsHand unfiltered - } +export :: Player.Key -> T -> Value +export key on = Object $ insert "deck" (toJSON $ length $ Hanafuda.KoiKoi.deck on) $ ast where Hanafuda.Player.Players unfiltered = Hanafuda.KoiKoi.players on maskOpponentsHand k player | k == key = player | otherwise = player {Hanafuda.Player.hand = Hanafuda.empty} + Object ast = toJSON $ on { + Hanafuda.KoiKoi.players = Hanafuda.Player.Players $ mapWithKey maskOpponentsHand unfiltered + } play :: Player.Key -> Hanafuda.KoiKoi.Move -> T -> IO (Hanafuda.KoiKoi.Game Player.Key) play key move on