forked from GitHub/gf-core
Added Read and Show instances for CId. Also added readCId :: String -> Maybe CId, and use that for readLanguage.
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user