diff options
Diffstat (limited to 'src/GF/Shell.hs')
| -rw-r--r-- | src/GF/Shell.hs | 40 |
1 files changed, 30 insertions, 10 deletions
diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs index 014f5bd60..3bc5fe4d8 100644 --- a/src/GF/Shell.hs +++ b/src/GF/Shell.hs @@ -7,6 +7,9 @@ import qualified Ident as I import qualified Compute as Co import qualified Lookup as L import qualified GFC +import qualified Look +import qualified CMacros +import qualified GrammarToCanon import Values import GetTree @@ -28,7 +31,7 @@ import HelpFile import PrOld import PrGrammar -import Monad (foldM) +import Monad (foldM,liftM) import System (system) import Random (newStdGen) ---- import Zipper ---- @@ -112,12 +115,15 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = checkOptions st co >> case comm of CPrintHistory -> (returnArg $ AString $ unlines $ reverse h) sa -- good to have here for piping; eh and ec must be done on outer level - CLinearize [] -> changeArg (opTS2CommandArg (optLinearizeTreeVal opts gro) . s2t) sa + CLinearize [] -> + changeArg (opTS2CommandArg (optLinearizeTreeVal opts gro) . s2t) sa ---- CLinearize m -> changeArg (opTS2CommandArg (optLinearizeArgForm opts gro m)) sa - CParse -> case optParseArgErrMsg opts gro (prCommandArg a) of - Ok (ts,msg) -> putStrLnFlush msg >> changeArg (const $ ATrms ts) sa - Bad msg -> changeArg (const $ AError msg) sa + CParse -> do + warnDiscont opts + case optParseArgErrMsg opts gro (prCommandArg a) of + Ok (ts,msg) -> putStrLnFlush msg >> changeArg (const $ ATrms ts) sa + Bad msg -> changeArg (const $ AError msg) sa CTranslate il ol -> do let a' = opST2CommandArg (optParseArgErr opts (sgr il)) a @@ -175,13 +181,19 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = checkOptions st co >> case comm of return . L.opersForType src))) sa - CTranslationQuiz il ol -> justOutput (teachTranslation opts (sgr il) (sgr ol)) sa - CTranslationList il ol n -> do + CTranslationQuiz il ol -> do + warnDiscont opts + justOutput (teachTranslation opts (sgr il) (sgr ol)) sa + CTranslationList il ol n -> do + warnDiscont opts qs <- transTrainList opts (sgr il) (sgr ol) (toInteger n) returnArg (AString $ foldr (+++++) [] [unlines (s:ss) | (s,ss) <- qs]) sa - CMorphoQuiz -> justOutput (teachMorpho opts gro) sa + CMorphoQuiz -> do + warnDiscont opts + justOutput (teachMorpho opts gro) sa CMorphoList n -> do + warnDiscont opts qs <- useIOE [] $ morphoTrainList opts gro (toInteger n) returnArg (AString $ foldr (+++++) [] [unlines (s:ss) | (s,ss) <- qs]) sa @@ -201,8 +213,8 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = checkOptions st co >> case comm of | oElem showAll opts -> returnArg (AString txtHelpFile) sa | otherwise -> returnArg (AString txtHelpFileSummary) sa - CPrintGrammar -> returnArg (AString (optPrintGrammar opts gro)) sa - CPrintGlobalOptions -> justOutput (putStrLn $ prShellStateInfo st) sa + CPrintGrammar -> returnArg (AString (optPrintGrammar opts gro)) sa + CPrintGlobalOptions -> justOutput (putStrLn $ prShellStateInfo st) sa CPrintInformation c -> justOutput (useIOE () $ showInformation opts st c) sa CPrintLanguages -> justOutput (putStrLn $ unwords $ map prLanguage $ allLanguages st) sa @@ -226,6 +238,14 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = checkOptions st co >> case comm of ASTrm s -> err AError (ATrms . return) $ string2treeErr gro s _ -> a + warnDiscont os = err putStrLn id $ do + let c0 = firstAbsCat os gro + c <- GrammarToCanon.redQIdent c0 + lang <- maybeErr "no concrete" $ languageOfOptState os st + t <- Look.lookupLincat cgr $ CMacros.redirectIdent lang c + return $ if CMacros.isDiscontinuousCType t + then (putStrLn ("Warning: discontinuous category" +++ prt_ c)) + else (return ()) -- commands either change the state or process the argument, but not both -- some commands just do output |