Import everything left in the server's Game module

src/Hanafuda/Message.hs

@@ -13,22 +13,28 @@ module Hanafuda.Message (
 
 import Data.Char (toLower)
 import Data.Aeson (
-      FromJSON(..), Options(..), SumEncoding(..), ToJSON(..), ToJSONKey(..)
+      FromJSON(..), FromJSONKey(..), Options(..), SumEncoding(..), ToJSON(..), ToJSONKey(..)
-    , Value, (.=), defaultOptions, eitherDecode', encode, genericParseJSON
+    , Value, (.:), (.=), defaultOptions, eitherDecode', encode, genericParseJSON
-    , genericToEncoding, object, pairs
+    , 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
-