okay errors are abound with the new setup slowly working through them though
This commit is contained in:
parent
b1f9a8d2f9
commit
b956f906ec
3 changed files with 33 additions and 19 deletions
14
app/IR.hs
14
app/IR.hs
|
|
@ -3,6 +3,7 @@ module IR where
|
|||
import Data.Text
|
||||
|
||||
newtype Document = Doc [Element]
|
||||
deriving (Show)
|
||||
|
||||
data Element
|
||||
= Heading Heading
|
||||
|
|
@ -12,6 +13,7 @@ data Element
|
|||
| HTML HTML
|
||||
| Paragraph Paragraph
|
||||
| HorizontalRule
|
||||
deriving (Show)
|
||||
|
||||
-- Removed: BlankLine
|
||||
|
||||
|
|
@ -19,32 +21,37 @@ data Heading = H
|
|||
{ level :: Int,
|
||||
text :: [InlineText]
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
data Code = C
|
||||
{ language :: Maybe Text,
|
||||
code :: Text
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
data BlockQuote = Q [InlineText]
|
||||
data BlockQuote = Q [InlineText] deriving (Show)
|
||||
|
||||
data ListItem = LI
|
||||
{ content :: [InlineText], -- Flatten continuations into here
|
||||
children :: [List]
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
data ListType = Ordered | Unordered
|
||||
data ListType = Ordered | Unordered deriving (Show)
|
||||
|
||||
data List = L
|
||||
{ list_type :: ListType,
|
||||
items :: [ListItem]
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
data HTML
|
||||
= HTMLTag
|
||||
{ html_content :: Text
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
newtype Paragraph = P [InlineText]
|
||||
newtype Paragraph = P [InlineText] deriving (Show)
|
||||
|
||||
data InlineText
|
||||
= Text Text -- Combined Normal and Escaped
|
||||
|
|
@ -62,6 +69,7 @@ data InlineText
|
|||
title :: Maybe Text
|
||||
}
|
||||
| HTMLInline {inline_html_content :: Text}
|
||||
deriving (Show)
|
||||
|
||||
-- for processing math
|
||||
-- https://hackage.haskell.org/package/typst-0.6.1/docs/Typst-Parse.html#v:parseTypst
|
||||
|
|
|
|||
|
|
@ -2,10 +2,11 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
module Markdown (document, metadata) where
|
||||
-- (document, metadata)
|
||||
module Markdown where
|
||||
|
||||
import Control.Applicative (many, optional, some, (<|>))
|
||||
import Control.Monad (guard, void, when)
|
||||
import Control.Monad (guard, void)
|
||||
import Data.Char (isAlpha)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
|
|
@ -175,7 +176,6 @@ orderedListItem = do
|
|||
-- HTML Block
|
||||
htmlBlock :: Parser Element
|
||||
htmlBlock = do
|
||||
start <- getPosition
|
||||
char '<'
|
||||
-- Capture the entire HTML block as raw text
|
||||
rest <- manyTill anyChar (try $ char '>' >> lineEnding)
|
||||
|
|
@ -219,10 +219,10 @@ paragraphBlock = do
|
|||
notFollowedBy (string "```" <|> string "~~~")
|
||||
notFollowedBy (count 4 (char ' ' <|> char '\t'))
|
||||
notFollowedBy (count 3 (char '*') <|> count 3 (char '-') <|> count 3 (char '_'))
|
||||
notFollowedBy (char '<')
|
||||
-- notFollowedBy (char '<')
|
||||
|
||||
content <- some inlineElement
|
||||
lineEnding
|
||||
lineEnding <|> eof
|
||||
pure $ Paragraph $ P content
|
||||
|
||||
-- Inline Elements
|
||||
|
|
@ -400,14 +400,14 @@ plainText = Text . T.pack <$> some plainTextChar
|
|||
|
||||
plainTextChar :: Parser Char
|
||||
plainTextChar = satisfy $ \c ->
|
||||
(c `notElem` ("*_`[!<\\\n\r" :: String)) && c >= ' '
|
||||
(c `notElem` ("*_`[<\\\n\r" :: String)) && c >= ' '
|
||||
|
||||
plainTextNoAsterisk :: Parser InlineText
|
||||
plainTextNoAsterisk =
|
||||
Text . T.pack
|
||||
<$> some
|
||||
( satisfy $ \c ->
|
||||
(c `notElem` ("*_`[!<\\\n\r" :: String)) && c >= ' '
|
||||
(c `notElem` ("*_`[<\\\n\r" :: String)) && c >= ' '
|
||||
)
|
||||
|
||||
plainTextNoUnderscore :: Parser InlineText
|
||||
|
|
@ -415,7 +415,7 @@ plainTextNoUnderscore =
|
|||
Text . T.pack
|
||||
<$> some
|
||||
( satisfy $ \c ->
|
||||
not (c `elem` ("_*`[!<\\\n\r" :: String)) && c >= ' '
|
||||
not (c `elem` ("_*`[<\\\n\r" :: String)) && c >= ' '
|
||||
)
|
||||
|
||||
plainTextNoBracket :: Parser InlineText
|
||||
|
|
@ -423,7 +423,7 @@ plainTextNoBracket =
|
|||
Text . T.pack
|
||||
<$> some
|
||||
( satisfy $ \c ->
|
||||
not (c `elem` ("]_*`[!<\\\n\r" :: String)) && c >= ' '
|
||||
not (c `elem` ("]_*`[<\\\n\r" :: String)) && c >= ' '
|
||||
)
|
||||
|
||||
-- Helper Parsers
|
||||
|
|
|
|||
|
|
@ -2,8 +2,6 @@ module Utilities where
|
|||
|
||||
import Config
|
||||
import Control.Monad (filterM)
|
||||
import Data.Aeson (Result (Error, Success))
|
||||
import qualified Data.Aeson as A
|
||||
import Data.List (find)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
|
|
@ -39,9 +37,13 @@ indexHtmlMarkdownSourcePath =
|
|||
markdownToHtml :: (FromJSON a) => FilePath -> Action (a, Text)
|
||||
markdownToHtml filePath = do
|
||||
content <- Shake.readFile' filePath
|
||||
-- TODO: error handling
|
||||
let Right (metadataText, document) = parse (liftA2 (,) Markdown.metadata Markdown.document) filePath content
|
||||
let Right metadata = decodeEither' $ encodeUtf8 metadataText
|
||||
let (metadataText, document) = case parse (liftA2 (,) Markdown.metadata Markdown.document) filePath content of
|
||||
Right (a, b) -> (a, b)
|
||||
Left e -> error $ show e
|
||||
|
||||
let metadata = case decodeEither' $ encodeUtf8 metadataText of
|
||||
Right m -> m
|
||||
Left e -> error $ show e
|
||||
pure (metadata, compileToHTML document)
|
||||
|
||||
now :: Action T.Text
|
||||
|
|
@ -51,8 +53,12 @@ markdownToPost :: FilePath -> Action Post
|
|||
markdownToPost path = do
|
||||
content <- Shake.readFile' path
|
||||
-- TODO: error handling
|
||||
let Right postData = parse Markdown.metadata path content
|
||||
let Right post = decodeEither' $ encodeUtf8 postData
|
||||
let postData = case parse Markdown.metadata path content of
|
||||
Right p -> p
|
||||
Left e -> error $ show e
|
||||
let post = case decodeEither' $ encodeUtf8 postData of
|
||||
Right p -> p
|
||||
Left e -> error $ show e
|
||||
pure post
|
||||
|
||||
yamlToPost :: FilePath -> Action Post
|
||||
|
|
|
|||
Loading…
Reference in a new issue