From 1955b88125f42b75eebc457063da0218498a9055 Mon Sep 17 00:00:00 2001 From: Benjamin Barenblat Date: Wed, 11 Feb 2015 19:36:14 -0500 Subject: Rewrite parser for cleanliness --- src/Fragment.hs | 32 ++++++++++++++------------------ 1 file changed, 14 insertions(+), 18 deletions(-) diff --git a/src/Fragment.hs b/src/Fragment.hs index 2d45ff4..539d35a 100644 --- a/src/Fragment.hs +++ b/src/Fragment.hs @@ -12,10 +12,7 @@ PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . -} -module Fragment ( Fragment - , parseStdin - , parseFile - , ParseError) where +module Fragment where import Data.Data (Data) import Data.Typeable (Typeable) @@ -31,22 +28,21 @@ data Fragment = Documentation String | BlockCode String String deriving (Eq, Show, Data, Typeable, Generic) -parseStdin :: IO (Either ParseError [Fragment]) -parseStdin = parse literateFile "" <$> hGetContents stdin - -parseFile :: FilePath -> IO (Either ParseError [Fragment]) -parseFile = parseFromFile literateFile - literateFile :: Parser [Fragment] -literateFile = alternate documentation blockCode +literateFile = many (blockCode <|> documentation) documentation :: Parser Fragment -documentation = Documentation <$> manyTill anyChar (void (string "<<") <|> eof) +documentation = do + body <- many1Till anyChar (eof <|> lookAhead (void blockCode)) + return $ Documentation body blockCode :: Parser Fragment -blockCode = - BlockCode <$> manyTill anyChar (void $ string ">>=") - <*> manyTill anyChar (void $ char '@') - -alternate :: Parser a -> Parser a -> Parser [a] -alternate x y = (:) <$> x <*> (alternate y x <|> pure []) +blockCode = do + void $ string "<<" + name <- manyTill anyChar (try $ string ">>=") + body <- manyTill anyChar (char '@') + return $ BlockCode name body + +many1Till :: Stream s m t + => ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a] +many1Till p end = (:) <$> p <*> manyTill p end -- cgit v1.2.3