diff options
-rw-r--r-- | src/Command.hs | 41 | ||||
-rw-r--r-- | src/Main.hs | 1 |
2 files changed, 41 insertions, 1 deletions
diff --git a/src/Command.hs b/src/Command.hs index fd21087..49dc966 100644 --- a/src/Command.hs +++ b/src/Command.hs | |||
@@ -5,6 +5,8 @@ module Command | |||
5 | , parseCmd | 5 | , parseCmd |
6 | ) where | 6 | ) where |
7 | 7 | ||
8 | import Data.Char (isSpace) | ||
9 | |||
8 | import Types | 10 | import Types |
9 | 11 | ||
10 | data Cmd = PerformAlt Alteration | 12 | data Cmd = PerformAlt Alteration |
@@ -12,6 +14,43 @@ data Cmd = PerformAlt Alteration | |||
12 | | Step | 14 | | Step |
13 | | UnknownCommand String | 15 | | UnknownCommand String |
14 | | ParseError String | 16 | | ParseError String |
17 | | Empty | ||
15 | 18 | ||
16 | parseCmd :: SequenceM m => String -> m Cmd | 19 | parseCmd :: SequenceM m => String -> m Cmd |
17 | parseCmd input = return $ UnknownCommand input | 20 | parseCmd = parseCmd' . split |
21 | where | ||
22 | split :: String -> [String] | ||
23 | split = reverse . split' [] "" Nothing Nothing | ||
24 | split' :: [String] -> String -> Maybe Char -> Maybe Char -> String -> [String] | ||
25 | split' ws w q e "" = trimStart $ (prepend q . append e $ reverse w):ws | ||
26 | where | ||
27 | prepend (Just c) = (c : ) | ||
28 | prepend _ = id | ||
29 | append (Just c) = (++ [c]) | ||
30 | append _ = id | ||
31 | trimStart ("":ws) = ws | ||
32 | trimStart ws = ws | ||
33 | split' ws w q e (c:cs) | ||
34 | | null w | ||
35 | , Nothing <- q | ||
36 | , Nothing <- e | ||
37 | , isQuote c = split' ws w (Just c) Nothing cs -- Start quoted word at unescaped quote | ||
38 | | Nothing <- e | ||
39 | , (Just q') <- q | ||
40 | , c == q' = split' (reverse w : ws) "" Nothing Nothing cs -- Close quoted word at unescaped quote of same type | ||
41 | | null w | ||
42 | , isSpace c | ||
43 | , Nothing <- e | ||
44 | , Nothing <- q = split' ws w Nothing Nothing cs -- Ignore leading unescaped spaces if not within quotes | ||
45 | | isSpace c | ||
46 | , Nothing <- e | ||
47 | , Nothing <- q = split' (reverse w : ws) "" Nothing Nothing cs -- Close unquoted word at unescaped space | ||
48 | | Nothing <- e | ||
49 | , isEscape c = split' ws w q (Just c) cs -- Set escaped flag at unescaped escape char | ||
50 | | otherwise = split' ws (c : w) q Nothing cs -- Append to word | ||
51 | isQuote q = q `elem` ['"', '\''] | ||
52 | isEscape e = e == '\\' | ||
53 | |||
54 | parseCmd' :: SequenceM m => [String] -> m Cmd | ||
55 | parseCmd' [] = return Empty | ||
56 | parseCmd' (cmd:args) = return $ UnknownCommand (show $ cmd:args) -- DEBUG | ||
diff --git a/src/Main.hs b/src/Main.hs index c4c09bc..e6a3024 100644 --- a/src/Main.hs +++ b/src/Main.hs | |||
@@ -44,6 +44,7 @@ runCli = do | |||
44 | lift . outputStrLn $ "Unknown command: »" <> cmd <> "«" | 44 | lift . outputStrLn $ "Unknown command: »" <> cmd <> "«" |
45 | ParseError err -> do | 45 | ParseError err -> do |
46 | lift . outputStrLn $ "Error parsing input »" <> (fromMaybe "" input) <> "«: " <> err | 46 | lift . outputStrLn $ "Error parsing input »" <> (fromMaybe "" input) <> "«: " <> err |
47 | Empty -> return () | ||
47 | 48 | ||
48 | Quit -> liftIO exitSuccess | 49 | Quit -> liftIO exitSuccess |
49 | PerformAlt alt -> apply' alt | 50 | PerformAlt alt -> apply' alt |