From d41616dd6aa52c813edf7dabef4c0684fae4e4e0 Mon Sep 17 00:00:00 2001
From: bjorn <bjorn@bringert.net>
Date: Mon, 20 Oct 2008 11:59:31 +0000
Subject: [PATCH] Added Read and Show instances for CId. Also added readCId ::
 String -> Maybe CId, and use that for readLanguage.

---
 src/GF/Command/Parse.hs |  1 +
 src/PGF.hs              |  6 +++---
 src/PGF/CId.hs          | 33 ++++++++++++++++++++++++++++++---
 src/PGF/Expr.hs         |  9 +--------
 src/PGF/Type.hs         |  8 ++++----
 5 files changed, 39 insertions(+), 18 deletions(-)

diff --git a/src/GF/Command/Parse.hs b/src/GF/Command/Parse.hs
index eaf4cba84..85a351ead 100644
--- a/src/GF/Command/Parse.hs
+++ b/src/GF/Command/Parse.hs
@@ -1,5 +1,6 @@
 module GF.Command.Parse(readCommandLine, pCommand) where
 
+import PGF.CId
 import PGF.Expr
 import PGF.Data(Tree)
 import GF.Command.Abstract
diff --git a/src/PGF.hs b/src/PGF.hs
index 113cc08b8..05d89651e 100644
--- a/src/PGF.hs
+++ b/src/PGF.hs
@@ -77,7 +77,7 @@ import qualified PGF.Parsing.FCFG.Incremental as Incremental
 import GF.Text.UTF8
 
 import GF.Data.ErrM
-import GF.Data.Utilities
+import GF.Data.Utilities (replace)
 
 import Data.Char
 import qualified Data.Map as Map
@@ -98,7 +98,7 @@ import Control.Monad
 -- > concrete LangEng of Lang = ...
 type Language     = CId
 
-readLanguage :: String -> Language
+readLanguage :: String -> Maybe Language
 
 showLanguage :: Language -> String
 
@@ -207,7 +207,7 @@ complete :: PGF -> Language -> Type -> String
 -- Implementation
 ---------------------------------------------------
 
-readLanguage = mkCId
+readLanguage = readCId
 
 showLanguage = prCId
 
diff --git a/src/PGF/CId.hs b/src/PGF/CId.hs
index 161529308..99325975e 100644
--- a/src/PGF/CId.hs
+++ b/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
\ No newline at end of file
diff --git a/src/PGF/Expr.hs b/src/PGF/Expr.hs
index 0dde19310..3b8ec01bc 100644
--- a/src/PGF/Expr.hs
+++ b/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
diff --git a/src/PGF/Type.hs b/src/PGF/Type.hs
index 9ec5b3022..fec8c0ff2 100644
--- a/src/PGF/Type.hs
+++ b/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)