forked from GitHub/gf-core
change PGF.categories to return list of identifiers instead of types
This commit is contained in:
@@ -835,7 +835,7 @@ allCommands cod env@(pgf, mos) = Map.fromList [
|
||||
_ -> fromExprs es
|
||||
|
||||
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 "missing" opts = return $ fromString $ unlines $ [unwords (showCId la:":": map showCId cs) |
|
||||
la <- optLangs opts, let cs = missingLins pgf la]
|
||||
|
||||
@@ -199,7 +199,7 @@ abstractName :: PGF -> Language
|
||||
-- | List of all categories defined in the given grammar.
|
||||
-- The categories are defined in the abstract syntax
|
||||
-- with the \'cat\' keyword.
|
||||
categories :: PGF -> [Type]
|
||||
categories :: PGF -> [CId]
|
||||
|
||||
-- | The start category is defined in the grammar with
|
||||
-- the \'startcat\' flag. This is usually the sentence category
|
||||
@@ -279,7 +279,7 @@ languages pgf = cncnames pgf
|
||||
languageCode pgf lang =
|
||||
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) []
|
||||
|
||||
|
||||
@@ -69,9 +69,8 @@ pgfMain pgf command =
|
||||
Nothing -> return Nothing
|
||||
Just "" -> return Nothing
|
||||
Just cat -> case PGF.readType cat of
|
||||
Nothing -> throwCGIError 400 "Bad category" ["Bad category: " ++ cat]
|
||||
Just typ | typ `elem` PGF.categories pgf -> return $ Just typ
|
||||
| otherwise -> throwCGIError 400 "Unknown category" ["Unknown category: " ++ PGF.showType [] typ]
|
||||
Nothing -> throwCGIError 400 "Bad category" ["Bad category: " ++ cat]
|
||||
Just typ -> return $ Just typ -- typecheck the category
|
||||
|
||||
getFrom :: CGI (Maybe PGF.Language)
|
||||
getFrom = getLang "from"
|
||||
@@ -146,7 +145,7 @@ doGrammar pgf macc = showJSON $ toJSObject
|
||||
("languageCode", showJSON $ fromMaybe "" (PGF.languageCode pgf l)),
|
||||
("canParse", showJSON $ PGF.canParse pgf l)]
|
||||
| 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
|
||||
let dot = PGF.graphvizAbstractTree pgf (True,True) tree
|
||||
|
||||
Reference in New Issue
Block a user