fix json instance

This commit is contained in:
2020-03-29 01:41:57 +01:00
parent 9eb443638a
commit 8f692d36ac
2 changed files with 8 additions and 4 deletions
+1
View File
@@ -145,6 +145,7 @@ newtype ChosenResponse = ChosenResponse Card
newtype BidResponse = BidResponse Int newtype BidResponse = BidResponse Int
newtype YesNo = YesNo Bool newtype YesNo = YesNo Bool
newtype GameResponse = GameResponse Game newtype GameResponse = GameResponse Game
deriving Show
newtype ChosenCards = ChosenCards [Card] newtype ChosenCards = ChosenCards [Card]
instance ToJSON Query where instance ToJSON Query where
+7 -4
View File
@@ -9,6 +9,7 @@ import Data.Aeson hiding (Null)
import Skat.Card import Skat.Card
import Data.List (sortOn) import Data.List (sortOn)
import Data.Ord (Down(..)) import Data.Ord (Down(..))
import Control.Monad
-- | different game types -- | different game types
data Game = Colour Colour Modifier data Game = Colour Colour Modifier
@@ -34,6 +35,7 @@ instance FromJSON Game where
"nullhand" -> return NullHand "nullhand" -> return NullHand
"nullouvert" -> return NullOuvert "nullouvert" -> return NullOuvert
"nullouverthand" -> return NullOuvertHand "nullouverthand" -> return NullOuvertHand
_ -> mzero
-- | modifiers for grand and colour games -- | modifiers for grand and colour games
data Modifier = Einfach data Modifier = Einfach
@@ -51,14 +53,15 @@ data Modifier = Einfach
instance FromJSON Modifier where instance FromJSON Modifier where
parseJSON = withObject "Modifier" $ \v -> do parseJSON = withObject "Modifier" $ \v -> do
hnd <- v .: "hand" hnd <- v .: "hand"
if read hnd then do if hnd then do
schneider <- v .: "schneider" schneider <- v .:? "schneider" .!= False
schwarz <- v .: "schwarz" schwarz <- v .:? "schwarz" .!= False
ouvert <- v .: "ouvert" ouvert <- v .:? "ouvert" .!= False
case (schneider, schwarz, ouvert) of case (schneider, schwarz, ouvert) of
(_, _, True) -> return Ouvert (_, _, True) -> return Ouvert
(True, False, _) -> return HandSchneiderAngesagt (True, False, _) -> return HandSchneiderAngesagt
(_, True, _) -> return HandSchwarzAngesagt (_, True, _) -> return HandSchwarzAngesagt
_ -> return Hand
else return Einfach else return Einfach
-- | calculate the value of a game with given cards -- | calculate the value of a game with given cards