Shell: custom data type for command arguments

2 files changed, 29 insertions, 11 deletions

diff --git a/src/Parser/Shell.hs b/src/Parser/Shell.hs
index 9dbd4e8..ffc8cf1 100644
--- a/src/Parser/Shell.hs
+++ b/src/Parser/Shell.hs
@@ -20,8 +20,8 @@ import Parser.Expr
 import Script.Expr
 import Script.Shell
 
-parseArgument :: TestParser (Expr Text)
-parseArgument = lexeme $ fmap (App AnnNone (Pure T.concat) <$> foldr (liftA2 (:)) (Pure [])) $ some $ choice
+parseTextArgument :: TestParser (Expr Text)
+parseTextArgument = lexeme $ fmap (App AnnNone (Pure T.concat) <$> foldr (liftA2 (:)) (Pure [])) $ some $ choice
     [ doubleQuotedString
     , singleQuotedString
     , standaloneEscapedChar
@@ -71,13 +71,18 @@ parseArgument = lexeme $ fmap (App AnnNone (Pure T.concat) <$> foldr (liftA2 (:)
             [ char ' ' >> return " "
             ]
 
-parseArguments :: TestParser (Expr [ Text ])
+parseArgument :: TestParser (Expr ShellArgument)
+parseArgument = choice
+    [ fmap ShellArgument <$> parseTextArgument
+    ]
+
+parseArguments :: TestParser (Expr [ ShellArgument ])
 parseArguments = foldr (liftA2 (:)) (Pure []) <$> many parseArgument
 
 parseCommand :: TestParser (Expr ShellCommand)
 parseCommand = label "shell statement" $ do
     line <- getSourceLine
-    command <- parseArgument
+    command <- parseTextArgument
     args <- parseArguments
     return $ ShellCommand
         <$> command
diff --git a/src/Script/Shell.hs b/src/Script/Shell.hs
index cc8d06f..5ac1240 100644
--- a/src/Script/Shell.hs
+++ b/src/Script/Shell.hs
@@ -1,8 +1,9 @@
 module Script.Shell (
     ShellScript(..),
-    ShellStatement(..),
-    ShellPipeline(..),
-    ShellCommand(..),
+    ShellStatement(ShellStatement),
+    ShellPipeline(ShellPipeline),
+    ShellCommand(ShellCommand),
+    ShellArgument(..),
     withShellProcess,
 ) where
 
@@ -13,6 +14,7 @@ import Control.Monad.Except
 import Control.Monad.IO.Class
 import Control.Monad.Reader
 
+import Data.Maybe
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Text.IO qualified as T
@@ -51,10 +53,16 @@ data ShellPipeline = ShellPipeline
 
 data ShellCommand = ShellCommand
     { cmdCommand :: Text
-    , cmdArguments :: [ Text ]
+    , cmdExtArguments :: [ ShellArgument ]
     , cmdSourceLine :: SourceLine
     }
 
+data ShellArgument
+    = ShellArgument Text
+
+cmdArguments :: ShellCommand -> [ Text ]
+cmdArguments = catMaybes . map (\case ShellArgument x -> Just x) . cmdExtArguments
+
 instance ExprType ShellScript where
     textExprType _ = T.pack "ShellScript"
     textExprValue _ = "<shell-script>"
@@ -71,6 +79,10 @@ instance ExprType ShellCommand where
     textExprType _ = T.pack "ShellCommand"
     textExprValue _ = "<shell-command>"
 
+instance ExprType ShellArgument where
+    textExprType _ = T.pack "ShellArgument"
+    textExprValue _ = "<shell-argument>"
+
 
 data ShellExecInfo = ShellExecInfo
     { seiNode :: Node
@@ -93,15 +105,16 @@ handledHandle (KeepHandle h) = h
 
 
 executeCommand :: ShellExecInfo -> HandleHandling -> HandleHandling -> HandleHandling -> ShellCommand -> TestRun ()
-executeCommand ShellExecInfo {..} pstdin pstdout pstderr ShellCommand {..} = do
+executeCommand ShellExecInfo {..} pstdin pstdout pstderr scmd@ShellCommand {..} = do
+    let args = cmdArguments scmd
     case cmdCommand of
         "echo" -> liftIO $ do
-            T.hPutStrLn (handledHandle pstdout) $ T.intercalate " " cmdArguments
+            T.hPutStrLn (handledHandle pstdout) $ T.intercalate " " args
             hFlush (handledHandle pstdout)
             mapM_ closeIfRequested [ pstdin, pstdout, pstderr ]
         cmd -> do
             (_, _, _, phandle) <- liftIO $ createProcess_ "shell"
-                (proc (T.unpack cmd) (map T.unpack cmdArguments))
+                (proc (T.unpack cmd) (map T.unpack args))
                     { std_in = UseHandle $ handledHandle pstdin
                     , std_out = UseHandle $ handledHandle pstdout
                     , std_err = UseHandle $ handledHandle pstderr