From c2c89cf5308ea5c490a4fe150cffc72ed09c4c1c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Tue, 1 Sep 2026 20:35:23 +0200 Subject: Add newtype for ShellArguments --- src/Script/Shell.hs | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) (limited to 'src/Script') 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 _ = "" +instance ExprType ShellArguments where + textExprType _ = T.pack "ShellArguments" + textExprValue _ = "" + instance ExprType ShellArgument where textExprType _ = T.pack "ShellArgument" textExprValue _ = "" @@ -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 -- cgit v1.2.3