msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

GF.Command.Command: turn CommandOutput into a newtype

Browse Source 
The output from commands is represented as ([Expr],String), where the [Expr] is
used when data is piped between commands and the String is used for the final
output. The String can represent the same list of trees as the [Expr] and/or
contain diagnostic information.

Sometimes the data that is piped between commands is not a list of trees, but
e.g. a string or a list of strings. In those cases, functions like fromStrings
and toStrings are used to encode the data as a [Expr].

This patch introduces a newtype for CommandOutput and collects the functions
dealing with command output in one place to make it clearer what is going on.
It also makes it easier to change to a more direct representation of piped
data, and make pipes more "type safe", if desired.
This commit is contained in:
hallgren
2012-10-16 13:01:03 +00:00
parent 7fa0407a6f
commit eff4d46fba
2 changed files with 45 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files

61
src/compiler/GF/Command/Commands.hs
View File

@@ -8,7 +8,7 @@ module GF.Command.Commands (
flags,
needsTypeCheck,
CommandInfo,
CommandOutput
CommandOutput(..),void
) where
import Prelude hiding (putStrLn)
@@ -52,7 +52,8 @@ import Data.List (sort)
import Debug.Trace
--import System.Random (newStdGen) ----
type CommandOutput = ([Expr],String) ---- errors, etc
type PGFEnv = (PGF, Map.Map Language Morpho)
data CommandInfo = CommandInfo {
exec :: PGFEnv -> [Option] -> [Expr] -> SIO CommandOutput,
@@ -66,9 +67,31 @@ data CommandInfo = CommandInfo {
needsTypeCheck :: Bool
}
--------------------------------------------------------------------------------
newtype CommandOutput = Piped {fromPipe :: ([Expr],String)} ---- errors, etc
-- Converting command output:
fromStrings ss = Piped (map (ELit . LStr) ss, unlines ss)
fromExprs es = Piped (es,unlines (map (showExpr []) es))
fromString s = Piped ([ELit (LStr s)], s)
pipeWithMessage es msg = Piped (es,msg)
pipeMessage msg = Piped ([],msg)
pipeExprs es = Piped (es,[]) -- only used in emptyCommandInfo
void = Piped ([],"")
-- Converting command input:
toString = unwords . toStrings
toStrings = map showAsString
where
showAsString t = case t of
ELit (LStr s) -> s
_ -> "\n" ++ showExpr [] t ---newline needed in other cases than the first
--------------------------------------------------------------------------------
emptyCommandInfo :: CommandInfo
emptyCommandInfo = CommandInfo {
exec = \_ _ ts -> return (ts,[]), ----
exec = \_ _ ts -> return $ pipeExprs ts, ----
synopsis = "",
syntax = "",
explanation = "",
@@ -135,8 +158,6 @@ compact [] = []
compact ([]:xs@([]:_)) = compact xs
compact (x:xs) = x:compact xs
type PGFEnv = (PGF, Map.Map Language Morpho)
mkEx s = let (command,expl) = break (=="--") (words s) in (unwords command, unwords (drop 1 expl))
-- this list must no more be kept sorted by the command name
@@ -570,7 +591,7 @@ allCommands = Map.fromList [
"will accept unknown adjectives, nouns and verbs with the resource grammar."
],
exec = \env@(pgf, mos) opts ts ->
return $ fromParse opts (concat [map ((,) s) (par pgf opts s) | s <- toStrings ts]),
return . Piped $ fromParse opts (concat [map ((,) s) (par pgf opts s) | s <- toStrings ts]),
flags = [
("cat","target category of parsing"),
("lang","the languages of parsing (comma-separated, no spaces)"),
@@ -720,8 +741,8 @@ allCommands = Map.fromList [
Nothing -> let (es,err) = exprs ls
in (es,text "on line" <+> int n <> colon <+> text "parse error" $$ err)
returnFromLines ls = case exprs ls of
(es, err) | null es -> return ([], render (err $$ text "no trees found"))
| otherwise -> return (es, render err)
(es, err) | null es -> return $ pipeMessage $ render (err $$ text "no trees found")
| otherwise -> return $ pipeWithMessage es (render err)
s <- restricted $ readFile file
case opts of
@@ -1093,8 +1114,6 @@ allCommands = Map.fromList [
where
dp = valIntOpts "depth" 4 opts
void = ([],[])
optLins pgf opts ts = case opts of
_ | isOpt "groups" opts ->
map (unlines . snd) $ groupResults
@@ -1202,18 +1221,12 @@ allCommands = Map.fromList [
optNumInf opts = valIntOpts "number" 1000000000 opts ---- 10^9
takeOptNum opts = take (optNumInf opts)
fromExprs es = (es,unlines (map (showExpr []) es))
fromStrings ss = (map (ELit . LStr) ss, unlines ss)
fromString s = ([ELit (LStr s)], s)
toStrings = map showAsString
toString = unwords . toStrings
fromParse opts [] = ([],"")
fromParse opts [] = ([],[])
fromParse opts ((s,(po,bs)):ps)
| isOpt "bracket" opts = (es, showBracketedString bs
++ "\n" ++ msg)
| otherwise = case po of
ParseOk ts -> let (es',msg') = fromExprs ts
ParseOk ts -> let Piped (es',msg') = fromExprs ts
in (es'++es,msg'++msg)
TypeError errs -> ([], render (text "The parsing is successful but the type checking failed with error(s):" $$
nest 2 (vcat (map (ppTcError . snd) errs)))
@@ -1225,7 +1238,7 @@ allCommands = Map.fromList [
(es,msg) = fromParse opts ps
returnFromExprs es = return $ case es of
[] -> ([], "no trees found")
[] -> pipeMessage "no trees found"
_ -> fromExprs es
prGrammar env@(pgf,mos) opts
@@ -1279,10 +1292,6 @@ allCommands = Map.fromList [
app (OFlag op (VId x)) | Just (Right f) <- treeOp pgf op = f (mkCId x)
app _ = id
showAsString t = case t of
ELit (LStr s) -> s
_ -> "\n" ++ showExpr [] t --- newline needed in other cases than the first
stringOpOptions = sort $ [
("bind","bind tokens separated by Prelude.BIND, i.e. &+"),
("chars","lexer that makes every non-space character a token"),
@@ -1353,12 +1362,12 @@ execToktok (pgf, _) opts exprs = do
case getLang opts of
Nothing -> do
let output = concatMap toStringList [t input | (_,t) <- Map.toList tokenizers]
return ([ELit $ LStr o | o <- output],unlines output)
return (fromStrings output)
Just lang -> case Map.lookup lang tokenizers of
Just tok -> do
let output = toStringList $ tok input
return ([ELit $ LStr o | o <- output],unlines output)
Nothing -> return ([],"Unknown language: " ++ show lang)
return (fromStrings output)
Nothing -> return (pipeMessage ("Unknown language: " ++ show lang))
where input = case exprs of
[ELit (LStr s)] -> s
_ -> ""

21
src/compiler/GF/Command/Interpreter.hs
View File

@@ -19,7 +19,8 @@ import GF.Infra.SIO
import GF.Infra.Option
import Text.PrettyPrint
import Control.Monad.Error
import Control.Monad(when)
--import Control.Monad.Error()
import qualified Data.Map as Map
data CommandEnv = CommandEnv {
@@ -47,12 +48,12 @@ interpretCommandLine env line =
Nothing -> putStrLnFlush "command not parsed"
interpretPipe env cs = do
v@(_,s) <- intercs ([],"") cs
Piped v@(_,s) <- intercs void cs
putStrLnFlush s
return v
where
intercs treess [] = return treess
intercs (trees,_) (c:cs) = do
intercs (Piped (trees,_)) (c:cs) = do
treess2 <- interc trees c
intercs treess2 cs
interc es comm@(Command co opts arg) = case co of
@@ -60,12 +61,12 @@ interpretPipe env cs = do
Just css ->
case getCommandTrees env False arg es of
Right es -> do mapM_ (interpretPipe env) (appLine es css)
return ([],[])
return void
Left msg -> do putStrLn ('\n':msg)
return ([],[])
return void
Nothing -> do
putStrLn $ "command macro " ++ co ++ " not interpreted"
return ([],[])
return void
_ -> interpret env es comm
appLine es = map (map (appCommand es))
@@ -87,12 +88,10 @@ interpret :: CommandEnv -> [Expr] -> Command -> SIO CommandOutput
interpret env trees comm =
case getCommand env trees comm of
Left msg -> do putStrLn ('\n':msg)
return ([],[])
return void
Right (info,opts,trees) -> do let cmdenv = (multigrammar env,morphos env)
tss@(_,s) <- exec info cmdenv opts trees
if isOpt "tr" opts
then putStrLn s
else return ()
tss@(Piped (_,s)) <- exec info cmdenv opts trees
when (isOpt "tr" opts) $ putStrLn s
return tss
-- analyse command parse tree to a uniform datastructure, normalizing comm name