system command pipes (sp)

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

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
 

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)

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)