hanafuda/protocol
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Generalize the definition of (From|To)JSON(|Key) to all ID types having a prefix as per the newest changes in the lib

Browse source
This commit is contained in:
Tissevert 2019-11-20 18:23:57 +01:00
parent f968c41d9d
commit ce31683fee
1 changed files with 12 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
src/Hanafuda/Message.hs
View file

@ -3,6 +3,7 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Hanafuda.Message (
T(..)
, FromClient(..)
@ -29,7 +30,7 @@ import qualified Data.Text as Text (pack, unpack)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import GHC.Generics (Generic)
import qualified Hanafuda (Card(..), Flower(..), Pack, cardsOfPack, empty, packOfCards)
import Hanafuda.ID (ID(..))
import Hanafuda.ID (ID(..), IDType(..), Prefix(..))
import Hanafuda.KoiKoi (PlayerID)
import qualified Hanafuda.KoiKoi as KoiKoi (
Action(..), Game(..), Mode(..), Move(..), Player(..), Players(..), PlayerTurn
@ -37,14 +38,16 @@ import qualified Hanafuda.KoiKoi as KoiKoi (
)
import Hanafuda.Player (Player(..), Players(..))
deriving instance Generic PlayerID
instance FromJSON PlayerID
instance FromJSONKey PlayerID where
fromJSONKey = FromJSONKeyText (ID . read . Text.unpack)
instance ToJSON PlayerID where
toEncoding = genericToEncoding defaultOptions
instance ToJSONKey PlayerID where
toJSONKey = toJSONKeyText (Text.pack . show . getID)
instance IDType a => FromJSON (ID a) where
parseJSON = withText decoding (return . read . Text.unpack)
where decoding = let Prefix p = (prefix :: Prefix a) in p ++ "ID"
instance IDType a => FromJSONKey (ID a) where
fromJSONKey = FromJSONKeyText (read . Text.unpack)
instance IDType a => ToJSON (ID a) where
toJSON = toJSON . show
toEncoding = toEncoding . show
instance IDType a => ToJSONKey (ID a) where
toJSONKey = toJSONKeyText (Text.pack . show)
first :: (a -> a) -> [a] -> [a]
first _ [] = []