interpreter with pipes

src/GF/Command/Interpreter.hs

@@ -1,26 +1,92 @@
 module GF.Command.Interpreter where
 
-import GF.Command.AbsGFShell
+import GF.Command.AbsGFShell hiding (Tree)
+import GF.Command.PPrTree
 import GF.Command.ParGFShell
 import GF.GFCC.API
+import GF.GFCC.Macros
+import GF.GFCC.AbsGFCC ----
 
-import GF.Command.ErrM
+import GF.Command.ErrM ----
 
-
+interpretCommandLine :: MultiGrammar -> String -> IO ()
-interpretCommandLine :: MultiGrammar -> CommandLine -> IO ()
+interpretCommandLine gr line = case (pCommandLine (myLexer line)) of
-interpretCommandLine gr line = case line of
+  Ok CEmpty -> return ()
-  CEmpty -> return ()
+  Ok (CLine pipes) -> mapM_ interPipe pipes
-  CLine pipes -> mapM_ interPipe pipes
+  _ -> putStrLn "command not parsed"
  where
    interPipe (PComm cs) = do
-     ts <- intercs [] cs
+     (_,s) <- intercs ([],"") cs
-     mapM_ (putStrLn . showTree) ts
+     putStrLn s
-   intercs trees [] = return trees
+   intercs treess [] = return treess
-   intercs trees (c:cs) = do
+   intercs (trees,_) (c:cs) = do
-     trees2 <- interc trees c
+     treess2 <- interc trees c
-     intercs trees2 cs
+     intercs treess2 cs
    interc = interpret gr
 
-interpret :: MultiGrammar -> [Tree] -> Command -> IO [Tree]
+-- return the trees to be sent in pipe, and the output possibly printed
-interpret gr trees comm = case (trees,command comm) of
+interpret :: MultiGrammar -> [Tree] -> Command -> IO ([Tree],String)
-  _ -> return trees ----  
+interpret mgr trees0 comm = do
+  tss@(_,s) <- exec co
+  optTrace s
+  return tss
+ where
+   exec co = case co of
+     "l"  -> return $ fromStrings $ map lin $ trees
+     "p"  -> return $ fromTrees   $ concatMap par $ toStrings $ trees
+     "gr" -> do
+       ts <- generateRandom mgr optCat
+       return $ fromTrees $ take optNum ts 
+     _ -> return (trees,"command not interpreted")
+
+   (co,opts,trees) = getCommand comm trees0
+
+   lin t = unlines [linearize mgr lang t    | lang <- optLangs]
+   par s = concat  [parse mgr lang optCat s | lang <- optLangs]
+ 
+   optLangs = case valIdOpts "lang" "" opts of
+     "" -> languages mgr
+     lang -> [lang] 
+   optCat   = valIdOpts "cat" (lookAbsFlag gr (cid "startcat")) opts
+   optNum   = valIntOpts "number" 1 opts
+   optTrace = if isOpt "tr" opts then putStrLn else const (return ()) 
+   gr       = gfcc mgr
+
+   fromTrees ts = (ts,unlines (map showTree ts))
+   fromStrings ss = (map tStr ss, unlines ss)
+   toStrings ts = [s | DTr [] (AS s) [] <- ts] 
+   tStr s = DTr [] (AS s) []
+
+valIdOpts :: String -> String -> [Option] -> String
+valIdOpts flag def opts = case valOpts flag (VId (Ident def)) opts of
+  VId (Ident v) -> v
+  _ -> def
+
+valIntOpts :: String -> Integer -> [Option] -> Int
+valIntOpts flag def opts = fromInteger $ case valOpts flag (VInt def) opts of
+  VInt 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 (Ident f) v <- opts]
+
+isOpt :: String -> [Option] -> Bool
+isOpt o opts = elem o [x | OOpt (Ident x) <- opts]
+
+-- analyse command parse tree to a uniform datastructure, normalizing comm name
+getCommand :: Command -> [Tree] -> (String,[Option],[Tree])
+getCommand co ts = case co of
+  Comm   (Ident c) opts (ATree t) -> (getOp c,opts,[tree2exp t]) -- ignore piped
+  CNoarg (Ident c) opts           -> (getOp c,opts,ts)           -- use piped
+ where
+   -- abbreviation convention from gf
+   getOp s = case break (=='_') s of
+     (a:_,_:b:_) -> [a,b]  -- axx_byy --> ab
+     _ -> case s of
+       [a,b] -> s          -- ab  --> ab
+       a:_ -> [a]          -- axx --> a
+

src/GF/Command/PPrTree.hs

@@ -1,4 +1,4 @@
-module GF.Command.PPrTree (pTree, prExp) where
+module GF.Command.PPrTree (pTree, prExp, tree2exp) where
 
 import GF.GFCC.AbsGFCC
 import GF.GFCC.Macros
@@ -17,7 +17,7 @@ tree2exp t = case t of
   TAbs xs t -> DTr (map i2i xs ++ ys) f ts where DTr ys f ts = tree2exp t 
   TId c     -> tree (AC (i2i c)) [] 
   TInt i    -> tree (AI i) []
---  TStr s
+  TStr s    -> tree (AS s) []
 --  TFloat d -> 
  where
    i2i (Ident s) = CId s

src/GF/Devel/Shell.hs

@@ -1,7 +1,7 @@
 module Main where
 
+import GF.Command.Interpreter
 import GF.GFCC.API
-import System.Random (newStdGen)
 import System (getArgs)
 import Data.Char (isDigit)
 
@@ -18,14 +18,15 @@ loop :: MultiGrammar -> IO ()
 loop grammar = do
   s <- getLine
   if s == "q" then return () else do
-    treat grammar s
+    interpretCommandLine grammar s
     loop grammar
 
 printHelp grammar = do
   putStrLn $ "languages:  " ++ unwords (languages grammar)
   putStrLn $ "categories: " ++ unwords (categories grammar)
-  putStrLn commands
+---  putStrLn commands
 
+{- obsolete
 
 commands = unlines [
   "Commands:",
@@ -64,4 +65,5 @@ treat mgr s = case words s of
     prlinonly t
   prlinonly t = mapM_ (lin t) $ langs
   read1 s = if all isDigit s then read s else 1
+-}