restructuring handling of markdown
This commit is contained in:
parent
2e9860d147
commit
07218a32a6
4 changed files with 82 additions and 40 deletions
|
@ -1,41 +1,9 @@
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
module Markdown
|
||||||
|
( module Markdown.Parser,
|
||||||
|
module Markdown.Data,
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
module Markdown where
|
import Markdown.Data
|
||||||
|
import Markdown.Parser
|
||||||
|
|
||||||
import Data.Functor (void)
|
|
||||||
import Data.Text (Text, pack)
|
|
||||||
import Text.Parsec
|
|
||||||
|
|
||||||
-- https://spec.commonmark.org/0.31.2/
|
|
||||||
-- https://hackage.haskell.org/package/parsec
|
|
||||||
|
|
||||||
linebreak ::
|
|
||||||
(Monad m, Stream s m Char) =>
|
|
||||||
ParsecT s u m ()
|
|
||||||
-- 2 newlines due to mark
|
|
||||||
linebreak = void (newline *> newline)
|
|
||||||
|
|
||||||
emptyParse ::
|
|
||||||
(Monad m, Stream s m Char) =>
|
|
||||||
ParsecT s u m String
|
|
||||||
emptyParse = "" <$ notFollowedBy anyChar
|
|
||||||
|
|
||||||
line ::
|
|
||||||
(Monad m, Stream s m Char) =>
|
|
||||||
ParsecT s u m Text
|
|
||||||
line = fmap pack $ many $ notFollowedBy linebreak *> anyChar
|
|
||||||
|
|
||||||
lines ::
|
|
||||||
(Monad m, Stream s m Char) =>
|
|
||||||
ParsecT s u m [Text]
|
|
||||||
lines = line `sepBy` linebreak
|
|
||||||
|
|
||||||
heading ::
|
|
||||||
(Monad m, Stream s m Char) =>
|
|
||||||
ParsecT s u m (Int, Text)
|
|
||||||
heading = do
|
|
||||||
level <- fmap length $ many1 $ char '#'
|
|
||||||
text <- line
|
|
||||||
pure (level, text)
|
|
||||||
|
|
||||||
-- TODO: blockquote, single backticks, triple backticks, links, arb HTML
|
|
||||||
|
|
30
app/Markdown/Data.hs
Normal file
30
app/Markdown/Data.hs
Normal file
|
@ -0,0 +1,30 @@
|
||||||
|
{-# LANGUAGE RankNTypes, FlexibleContexts #-}
|
||||||
|
|
||||||
|
module Markdown.Data
|
||||||
|
( MarkDownElement,
|
||||||
|
MListItem,
|
||||||
|
Parser,
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Data.Text
|
||||||
|
import Text.Parsec
|
||||||
|
|
||||||
|
-- modified version of https://github.com/tusharad/markdown-parser
|
||||||
|
data MarkDownElement
|
||||||
|
= MHeading Int MarkDownElement
|
||||||
|
| MParagraph MarkDownElement
|
||||||
|
| MBold MarkDownElement
|
||||||
|
| MItalic MarkDownElement
|
||||||
|
| MBoldItalic MarkDownElement
|
||||||
|
| MLink MarkDownElement Text
|
||||||
|
| MLine [MarkDownElement]
|
||||||
|
| MUnorderedList [MListItem]
|
||||||
|
| MOrderedList [MListItem]
|
||||||
|
| Only Text -- Bottom of all types
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
data MListItem = MListItem MarkDownElement [MarkDownElement]
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
type Parser v = forall s u m. (Monad m, Stream s m Char) => ParsecT s u m v
|
44
app/Markdown/Parser.hs
Normal file
44
app/Markdown/Parser.hs
Normal file
|
@ -0,0 +1,44 @@
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
|
||||||
|
module Markdown.Parser
|
||||||
|
( Markdown.Parser.lines,
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Data.Functor (void)
|
||||||
|
import Data.Text (Text, pack)
|
||||||
|
import Text.Parsec
|
||||||
|
|
||||||
|
-- https://spec.commonmark.org/0.31.2/
|
||||||
|
-- https://hackage.haskell.org/package/parsec
|
||||||
|
|
||||||
|
linebreak ::
|
||||||
|
(Monad m, Stream s m Char) =>
|
||||||
|
ParsecT s u m ()
|
||||||
|
-- 2 newlines due to mark
|
||||||
|
linebreak = void (newline *> newline)
|
||||||
|
|
||||||
|
emptyParse ::
|
||||||
|
(Monad m, Stream s m Char) =>
|
||||||
|
ParsecT s u m String
|
||||||
|
emptyParse = "" <$ notFollowedBy anyChar
|
||||||
|
|
||||||
|
line ::
|
||||||
|
(Monad m, Stream s m Char) =>
|
||||||
|
ParsecT s u m Text
|
||||||
|
line = fmap pack $ many $ notFollowedBy linebreak *> anyChar
|
||||||
|
|
||||||
|
lines ::
|
||||||
|
(Monad m, Stream s m Char) =>
|
||||||
|
ParsecT s u m [Text]
|
||||||
|
lines = line `sepBy` linebreak
|
||||||
|
|
||||||
|
heading ::
|
||||||
|
(Monad m, Stream s m Char) =>
|
||||||
|
ParsecT s u m (Int, Text)
|
||||||
|
heading = do
|
||||||
|
level <- fmap length $ many1 $ char '#'
|
||||||
|
text <- line
|
||||||
|
pure (level, text)
|
||||||
|
|
||||||
|
-- TODO: blockquote, single backticks, triple backticks, links, arb HTML
|
|
@ -29,7 +29,7 @@ executable psb
|
||||||
-- .hs or .lhs file containing the Main module.
|
-- .hs or .lhs file containing the Main module.
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
|
|
||||||
other-modules: Config Utilities Templates Types IR Markdown Restruct
|
other-modules: Config Utilities Templates Types IR Markdown Markdown.Data Markdown.Parser Restruct
|
||||||
|
|
||||||
default-extensions: ApplicativeDo DataKinds NamedFieldPuns DerivingVia LambdaCase TypeApplications DeriveGeneric
|
default-extensions: ApplicativeDo DataKinds NamedFieldPuns DerivingVia LambdaCase TypeApplications DeriveGeneric
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue