diff options
| -rw-r--r-- | src/Fragment.hs | 32 |
1 files 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 <http://www.gnu.org/licenses/>. -} -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 "<stdin>" <$> 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 |