Add newtype for ShellArguments

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