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
|
module GF.Command.Parse(readCommandLine, pCommand) where
|
||||||
|
|
||||||
|
import PGF.CId
|
||||||
import PGF.Expr
|
import PGF.Expr
|
||||||
import PGF.Data(Tree)
|
import PGF.Data(Tree)
|
||||||
import GF.Command.Abstract
|
import GF.Command.Abstract
|
||||||
|
|||||||
@@ -77,7 +77,7 @@ import qualified PGF.Parsing.FCFG.Incremental as Incremental
|
|||||||
import GF.Text.UTF8
|
import GF.Text.UTF8
|
||||||
|
|
||||||
import GF.Data.ErrM
|
import GF.Data.ErrM
|
||||||
import GF.Data.Utilities
|
import GF.Data.Utilities (replace)
|
||||||
|
|
||||||
import Data.Char
|
import Data.Char
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
@@ -98,7 +98,7 @@ import Control.Monad
|
|||||||
-- > concrete LangEng of Lang = ...
|
-- > concrete LangEng of Lang = ...
|
||||||
type Language = CId
|
type Language = CId
|
||||||
|
|
||||||
readLanguage :: String -> Language
|
readLanguage :: String -> Maybe Language
|
||||||
|
|
||||||
showLanguage :: Language -> String
|
showLanguage :: Language -> String
|
||||||
|
|
||||||
@@ -207,7 +207,7 @@ complete :: PGF -> Language -> Type -> String
|
|||||||
-- Implementation
|
-- Implementation
|
||||||
---------------------------------------------------
|
---------------------------------------------------
|
||||||
|
|
||||||
readLanguage = mkCId
|
readLanguage = readCId
|
||||||
|
|
||||||
showLanguage = prCId
|
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
|
-- | An abstract data type that represents
|
||||||
-- function identifier in PGF.
|
-- 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
|
||||||
wildCId = CId (BS.singleton '_')
|
wildCId = CId (BS.singleton '_')
|
||||||
@@ -13,6 +20,26 @@ wildCId = CId (BS.singleton '_')
|
|||||||
mkCId :: String -> CId
|
mkCId :: String -> CId
|
||||||
mkCId s = CId (BS.pack s)
|
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'
|
-- | Renders the identifier as 'String'
|
||||||
prCId :: CId -> String
|
prCId :: CId -> String
|
||||||
prCId (CId x) = BS.unpack x
|
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,
|
Value(..), Env, eval, apply,
|
||||||
|
|
||||||
-- helpers
|
-- helpers
|
||||||
pIdent,pStr,pFactor
|
pStr,pFactor
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import PGF.CId
|
import PGF.CId
|
||||||
@@ -145,13 +145,6 @@ pStr = RP.char '"' >> (RP.manyTill (pEsc RP.<++ RP.get) (RP.char '"'))
|
|||||||
where
|
where
|
||||||
pEsc = RP.char '\\' >> RP.get
|
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
|
-- Printing
|
||||||
|
|||||||
@@ -49,18 +49,18 @@ pType = do
|
|||||||
RP.<++
|
RP.<++
|
||||||
(RP.between (RP.char '(') (RP.char ')') $ do
|
(RP.between (RP.char '(') (RP.char ')') $ do
|
||||||
var <- RP.option wildCId $ do
|
var <- RP.option wildCId $ do
|
||||||
v <- pIdent
|
v <- pCId
|
||||||
RP.skipSpaces
|
RP.skipSpaces
|
||||||
RP.string ":"
|
RP.string ":"
|
||||||
return (mkCId v)
|
return v
|
||||||
ty <- pType
|
ty <- pType
|
||||||
return (Hyp var ty))
|
return (Hyp var ty))
|
||||||
|
|
||||||
pAtom = do
|
pAtom = do
|
||||||
cat <- pIdent
|
cat <- pCId
|
||||||
RP.skipSpaces
|
RP.skipSpaces
|
||||||
args <- RP.sepBy pFactor RP.skipSpaces
|
args <- RP.sepBy pFactor RP.skipSpaces
|
||||||
return (mkCId cat, args)
|
return (cat, args)
|
||||||
|
|
||||||
ppType :: Int -> Type -> PP.Doc
|
ppType :: Int -> Type -> PP.Doc
|
||||||
ppType d (DTyp ctxt cat args)
|
ppType d (DTyp ctxt cat args)
|
||||||
|
|||||||
Reference in New Issue
Block a user