GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-23 11:42:49 -06:00
Code Issues Packages Projects Releases Wiki Activity

change PGF.categories to return list of identifiers instead of types

Browse Source
This commit is contained in:
krasimir
2009-11-26 14:43:31 +00:00
parent 6b0a662c35
commit ba1b602053
3 changed files with 6 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
src/GF/Command/Commands.hs
View File

@@ -835,7 +835,7 @@ allCommands cod env@(pgf, mos) = Map.fromList [
_ -> fromExprs es _ -> fromExprs es
prGrammar opts prGrammar opts
| isOpt "cats" opts = return $ fromString $ unwords $ map (showType []) $ categories pgf | isOpt "cats" opts = return $ fromString $ unwords $ map showCId $ categories pgf
| isOpt "fullform" opts = return $ fromString $ concatMap (morpho "" prFullFormLexicon) $ optLangs opts | isOpt "fullform" opts = return $ fromString $ concatMap (morpho "" prFullFormLexicon) $ optLangs opts
| isOpt "missing" opts = return $ fromString $ unlines $ [unwords (showCId la:":": map showCId cs) | | isOpt "missing" opts = return $ fromString $ unlines $ [unwords (showCId la:":": map showCId cs) |
la <- optLangs opts, let cs = missingLins pgf la] la <- optLangs opts, let cs = missingLins pgf la]

4
src/PGF.hs
View File

@@ -199,7 +199,7 @@ abstractName :: PGF -> Language
-- | List of all categories defined in the given grammar. -- | List of all categories defined in the given grammar.
-- The categories are defined in the abstract syntax -- The categories are defined in the abstract syntax
-- with the \'cat\' keyword. -- with the \'cat\' keyword.
categories :: PGF -> [Type] categories :: PGF -> [CId]
-- | The start category is defined in the grammar with -- | The start category is defined in the grammar with
-- the \'startcat\' flag. This is usually the sentence category -- the \'startcat\' flag. This is usually the sentence category
@@ -279,7 +279,7 @@ languages pgf = cncnames pgf
languageCode pgf lang = languageCode pgf lang =
fmap (replace '_' '-') $ lookConcrFlag pgf lang (mkCId "language") fmap (replace '_' '-') $ lookConcrFlag pgf lang (mkCId "language")
categories pgf = [DTyp [] c (map EMeta [0..length hs]) | (c,hs) <- Map.toList (cats (abstract pgf))] categories pgf = [c | (c,hs) <- Map.toList (cats (abstract pgf))]
startCat pgf = DTyp [] (lookStartCat pgf) [] startCat pgf = DTyp [] (lookStartCat pgf) []

7
src/server/PGFService.hs
View File

@@ -69,9 +69,8 @@ pgfMain pgf command =
Nothing -> return Nothing Nothing -> return Nothing
Just "" -> return Nothing Just "" -> return Nothing
Just cat -> case PGF.readType cat of Just cat -> case PGF.readType cat of
Nothing -> throwCGIError 400 "Bad category" ["Bad category: " ++ cat] Nothing -> throwCGIError 400 "Bad category" ["Bad category: " ++ cat]
Just typ | typ `elem` PGF.categories pgf -> return $ Just typ Just typ -> return $ Just typ -- typecheck the category
| otherwise -> throwCGIError 400 "Unknown category" ["Unknown category: " ++ PGF.showType [] typ]
getFrom :: CGI (Maybe PGF.Language) getFrom :: CGI (Maybe PGF.Language)
getFrom = getLang "from" getFrom = getLang "from"
@@ -146,7 +145,7 @@ doGrammar pgf macc = showJSON $ toJSObject
("languageCode", showJSON $ fromMaybe "" (PGF.languageCode pgf l)), ("languageCode", showJSON $ fromMaybe "" (PGF.languageCode pgf l)),
("canParse", showJSON $ PGF.canParse pgf l)] ("canParse", showJSON $ PGF.canParse pgf l)]
| l <- PGF.languages pgf] | l <- PGF.languages pgf]
categories = map toJSObject [[("cat", PGF.showType [] cat)] | cat <- PGF.categories pgf] categories = map toJSObject [[("name", PGF.showCId cat)] | cat <- PGF.categories pgf]
doGraphvizAbstrTree pgf tree = do doGraphvizAbstrTree pgf tree = do
let dot = PGF.graphvizAbstractTree pgf (True,True) tree let dot = PGF.graphvizAbstractTree pgf (True,True) tree