{-# OPTIONS_GHC -fglasgow-exts #-}
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


-- N will be used by the input file parser for unboundable nominals,
-- X will be used for boundable nominals
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)
  ]