diff --git a/src/Hanafuda/Message.hs b/src/Hanafuda/Message.hs index b63cac7..aa529bc 100644 --- a/src/Hanafuda/Message.hs +++ b/src/Hanafuda/Message.hs @@ -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 _ [] = []