---------------------------------------------------------------------- -- | -- Module : Main -- Maintainer : Markus Forsberg -- Stability : (stability) -- Portability : (portability) -- -- > CVS $Date: 2006/06/05 15:25:00 $ -- > CVS $Author: markus $ -- > CVS $Revision: 1.1 $ -- ----------------------------------------------------------------------------- module Command where import System.Console.GetOpt import Maybe(fromMaybe) import List(isSuffixOf) import System(getProgName) import Dict.ErrM import IO import Char import General import Tokenize(tokens,norm) import Dictionary import Frontend import List(intersperse) import qualified Data.Map as Map -- import Frontend {- |Does the filename end with the suffix .dict? -} is_dictionary :: FilePath -> Bool is_dictionary = isSuffixOf ".dict" {- |Does the filename end with the suffix .lexicon? -} is_lexicon :: FilePath -> Bool is_lexicon = isSuffixOf ".lexicon" output :: [Flag] -> Maybe FilePath output xs = case [f | Output f <- xs] of [f] -> Just f _ -> Nothing printer :: [Flag] -> Maybe String printer xs = case [p | (Print p) <- xs] of (x:_) -> return x _ -> Nothing apply_encoding l flags d = case [x | Encoding x <- flags] of [] -> d (x:_) -> case Map.lookup x (encoding l) of Nothing -> error $ "Unknown encoding: " ++ x Just t -> transform_dictionary t d output_write :: [Flag] -> (String -> IO()) output_write xs = case output xs of Nothing -> putStr Just f -> writeFile f dictionary_needed :: [Flag] -> Bool dictionary_needed [] = True dictionary_needed xs = not $ or [elem x nodict | x <- xs] where nodict = Infl : Help : Version : Paradigm : [Print s | s <- ["paradigms","paradigms_compact", "paradigms_latex","paradigms_list","paradigms_plist","pos_plist","tagset", "core","extract","compound"]] is_mode :: [Flag] -> Bool is_mode xs = case [f | Mode f <- xs] of [_] -> True _ -> False --is_fullform :: [Flag] -> Bool --is_fullform xs = False -- case [f | Fullform f <- xs] of -- [_] -> True -- _ -> False is_help :: [Flag] -> Bool is_help = elem Help is_version :: [Flag] -> Bool is_version = elem Version is_paradigm :: [Flag] -> Bool is_paradigm = elem Paradigm is_compound :: [Flag] -> Bool is_compound xs = case [f | Compound f <- xs] of [_] -> True _ -> False data Comp = All | Min | Max | None | Unknown deriving Eq pr_comp :: Comp -> String pr_comp c = case c of All -> "all" Min -> "min" Max -> "max" None -> "none" --Length n -> "minlen=" ++ show n Unknown -> "unknown (defaults to all)" get_compound :: [Flag] -> Comp get_compound xs = case [f | Compound f <- xs] of (f@("none"):_) -> None (f@("all"):_) -> All (f@("min"):_) -> Min (f@("max"):_) -> Max -- (f@('m':'i':'n':'l':'e':'n':'=':n):_) | all isDigit n -> Length (read n) _ -> Unknown is_quality :: [Flag] -> Bool is_quality xs = case [ x | Quality x <- xs ] of [_] -> True _ -> False is_undef :: [Flag] -> Bool is_undef = elem (Quality "undef") is_argc :: [Flag] -> Bool is_argc = elem (Quality "argc") is_unused :: [Flag] -> Bool is_unused = elem (Quality "pop") is_duplicated :: [Flag] -> Bool is_duplicated = elem (Quality "dup") --is_dict :: [Flag] -> Bool --is_dict = elem (Quality "dict") is_all :: [Flag] -> Bool is_all = elem (Quality "all") is_test :: [Flag] -> Bool is_test = elem (Quality "test") is_paradigm_test :: [Flag] -> Bool is_paradigm_test = elem (Quality "para") is_net :: [Flag] -> Bool is_net fs = not $ null [x | Net x <- fs] get_port :: [Flag] -> Maybe Int get_port fs = case [x | Net x <- fs] of (x:_) | all isDigit x -> return $ read x _ -> Nothing get_quality :: [Flag] -> String get_quality xs = case [ x | Quality x <- xs ] of (x:_) -> x invalid_quality :: [Flag] -> Bool invalid_quality xs = or [not (elem x ["undef", "pop","dup","para","argc","all","test"]) | Quality x <- xs ] get_mode :: [Flag] -> String get_mode xs = case [f | Mode f <- xs] of (f:_) -> f is_printer :: [Flag] -> Bool is_printer xs = case [f | Print f <- xs] of [_] -> True _ -> False get_tokenizer :: (String -> [Tok]) -> [Flag] -> (String -> [Tok]) get_tokenizer tokf fs = case get_tokenizer_name fs of "words" -> (map W . words) "lines" -> (map tokl . lines) "norm" -> norm . lines "default" -> tokens x -> error $ "unknown tokenizer: " ++ x where tokl [] = BL tokl s = W s norm_tokenizer = norm . lines invalid_tokenizer :: [Flag] -> Bool invalid_tokenizer fs | elem (get_tokenizer_name fs) ["words","norm", "lines","default"] = False | otherwise = True get_tokenizer_name :: [Flag] -> String get_tokenizer_name fs = case [t | (Tokenizer t) <- fs] of (t:_) -> t _ -> "default" is_reduce :: [Flag] -> Bool is_reduce fs = not $ null [f | f@(Reduce _) <- fs] get_reduce_file :: [Flag] -> String get_reduce_file fs = case [f | (Reduce f) <- fs] of (f:_) -> f {-|Data type for the Command line arguments. -} data Flag = Help | Synth | Quality String | Compound String | Encoding String | Infl | Length String | DupID | Paradigm | Tag | Reduce String | Net String | Version | Tokenizer String | Mode String | Print String | Output String deriving (Show,Eq) {- |Lists all possible arguments and their explainations -} options :: Language l => l -> [OptDescr Flag] options l = [ Option ['i'] ["inflection"] (NoArg Infl) "run inflection engine" , Option ['s'] ["synthesiser"] (NoArg Synth) "enter synthesizer mode" , Option ['a'] ["analysis"] (NoArg Tag) "pos tagging" , Option ['r'] ["reduce"] (ReqArg Reduce "TAGFILE") "reduce ambiguity with external file" , Option ['c'] ["compound"] (ReqArg Compound "COMPOUND") "activate compound analysis (none,min,max,all)" , Option ['t'] ["tokenizer"] (ReqArg Tokenizer "TOKENIZER") "select mode (default, words, lines, norm)" , Option ['m'] ["mode"] (ReqArg Mode "MODE") "select mode (fail, lexfail, nocomp, lexcomp)" , Option ['p'] ["printer"] (ReqArg Print "PRINTER") "print using PRINTER (core, paradigms, paradigms_compact, paradigms_latex, compound, tagset, words, lex, tables, extract, gf, xml, sfst, sfstlex, sfstheader, lexc, xfst, sql, hundict, hunaffix, lmf,rdf)" , Option ['e'] ["encoding"] (ReqArg Encoding "ENCODING") ("select another morphosyntactic encoding (" ++ (concat (intersperse ", " (Map.keys (encoding l)))) ++ ")") , Option ['q'] ["quality"] (ReqArg Quality "QUALITY") "run tests (all, test, dup, undef, pop, argc, para)" --, Option ['o'] ["output"] (ReqArg Output "FILE") "output printer content to FILE" -- , Option ['g'] ["go"] (ReqArg Net "PORTNUMBER") "Go online with FM server on port PORTNUMBER" , Option ['f'] ["find"] (NoArg Paradigm) "find all paradigms that predict the given word forms" , Option ['h'] ["help"] (NoArg Help) "display this message" , Option ['v'] ["version"] (NoArg Version) "display version information" ] {- outp = Output . fromMaybe "stdout" inp = Input . fromMaybe "stdin" -} {- |Collect the valid arguments. Raises an IO error if it fails. -} compilerOpts :: Language l => l -> [String] -> IO ([Flag], [String]) compilerOpts l argv = case getOpt Permute (options l) argv of (o,xs,[] ) -> return (o,xs) (_,_,errs) -> do head <- header ioError (userError (concat errs ++ usageInfo head (options l))) header :: IO String header= do prg <- getProgName return $ "Usage: " ++ prg ++ " [OPTION...] dictionary_file(s)..." help :: Language l => l -> IO String help l = do head <- header return $ usageInfo head (options l) retrieve :: Language l => l -> [String] -> IO (Either String ([Flag],[FilePath])) retrieve l xs = do res <- try (compilerOpts l xs) case res of Left io_err -> return $ Left $ ioeGetErrorString io_err Right res -> return $ Right res