{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module HyLo.Signature.Simple( SimpleSignature,
                              PropSymbol(..),
                              NomSymbol(..),
                              RelSymbol(..) )

where

import Control.Monad   ( liftM )

import HyLo.Signature ( Signature )

import Text.Read ( Read(..) )
import Text.ParserCombinators.ReadPrec( get, (<++) )


newtype PropSymbol = PropSymbol Int deriving(Eq, Ord, Enum)

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)

newtype RelSymbol =    RelSymbol Int      deriving(Eq, Ord)

instance Show RelSymbol where
    showsPrec _ (   RelSymbol i) =          ('R':) . shows i

instance Read RelSymbol where
    readPrec = do 'R' <- get;    RelSymbol `liftM` readPrec

type SimpleSignature = Signature NomSymbol PropSymbol RelSymbol