summaryrefslogtreecommitdiff
path: root/src/Parser/Shell.hs
blob: 0f34fee2720f22fbb0bc86755f3e3ae16cdc0055 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
module Parser.Shell (
    ShellScript,
    shellScript,
) where

import Control.Monad

import Data.Char
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Lazy qualified as TL

import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer qualified as L

import Parser.Core
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
    [ doubleQuotedString
    , escapedChar
    , stringExpansion
    , unquotedString
    ]
  where
    specialChars = [ '\"', '\\', '$' ]

    unquotedString :: TestParser (Expr Text)
    unquotedString = do
        Pure . TL.toStrict <$> takeWhile1P Nothing (\c -> not (isSpace c) && c `notElem` specialChars)

    doubleQuotedString :: TestParser (Expr Text)
    doubleQuotedString = do
        void $ char '"'
        let inner = choice
                [ char '"' >> return []
                , (:) <$> (Pure . TL.toStrict <$> takeWhile1P Nothing (`notElem` specialChars)) <*> inner
                , (:) <$> escapedChar <*> inner
                , (:) <$> stringExpansion <*> inner
                ]
        App AnnNone (Pure T.concat) . foldr (liftA2 (:)) (Pure []) <$> inner

    escapedChar :: TestParser (Expr Text)
    escapedChar = do
        void $ char '\\'
        Pure <$> choice
            [ char '\\' >> return "\\"
            , char '"' >> return "\""
            , char '$' >> return "$"
            , char 'n' >> return "\n"
            , char 'r' >> return "\r"
            , char 't' >> return "\t"
            ]

parseArguments :: TestParser (Expr [ Text ])
parseArguments = foldr (liftA2 (:)) (Pure []) <$> many parseArgument

shellStatement :: TestParser (Expr [ ShellStatement ])
shellStatement = label "shell statement" $ do
    command <- parseArgument
    args <- parseArguments
    return $ fmap (: []) $ ShellStatement
        <$> command
        <*> args

shellScript :: TestParser (Expr ShellScript)
shellScript = do
    indent <- L.indentLevel
    fmap ShellScript <$> blockOf indent shellStatement