module HyLo.Signature.Simple( SimpleSignature,
PropSymbol(..),
NomSymbol(..),
RelSymbol(..), inv,
unit_tests )
where
import Test.QuickCheck ( Arbitrary(..), oneof, variant )
import HyLo.Test ( UnitTest, runTest )
import Control.Monad ( liftM )
import HyLo.Signature ( Signature, IsRelSym(..) )
import Text.Read ( Read(..) )
import Text.ParserCombinators.ReadPrec( get, (<++) )
newtype PropSymbol = PropSymbol Int deriving(Eq, Ord, Enum, Arbitrary)
instance Show PropSymbol where
showsPrec _ (PropSymbol i) = ('P':) . shows i
instance Read PropSymbol where
readPrec = do 'P' <- get; PropSymbol `liftM` readPrec
data NomSymbol = N Int | X Int
deriving (Eq, Ord)
instance Show NomSymbol where
showsPrec _ (N i) = ('N':) . shows i
showsPrec _ (X i) = ('X':) . shows i
instance Read NomSymbol where
readPrec = (do 'N' <- get; N `liftM` readPrec)
<++ (do 'X' <- get; X `liftM` readPrec)
data RelSymbol = RelSymbol Int
| InvRelSymbol Int
deriving(Eq, Ord)
instance Show RelSymbol where
showsPrec _ ( RelSymbol i) = ('R':) . shows i
showsPrec _ (InvRelSymbol i) = ('-':) . ('R':) . shows i
instance Read RelSymbol where
readPrec = (do 'R' <- get; RelSymbol `liftM` readPrec)
<++ (do '-' <- get; 'R' <- get; InvRelSymbol `liftM` readPrec)
inv :: RelSymbol -> RelSymbol
inv ( RelSymbol r) = InvRelSymbol r
inv (InvRelSymbol r) = RelSymbol r
instance IsRelSym RelSymbol where
invRel = Just . inv
type SimpleSignature = Signature NomSymbol PropSymbol RelSymbol
instance Arbitrary NomSymbol where
arbitrary = oneof [N `liftM` arbitrary, X `liftM` arbitrary]
coarbitrary (N i) = variant 0 . coarbitrary i
coarbitrary (X i) = variant 1 . coarbitrary i
instance Arbitrary RelSymbol where
arbitrary = oneof [RelSymbol`liftM` arbitrary,
InvRelSymbol `liftM` arbitrary]
coarbitrary (RelSymbol r) = variant 0 . coarbitrary r
coarbitrary (InvRelSymbol r) = variant 1 . coarbitrary r
prop_read_PropSymbol :: PropSymbol -> Bool
prop_read_PropSymbol p = p == (read . show $ p)
prop_read_NomSymbol :: NomSymbol -> Bool
prop_read_NomSymbol i = i == (read . show $ i)
prop_read_RelSymbol :: RelSymbol -> Bool
prop_read_RelSymbol r = r == (read . show $ r)
unit_tests :: UnitTest
unit_tests = [
("read/show - PropSymbol", runTest prop_read_PropSymbol),
("read/show - NomSymbol", runTest prop_read_NomSymbol),
("read/show - RelSymbol", runTest prop_read_RelSymbol)
]