Added Read and Show instances for CId. Also added readCId :: String -> Maybe CId, and use that for readLanguage.

src/PGF/CId.hs

@@ -1,10 +1,17 @@
-module PGF.CId (CId(..), wildCId, mkCId, prCId) where
+module PGF.CId (CId(..), 
+                mkCId, readCId, prCId,
+                wildCId, 
+                pCId, pIdent) where
+
+import Control.Monad
+import qualified Data.ByteString.Char8 as BS
+import Data.Char
+import qualified Text.ParserCombinators.ReadP as RP
 
-import Data.ByteString.Char8 as BS
 
 -- | An abstract data type that represents
 -- function identifier in PGF.
-newtype CId = CId BS.ByteString deriving (Eq,Ord,Show)
+newtype CId = CId BS.ByteString deriving (Eq,Ord)
 
 wildCId :: CId
 wildCId = CId (BS.singleton '_')
@@ -13,6 +20,26 @@ wildCId = CId (BS.singleton '_')
 mkCId :: String -> CId
 mkCId s = CId (BS.pack s)
 
+readCId :: String -> Maybe CId
+readCId s = case [x | (x,cs) <- RP.readP_to_S pCId s, all isSpace cs] of
+              [x] -> Just x
+              _   -> Nothing
+
 -- | Renders the identifier as 'String'
 prCId :: CId -> String
 prCId (CId x) = BS.unpack x
+
+instance Show CId where
+    showsPrec _ = showString . prCId
+
+instance Read CId where
+    readsPrec _ = RP.readP_to_S pCId
+
+pCId :: RP.ReadP CId
+pCId = fmap mkCId pIdent
+
+pIdent :: RP.ReadP String
+pIdent = liftM2 (:) (RP.satisfy isIdentFirst) (RP.munch isIdentRest)
+  where
+    isIdentFirst c = c == '_' || isLetter c
+    isIdentRest c = c == '_' || c == '\'' || isAlphaNum c

src/PGF/Expr.hs

@@ -10,7 +10,7 @@ module PGF.Expr(Tree(..), Literal(..),
                 Value(..), Env, eval, apply,
 
                 -- helpers
-                pIdent,pStr,pFactor
+                pStr,pFactor
                ) where
 
 import PGF.CId
@@ -145,13 +145,6 @@ pStr = RP.char '"' >> (RP.manyTill (pEsc RP.<++ RP.get) (RP.char '"'))
        where
          pEsc = RP.char '\\' >> RP.get    
 
-pCId = fmap mkCId pIdent
-
-pIdent = liftM2 (:) (RP.satisfy isIdentFirst) (RP.munch isIdentRest)
-  where
-    isIdentFirst c = c == '_' || isLetter c
-    isIdentRest c = c == '_' || c == '\'' || isAlphaNum c
-
 
 -----------------------------------------------------
 -- Printing

src/PGF/Type.hs

@@ -49,18 +49,18 @@ pType = do
       RP.<++
       (RP.between (RP.char '(') (RP.char ')') $ do
          var <- RP.option wildCId $ do
-                     v <- pIdent
+                     v <- pCId
                      RP.skipSpaces
                      RP.string ":"
-                     return (mkCId v)
+                     return v
          ty <- pType
          return (Hyp var ty))
 
     pAtom = do
-      cat <- pIdent
+      cat <- pCId
       RP.skipSpaces
       args <- RP.sepBy pFactor RP.skipSpaces
-      return (mkCId cat, args)
+      return (cat, args)
 
 ppType :: Int -> Type -> PP.Doc
 ppType d (DTyp ctxt cat args)