From ce31683feee3b1305a9ddbfbc75933d6aa4df71c Mon Sep 17 00:00:00 2001
From: Tissevert <tissevert+devel@marvid.fr>
Date: Wed, 20 Nov 2019 18:23:57 +0100
Subject: [PATCH] Generalize the definition of (From|To)JSON(|Key) to all ID
 types having a prefix as per the newest changes in the lib

---
 src/Hanafuda/Message.hs | 21 ++++++++++++---------
 1 file changed, 12 insertions(+), 9 deletions(-)

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 _ [] = []