Fixed error with grouping and cleaned up some error msgs
Getty Ritter
8 years ago
| 32 | 32 | go "" = return ("", "") |
| 33 | 33 | |
| 34 | 34 | pTagName :: Parse String |
| 35 | pTagName i@(x:xs) | |
| 36 | | isAlpha x = (x:) `over` pTagName xs | |
| 37 | | elem x "-_" = (x:) `over` pTagName xs | |
| 38 | | otherwise = return (i, "") | |
| 35 | pTagName s = go s `bind` ensureLen | |
| 36 | where go i@(x:xs) | |
| 37 | | isAlpha x = (x:) `over` pTagName xs | |
| 38 | | elem x "-_" = (x:) `over` pTagName xs | |
| 39 | | otherwise = return (i, "") | |
| 40 | go [] = throw "unexpected end-of-document while parsing tag" | |
| 41 | ensureLen (xs, name) | |
| 42 | | length name > 0 = return (xs, name) | |
| 43 | | otherwise = throw "expected tag name after `\\'" | |
| 39 | 44 | |
| 40 | 45 | skipSpace :: Parse () |
| 41 | 46 | skipSpace i@(x:xs) |
| 42 | 47 | | isSpace x = skipSpace xs |
| 43 | 48 | | otherwise = return (i, ()) |
| 49 | skipSpace _ = return ("", ()) | |
| 44 | 50 | |
| 45 | 51 | pTag :: Parse Fragment |
| 46 | 52 | pTag i = |
| 47 | 53 | bind (pTagName i) $ \ (i', name) -> |
| 48 | 54 | bind (skipSpace i') $ \case |
| 49 | 55 | ('{':i'', ()) -> Tag name `over` pArgs i'' |
| 56 | ("",_) -> throw "unexpected end-of-document while parsing tag" | |
| 50 | 57 | _ -> throw "expected start of block" |
| 51 | 58 | |
| 52 | 59 | pArgs :: Parse [Document] |
| 64 | 71 | |
| 65 | 72 | pFragments :: Parse Document |
| 66 | 73 | pFragments "" = return ("", []) |
| 74 | pFragments ('{':s) = bind (pFragments s) $ \case | |
| 75 | ('}':xs, cs) -> bind (pFragments xs) $ \(xs', cs') -> return (xs', cs ++ cs') | |
| 76 | (x:_, _) -> throw ("unexpected " ++ show x ++ "; expected '}'") | |
| 77 | ([], _) -> throw ("unexpected end-of-document while parsing block") | |
| 67 | 78 | pFragments s@(x:_) |
| 68 | 79 | | x `elem` "}|" = return (s, []) |
| 69 | 80 | | otherwise = |
| 71 | 82 | (s', c) -> (c:) `over` pFragments s' |
| 72 | 83 | |
| 73 | 84 | parse :: String -> Either String Document |
| 74 | parse s = case pFragments s of | |
| 75 | Right ("", r) -> return r | |
| 76 | Right (s, _) -> throw ("expected end of document but found " ++ show s) | |
| 77 | Left err -> throw err | |
| 85 | parse str = case pFragments str of | |
| 86 | Right ("", r) -> return r | |
| 87 | Right ('}':_, _) -> throw ("Found unmatched '}' in document") | |
| 88 | Right (s, _) -> throw ("expected end of document but found " ++ show s) | |
| 89 | Left err -> throw err | |