Cleaned up parts of parser
Getty Ritter
10 years ago
| 13 | 13 | |
| 14 | 14 | type Pair = (Text, Text) |
| 15 | 15 | |
| 16 | ||
| 17 | ||
| 18 | 16 | isSep :: Char -> Bool |
| 19 | 17 | isSep ' ' = True |
| 20 | 18 | isSep '\t' = True |
| 23 | 21 | isSep '=' = True |
| 24 | 22 | isSep _ = False |
| 25 | 23 | |
| 24 | -- | Skips any horizontal (non-new-line) spaces | |
| 26 | 25 | hSpace :: Parser () |
| 27 | 26 | hSpace = skipWhile isHorizontalSpace |
| 28 | 27 | |
| 29 | pString :: Parser Text | |
| 30 | pString = string "\"" *> (T.pack <$> sBody) | |
| 28 | -- | Parses a quotedd string | |
| 29 | pQString :: Parser Text | |
| 30 | pQString = string "\"" *> (T.pack <$> sBody) | |
| 31 | 31 | where sBody = do |
| 32 | 32 | c <- anyChar |
| 33 | 33 | case c of |
| 35 | 35 | '"' -> return [] |
| 36 | 36 | _ -> (c:) <$> sBody |
| 37 | 37 | |
| 38 | -- | Parse a word of any length | |
| 38 | 39 | pWord :: Parser Text |
| 39 | 40 | pWord = takeWhile (not . isSep) |
| 40 | 41 | |
| 42 | -- | Parse a word of at least length one | |
| 41 | 43 | pWord1 :: Parser Text |
| 42 | 44 | pWord1 = takeWhile1 (not . isSep) |
| 43 | 45 | |
| 46 | -- | Parse a key-value pair | |
| 44 | 47 | pPair :: Parser Pair |
| 45 |
pPair = (,) <$> pWord1 <*. "=" <*> (p |
|
| 48 | pPair = (,) <$> pWord1 <*. "=" <*> (pQString <|> pWord) | |
| 46 | 49 | |
| 50 | -- | Directions passed back from the skipping parsers---whether | |
| 51 | -- to continue parsing the current block, start a new block, | |
| 52 | -- or stop entirely. | |
| 47 | 53 | data NewBlock |
| 48 | 54 | = StartNewBlock |
| 49 | 55 | | ContinueBlock |
| 50 | 56 | | StopParsing |
| 51 | 57 | deriving (Eq,Show) |
| 52 | 58 | |
| 53 | sNextMSet :: Parser NewBlock | |
| 54 | sNextMSet = do | |
| 55 | hSpace | |
| 56 | n <- peekChar | |
| 57 | go n | |
| 58 | where go (Just '\n') = do | |
| 59 | _ <- anyChar | |
| 60 | n <- peekChar | |
| 61 | go' n | |
| 62 | go (Just '#') = do | |
| 63 | skipWhile (not . (== '\n')) | |
| 64 | sNextMSet | |
| 65 | go (Just _) = return ContinueBlock | |
| 66 | go Nothing = return StopParsing | |
| 67 | go' (Just '\n') = do | |
| 68 | _ <- anyChar | |
| 69 | n <- peekChar | |
| 70 | go' n | |
| 71 | go' (Just '#') = do | |
| 72 | skipWhile (not . (== '\n')) | |
| 73 | n <- peekChar | |
| 74 | go' n | |
| 75 | go' (Just c) | isSpace c = sNextMSet | |
| 76 | | otherwise = return StartNewBlock | |
| 77 | go' Nothing = return StopParsing | |
| 59 | comment :: Parser () | |
| 60 | comment = char '#' >> skipWhile (not . (== '\n')) | |
| 61 | ||
| 62 | -- | Skips to the next pair (or end of input) and returns whether to parse | |
| 63 | -- the next pair as part of the same group, the next group, or whether | |
| 64 | -- it's reached the end. | |
| 65 | sSkipToNext :: Bool -> Parser NewBlock | |
| 66 | sSkipToNext False = hSpace >> peekChar >>= go | |
| 67 | where go (Just '\n') = anyChar >> sSkipToNext True | |
| 68 | go (Just '\r') = anyChar >> sSkipToNext True | |
| 69 | go (Just '#') = comment >> sSkipToNext False | |
| 70 | go (Just _) = return ContinueBlock | |
| 71 | go Nothing = return StopParsing | |
| 72 | sSkipToNext True = peekChar >>= go | |
| 73 | where go (Just c) | isSpace c = anyChar >> sSkipToNext False | |
| 74 | | otherwise = return StartNewBlock | |
| 75 | go Nothing = return StopParsing | |
| 78 | 76 | |
| 79 | 77 | pBlock :: Parser (NewBlock, [Pair]) |
| 80 | 78 | pBlock = do |
| 81 | 79 | p <- pPair |
| 82 |
b <- s |
|
| 80 | b <- sSkipToNext False | |
| 83 | 81 | case b of |
| 84 | 82 | StartNewBlock -> return (StartNewBlock, [p]) |
| 85 | 83 | StopParsing -> return (StopParsing, [p]) |