1 files changed, 79 insertions, 19 deletions
diff --git a/src/Parser/Shell.hs b/src/Parser/Shell.hs
index 0f34fee..105edfa 100644
--- a/src/Parser/Shell.hs
+++ b/src/Parser/Shell.hs
@@ -3,6 +3,7 @@ module Parser.Shell (
     shellScript,
 ) where
 
+import Control.Applicative (liftA2)
 import Control.Monad
 
 import Data.Char
@@ -19,15 +20,18 @@ 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
-    , escapedChar
+    , singleQuotedString
+    , standaloneEscapedChar
     , stringExpansion
     , unquotedString
     ]
   where
-    specialChars = [ '\"', '\\', '$' ]
+    specialChars = [ '"', '\'', '\\', '$', '#', '|', '>', '<', ';', '[', ']'{-, '{', '}' -}, '(', ')'{-, '*', '?', '~', '&', '!' -} ]
+
+    stringSpecialChars = [ '"', '\\', '$' ]
 
     unquotedString :: TestParser (Expr Text)
     unquotedString = do
@@ -38,36 +42,92 @@ parseArgument = lexeme $ fmap (App AnnNone (Pure T.concat) <$> foldr (liftA2 (:)
         void $ char '"'
         let inner = choice
                 [ char '"' >> return []
-                , (:) <$> (Pure . TL.toStrict <$> takeWhile1P Nothing (`notElem` specialChars)) <*> inner
-                , (:) <$> escapedChar <*> inner
+                , (:) <$> (Pure . TL.toStrict <$> takeWhile1P Nothing (`notElem` stringSpecialChars)) <*> inner
+                , (:) <$> stringEscapedChar <*> inner
                 , (:) <$> stringExpansion <*> inner
                 ]
         App AnnNone (Pure T.concat) . foldr (liftA2 (:)) (Pure []) <$> inner
 
-    escapedChar :: TestParser (Expr Text)
-    escapedChar = do
+    singleQuotedString :: TestParser (Expr Text)
+    singleQuotedString = do
+        Pure . TL.toStrict <$> (char '\'' *> takeWhileP Nothing (/= '\'') <* char '\'')
+
+    stringEscapedChar :: TestParser (Expr Text)
+    stringEscapedChar = do
         void $ char '\\'
-        Pure <$> choice
-            [ char '\\' >> return "\\"
-            , char '"' >> return "\""
-            , char '$' >> return "$"
-            , char 'n' >> return "\n"
+        fmap Pure $ choice $
+            map (\c -> char c >> return (T.singleton c)) stringSpecialChars ++
+            [ char 'n' >> return "\n"
             , char 'r' >> return "\r"
             , char 't' >> return "\t"
+            , return "\\"
             ]
 
-parseArguments :: TestParser (Expr [ Text ])
+    standaloneEscapedChar :: TestParser (Expr Text)
+    standaloneEscapedChar = do
+        void $ char '\\'
+        fmap T.singleton . Pure <$> printChar
+
+parseRedirection :: TestParser (Expr ShellArgument)
+parseRedirection = choice
+    [ do
+        osymbol "<"
+        fmap ShellRedirectStdin <$> parseTextArgument
+    , do
+        osymbol ">"
+        fmap (ShellRedirectStdout False) <$> parseTextArgument
+    , do
+        osymbol ">>"
+        fmap (ShellRedirectStdout True) <$> parseTextArgument
+    , do
+        osymbol "2>"
+        fmap (ShellRedirectStderr False) <$> parseTextArgument
+    , do
+        osymbol "2>>"
+        fmap (ShellRedirectStderr True) <$> parseTextArgument
+    ]
+
+parseArgument :: TestParser (Expr ShellArgument)
+parseArgument = choice
+    [ parseRedirection
+    , fmap ShellArgument <$> parseTextArgument
+    ]
+
+parseArguments :: TestParser (Expr [ ShellArgument ])
 parseArguments = foldr (liftA2 (:)) (Pure []) <$> many parseArgument
 
-shellStatement :: TestParser (Expr [ ShellStatement ])
-shellStatement = label "shell statement" $ do
-    command <- parseArgument
+parseCommand :: TestParser (Expr ShellCommand)
+parseCommand = label "shell statement" $ do
+    line <- getSourceLine
+    command <- parseTextArgument
     args <- parseArguments
-    return $ fmap (: []) $ ShellStatement
+    return $ ShellCommand
         <$> command
         <*> args
+        <*> pure line
+
+parsePipeline :: Maybe (Expr ShellPipeline) -> TestParser (Expr ShellPipeline)
+parsePipeline mbupper = do
+    cmd <- parseCommand
+    let pipeline =
+            case mbupper of
+                Nothing -> fmap (\ecmd -> ShellPipeline ecmd Nothing) cmd
+                Just upper -> liftA2 (\ecmd eupper -> ShellPipeline ecmd (Just eupper)) cmd upper
+    choice
+        [ do
+            osymbol "|"
+            parsePipeline (Just pipeline)
+
+        , do
+            return pipeline
+        ]
+
+parseStatement :: TestParser (Expr [ ShellStatement ])
+parseStatement = do
+    line <- getSourceLine
+    fmap ((: []) . flip ShellStatement line) <$> parsePipeline Nothing
 
 shellScript :: TestParser (Expr ShellScript)
 shellScript = do
     indent <- L.indentLevel
-    fmap ShellScript <$> blockOf indent shellStatement
+    fmap ShellScript <$> blockOf indent parseStatement