blob: 49dc96632cc8132a3f6e57e01261a91ec5c4c411 (
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
|
{-# LANGUAGE FlexibleContexts #-}
module Command
( Cmd(..)
, parseCmd
) where
import Data.Char (isSpace)
import Types
data Cmd = PerformAlt Alteration
| Quit
| Step
| UnknownCommand String
| ParseError String
| Empty
parseCmd :: SequenceM m => String -> m Cmd
parseCmd = parseCmd' . split
where
split :: String -> [String]
split = reverse . split' [] "" Nothing Nothing
split' :: [String] -> String -> Maybe Char -> Maybe Char -> String -> [String]
split' ws w q e "" = trimStart $ (prepend q . append e $ reverse w):ws
where
prepend (Just c) = (c : )
prepend _ = id
append (Just c) = (++ [c])
append _ = id
trimStart ("":ws) = ws
trimStart ws = ws
split' ws w q e (c:cs)
| null w
, Nothing <- q
, Nothing <- e
, isQuote c = split' ws w (Just c) Nothing cs -- Start quoted word at unescaped quote
| Nothing <- e
, (Just q') <- q
, c == q' = split' (reverse w : ws) "" Nothing Nothing cs -- Close quoted word at unescaped quote of same type
| null w
, isSpace c
, Nothing <- e
, Nothing <- q = split' ws w Nothing Nothing cs -- Ignore leading unescaped spaces if not within quotes
| isSpace c
, Nothing <- e
, Nothing <- q = split' (reverse w : ws) "" Nothing Nothing cs -- Close unquoted word at unescaped space
| Nothing <- e
, isEscape c = split' ws w q (Just c) cs -- Set escaped flag at unescaped escape char
| otherwise = split' ws (c : w) q Nothing cs -- Append to word
isQuote q = q `elem` ['"', '\'']
isEscape e = e == '\\'
parseCmd' :: SequenceM m => [String] -> m Cmd
parseCmd' [] = return Empty
parseCmd' (cmd:args) = return $ UnknownCommand (show $ cmd:args) -- DEBUG
|
