diff --git a/src/Hanafuda/Message.hs b/src/Hanafuda/Message.hs index 21429b9..fbf5ad7 100644 --- a/src/Hanafuda/Message.hs +++ b/src/Hanafuda/Message.hs @@ -13,22 +13,28 @@ module Hanafuda.Message ( import Data.Char (toLower) import Data.Aeson ( - FromJSON(..), Options(..), SumEncoding(..), ToJSON(..), ToJSONKey(..) - , Value, (.=), defaultOptions, eitherDecode', encode, genericParseJSON - , genericToEncoding, object, pairs + FromJSON(..), FromJSONKey(..), Options(..), SumEncoding(..), ToJSON(..), ToJSONKey(..) + , Value, (.:), (.=), defaultOptions, eitherDecode', encode, genericParseJSON + , genericToEncoding, object, pairs, withObject ) import Data.Aeson.Types (toJSONKeyText) import Data.Map (Map) +import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as Text (pack) import GHC.Generics (Generic) -import qualified Hanafuda (Card(..)) +import qualified Hanafuda (Card(..), Flower(..), Pack, cardsOfPack, empty, packOfCards) import Hanafuda.Key (Key(..), getKey) import Hanafuda.KoiKoi (PlayerKey, GameBlueprint(..)) -import qualified Hanafuda.KoiKoi as KoiKoi (Action(..), Game(..), Move(..), Source(..)) +import qualified Hanafuda.KoiKoi as KoiKoi ( + Action(..), Game(..), Mode(..), Move(..), Score, Source(..), Step(..), Yaku(..) + ) +import Hanafuda.Player (Player(..), Players(..)) deriving instance Generic PlayerKey instance FromJSON PlayerKey +instance FromJSONKey PlayerKey where + fromJSONKey = fromJSONKey instance ToJSON PlayerKey where toEncoding = genericToEncoding defaultOptions instance ToJSONKey PlayerKey where @@ -69,8 +75,12 @@ instance FromJSON FromClient instance ToJSON FromClient where toEncoding = genericToEncoding defaultOptions -newtype PlayerStatus = PlayerStatus (Text, Bool) +newtype PlayerStatus = PlayerStatus (Text, Bool) deriving (Generic, Show) +instance FromJSON PlayerStatus where + parseJSON = withObject "PlayerStatus" $ \v -> fmap PlayerStatus . (,) + <$> v .: "name" + <*> v .: "alone" instance ToJSON PlayerStatus where toJSON (PlayerStatus (name, alone)) = object ["name" .= name, "alone" .= alone] @@ -80,10 +90,53 @@ instance ToJSON PlayerStatus where type Room = Map PlayerKey PlayerStatus deriving instance Generic KoiKoi.Source -instance ToJSON KoiKoi.Source +instance FromJSON KoiKoi.Source +instance ToJSON KoiKoi.Source where + toEncoding = genericToEncoding defaultOptions deriving instance Generic KoiKoi.Action -instance ToJSON KoiKoi.Action +instance FromJSON KoiKoi.Action +instance ToJSON KoiKoi.Action where + toEncoding = genericToEncoding defaultOptions + +deriving instance Generic KoiKoi.Yaku +instance FromJSON KoiKoi.Yaku +instance FromJSONKey KoiKoi.Yaku +instance ToJSON KoiKoi.Yaku where + toEncoding = genericToEncoding defaultOptions +instance ToJSONKey KoiKoi.Yaku where + toJSONKey = toJSONKeyText (Text.pack . show) + +deriving instance Generic (Player KoiKoi.Score) +instance FromJSON (Player KoiKoi.Score) +instance ToJSON (Player KoiKoi.Score) where + toEncoding = genericToEncoding defaultOptions + +deriving instance Generic (Players KoiKoi.Score) +instance FromJSON (Players KoiKoi.Score) +instance ToJSON (Players KoiKoi.Score) where + toEncoding = genericToEncoding defaultOptions + +deriving instance Generic KoiKoi.Step +instance FromJSON KoiKoi.Step +instance ToJSON KoiKoi.Step where + toEncoding = genericToEncoding defaultOptions + +instance FromJSON Hanafuda.Pack where + parseJSON = fmap Hanafuda.packOfCards . parseJSON +instance ToJSON Hanafuda.Pack where + toJSON = toJSON . Hanafuda.cardsOfPack + toEncoding = toEncoding . Hanafuda.cardsOfPack + +deriving instance Generic KoiKoi.Mode +instance FromJSON KoiKoi.Mode +instance ToJSON KoiKoi.Mode where + toEncoding = genericToEncoding defaultOptions + +deriving instance Generic Hanafuda.Flower +instance FromJSON Hanafuda.Flower +instance ToJSON Hanafuda.Flower where + toEncoding = genericToEncoding defaultOptions type PublicGame = GameBlueprint Int @@ -101,6 +154,6 @@ data T = | Error {error :: String} deriving (Generic) +instance FromJSON T instance ToJSON T where toEncoding = genericToEncoding defaultOptions -