summaryrefslogtreecommitdiff
path: root/src/GF
diff options
context:
space:
mode:
Diffstat (limited to 'src/GF')
-rw-r--r--src/GF/Command/Abstract.hs37
-rw-r--r--src/GF/Command/Commands.hs74
-rw-r--r--src/GF/Quiz.hs16
3 files changed, 65 insertions, 62 deletions
diff --git a/src/GF/Command/Abstract.hs b/src/GF/Command/Abstract.hs
index 1ae5d6dff..cf82e96c6 100644
--- a/src/GF/Command/Abstract.hs
+++ b/src/GF/Command/Abstract.hs
@@ -1,5 +1,6 @@
module GF.Command.Abstract where
+import PGF.CId
import PGF.Data
type Ident = String
@@ -19,7 +20,7 @@ data Option
data Value
= VId Ident
- | VInt Integer
+ | VInt Int
| VStr String
deriving (Eq,Ord,Show)
@@ -29,27 +30,25 @@ data Argument
| AMacro Ident
deriving (Eq,Ord,Show)
-valIdOpts :: String -> String -> [Option] -> String
-valIdOpts flag def opts = case valOpts flag (VId def) opts of
- VId v -> v
- _ -> def
+valCIdOpts :: String -> CId -> [Option] -> CId
+valCIdOpts flag def opts =
+ case [v | OFlag f (VId v) <- opts, f == flag] of
+ (v:_) -> mkCId v
+ _ -> def
-valIntOpts :: String -> Integer -> [Option] -> Int
-valIntOpts flag def opts = fromInteger $ case valOpts flag (VInt def) opts of
- VInt v -> v
- _ -> def
+valIntOpts :: String -> Int -> [Option] -> Int
+valIntOpts flag def opts =
+ case [v | OFlag f (VInt v) <- opts, f == flag] of
+ (v:_) -> v
+ _ -> def
valStrOpts :: String -> String -> [Option] -> String
-valStrOpts flag def opts = case valOpts flag (VStr def) opts of
- VStr v -> v
- _ -> def
-
-valOpts :: String -> Value -> [Option] -> Value
-valOpts flag def opts = case lookup flag flags of
- Just v -> v
- _ -> def
- where
- flags = [(f,v) | OFlag f v <- opts]
+valStrOpts flag def opts =
+ case [v | OFlag f v <- opts, f == flag] of
+ (VStr v:_) -> v
+ (VId v:_) -> v
+ (VInt v:_) -> show v
+ _ -> def
isOpt :: String -> [Option] -> Bool
isOpt o opts = elem o [x | OOpt x <- opts]
diff --git a/src/GF/Command/Commands.hs b/src/GF/Command/Commands.hs
index e9a2819ba..a2850b6a2 100644
--- a/src/GF/Command/Commands.hs
+++ b/src/GF/Command/Commands.hs
@@ -164,7 +164,7 @@ allCommands cod pgf = Map.fromList [
],
exec = \opts _ -> do
let pgfr = optRestricted opts
- ts <- generateRandom pgfr (optCat opts)
+ ts <- generateRandom pgfr (optType opts)
return $ fromTrees $ take (optNum opts) ts
}),
("gt", emptyCommandInfo {
@@ -185,7 +185,7 @@ allCommands cod pgf = Map.fromList [
exec = \opts _ -> do
let pgfr = optRestricted opts
let dp = return $ valIntOpts "depth" 4 opts
- let ts = generateAllDepth pgfr (optCat opts) dp
+ let ts = generateAllDepth pgfr (optType opts) dp
return $ fromTrees $ take (optNumInf opts) ts
}),
("h", emptyCommandInfo {
@@ -285,8 +285,8 @@ allCommands cod pgf = Map.fromList [
synopsis = "start a morphology quiz",
exec = \opts _ -> do
let lang = optLang opts
- let cat = optCat opts
- morphologyQuiz cod pgf lang cat
+ let typ = optType opts
+ morphologyQuiz cod pgf lang typ
return void,
flags = [
("lang","language of the quiz"),
@@ -405,7 +405,7 @@ allCommands cod pgf = Map.fromList [
("tree","convert strings into trees")
],
exec = \opts arg -> do
- let file = valIdOpts "file" "_gftmp" opts
+ let file = valStrOpts "file" "_gftmp" opts
s <- readFile file
return $ case opts of
_ | isOpt "lines" opts && isOpt "tree" opts ->
@@ -420,10 +420,10 @@ allCommands cod pgf = Map.fromList [
longname = "translation_quiz",
synopsis = "start a translation quiz",
exec = \opts _ -> do
- let from = valIdOpts "from" (optLang opts) opts
- let to = valIdOpts "to" (optLang opts) opts
- let cat = optCat opts
- translationQuiz cod pgf from to cat
+ let from = valCIdOpts "from" (optLang opts) opts
+ let to = valCIdOpts "to" (optLang opts) opts
+ let typ = optType opts
+ translationQuiz cod pgf from to typ
return void,
flags = [
("from","translate from this language"),
@@ -516,7 +516,7 @@ allCommands cod pgf = Map.fromList [
longname = "write_file",
synopsis = "send string or tree to a file",
exec = \opts arg -> do
- let file = valIdOpts "file" "_gftmp" opts
+ let file = valStrOpts "file" "_gftmp" opts
if isOpt "append" opts
then appendFile file (enc (toString arg))
else writeFile file (enc (toString arg))
@@ -530,7 +530,7 @@ allCommands cod pgf = Map.fromList [
where
enc = encodeUnicode cod
lin opts t = unlines [linearize pgf lang t | lang <- optLangs opts]
- par opts s = concat [parse pgf lang (optCat opts) s | lang <- optLangs opts, canParse pgf lang]
+ par opts s = concat [parse pgf lang (optType opts) s | lang <- optLangs opts, canParse pgf lang]
void = ([],[])
@@ -539,21 +539,21 @@ allCommands cod pgf = Map.fromList [
_ -> unlines [linear opts lang t | lang <- optLangs opts]
linear opts lang = let unl = unlex opts lang in case opts of
- _ | isOpt "all" opts -> allLinearize unl pgf (mkCId lang)
- _ | isOpt "table" opts -> tableLinearize unl pgf (mkCId lang)
- _ | isOpt "term" opts -> termLinearize pgf (mkCId lang)
- _ | isOpt "record" opts -> recordLinearize pgf (mkCId lang)
+ _ | isOpt "all" opts -> allLinearize unl pgf lang
+ _ | isOpt "table" opts -> tableLinearize unl pgf lang
+ _ | isOpt "term" opts -> termLinearize pgf lang
+ _ | isOpt "record" opts -> recordLinearize pgf lang
_ -> unl . linearize pgf lang
treebank opts t = unlines $
- (abstractName pgf ++ ": " ++ showTree t) :
- [lang ++ ": " ++ linear opts lang t | lang <- optLangs opts]
+ (prCId (abstractName pgf) ++ ": " ++ showTree t) :
+ [prCId lang ++ ": " ++ linear opts lang t | lang <- optLangs opts]
unlex opts lang = stringOps (getUnlex opts lang ++ map prOpt opts)
getUnlex opts lang = case words (valStrOpts "unlexer" "" opts) of
lexs -> case lookup lang
- [(la,tail le) | lex <- lexs, let (la,le) = span (/='=') lex, not (null le)] of
+ [(mkCId la,tail le) | lex <- lexs, let (la,le) = span (/='=') lex, not (null le)] of
Just le -> chunks ',' le
_ -> []
@@ -571,13 +571,17 @@ allCommands cod pgf = Map.fromList [
_ -> map prOpt opts
optRestricted opts =
- restrictPGF (\f -> and [hasLin pgf (mkCId la) f | la <- optLangs opts]) pgf
+ restrictPGF (\f -> and [hasLin pgf la f | la <- optLangs opts]) pgf
- optLangs opts = case valIdOpts "lang" "" opts of
+ optLangs opts = case valStrOpts "lang" "" opts of
"" -> languages pgf
- lang -> chunks ',' lang
- optLang opts = head $ optLangs opts ++ ["#NOLANG"]
- optCat opts = valIdOpts "cat" (lookStartCat pgf) opts
+ lang -> map mkCId (chunks ',' lang)
+ optLang opts = head $ optLangs opts ++ [wildCId]
+ optType opts =
+ let str = valStrOpts "cat" (lookStartCat pgf) opts
+ in case readType str of
+ Just ty -> ty
+ Nothing -> error ("Can't parse '"++str++"' as type")
optComm opts = valStrOpts "command" "" opts
optViewFormat opts = valStrOpts "format" "ps" opts
optViewGraph opts = valStrOpts "view" "gv" opts
@@ -591,17 +595,17 @@ allCommands cod pgf = Map.fromList [
toString = unwords . toStrings
prGrammar opts = case opts of
- _ | isOpt "cats" opts -> unwords $ categories pgf
+ _ | isOpt "cats" opts -> unwords $ map prCId $ categories pgf
_ | isOpt "fullform" opts -> concatMap
- (prFullFormLexicon . buildMorpho pgf . mkCId) $ optLangs opts
+ (prFullFormLexicon . buildMorpho pgf) $ optLangs opts
_ | isOpt "missing" opts ->
- unlines $ [unwords (la:":": map prCId cs) |
- la <- optLangs opts, let cs = missingLins pgf (mkCId la)]
- _ -> case valIdOpts "printer" "pgf" opts of
+ unlines $ [unwords (prCId la:":": map prCId cs) |
+ la <- optLangs opts, let cs = missingLins pgf la]
+ _ -> case valStrOpts "printer" "pgf" opts of
v -> concatMap snd $ exportPGF noOptions (read v) pgf
morphos opts s =
- [lookupMorpho (buildMorpho pgf (mkCId la)) s | la <- optLangs opts]
+ [lookupMorpho (buildMorpho pgf la) s | la <- optLangs opts]
-- ps -f -g s returns g (f s)
stringOps opts s = foldr app s (reverse opts) where
@@ -643,14 +647,14 @@ stringOpOptions = [
treeOpOptions pgf = [(op,expl) | (op,(expl,_)) <- allTreeOps pgf]
-translationQuiz :: String -> PGF -> Language -> Language -> Category -> IO ()
-translationQuiz cod pgf ig og cat = do
- tts <- translationList pgf ig og cat infinity
+translationQuiz :: String -> PGF -> Language -> Language -> Type -> IO ()
+translationQuiz cod pgf ig og typ = do
+ tts <- translationList pgf ig og typ infinity
mkQuiz cod "Welcome to GF Translation Quiz." tts
-morphologyQuiz :: String -> PGF -> Language -> Category -> IO ()
-morphologyQuiz cod pgf ig cat = do
- tts <- morphologyList pgf ig cat infinity
+morphologyQuiz :: String -> PGF -> Language -> Type -> IO ()
+morphologyQuiz cod pgf ig typ = do
+ tts <- morphologyList pgf ig typ infinity
mkQuiz cod "Welcome to GF Morphology Quiz." tts
-- | the maximal number of precompiled quiz problems
diff --git a/src/GF/Quiz.hs b/src/GF/Quiz.hs
index 92969aa3c..bfdd9a54a 100644
--- a/src/GF/Quiz.hs
+++ b/src/GF/Quiz.hs
@@ -39,19 +39,19 @@ mkQuiz cod msg tts = do
teachDialogue qas msg
translationList ::
- PGF -> Language -> Language -> Category -> Int -> IO [(String,[String])]
-translationList pgf ig og cat number = do
- ts <- generateRandom pgf cat >>= return . take number
+ PGF -> Language -> Language -> Type -> Int -> IO [(String,[String])]
+translationList pgf ig og typ number = do
+ ts <- generateRandom pgf typ >>= return . take number
return $ map mkOne $ ts
where
mkOne t = (norml (linearize pgf ig t), map (norml . linearize pgf og) (homonyms t))
- homonyms = nub . parse pgf ig cat . linearize pgf ig
+ homonyms = nub . parse pgf ig typ . linearize pgf ig
-morphologyList :: PGF -> Language -> Category -> Int -> IO [(String,[String])]
-morphologyList pgf ig cat number = do
- ts <- generateRandom pgf cat >>= return . take (max 1 number)
+morphologyList :: PGF -> Language -> Type -> Int -> IO [(String,[String])]
+morphologyList pgf ig typ number = do
+ ts <- generateRandom pgf typ >>= return . take (max 1 number)
gen <- newStdGen
- let ss = map (tabularLinearize pgf (mkCId ig)) ts
+ let ss = map (tabularLinearize pgf ig) ts
let size = length (head ss)
let forms = take number $ randomRs (0,size-1) gen
return [(head (snd (head pws)) +++ par, ws) |
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 07:14:46 +0000