From 31ad94e5afbeb5443fe1a4c782ed7a1452658774 Mon Sep 17 00:00:00 2001
From: Tissevert <tissevert+devel@marvid.fr>
Date: Wed, 20 Nov 2019 18:22:27 +0100
Subject: [PATCH] =?UTF-8?q?Require=20a=20type=20=C2=ABa=C2=BB=20to=20defin?=
 =?UTF-8?q?e=20a=20prefix=20to=20get=20an=20instance=20of=20Show=20(ID=20a?=
 =?UTF-8?q?)?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Hanafuda/ID.hs     | 25 +++++++++++++++++++++++--
 src/Hanafuda/Player.hs |  5 ++++-
 2 files changed, 27 insertions(+), 3 deletions(-)

diff --git a/src/Hanafuda/ID.hs b/src/Hanafuda/ID.hs
index 5e7eeba..39b6ec4 100644
--- a/src/Hanafuda/ID.hs
+++ b/src/Hanafuda/ID.hs
@@ -1,13 +1,34 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Hanafuda.ID (
-    ID(..)
+      ID(..)
+    , IDType(..)
+    , Prefix(..)
   ) where
 
+import Data.Char (isDigit)
 import System.Random (Random(..))
+import Text.ParserCombinators.ReadP (char, munch, string)
+import Text.ParserCombinators.ReadPrec (lift)
+import Text.Read (readPrec)
 
 newtype ID a = ID {
     getID :: Int
-  } deriving (Eq, Ord, Enum, Read, Show)
+  } deriving (Eq, Ord)
+
+newtype Prefix a = Prefix String
+
+class IDType a where
+  prefix :: Prefix a
+
+instance IDType a => Show (ID a) where
+  show (ID someID) = p ++ ('#' : show someID)
+    where Prefix p = (prefix :: Prefix a)
+
+instance IDType a => Read (ID a) where
+  readPrec = fmap (ID . read) . lift $
+    string p >> char '#' >> munch (isDigit)
+    where Prefix p = (prefix :: Prefix a)
 
 rIntToRID :: (Int, g) -> (ID a, g)
 rIntToRID (someID, g) = (ID someID, g)
diff --git a/src/Hanafuda/Player.hs b/src/Hanafuda/Player.hs
index ca93ae8..078f429 100644
--- a/src/Hanafuda/Player.hs
+++ b/src/Hanafuda/Player.hs
@@ -3,7 +3,7 @@
 module Hanafuda.Player where
 
 import Hanafuda (Card, Pack, contains, packOfCards, remove)
-import qualified Hanafuda.ID as Hanafuda (ID)
+import qualified Hanafuda.ID as Hanafuda (ID, IDType(..), Prefix(..))
 import Data.Map ((!), Map, elemAt, insert, keys, size)
 import qualified Data.Map as Map (fromList, keys)
 import Control.Monad.IO.Class (MonadIO(..))
@@ -11,6 +11,9 @@ import Control.Monad.Except (MonadError(..))
 import System.Random (Random(..))
 
 type ID yakus = Hanafuda.ID (Player yakus)
+instance Hanafuda.IDType (Player yakus) where
+  prefix = Hanafuda.Prefix "Player"
+
 data Player yakus = Player {
       hand :: Pack
     , meld :: Pack