???

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 (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, lowerChar, newline, numberChar, space, string, tab, upperChar)
+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"