diff --git a/src/Djot.hs b/src/Djot.hs
index 997c85c..eb56ca0 100644
--- a/src/Djot.hs
+++ b/src/Djot.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
@@ -10,14 +11,17 @@ module Djot
where
import Control.Applicative (many, optional, some, (<|>))
+import Control.Monad.ST (runST)
+import Data.Foldable (for_)
import Data.Functor (void, (<$>))
import Data.List (elemIndex)
import qualified Data.List.NonEmpty as NE
+import Data.STRef (modifySTRef', newSTRef, readSTRef, writeSTRef)
import Data.Text (Text)
import qualified Data.Text as T
import IR
import Logger (Logger (logCallStack, logDebug, logError))
-import Text.Megaparsec (MonadParsec (lookAhead, notFollowedBy, parseError, try), ParseErrorBundle (ParseErrorBundle, bundleErrors), SourcePos (sourceColumn), anySingle, choice, errorOffset, getInput, getOffset, manyTill, parse, sepBy, setErrorOffset, someTill)
+import Text.Megaparsec (MonadParsec (lookAhead, notFollowedBy, parseError, try), ParseErrorBundle (ParseErrorBundle, bundleErrors), SourcePos (sourceColumn), anySingle, choice, errorOffset, getInput, getOffset, manyTill, parse, satisfy, sepBy, setErrorOffset, someTill)
import Text.Megaparsec.Char (char, lowerChar, newline, numberChar, space, string, tab, upperChar)
import Utilities.Parsing
@@ -46,10 +50,10 @@ blockElement accumulated_attributes =
try $ thematicBreak accumulated_attributes,
lookAhead (string ":::") *> containerBlock accumulated_attributes,
-- try used due to table having a non-trivial structure at the start
- try tableBlock accumulated_attributes,
+ try $ tableBlock accumulated_attributes,
-- using try due to ambiguity between these and normal text until we've already done some amount of parsing
- try footnoteDefinition accumulated_attributes,
- try referenceDef accumulated_attributes,
+ try $ footnoteDefinition accumulated_attributes,
+ try $ referenceDef accumulated_attributes,
lookAhead (char '{') *> blockAttribute accumulated_attributes,
paragraph accumulated_attributes
]
@@ -86,7 +90,9 @@ blockQuote attrs = do
parseError $ remap $ NE.head errs
where
blockQuote' = do
- pure $ BlockQuote (error "todo") attrs
+ -- using document for convenience
+ (Doc contents) <- document
+ pure $ BlockQuote (Q contents) attrs
bq_line = do
char '>'
space
@@ -98,7 +104,7 @@ listBlock attrs = do
startOffset <- getOffset
list_type <- listMarker
first_item <- list_item_content
- rem_items <- manyTill (listMarker *> list_item_content) $ lookAhead blockSeparator
+ rem_items <- manyTill (listMarker' list_type *> list_item_content) $ lookAhead blockSeparator
let items = first_item : rem_items
case parse listBlock' "" $ error "todo: figure out how to take our list of items and put them toegether for easy parsing" of
Right ret -> pure ret
@@ -127,6 +133,41 @@ lowerAlphabet = ['a' .. 'z']
upperAlphabet :: [Char]
upperAlphabet = ['A' .. 'Z']
+-- inner parsing of roman numerals done via Gemini due to lazy
+romanValue :: Char -> Int
+romanValue 'I' = 1
+romanValue 'V' = 5
+romanValue 'X' = 10
+romanValue 'L' = 50
+romanValue 'C' = 100
+romanValue 'D' = 500
+romanValue 'M' = 1000
+romanValue _ = 0
+
+romanToInt :: Text -> Int
+romanToInt s = runST $ do
+ total <- newSTRef 0
+ prevVal <- newSTRef 0
+
+ for_ (T.unpack s) $ \char -> do
+ let curr = romanValue char
+ p <- readSTRef prevVal
+
+ -- If current > previous (e.g., IV), we subtract the previous twice
+ if curr > p
+ then modifySTRef' total (\t -> t + curr - 2 * p)
+ else modifySTRef' total (+ curr)
+
+ writeSTRef prevVal curr
+
+ readSTRef total
+
+upperRoman :: [Char]
+upperRoman = "IVXLCDM"
+
+lowerRoman :: [Char]
+lowerRoman = T.unpack $ T.toLower $ T.pack upperRoman
+
-- consumes whitespace as well for convenience in element parser
listMarker :: (Logger m, Characters s) => Parser s m ListType
listMarker = choice [bullet, decimal, try lower_letter, try upper_letter, try lower_roman_numeral, try upper_roman_numeral] <* space
@@ -145,7 +186,14 @@ listMarker = choice [bullet, decimal, try lower_letter, try upper_letter, try lo
letter <- choice $ map ($ upperChar) [try . surroundParen, try . rightParen, point]
let start_number = elemIndex letter upperAlphabet
pure $ Ordered {start_number, style = Just "A"}
- roman_numeral = error "todo"
+ lower_roman_numeral = do
+ numeral <- choice $ map ($ some (satisfy (`elem` lowerRoman))) [try . surroundParen, try . rightParen, point]
+ let start_number = Just $ romanToInt $ T.toUpper $ toText numeral
+ pure $ Ordered {start_number, style = Just "i"}
+ upper_roman_numeral = do
+ numeral <- choice $ map ($ some (satisfy (`elem` upperRoman))) [try . surroundParen, try . rightParen, point]
+ let start_number = Just $ romanToInt $ T.toUpper $ toText numeral
+ pure $ Ordered {start_number, style = Just "I"}
surroundParen :: (Logger m, Characters s) => Parser s m a -> Parser s m a
surroundParen parser = do
@@ -180,7 +228,7 @@ codeBlock attrs = do
else
Just $ toText language'
code <- toText <$> manyTill anySingle codeFence
- pure $ Code $ C {language, code}
+ pure $ Code (C {language, code}) attrs
blockAttribute :: (Logger m, Characters s) => Attrs -> Parser s m Element
blockAttribute attrs = do
@@ -310,4 +358,76 @@ inlineContent' opened = someTill (inlineElement opened) $ lookAhead blockSeparat
inlineElement :: (Logger m, Characters s) => [OpenInline] -> Parser s m InlineText
inlineElement opened =
choice
- [lookAhead (string "![") *> image, lookAhead]
+ -- spamming try because backtracking is easier than having state for partial parses
+ [ try $ image opened,
+ try $ Djot.link opened,
+ try $ autolink opened,
+ try $ verbatim opened,
+ try $ emphasis opened,
+ try $ highlight opened,
+ try $ superscript opened,
+ try $ subscript opened,
+ try $ insert opened,
+ try $ math opened,
+ try $ footnoteRef opened,
+ try $ linebreak opened,
+ try $ symbol opened,
+ try $ rawInline opened,
+ try $ Djot.span opened,
+ try $ inlineAttribute opened,
+ plainText
+ ]
+
+image :: (Logger m, Characters s) => [OpenInline] -> Parser s m InlineText
+image opened = error "todo"
+
+link :: (Logger m, Characters s) => [OpenInline] -> Parser s m InlineText
+link opened = error "todo"
+
+autolink :: (Logger m, Characters s) => [OpenInline] -> Parser s m InlineText
+autolink opened = error "todo"
+
+verbatim :: (Logger m, Characters s) => [OpenInline] -> Parser s m InlineText
+verbatim opened = error "todo"
+
+emphasis :: (Logger m, Characters s) => [OpenInline] -> Parser s m InlineText
+emphasis opened = error "todo"
+
+highlight :: (Logger m, Characters s) => [OpenInline] -> Parser s m InlineText
+highlight opened = error "todo"
+
+superscript :: (Logger m, Characters s) => [OpenInline] -> Parser s m InlineText
+superscript opene = error "todo"
+
+subscript :: (Logger m, Characters s) => [OpenInline] -> Parser s m InlineText
+subscript opened = error "todo"
+
+insert :: (Logger m, Characters s) => [OpenInline] -> Parser s m InlineText
+insert opened = error "todo"
+
+delete :: (Logger m, Characters s) => [OpenInline] -> Parser s m InlineText
+delete = error "todo"
+
+math :: (Logger m, Characters s) => [OpenInline] -> Parser s m InlineText
+math opened = error "todo"
+
+footnoteRef :: (Logger m, Characters s) => [OpenInline] -> Parser s m InlineText
+footnoteRef opened = error "todo"
+
+linebreak :: (Logger m, Characters s) => [OpenInline] -> Parser s m InlineText
+linebreak opened = error "todo"
+
+symbol :: (Logger m, Characters s) => [OpenInline] -> Parser s m InlineText
+symbol opened = error "todo"
+
+rawInline :: (Logger m, Characters s) => [OpenInline] -> Parser s m InlineText
+rawInline opened = error "todo"
+
+span :: (Logger m, Characters s) => [OpenInline] -> Parser s m InlineText
+span opened = error "todo"
+
+inlineAttribute :: (Logger m, Characters s) => [OpenInline] -> Parser s m InlineText
+inlineAttribute opened = error "todo"
+
+plainText :: (Logger m, Characters s) => Parser s m InlineText
+plainText = error "todo"
diff --git a/src/HTML.hs b/src/HTML.hs
index ec65f45..1fb2f9b 100644
--- a/src/HTML.hs
+++ b/src/HTML.hs
@@ -49,16 +49,16 @@ spaceSep = T.intercalate " "
elementToHTML :: Element -> T.Text
elementToHTML (Heading header attrs) = T.concat ["
", escapeText code_block.code, "", ""]
+elementToHTML (Code code_block attrs) = T.concat ["", escapeText code_block.code, "", ""]
where
language = fromMaybe "" code_block.language
-elementToHTML (BlockQuote (Q elems)) = T.concat ["", elementsToHTML elems, ""] +elementToHTML (BlockQuote (Q elems) attrs) = T.concat ["
", elementsToHTML elems, ""] elementToHTML (List (L {list_type = Ordered {start_number, style}, items}) attrs) = spaceSep ["
", serializeInlineToHTML snippets, "
"] elementToHTML (Transparent snippets) = serializeInlineToHTML snippets -elementToHTML HorizontalRule = "