From 85ce3ee34a93f0b072a608d1d909ca0b924c48d8 Mon Sep 17 00:00:00 2001 From: Pagwin Date: Fri, 4 Sep 2026 14:37:17 -0400 Subject: [PATCH] ??? --- src/Djot.hs | 103 ++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 99 insertions(+), 4 deletions(-) diff --git a/src/Djot.hs b/src/Djot.hs index 270ab93..df0a307 100644 --- a/src/Djot.hs +++ b/src/Djot.hs @@ -11,6 +11,7 @@ module Djot where import Control.Applicative (many, optional, some, (<|>)) +import Control.Monad (guard) import Data.Foldable (for_) import Data.Functor (void, (<$>)) import Data.List (elemIndex) @@ -19,8 +20,8 @@ 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, satisfy, sepBy, setErrorOffset, someTill) -import Text.Megaparsec.Char (char, lowerChar, newline, numberChar, space, string, tab, upperChar) +import Text.Megaparsec (MonadParsec (lookAhead, notFollowedBy, parseError, try), ParseErrorBundle (ParseErrorBundle, bundleErrors), SourcePos (sourceColumn), anySingle, choice, errorOffset, getInput, getOffset, manyTill, oneOf, parse, satisfy, sepBy, setErrorOffset, someTill) +import Text.Megaparsec.Char (char, digitChar, lowerChar, newline, numberChar, space, spaceChar, string, tab, upperChar) import Utilities.Parsing (.>) :: (a -> b) -> (b -> c) -> a -> c @@ -115,7 +116,11 @@ listBlock attrs = do error "todo" -- any listMarker -- can probably just use listMarker' via choice or smth like that - listMarker = error "todo" + listMarker = do + indent <- length <$> many (notFollowedBy newline *> spaceChar) + (lt, markerLen) <- choice [unorderedMarker, orderedMarker] + void (char ' ') <|> lookAhead (void newline) + pure (lt, indent + markerLen + 1) -- listItem which must be of list_type listItem' list_type = do listMarker' list_type @@ -123,14 +128,104 @@ listBlock attrs = do content <- some $ listLine $ notFollowedBy $ listMarker' list_type error "todo" + unorderedMarker = do + c <- oneOf ['-', '+', '*'] + pure (Unordered {style = Just (T.singleton c)}, 1) + orderedMarker = + choice + [ parenEnclosed, + periodOrParen + ] + + parenEnclosed = do + void $ char '(' + (content, lt) <- orderedContent + void $ char ')' + let markerLen = T.length content + 2 -- ( + content + ) + pure (lt, markerLen) + + periodOrParen = do + (content, baseType) <- orderedContent + suffix <- oneOf ['.', ')'] + let markerLen = T.length content + 1 + style = orderedStyle baseType + lt = + Ordered + { start_number = orderedStart baseType content, + style = style + } + pure (lt, markerLen) + orderedStart _ (DecimalContent d) = Just (read d) + orderedStart _ _ = Nothing -- roman/alpha start not tracked numerically + orderedStyle DecimalContent {} = Nothing -- default, omit attribute + orderedStyle UpperRomanContent {} = Just "I" + orderedStyle LowerRomanContent {} = Just "i" + orderedStyle UpperAlphaContent {} = Just "A" + orderedStyle LowerAlphaContent {} = Just "a" + orderedStyle UpperRomanMulti {} = Just "I" + orderedStyle LowerRomanMulti {} = Just "i" + orderedStyle UpperAlphaMulti {} = Just "A" + orderedStyle LowerAlphaMulti {} = Just "a" + ol_digit_handle = do + digits <- some digitChar + pure (T.pack digits, DecimalContent digits) + isRomanUpper c = c `elem` ("IVXLCDM" :: String) + isRomanLower c = c `elem` ("ivxlcdm" :: String) + ol_upper_handle = do + c <- upperChar + let t = T.singleton c + if isRomanUpper c + then pure (t, UpperRomanContent c) + else pure (t, UpperAlphaContent c) + orderedContent = do + choice + [ ol_digit_handle, + ol_upper_handle, + do + c <- lowerChar + let t = T.singleton c + if isRomanLower c + then pure (t, LowerRomanContent c) -- assume roman for ambiguous + else pure (t, LowerAlphaContent c), + do + -- multi-char lower: roman or alpha (xix, viii, etc.) + cs <- some lowerChar + let t = T.pack cs + if all isRomanLower cs + then pure (t, LowerRomanMulti cs) + else pure (t, LowerAlphaMulti cs) + ] -- listMarker which must be of list_type - listMarker' list_type = error "todo" + listMarker' expected = do + indent <- length <$> many (many (notFollowedBy newline *> spaceChar)) + (lt, markerLen) <- case expected of + Unordered {style} -> do + (lt, ml) <- unorderedMarker + guard $ matchesUnordered style lt + pure (lt, ml) + Ordered {style} -> do + (lt, ml) <- orderedMarker + guard $ matchesOrdered style lt + pure (lt, ml) + void (char ' ') <|> lookAhead (void newline) + pure (lt, indent + markerLen + 1) -- list line which must parse check before the rest of the line listLine check = do check manyTill anySingle newline +data OrderedContent + = DecimalContent String + | UpperRomanContent Char + | LowerRomanContent Char + | UpperAlphaContent Char + | LowerAlphaContent Char + | UpperRomanMulti String + | LowerRomanMulti String + | UpperAlphaMulti String + | LowerAlphaMulti String + taskListBlock :: (Logger m, Characters s) => Attrs -> Parser s m Element taskListBlock attrs = do error "todo"