39 lines
994 B
Haskell
39 lines
994 B
Haskell
{-# 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)
|
|
|
|
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)
|
|
|
|
instance Random (ID a) where
|
|
random = rIntToRID . randomR (0, maxBound)
|
|
randomR (ID idA, ID idB) = rIntToRID . randomR (idA, idB)
|