system command pipes (sp)

4 files changed, 39 insertions, 7 deletions

diff --git a/src-3.0/GF/Command/Abstract.hs b/src-3.0/GF/Command/Abstract.hs
index 2b9ce5d1d..8643a649f 100644
--- a/src-3.0/GF/Command/Abstract.hs
+++ b/src-3.0/GF/Command/Abstract.hs
@@ -20,6 +20,7 @@ data Option
 data Value
   = VId  Ident
   | VInt Integer
+  | VStr String
   deriving (Eq,Ord,Show)
 
 data Argument
@@ -38,6 +39,11 @@ valIntOpts flag def opts = fromInteger $ case valOpts flag (VInt def) opts of
   VInt 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
diff --git a/src-3.0/GF/Command/Commands.hs b/src-3.0/GF/Command/Commands.hs
index 7441e6fb5..b66d4764d 100644
--- a/src-3.0/GF/Command/Commands.hs
+++ b/src-3.0/GF/Command/Commands.hs
@@ -29,6 +29,7 @@ import GF.Data.Operations
 
 import Data.Maybe
 import qualified Data.Map as Map
+import System
 
 type CommandOutput = ([Exp],String) ---- errors, etc
 
@@ -403,6 +404,26 @@ allCommands pgf = Map.fromList [
        ("number","the maximum number of questions")
        ] 
      }),
+  ("sp", emptyCommandInfo {
+     longname = "system_pipe",
+     synopsis = "send argument to a system command",
+     syntax   = "sp -command=\"SYSTEMCOMMAND\" STRING",
+     exec = \opts arg -> do
+       let tmpi = "_tmpi" ---
+       let tmpo = "_tmpo"
+       writeFile tmpi $ toString arg
+       let syst = optComm opts ++ " " ++ tmpi
+       system $ syst ++ " <" ++ tmpi ++ " >" ++ tmpo 
+       s <- readFile tmpo
+       return $ fromString s,
+     flags = [
+       ("command","the system command applied to the argument")
+       ],
+     examples = [
+       "ps -command=\"wc\" \"foo\"",
+       "gt | l | sp -command=\"grep \\\"who\\\"\" | sp -command=\"wc\""
+       ]
+     }),
   ("ut", emptyCommandInfo {
      longname = "unicode_table",
      synopsis = "show a transliteration table for a unicode character set",
@@ -458,6 +479,7 @@ allCommands pgf = Map.fromList [
      lang -> chunks ',' lang
    optLang opts = head $ optLangs opts ++ ["#NOLANG"] 
    optCat opts = valIdOpts "cat" (lookStartCat pgf) opts
+   optComm opts = valStrOpts "command" "" opts
    optNum opts = valIntOpts "number" 1 opts
    optNumInf opts = valIntOpts "number" 1000000000 opts ---- 10^9
 
diff --git a/src-3.0/GF/Command/Parse.hs b/src-3.0/GF/Command/Parse.hs
index 12c88464f..1b603f411 100644
--- a/src-3.0/GF/Command/Parse.hs
+++ b/src-3.0/GF/Command/Parse.hs
@@ -32,9 +32,11 @@ pOption = do
   RP.option (OOpt flg) (fmap (OFlag flg) (RP.char '=' >> pValue))
 
 pValue = do
-  fmap VId  pFilename
-  RP.<++
   fmap (VInt . read) (RP.munch1 isDigit)
+  RP.<++
+  fmap VStr pStr
+  RP.<++
+  fmap VId  pFilename
 
 pFilename = liftM2 (:) (RP.satisfy isFileFirst) (RP.munch (not . isSpace)) where
   isFileFirst c = not (isSpace c) && not (isDigit c)
diff --git a/src-3.0/PGF/ExprSyntax.hs b/src-3.0/PGF/ExprSyntax.hs
index 596407348..ee4be36ea 100644
--- a/src-3.0/PGF/ExprSyntax.hs
+++ b/src-3.0/PGF/ExprSyntax.hs
@@ -2,7 +2,7 @@ module PGF.ExprSyntax(readExp, showExp,
                       pExp,ppExp,

                       

                      -- helpers

-                      pIdent

+                      pIdent,pStr

                      ) where

 

 import PGF.CId

@@ -28,7 +28,8 @@ pExps :: RP.ReadP [Exp]
 pExps = liftM2 (:) (pExp True) pExps RP.<++ (RP.skipSpaces >> return [])

 

 pExp :: Bool -> RP.ReadP Exp

-pExp isNested = RP.skipSpaces >> (pParen RP.<++ pAbs RP.<++ pApp RP.<++ pNum RP.<++ pStr RP.<++ pMeta)

+pExp isNested = RP.skipSpaces >> (pParen RP.<++ pAbs RP.<++ pApp RP.<++ pNum RP.<++ 

+    liftM EStr pStr RP.<++ pMeta)

   where 

         pParen = RP.between (RP.char '(') (RP.char ')') (pExp False)

         pAbs = do xs <- RP.between (RP.char '\\') (RP.skipSpaces >> RP.string "->") (RP.sepBy1 (RP.skipSpaces >> pCId) (RP.skipSpaces >> RP.char ','))

@@ -40,14 +41,15 @@ pExp isNested = RP.skipSpaces >> (pParen RP.<++ pAbs RP.<++ pApp RP.<++ pNum RP.
         pMeta = do RP.char '?'

                    x <- RP.munch1 isDigit

                    return (EMeta (read x))

-        pStr = RP.char '"' >> liftM EStr (RP.manyTill (pEsc RP.<++ RP.get) (RP.char '"'))

-          where

-            pEsc = RP.char '\\' >> RP.get    

         pNum = do x <- RP.munch1 isDigit

                   ((RP.char '.' >> RP.munch1 isDigit >>= \y -> return (EFloat (read (x++"."++y))))

                    RP.<++

                    (return (EInt (read x))))

 

+pStr = RP.char '"' >> (RP.manyTill (pEsc RP.<++ RP.get) (RP.char '"'))

+          where

+            pEsc = RP.char '\\' >> RP.get    

+

 pCId = fmap mkCId pIdent

 

 pIdent = liftM2 (:) (RP.satisfy isIdentFirst) (RP.munch isIdentRest)