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

This commit is contained in:
Tissevert 2019-11-20 18:23:57 +01:00
parent f968c41d9d
commit ce31683fee

View file

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