all block level elements other than paragraph are handled

src/Djot.hs

@@ -9,15 +9,15 @@ module Djot
   )
 where
 
-import Control.Applicative (many, some, (<|>))
+import Control.Applicative (many, optional, some, (<|>))
 import Data.Functor (void, (<$>))
 import qualified Data.List.NonEmpty as NE
 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), anySingle, choice, errorOffset, getInput, getOffset, manyTill, parse, sepBy, setErrorOffset)
-import Text.Megaparsec.Char (char, newline, space, string)
+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.Char (char, newline, space, string, tab)
 import Utilities.Parsing
 
 (.>) :: (a -> b) -> (b -> c) -> a -> c
@@ -178,7 +178,10 @@ referenceDef attrs = do
   pure $ ReferenceDefinition $ RD {label, link}
 
 rawBlock :: (Logger m, Characters s) => Attrs -> Parser s m Element
-rawBlock = error "todo"
+rawBlock attrs = do
+  Code (C {language = Just format', code = content}) _ <- codeBlock mempty
+  let format = T.drop 1 format'
+  pure $ RawBlock (RB {format, content}) attrs
 
 thematicBreak :: (Logger m, Characters s) => Attrs -> Parser s m Element
 thematicBreak attrs = do
@@ -201,16 +204,55 @@ thematicBreak attrs = do
     part = choice $ map char "*-"
 
 containerBlock :: (Logger m, Characters s) => Attrs -> Parser s m Element
-containerBlock = error "todo"
+containerBlock = containerBlock' 0
+
+containerBlock' :: (Logger m, Characters s) => Int -> Attrs -> Parser s m Element
+containerBlock' n attrs = do
+  startOffset <- getOffset
+  input <- fromText . toText <$> getInput
+  let fence = string ":::"
+  fence
+  space
+  div_class <- someTill anySingle newline
+  contents <- manyTill anySingle (newline *> fence)
+  case parse containerBlock'' input $ fromText $ toText contents of
+    Right ret -> pure ret
+    Left (ParseErrorBundle errs _) ->
+      let remap err = setErrorOffset (errorOffset err + startOffset) err in parseError $ remap $ NE.head errs
+  where
+    containerBlock'' = error "todo"
 
 tableBlock :: (Logger m, Characters s) => Attrs -> Parser s m Element
-tableBlock = error "todo"
+tableBlock attrs = do
+  prefix <- tablePrefix
+  rem_rows <- manyTill tableRow blockSeparator
+  case prefix of
+    Just (header, separator) -> pure $ Table (T {tableCaption = Nothing, tableHead = Just header, tableBody = rem_rows, columnAlignments = Just separator}) attrs
+    Nothing -> pure $ Table (T {tableCaption = Nothing, columnAlignments = Nothing, tableHead = Nothing, tableBody = rem_rows}) attrs
+  where
+    tablePrefix = error "todo" :: Parser s m (Maybe (TableRow, [Alignment]))
+    tableSeparatorRow = error "todo" :: Parser s m [Alignment]
 
-tableRow :: (Logger m, Characters s) => Parser s m Element
-tableRow = error "todo"
+tableRow :: (Logger m, Characters s) => Parser s m TableRow
+tableRow = do
+  char '|'
+  cells <- tableCell `sepBy` char '|'
+  char '|'
+  pure $ TR cells
+  where
+    tableCell = error "todo"
 
 footnoteDefinition :: (Logger m, Characters s) => Attrs -> Parser s m Element
-footnoteDefinition = error "todo"
+footnoteDefinition attrs = do
+  string "[^"
+  label <- toText <$> manyTill anySingle (char ']')
+  char ':'
+  first_line <- footnoteElement'
+  rem_lines <- many footnoteElement
+  pure $ Footnote (F {label, content = first_line : rem_lines}) attrs
+  where
+    footnoteElement' = error "todo"
+    footnoteElement = tab *> footnoteElement'
 
 paragraph :: (Logger m, Characters s) => Attrs -> Parser s m Element
 paragraph = error "todo"

src/IR.hs

@@ -8,7 +8,7 @@ newtype Document = Doc [Element]
 
 data Element
   = Heading Heading Attrs
-  | Code Code
+  | Code Code Attrs
   | BlockQuote BlockQuote Attrs
   | List List Attrs
   | -- Markdown only, DJOT will produce a RawBlock with an html type
@@ -131,9 +131,8 @@ data Math
 data Alignment = AlignLeft | AlignRight | AlignCenter | AlignDefault
   deriving (Show)
 
-data TableCell = TC
-  { cellContent :: [InlineText],
-    cellAlign :: Alignment
+newtype TableCell = TC
+  { cellContent :: [InlineText]
   }
   deriving (Show)
 
@@ -142,7 +141,8 @@ newtype TableRow = TR [TableCell] deriving (Show)
 data Table = T
   { tableCaption :: Maybe [InlineText],
     tableHead :: Maybe TableRow,
-    tableBody :: [TableRow]
+    tableBody :: [TableRow],
+    columnAlignments :: Maybe [Alignment]
   }
   deriving (Show)
 
@@ -164,15 +164,15 @@ data Task = Ta
   }
   deriving (Show)
 
--- TODO
 data RawInline = RI
-  {
+  { format :: Text,
+    content :: Text
   }
   deriving (Show)
 
--- TODO
 data RawBlock = RB
-  {
+  { format :: Text,
+    content :: Text
   }
   deriving (Show)