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