Require a type «a» to define a prefix to get an instance of Show (ID a)

src/Hanafuda/ID.hs

@@ -1,13 +1,34 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Hanafuda.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)

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