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/Parser/Shell.hs | 4 ++-- src/Script/Shell.hs | 14 ++++++++++---- 2 files changed, 12 insertions(+), 6 deletions(-) (limited to 'src') 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 _ = "" +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