diff options
Diffstat (limited to 'src/Script')
| -rw-r--r-- | src/Script/Shell.hs | 14 |
1 files changed, 10 insertions, 4 deletions
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 |