diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Parser/Shell.hs | 4 | ||||
| -rw-r--r-- | src/Script/Shell.hs | 14 |
2 files changed, 12 insertions, 6 deletions
diff --git a/src/Parser/Shell.hs b/src/Parser/Shell.hs index c6c2a40..45f00b9 100644 --- a/src/Parser/Shell.hs +++ b/src/Parser/Shell.hs @@ -95,8 +95,8 @@ parseArgument = choice , fmap ShellArgument <$> parseTextArgument ] -parseArguments :: TestParser (Expr [ ShellArgument ]) -parseArguments = foldr (liftA2 (:)) (Pure []) <$> many parseArgument +parseArguments :: TestParser (Expr ShellArguments) +parseArguments = (ShellArguments <$>) . foldr (liftA2 (:)) (Pure []) <$> many parseArgument parseCommand :: TestParser (Expr ShellCommand) parseCommand = label "shell statement" $ do diff --git a/src/Script/Shell.hs b/src/Script/Shell.hs index dbecee3..3e98e66 100644 --- a/src/Script/Shell.hs +++ b/src/Script/Shell.hs @@ -3,7 +3,7 @@ module Script.Shell ( ShellStatement(ShellStatement), ShellPipeline(ShellPipeline), ShellCommand(ShellCommand), - ShellArgument(..), + ShellArguments(..), ShellArgument(..), withShellProcess, ) where @@ -62,10 +62,12 @@ data ShellPipeline = ShellPipeline data ShellCommand = ShellCommand { cmdCommand :: Text - , cmdExtArguments :: [ ShellArgument ] + , cmdExtArguments :: ShellArguments , cmdSourceLine :: SourceLine } +newtype ShellArguments = ShellArguments { fromShellArguments :: [ ShellArgument ] } + data ShellArgument = ShellArgument Text | ShellRedirectStdin Text @@ -73,7 +75,7 @@ data ShellArgument | ShellRedirectStderr Bool Text cmdArguments :: ShellCommand -> [ Text ] -cmdArguments = catMaybes . map (\case ShellArgument x -> Just x; _ -> Nothing) . cmdExtArguments +cmdArguments = catMaybes . map (\case ShellArgument x -> Just x; _ -> Nothing) . fromShellArguments . cmdExtArguments instance ExprType ShellScript where textExprType _ = T.pack "ShellScript" @@ -91,6 +93,10 @@ instance ExprType ShellCommand where textExprType _ = T.pack "ShellCommand" textExprValue _ = "<shell-command>" +instance ExprType ShellArguments where + textExprType _ = T.pack "ShellArguments" + textExprValue _ = "<shell-arguments>" + instance ExprType ShellArgument where textExprType _ = T.pack "ShellArgument" textExprValue _ = "<shell-argument>" @@ -119,7 +125,7 @@ handledHandle (KeepHandle h) = h executeCommand :: ShellExecInfo -> ShellState -> HandleHandling -> HandleHandling -> HandleHandling -> ShellCommand -> TestRun ShellState executeCommand sei@ShellExecInfo {..} st pstdin pstdout pstderr scmd@ShellCommand {..} = do let args = cmdArguments scmd - ( pstdin', pstdout', pstderr' ) <- (\f -> foldM f ( pstdin, pstdout, pstderr ) cmdExtArguments) $ \cur@( cin, cout, cerr ) -> \case + ( pstdin', pstdout', pstderr' ) <- (\f -> foldM f ( pstdin, pstdout, pstderr ) (fromShellArguments cmdExtArguments)) $ \cur@( cin, cout, cerr ) -> \case ShellRedirectStdin path -> do closeIfRequested cin h <- liftIO $ openBinaryFile (nodeDir seiNode </> T.unpack path) ReadMode |