Require a type «a» to define a prefix to get an instance of Show (ID a)
This commit is contained in:
parent
3440c84543
commit
31ad94e5af
2 changed files with 27 additions and 3 deletions
|
@ -1,13 +1,34 @@
|
||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
module Hanafuda.ID (
|
module Hanafuda.ID (
|
||||||
ID(..)
|
ID(..)
|
||||||
|
, IDType(..)
|
||||||
|
, Prefix(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Data.Char (isDigit)
|
||||||
import System.Random (Random(..))
|
import System.Random (Random(..))
|
||||||
|
import Text.ParserCombinators.ReadP (char, munch, string)
|
||||||
|
import Text.ParserCombinators.ReadPrec (lift)
|
||||||
|
import Text.Read (readPrec)
|
||||||
|
|
||||||
newtype ID a = ID {
|
newtype ID a = ID {
|
||||||
getID :: Int
|
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 :: (Int, g) -> (ID a, g)
|
||||||
rIntToRID (someID, g) = (ID someID, g)
|
rIntToRID (someID, g) = (ID someID, g)
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
module Hanafuda.Player where
|
module Hanafuda.Player where
|
||||||
|
|
||||||
import Hanafuda (Card, Pack, contains, packOfCards, remove)
|
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 Data.Map ((!), Map, elemAt, insert, keys, size)
|
||||||
import qualified Data.Map as Map (fromList, keys)
|
import qualified Data.Map as Map (fromList, keys)
|
||||||
import Control.Monad.IO.Class (MonadIO(..))
|
import Control.Monad.IO.Class (MonadIO(..))
|
||||||
|
@ -11,6 +11,9 @@ import Control.Monad.Except (MonadError(..))
|
||||||
import System.Random (Random(..))
|
import System.Random (Random(..))
|
||||||
|
|
||||||
type ID yakus = Hanafuda.ID (Player yakus)
|
type ID yakus = Hanafuda.ID (Player yakus)
|
||||||
|
instance Hanafuda.IDType (Player yakus) where
|
||||||
|
prefix = Hanafuda.Prefix "Player"
|
||||||
|
|
||||||
data Player yakus = Player {
|
data Player yakus = Player {
|
||||||
hand :: Pack
|
hand :: Pack
|
||||||
, meld :: Pack
|
, meld :: Pack
|
||||||
|
|
Loading…
Reference in a new issue