summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2016-05-07 22:45:25 +0200
committerGregor Kleen <gkleen@yggdrasil.li>2016-05-07 22:45:25 +0200
commitf61d1bfa8a36e2f50fcfa7efc7612317d79da2a1 (patch)
treee74095dff34c133179b9750a70323ddd96ab8ab3
parent42ec5aea1e5fdeb447817a2993e77f4955060d95 (diff)
download2017-01-16_17:13:37-f61d1bfa8a36e2f50fcfa7efc7612317d79da2a1.tar
2017-01-16_17:13:37-f61d1bfa8a36e2f50fcfa7efc7612317d79da2a1.tar.gz
2017-01-16_17:13:37-f61d1bfa8a36e2f50fcfa7efc7612317d79da2a1.tar.bz2
2017-01-16_17:13:37-f61d1bfa8a36e2f50fcfa7efc7612317d79da2a1.tar.xz
2017-01-16_17:13:37-f61d1bfa8a36e2f50fcfa7efc7612317d79da2a1.zip
Parse line input to argument list
-rw-r--r--src/Command.hs41
-rw-r--r--src/Main.hs1
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
8import Data.Char (isSpace)
9
8import Types 10import Types
9 11
10data Cmd = PerformAlt Alteration 12data 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
16parseCmd :: SequenceM m => String -> m Cmd 19parseCmd :: SequenceM m => String -> m Cmd
17parseCmd input = return $ UnknownCommand input 20parseCmd = 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
54parseCmd' :: SequenceM m => [String] -> m Cmd
55parseCmd' [] = return Empty
56parseCmd' (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