diff options
Diffstat (limited to 'src')
| -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 |
