summaryrefslogtreecommitdiff
path: root/src/Fragment.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Fragment.hs')
-rw-r--r--src/Fragment.hs32
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