Import everything left in the server's Game module
This commit is contained in:
parent
2854434dca
commit
3e0f1834d1
1 changed files with 62 additions and 9 deletions
|
@ -13,22 +13,28 @@ module Hanafuda.Message (
|
||||||
|
|
||||||
import Data.Char (toLower)
|
import Data.Char (toLower)
|
||||||
import Data.Aeson (
|
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.Aeson.Types (toJSONKeyText)
|
||||||
import Data.Map (Map)
|
import Data.Map (Map)
|
||||||
|
import Data.Monoid ((<>))
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as Text (pack)
|
import qualified Data.Text as Text (pack)
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
import qualified Hanafuda (Card(..))
|
import qualified Hanafuda (Card(..), Flower(..), Pack, cardsOfPack, empty, packOfCards)
|
||||||
import Hanafuda.Key (Key(..), getKey)
|
import Hanafuda.Key (Key(..), getKey)
|
||||||
import Hanafuda.KoiKoi (PlayerKey, GameBlueprint(..))
|
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
|
deriving instance Generic PlayerKey
|
||||||
instance FromJSON PlayerKey
|
instance FromJSON PlayerKey
|
||||||
|
instance FromJSONKey PlayerKey where
|
||||||
|
fromJSONKey = fromJSONKey
|
||||||
instance ToJSON PlayerKey where
|
instance ToJSON PlayerKey where
|
||||||
toEncoding = genericToEncoding defaultOptions
|
toEncoding = genericToEncoding defaultOptions
|
||||||
instance ToJSONKey PlayerKey where
|
instance ToJSONKey PlayerKey where
|
||||||
|
@ -69,8 +75,12 @@ instance FromJSON FromClient
|
||||||
instance ToJSON FromClient where
|
instance ToJSON FromClient where
|
||||||
toEncoding = genericToEncoding defaultOptions
|
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
|
instance ToJSON PlayerStatus where
|
||||||
toJSON (PlayerStatus (name, alone)) =
|
toJSON (PlayerStatus (name, alone)) =
|
||||||
object ["name" .= name, "alone" .= alone]
|
object ["name" .= name, "alone" .= alone]
|
||||||
|
@ -80,10 +90,53 @@ instance ToJSON PlayerStatus where
|
||||||
type Room = Map PlayerKey PlayerStatus
|
type Room = Map PlayerKey PlayerStatus
|
||||||
|
|
||||||
deriving instance Generic KoiKoi.Source
|
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
|
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
|
type PublicGame = GameBlueprint Int
|
||||||
|
|
||||||
|
@ -101,6 +154,6 @@ data T =
|
||||||
| Error {error :: String}
|
| Error {error :: String}
|
||||||
deriving (Generic)
|
deriving (Generic)
|
||||||
|
|
||||||
|
instance FromJSON T
|
||||||
instance ToJSON T where
|
instance ToJSON T where
|
||||||
toEncoding = genericToEncoding defaultOptions
|
toEncoding = genericToEncoding defaultOptions
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue