    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE Strict #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    module Djot.Blocks
    ( parseDoc
    , toIdentifier
    )
    where

    import Prelude hiding (div)
    import Text.Read (readMaybe)
    import Data.Maybe (fromMaybe)
    import Data.Char (ord, isAsciiLower, isAsciiUpper, isAscii, isAlphaNum, isDigit)
    import Data.Foldable as F
    import Djot.Parse
    import Djot.AST
    import Djot.Inlines (parseInlines, parseTableCells)
    import Djot.Options (ParseOptions(..), SourcePosOption(..))
    import Djot.Attributes (parseAttributes, AttrParserState, AttrParseResult(..))
    import Data.Sequence (Seq)
    import qualified Data.Sequence as Seq
    import qualified Data.ByteString as B
    import qualified Data.ByteString.Char8 as B8
    import Data.ByteString (ByteString)
    import Control.Monad (replicateM_, void, mzero, unless, when, guard, foldM)
    import Data.List.NonEmpty (NonEmpty(..))
    import Data.List (intercalate)
    import qualified Data.List.NonEmpty as NonEmpty
    import Data.Set (Set)
    import qualified Data.Set as Set
    import Control.Applicative
    import Data.Typeable (Typeable)
    -- import Debug.Trace

    parseDoc :: ParseOptions -> ByteString -> Either String Doc
    parseDoc :: ParseOptions -> ByteString -> Either [Char] Doc
    parseDoc ParseOptions
    opts ByteString
    bs = do
      case Parser PState Doc -> PState -> [Chunk] -> Maybe Doc
    forall s a. Parser s a -> s -> [Chunk] -> Maybe a
    parse Parser PState Doc
    pDoc PState{ psParseOptions :: ParseOptions
    psParseOptions = ParseOptions
    opts
                            , psContainerStack :: NonEmpty Container
    psContainerStack =
                                [Container] -> NonEmpty Container
    forall a. HasCallStack => [a] -> NonEmpty a
    NonEmpty.fromList
                                 [Container
    emptyContainer{ containerSpec = docSpec }]
                            , psReferenceMap :: ReferenceMap
    psReferenceMap = ReferenceMap
    forall a. Monoid a => a
    mempty
                            , psAutoReferenceMap :: ReferenceMap
    psAutoReferenceMap = ReferenceMap
    forall a. Monoid a => a
    mempty
                            , psNoteMap :: NoteMap
    psNoteMap = NoteMap
    forall a. Monoid a => a
    mempty
                            , psAttributes :: Attr
    psAttributes = Attr
    forall a. Monoid a => a
    mempty
                            , psAttrParserState :: Maybe AttrParserState
    psAttrParserState = Maybe AttrParserState
    forall a. Maybe a
    Nothing
                            , psIds :: Set ByteString
    psIds = Set ByteString
    forall a. Monoid a => a
    mempty
                            , psAutoIds :: Set ByteString
    psAutoIds = Set ByteString
    forall a. Monoid a => a
    mempty
                            , psLastColumnPrevLine :: Int
    psLastColumnPrevLine = Int
    0
                            , psLastLine :: Int
    psLastLine = Int
    1
                            } [Chunk{ chunkLine :: Int
    chunkLine = Int
    1, chunkColumn :: Int
    chunkColumn = Int
    1, chunkBytes :: ByteString
    chunkBytes = ByteString
    bs }] of
        Just Doc
    doc -> Doc -> Either [Char] Doc
    forall a b. b -> Either a b
    Right Doc
    doc
        Maybe Doc
    Nothing -> [Char] -> Either [Char] Doc
    forall a b. a -> Either a b
    Left [Char]
    "Parse failure."

    data BlockType =
      Normal | ListItem | CaptionBlock | Document
      deriving (Int -> BlockType -> [Char] -> [Char]
    [BlockType] -> [Char] -> [Char]
    BlockType -> [Char]
    (Int -> BlockType -> [Char] -> [Char])
    -> (BlockType -> [Char])
    -> ([BlockType] -> [Char] -> [Char])
    -> Show BlockType
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: Int -> BlockType -> [Char] -> [Char]
    showsPrec :: Int -> BlockType -> [Char] -> [Char]
    $cshow :: BlockType -> [Char]
    show :: BlockType -> [Char]
    $cshowList :: [BlockType] -> [Char] -> [Char]
    showList :: [BlockType] -> [Char] -> [Char]
    Show, BlockType -> BlockType -> Bool
    (BlockType -> BlockType -> Bool)
    -> (BlockType -> BlockType -> Bool) -> Eq BlockType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: BlockType -> BlockType -> Bool
    == :: BlockType -> BlockType -> Bool
    $c/= :: BlockType -> BlockType -> Bool
    /= :: BlockType -> BlockType -> Bool
    Eq)

    data BlockSpec =
      BlockSpec
      { -- | Descriptive name
        BlockSpec -> [Char]
    blockName :: String
      , -- | Type of block
        BlockSpec -> BlockType
    blockType :: BlockType
        -- | Parser for start of this block type
      , BlockSpec -> P ()
    blockStart :: P ()
        -- | Parser that must return True if this block is to continue
      , BlockSpec -> Container -> P Bool
    blockContinue :: Container -> P Bool
        -- | Just blockType if it can contain that type of block
      , BlockSpec -> Maybe BlockType
    blockContainsBlock :: Maybe BlockType
        -- | True if it can accept text lines
      , BlockSpec -> Bool
    blockContainsLines :: Bool
        -- | Parser that runs when block is closed, possibly
        -- updating the container.
      , BlockSpec -> Container -> P Container
    blockClose :: Container -> P Container
        -- | Parser that runs when the document is closed, creating the
        -- block AST element.
      , BlockSpec -> Container -> Blocks
    blockFinalize :: Container -> Blocks
      }

    docSpec :: BlockSpec
    docSpec :: BlockSpec
    docSpec =
      BlockSpec
      { blockName :: [Char]
    blockName = [Char]
    "Doc"
      , blockType :: BlockType
    blockType = BlockType
    Document
      , blockStart :: P ()
    blockStart = P ()
    forall a. Parser PState a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
      , blockContinue :: Container -> P Bool
    blockContinue = \Container
    _ -> Bool -> P Bool
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True
      , blockContainsBlock :: Maybe BlockType
    blockContainsBlock = BlockType -> Maybe BlockType
    forall a. a -> Maybe a
    Just BlockType
    Normal
      , blockContainsLines :: Bool
    blockContainsLines = Bool
    False
      , blockClose :: Container -> P Container
    blockClose = Container -> P Container
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      , blockFinalize :: Container -> Blocks
    blockFinalize = Container -> Blocks
    finalizeChildren
      }

    listItemSpec :: BlockSpec
    listItemSpec :: BlockSpec
    listItemSpec =
      BlockSpec
      { blockName :: [Char]
    blockName = [Char]
    "ListItem"
      , blockType :: BlockType
    blockType = BlockType
    ListItem
      , blockStart :: P ()
    blockStart = do
          ind <- Parser PState Int
    forall st. Parser st Int
    sourceColumn
          ltypes <- pListStart
          skipMany spaceOrTab
          tip :| _ <- psContainerStack <$> getState
          case blockContainsBlock (containerSpec tip) of
            Just BlockType
    ListItem -> () -> P ()
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
            Maybe BlockType
    _ -> BlockSpec -> Int -> ContainerData -> P ()
    addContainer BlockSpec
    listSpec Int
    ind ContainerData
    NoData
          addContainer listItemSpec ind (ListItemData ind ltypes False)
      , blockContinue :: Container -> P Bool
    blockContinue = \Container
    container -> do
              Bool
    True Bool -> P () -> P Bool
    forall a b. a -> Parser PState b -> Parser PState a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ P () -> P ()
    forall s a. Parser s a -> Parser s ()
    fails
                (do P () -> P ()
    forall s a. Parser s a -> Parser s ()
    skipMany P ()
    forall s. Parser s ()
    spaceOrTab
                    curind <- Parser PState Int
    forall st. Parser st Int
    sourceColumn
                    let liIndent = case Container -> ContainerData
    containerData Container
    container of
                                     ListItemData Int
    i [ListType]
    _ Bool
    _ -> Int
    i
                                     ContainerData
    _ -> [Char] -> Int
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Missing ListItemData"
                    tip :| _ <- psContainerStack <$> getState
                    guard (curind <= liIndent)
                    case blockName (containerSpec tip) of
                      [Char]
    "Para" -> P [ListType] -> P ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void P [ListType]
    pListStart
                      [Char]
    _ -> () -> P ()
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ())
            P Bool -> P Bool -> P Bool
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Bool
    True Bool -> P () -> P Bool
    forall a b. a -> Parser PState b -> Parser PState a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ P ()
    forall s. Parser s ()
    followedByBlankLine
            P Bool -> P Bool -> P Bool
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Bool -> P Bool
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
      , blockContainsBlock :: Maybe BlockType
    blockContainsBlock = BlockType -> Maybe BlockType
    forall a. a -> Maybe a
    Just BlockType
    Normal
      , blockContainsLines :: Bool
    blockContainsLines = Bool
    False
      , blockClose :: Container -> P Container
    blockClose = Container -> P Container
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      , blockFinalize :: Container -> Blocks
    blockFinalize = Container -> Blocks
    finalizeChildren
      }

    pListStart :: P [ListType]
    pListStart :: P [ListType]
    pListStart = P [ListType]
    pBulletListStart P [ListType] -> P [ListType] -> P [ListType]
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> P [ListType]
    pDefinitionListStart P [ListType] -> P [ListType] -> P [ListType]
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> P [ListType]
    pOrderedListStart

    pBulletListStart :: P [ListType]
    pBulletListStart :: P [ListType]
    pBulletListStart = do
      bulletchar <- (Char -> Bool) -> Parser PState Char
    forall s. (Char -> Bool) -> Parser s Char
    satisfyByte (\Char
    c -> Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '-' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '+' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '*')
      followedByWhitespace
      (do skipMany spaceOrTab
          asciiChar '['
          status <- (Complete <$ byteString "x]")
                <|> (Complete <$ byteString "X]")
                <|> (Incomplete <$ byteString " ]")
          followedByWhitespace
          pure [Task status])
       <|> pure [Bullet bulletchar]

    pDefinitionListStart :: P [ListType]
    pDefinitionListStart :: P [ListType]
    pDefinitionListStart = do
      Char -> P ()
    forall s. Char -> Parser s ()
    asciiChar Char
    ':'
      P ()
    forall s. Parser s ()
    followedByWhitespace
      [ListType] -> P [ListType]
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [ListType
    Definition]

    groupLists :: Seq Container -> Seq ([ListType], Seq Container)
    groupLists :: Seq Container -> Seq ([ListType], Seq Container)
    groupLists = ([ListType], Seq ([ListType], Seq Container))
    -> Seq ([ListType], Seq Container)
    forall a b. (a, b) -> b
    snd (([ListType], Seq ([ListType], Seq Container))
     -> Seq ([ListType], Seq Container))
    -> (Seq Container -> ([ListType], Seq ([ListType], Seq Container)))
    -> Seq Container
    -> Seq ([ListType], Seq Container)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([ListType], Seq ([ListType], Seq Container))
     -> Container -> ([ListType], Seq ([ListType], Seq Container)))
    -> ([ListType], Seq ([ListType], Seq Container))
    -> Seq Container
    -> ([ListType], Seq ([ListType], Seq Container))
    forall b a. (b -> a -> b) -> b -> Seq a -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' ([ListType], Seq ([ListType], Seq Container))
    -> Container -> ([ListType], Seq ([ListType], Seq Container))
    go ([], Seq ([ListType], Seq Container)
    forall a. Monoid a => a
    mempty)
     where
       go :: ([ListType], Seq ([ListType], Seq Container))
          -> Container
          -> ([ListType], Seq ([ListType], Seq Container))
       go :: ([ListType], Seq ([ListType], Seq Container))
    -> Container -> ([ListType], Seq ([ListType], Seq Container))
    go ([ListType]
    curtypes, Seq ([ListType], Seq Container)
    lists) Container
    cont =
         case Seq ([ListType], Seq Container)
    -> ViewR ([ListType], Seq Container)
    forall a. Seq a -> ViewR a
    Seq.viewr Seq ([ListType], Seq Container)
    lists of
           ViewR ([ListType], Seq Container)
    Seq.EmptyR -> (Container -> [ListType]
    getListTypes Container
    cont,
                           ([ListType], Seq Container) -> Seq ([ListType], Seq Container)
    forall a. a -> Seq a
    Seq.singleton (Container -> [ListType]
    getListTypes Container
    cont, Container -> Seq Container
    forall a. a -> Seq a
    Seq.singleton Container
    cont))
           Seq ([ListType], Seq Container)
    rest Seq.:> ([ListType]
    _, Seq Container
    cur) ->
             let lt :: [ListType]
    lt = Container -> [ListType]
    getListTypes Container
    cont
                 matchedTypes :: [ListType]
    matchedTypes = [ListType
    ty | ListType
    ty <- [ListType]
    curtypes, (ListType -> Bool) -> [ListType] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (ListType
    ty ListType -> ListType -> Bool
    `matches`) [ListType]
    lt]
             in if [ListType] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ListType]
    matchedTypes
                   then (Container -> [ListType]
    getListTypes Container
    cont, Seq ([ListType], Seq Container)
    lists Seq ([ListType], Seq Container)
    -> ([ListType], Seq Container) -> Seq ([ListType], Seq Container)
    forall a. Seq a -> a -> Seq a
    Seq.|> (Container -> [ListType]
    getListTypes Container
    cont, Container -> Seq Container
    forall a. a -> Seq a
    Seq.singleton Container
    cont)) -- new list
                   else ([ListType]
    matchedTypes, Seq ([ListType], Seq Container)
    rest Seq ([ListType], Seq Container)
    -> ([ListType], Seq Container) -> Seq ([ListType], Seq Container)
    forall a. Seq a -> a -> Seq a
    Seq.|> ([ListType]
    matchedTypes, Seq Container
    cur Seq Container -> Container -> Seq Container
    forall a. Seq a -> a -> Seq a
    Seq.|> Container
    cont))

       matches :: ListType -> ListType -> Bool
       matches :: ListType -> ListType -> Bool
    matches (Bullet Char
    b1) (Bullet Char
    b2) = Char
    b1 Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    b2
       matches (Ordered OrderedListAttributes
    o1) (Ordered OrderedListAttributes
    o2) =
         OrderedListAttributes -> OrderedListStyle
    orderedListStyle OrderedListAttributes
    o1 OrderedListStyle -> OrderedListStyle -> Bool
    forall a. Eq a => a -> a -> Bool
    == OrderedListAttributes -> OrderedListStyle
    orderedListStyle OrderedListAttributes
    o2 Bool -> Bool -> Bool
    &&
         OrderedListAttributes -> OrderedListDelim
    orderedListDelim OrderedListAttributes
    o1 OrderedListDelim -> OrderedListDelim -> Bool
    forall a. Eq a => a -> a -> Bool
    == OrderedListAttributes -> OrderedListDelim
    orderedListDelim OrderedListAttributes
    o2
       matches ListType
    Definition ListType
    Definition = Bool
    True
       matches Task{} Task{} = Bool
    True
       matches ListType
    _ ListType
    _ = Bool
    False

    getListTypes :: Container -> [ListType]
    getListTypes :: Container -> [ListType]
    getListTypes Container
    cont = case Container -> ContainerData
    containerData Container
    cont of
                          ListItemData Int
    _ [ListType]
    tys Bool
    _ -> [ListType]
    tys
                          ContainerData
    _ -> [Char] -> [ListType]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Missing ListItemData"

    pOrderedListStart :: P [ListType]
    pOrderedListStart :: P [ListType]
    pOrderedListStart = do
      openParen <- (Bool
    True Bool -> P () -> P Bool
    forall a b. a -> Parser PState b -> Parser PState a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Char -> P ()
    forall s. Char -> Parser s ()
    asciiChar Char
    '(') P Bool -> P Bool -> P Bool
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Bool -> P Bool
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
      lookahead $ do
        skipSome $ skipSatisfyByte (\Char
    c -> Char -> Bool
    isAscii Char
    c Bool -> Bool -> Bool
    && Char -> Bool
    isAlphaNum Char
    c)
        skipSatisfyByte (\Char
    c -> Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '.' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ')')
      stylesAndStarts <- decimalStart <|> romanStart <|> letterStart
      delimType <-
        if openParen
           then LeftRightParen <$ asciiChar ')'
           else (RightParen <$ asciiChar ')') <|> (RightPeriod <$ asciiChar '.')
      followedByWhitespace
      pure $ map
        (\(OrderedListStyle
    style, Int
    start) -> OrderedListAttributes -> ListType
    Ordered
            OrderedListAttributes
            { orderedListStyle :: OrderedListStyle
    orderedListStyle = OrderedListStyle
    style
            , orderedListDelim :: OrderedListDelim
    orderedListDelim = OrderedListDelim
    delimType
            , orderedListStart :: Int
    orderedListStart = Int
    start }) stylesAndStarts
     where
      decimalStart :: Parser s [(OrderedListStyle, Int)]
    decimalStart = do
        digits <- Parser s Char -> Parser s [Char]
    forall a. Parser s a -> Parser s [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    some ((Char -> Bool) -> Parser s Char
    forall s. (Char -> Bool) -> Parser s Char
    satisfyByte Char -> Bool
    isDigit)
        case readMaybe digits of
          Just Int
    n -> [(OrderedListStyle, Int)] -> Parser s [(OrderedListStyle, Int)]
    forall a. a -> Parser s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [(OrderedListStyle
    Decimal, Int
    n)]
          Maybe Int
    Nothing -> Parser s [(OrderedListStyle, Int)]
    forall a. Parser s a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
      letterStart :: Parser s [(OrderedListStyle, Int)]
    letterStart = do
        c <- (Char -> Bool) -> Parser s Char
    forall s. (Char -> Bool) -> Parser s Char
    satisfyByte (\Char
    c -> Char -> Bool
    isAsciiLower Char
    c Bool -> Bool -> Bool
    || Char -> Bool
    isAsciiUpper Char
    c)
        if isAsciiLower c
           then pure [(LetterLower, 1 + (ord c - ord 'a'))]
           else pure [(LetterUpper, 1 + (ord c - ord 'A'))]
      romanStart :: Parser PState [(OrderedListStyle, Int)]
    romanStart = do
        (n, lettercase) <- P (Int, Case)
    pRomanNumeral
        let sty = if Case
    lettercase Case -> Case -> Bool
    forall a. Eq a => a -> a -> Bool
    == Case
    Uppercase then OrderedListStyle
    RomanUpper else OrderedListStyle
    RomanLower
        let altsty = if Case
    lettercase Case -> Case -> Bool
    forall a. Eq a => a -> a -> Bool
    == Case
    Uppercase then OrderedListStyle
    LetterUpper else OrderedListStyle
    LetterLower
        pure $ (sty, n) :
          case n of
            Int
    1 -> [(OrderedListStyle
    altsty, Int
    9)]
            Int
    5 -> [(OrderedListStyle
    altsty, Int
    22)]
            Int
    10 -> [(OrderedListStyle
    altsty, Int
    24)]
            Int
    50 -> [(OrderedListStyle
    altsty, Int
    12)]
            Int
    100 -> [(OrderedListStyle
    altsty, Int
    3)]
            Int
    500 -> [(OrderedListStyle
    altsty, Int
    4)]
            Int
    1000 -> [(OrderedListStyle
    altsty, Int
    13)]
            Int
    _ -> []

    data Case = Uppercase | Lowercase
      deriving (Case -> Case -> Bool
    (Case -> Case -> Bool) -> (Case -> Case -> Bool) -> Eq Case
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Case -> Case -> Bool
    == :: Case -> Case -> Bool
    $c/= :: Case -> Case -> Bool
    /= :: Case -> Case -> Bool
    Eq)

    pRomanNumeral :: P (Int, Case)
    pRomanNumeral :: P (Int, Case)
    pRomanNumeral = do
      let isUpperRomanChar :: Char -> Bool
    isUpperRomanChar Char
    c = Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'I' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'V' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'X' Bool -> Bool -> Bool
    ||
                               Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'L' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'C' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'D' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'M'
      let isLowerRomanChar :: Char -> Bool
    isLowerRomanChar Char
    c = Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'i' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'v' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'x' Bool -> Bool -> Bool
    ||
                               Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'l' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'c' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'd' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'm'
      let isRomanChar :: Char -> Bool
    isRomanChar Char
    c = Char -> Bool
    isUpperRomanChar Char
    c Bool -> Bool -> Bool
    || Char -> Bool
    isLowerRomanChar Char
    c
      lettercase <- Parser PState Case -> Parser PState Case
    forall s a. Parser s a -> Parser s a
    lookahead (Parser PState Case -> Parser PState Case)
    -> Parser PState Case -> Parser PState Case
    forall a b. (a -> b) -> a -> b
    $ do
        c <- (Char -> Bool) -> Parser PState Char
    forall s. (Char -> Bool) -> Parser s Char
    satisfyByte Char -> Bool
    isRomanChar
        let lettercase = if Char -> Bool
    isUpperRomanChar Char
    c then Case
    Uppercase else Case
    Lowercase
        skipMany $ skipSatisfyByte $
          case lettercase of
            Case
    Uppercase -> Char -> Bool
    isUpperRomanChar
            Case
    Lowercase -> Char -> Bool
    isLowerRomanChar
        skipSatisfyByte (\Char
    d -> Char
    d Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ')' Bool -> Bool -> Bool
    || Char
    d Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '.')
        pure lettercase
      let rchar Char
    uc Char
    lc = (Char -> Bool) -> Parser s Char
    forall s. (Char -> Bool) -> Parser s Char
    satisfyByte ((Char -> Bool) -> Parser s Char)
    -> (Char -> Bool) -> Parser s Char
    forall a b. (a -> b) -> a -> b
    $ if Case
    lettercase Case -> Case -> Bool
    forall a. Eq a => a -> a -> Bool
    == Case
    Uppercase
                                           then (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    uc)
                                           else (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    lc)
      let one         = Char -> Char -> Parser s Char
    forall {s}. Char -> Char -> Parser s Char
    rchar Char
    'I' Char
    'i'
      let five        = Char -> Char -> Parser s Char
    forall {s}. Char -> Char -> Parser s Char
    rchar Char
    'V' Char
    'v'
      let ten         = Char -> Char -> Parser s Char
    forall {s}. Char -> Char -> Parser s Char
    rchar Char
    'X' Char
    'x'
      let fifty       = Char -> Char -> Parser s Char
    forall {s}. Char -> Char -> Parser s Char
    rchar Char
    'L' Char
    'l'
      let hundred     = Char -> Char -> Parser s Char
    forall {s}. Char -> Char -> Parser s Char
    rchar Char
    'C' Char
    'c'
      let fivehundred = Char -> Char -> Parser s Char
    forall {s}. Char -> Char -> Parser s Char
    rchar Char
    'D' Char
    'd'
      let thousand    = Char -> Char -> Parser s Char
    forall {s}. Char -> Char -> Parser s Char
    rchar Char
    'M' Char
    'm'
      thousands <- (1000 *) . length <$> many thousand
      ninehundreds <- option 0 $ hundred >> thousand >> return 900
      fivehundreds <- option 0 $ 500 <$ fivehundred
      fourhundreds <- option 0 $ hundred >> fivehundred >> return 400
      hundreds <- (100 *) . length <$> many hundred
      nineties <- option 0 $ ten >> hundred >> return 90
      fifties <- option 0 (50 <$ fifty)
      forties <- option 0 $ ten >> fifty >> return 40
      tens <- (10 *) . length <$> many ten
      nines <- option 0 $ one >> ten >> return 9
      fives <- option 0 (5 <$ five)
      fours <- option 0 $ one >> five >> return 4
      ones <- length <$> many one
      let total = Int
    thousands Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    ninehundreds Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    fivehundreds Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    fourhundreds Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +
                  Int
    hundreds Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    nineties Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    fifties Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    forties Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    tens Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    nines Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +
                  Int
    fives Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    fours Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    ones
      if total == 0
         then mzero
         else return (total, lettercase)
     where
       option :: a -> f a -> f a
    option a
    defval f a
    p = f a
    p f a -> f a -> f a
    forall a. f a -> f a -> f a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> a -> f a
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    defval

    listSpec :: BlockSpec
    listSpec :: BlockSpec
    listSpec =
      BlockSpec
      { blockName :: [Char]
    blockName = [Char]
    "List"
      , blockType :: BlockType
    blockType = BlockType
    Normal
      , blockStart :: P ()
    blockStart = P ()
    forall a. Parser PState a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero -- added in listItemSpec
      , blockContinue :: Container -> P Bool
    blockContinue = \Container
    _ -> Bool -> P Bool
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True
      , blockContainsBlock :: Maybe BlockType
    blockContainsBlock = BlockType -> Maybe BlockType
    forall a. a -> Maybe a
    Just BlockType
    ListItem
      , blockContainsLines :: Bool
    blockContainsLines = Bool
    False
      , blockClose :: Container -> P Container
    blockClose = Container -> P Container
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      , blockFinalize :: Container -> Blocks
    blockFinalize = (([ListType], Seq Container) -> Blocks)
    -> Seq ([ListType], Seq Container) -> Blocks
    forall m a. Monoid m => (a -> m) -> Seq a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap ([ListType], Seq Container) -> Blocks
    itemsToList (Seq ([ListType], Seq Container) -> Blocks)
    -> (Container -> Seq ([ListType], Seq Container))
    -> Container
    -> Blocks
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Seq Container -> Seq ([ListType], Seq Container)
    groupLists (Seq Container -> Seq ([ListType], Seq Container))
    -> (Container -> Seq Container)
    -> Container
    -> Seq ([ListType], Seq Container)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Container -> Seq Container
    containerChildren
      }

    itemsToList :: ([ListType], Seq Container) -> Blocks
    itemsToList :: ([ListType], Seq Container) -> Blocks
    itemsToList ([ListType]
    ltypes, Seq Container
    containers) =
      case Seq Container
    containers of
        Seq Container
    Seq.Empty -> Blocks
    forall a. Monoid a => a
    mempty
        Seq Container
    _ ->
           let spacing :: ListSpacing
    spacing =
                 case Seq Container -> ViewR Container
    forall a. Seq a -> ViewR a
    Seq.viewr Seq Container
    containers of
                   ViewR Container
    Seq.EmptyR -> ListSpacing
    Tight
                   Seq Container
    as Seq.:> Container
    _ | (Container -> Bool) -> Seq Container -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Container -> Bool
    itemEndsWithBlank Seq Container
    as Bool -> Bool -> Bool
    ||
                                 (Container -> Bool) -> Seq Container -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Container -> Bool
    hasChildrenSeparatedWithBlank Seq Container
    containers
                              -> ListSpacing
    Loose
                   ViewR Container
    _ -> ListSpacing
    Tight
               items' :: [Blocks]
    items' = [Blocks] -> [Blocks]
    forall a. [a] -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList [Blocks]
    items
               taskListStatus :: [TaskStatus]
    taskListStatus = (Container -> TaskStatus) -> [Container] -> [TaskStatus]
    forall a b. (a -> b) -> [a] -> [b]
    map Container -> TaskStatus
    getTaskStatus (Seq Container -> [Container]
    forall a. Seq a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList Seq Container
    containers)
               pos :: Pos
    pos = case (Seq Container -> ViewL Container
    forall a. Seq a -> ViewL a
    Seq.viewl Seq Container
    containers, Seq Container -> ViewR Container
    forall a. Seq a -> ViewR a
    Seq.viewr Seq Container
    containers) of
                        (Container
    s Seq.:< Seq Container
    _, Seq Container
    _ Seq.:> Container
    e) | Container -> Bool
    containerSourcePos Container
    s ->
                          Int -> Int -> Int -> Int -> Pos
    Pos (Container -> Int
    containerStartLine Container
    s) (Container -> Int
    containerStartColumn Container
    s)
                              (Container -> Int
    containerEndLine Container
    e) (Container -> Int
    containerEndColumn Container
    e)
                        (ViewL Container, ViewR Container)
    _ -> Pos
    NoPos
           in Pos -> Node Block -> Node Block
    forall a. Pos -> Node a -> Node a
    addPos Pos
    pos (Node Block -> Node Block) -> Blocks -> Blocks
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
              case [ListType]
    ltypes of
                Bullet{} : [ListType]
    _-> ListSpacing -> [Blocks] -> Blocks
    bulletList ListSpacing
    spacing [Blocks]
    items'
                Ordered OrderedListAttributes
    _ : [ListType]
    _->
                  OrderedListAttributes -> ListSpacing -> [Blocks] -> Blocks
    orderedList ([ListType] -> OrderedListAttributes
    chooseOrderedAttr [ListType]
    ltypes) ListSpacing
    spacing [Blocks]
    items'
                ListType
    Definition : [ListType]
    _ -> ListSpacing -> [(Inlines, Blocks)] -> Blocks
    definitionList ListSpacing
    spacing ([(Inlines, Blocks)] -> Blocks) -> [(Inlines, Blocks)] -> Blocks
    forall a b. (a -> b) -> a -> b
    $ (Blocks -> (Inlines, Blocks)) -> [Blocks] -> [(Inlines, Blocks)]
    forall a b. (a -> b) -> [a] -> [b]
    map Blocks -> (Inlines, Blocks)
    toDefinition [Blocks]
    items'
                Task TaskStatus
    _ : [ListType]
    _ -> ListSpacing -> [(TaskStatus, Blocks)] -> Blocks
    taskList ListSpacing
    spacing ([(TaskStatus, Blocks)] -> Blocks)
    -> [(TaskStatus, Blocks)] -> Blocks
    forall a b. (a -> b) -> a -> b
    $ [TaskStatus] -> [Blocks] -> [(TaskStatus, Blocks)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [TaskStatus]
    taskListStatus [Blocks]
    items'
                [] -> Blocks
    forall a. Monoid a => a
    mempty
     where
       items :: [Blocks]
    items = (Container -> Blocks) -> [Container] -> [Blocks]
    forall a b. (a -> b) -> [a] -> [b]
    map Container -> Blocks
    finalize ([Container] -> [Blocks]) -> [Container] -> [Blocks]
    forall a b. (a -> b) -> a -> b
    $ Seq Container -> [Container]
    forall a. Seq a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList Seq Container
    containers
       getTaskStatus :: Container -> TaskStatus
    getTaskStatus Container
    cont = case Container -> [ListType]
    getListTypes Container
    cont of
                               ([Task TaskStatus
    stat] :: [ListType]) -> TaskStatus
    stat
                               [ListType]
    _ -> [Char] -> TaskStatus
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "getTaskStatus: wrong shape"
       -- when ambiguous between roman and lettered list, choose roman if start number is 1,
       -- otherwise lettered
       chooseOrderedAttr :: [ListType] -> OrderedListAttributes
    chooseOrderedAttr [ListType]
    os =
         case [OrderedListAttributes
    at | Ordered OrderedListAttributes
    at <- [ListType]
    os, OrderedListAttributes -> Bool
    isRomanStartOne OrderedListAttributes
    at] of
           (OrderedListAttributes
    a:[OrderedListAttributes]
    _) -> OrderedListAttributes
    a
           [OrderedListAttributes]
    _ -> case [OrderedListAttributes
    at | Ordered OrderedListAttributes
    at <- [ListType]
    os, OrderedListAttributes -> Bool
    isLettered OrderedListAttributes
    at] of
             (OrderedListAttributes
    a:[OrderedListAttributes]
    _)  -> OrderedListAttributes
    a
             [OrderedListAttributes]
    _ -> case [OrderedListAttributes
    at | Ordered OrderedListAttributes
    at <- [ListType]
    os] of
               (OrderedListAttributes
    a:[OrderedListAttributes]
    _) -> OrderedListAttributes
    a
               [] -> [Char] -> OrderedListAttributes
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "chooseOrderedAttr on empty list"
       isRomanStartOne :: OrderedListAttributes -> Bool
    isRomanStartOne OrderedListAttributes
    at = (OrderedListAttributes -> OrderedListStyle
    orderedListStyle OrderedListAttributes
    at OrderedListStyle -> OrderedListStyle -> Bool
    forall a. Eq a => a -> a -> Bool
    == OrderedListStyle
    RomanUpper Bool -> Bool -> Bool
    ||
                             OrderedListAttributes -> OrderedListStyle
    orderedListStyle OrderedListAttributes
    at OrderedListStyle -> OrderedListStyle -> Bool
    forall a. Eq a => a -> a -> Bool
    == OrderedListStyle
    RomanLower) Bool -> Bool -> Bool
    &&
                             OrderedListAttributes -> Int
    orderedListStart OrderedListAttributes
    at Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1
       isLettered :: OrderedListAttributes -> Bool
    isLettered OrderedListAttributes
    at = OrderedListAttributes -> OrderedListStyle
    orderedListStyle OrderedListAttributes
    at OrderedListStyle -> OrderedListStyle -> Bool
    forall a. Eq a => a -> a -> Bool
    == OrderedListStyle
    LetterUpper Bool -> Bool -> Bool
    ||
                       OrderedListAttributes -> OrderedListStyle
    orderedListStyle OrderedListAttributes
    at OrderedListStyle -> OrderedListStyle -> Bool
    forall a. Eq a => a -> a -> Bool
    == OrderedListStyle
    LetterLower

    -- | We determine whether a list item ends with a blank line by
    -- comparing its end line with the end line of its last child.
    itemEndsWithBlank :: Container -> Bool
    itemEndsWithBlank :: Container -> Bool
    itemEndsWithBlank Container
    li =
      case Seq Container -> ViewR Container
    forall a. Seq a -> ViewR a
    Seq.viewr (Container -> Seq Container
    containerChildren Container
    li) of
        ViewR Container
    Seq.EmptyR -> Bool
    False
        Seq Container
    _ Seq.:> Container
    lastChild -> Container -> Int
    containerEndLine Container
    li Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Container -> Int
    containerEndLine Container
    lastChild

    -- | We don't count blanks before lists, because
    -- otherwise it would be impossible to have nested tight lists.
    hasChildrenSeparatedWithBlank :: Container -> Bool
    hasChildrenSeparatedWithBlank :: Container -> Bool
    hasChildrenSeparatedWithBlank Container
    cont =
      Seq Bool -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    or (Seq Bool -> Bool) -> Seq Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ (Container -> Container -> Bool)
    -> Seq Container -> Seq Container -> Seq Bool
    forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
    Seq.zipWith Container -> Container -> Bool
    check Seq Container
    children (Int -> Seq Container -> Seq Container
    forall a. Int -> Seq a -> Seq a
    Seq.drop Int
    1 Seq Container
    children)
     where
       children :: Seq Container
    children = (if ListType
    Definition ListType -> [ListType] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [ListType]
    liTypes then Int -> Seq Container -> Seq Container
    forall a. Int -> Seq a -> Seq a
    Seq.drop Int
    1 else Seq Container -> Seq Container
    forall a. a -> a
    id) (Seq Container -> Seq Container) -> Seq Container -> Seq Container
    forall a b. (a -> b) -> a -> b
    $
                      Container -> Seq Container
    containerChildren Container
    cont
       check :: Container -> Container -> Bool
    check Container
    x Container
    y = (BlockSpec -> [Char]
    blockName (Container -> BlockSpec
    containerSpec Container
    y) [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [Char]
    "List") Bool -> Bool -> Bool
    &&
                   (Container -> Int
    containerStartLine Container
    y Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Container -> Int
    containerEndLine Container
    x)
       liTypes :: [ListType]
    liTypes = Container -> [ListType]
    getListTypes Container
    cont

    toDefinition :: Blocks -> (Inlines, Blocks)
    toDefinition :: Blocks -> (Inlines, Blocks)
    toDefinition Blocks
    bs =
      case Seq (Node Block) -> ViewL (Node Block)
    forall a. Seq a -> ViewL a
    Seq.viewl Seq (Node Block)
    bs' of
        Node Pos
    _ Attr
    _ (Para Inlines
    ils) Seq.:< Seq (Node Block)
    _ -> (Inlines
    ils, Seq (Node Block) -> Blocks
    forall a. Seq a -> Many a
    Many (Int -> Seq (Node Block) -> Seq (Node Block)
    forall a. Int -> Seq a -> Seq a
    Seq.drop Int
    1 Seq (Node Block)
    bs'))
        ViewL (Node Block)
    _ -> (Inlines
    forall a. Monoid a => a
    mempty, Blocks
    bs)
      where
       bs' :: Seq (Node Block)
    bs' = Blocks -> Seq (Node Block)
    forall a. Many a -> Seq a
    unMany Blocks
    bs

    sectionSpec :: BlockSpec
    sectionSpec :: BlockSpec
    sectionSpec =
      BlockSpec
      { blockName :: [Char]
    blockName = [Char]
    "Section"
      , blockType :: BlockType
    blockType = BlockType
    Normal
      , blockStart :: P ()
    blockStart = P ()
    forall a. Parser PState a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero  -- these containers are added by headingSpec
      , blockContinue :: Container -> P Bool
    blockContinue = \Container
    _ -> Bool -> P Bool
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True  -- these are closed by headingSpec
      , blockContainsBlock :: Maybe BlockType
    blockContainsBlock = BlockType -> Maybe BlockType
    forall a. a -> Maybe a
    Just BlockType
    Normal
      , blockContainsLines :: Bool
    blockContainsLines = Bool
    False
      , blockClose :: Container -> P Container
    blockClose = \Container
    container -> do
          case Container -> Seq Container
    containerChildren Container
    container of
            Container
    h Seq.:<| Seq Container
    _
              | BlockSpec -> [Char]
    blockName (Container -> BlockSpec
    containerSpec Container
    h) [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    "Heading" -> do
                 let lev :: Int
    lev = case Container -> ContainerData
    containerData Container
    container of
                             SectionData Int
    n Maybe ByteString
    _ -> Int
    n
                             ContainerData
    _ -> [Char] -> Int
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Missing SectionData"
                 let ils :: Inlines
    ils = case Container -> ContainerData
    containerData Container
    h of
                             HeadingData Int
    _ Inlines
    xs -> Inlines
    xs
                             ContainerData
    _ -> [Char] -> Inlines
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Missing HeadingData"
                 (secid, attr, label) <- do
                   let bs :: ByteString
    bs = Inlines -> ByteString
    inlinesToByteString Inlines
    ils
                   let Attr [(ByteString, ByteString)]
    ats = Container -> Attr
    containerAttr Container
    container
                   case ByteString -> [(ByteString, ByteString)] -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup ByteString
    "id" [(ByteString, ByteString)]
    ats of
                     Just ByteString
    id' -> (ByteString, Attr, ByteString)
    -> Parser PState (ByteString, Attr, ByteString)
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ByteString
    id', Attr
    forall a. Monoid a => a
    mempty, ByteString -> ByteString
    normalizeLabel ByteString
    bs)
                     Maybe ByteString
    Nothing -> do -- generate id from title
                       let generateId :: Int -> ByteString -> Parser PState ByteString
    generateId (Int
    n :: Int) ByteString
    base = do
                             let candidate :: ByteString
    candidate
                                   | Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 = ByteString
    base
                                   | Bool
    otherwise = ByteString
    base ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    "-" ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> [Char] -> ByteString
    B8.pack (Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    n)
                             ids <- PState -> Set ByteString
    psIds (PState -> Set ByteString)
    -> Parser PState PState -> Parser PState (Set ByteString)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser PState PState
    forall s. Parser s s
    getState
                             if candidate `Set.member` ids
                                then generateId (n+1) base
                                else do
                                  updateState $ \PState
    st ->
                                    PState
    st{ psIds = Set.insert candidate (psIds st)
                                      , psAutoIds = Set.insert candidate
                                                       (psAutoIds st) }
                                  pure candidate
                       ident <- Int -> ByteString -> Parser PState ByteString
    generateId Int
    0 (ByteString -> ByteString
    toIdentifier ByteString
    bs)
                       pure (ident, mempty, normalizeLabel bs)
                 -- add implicit reference
                 let dest = ByteString
    "#" ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    secid
                 updateState $ \PState
    st -> PState
    st{ psAutoReferenceMap = insertReference label
                                         (dest, Attr []) (psAutoReferenceMap st) }

                 pure container{ containerData =
                                   SectionData lev (Just secid)
                               , containerAttr = containerAttr container <> attr }
            Seq Container
    _ -> Container -> P Container
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Container
    container
      , blockFinalize :: Container -> Blocks
    blockFinalize = \Container
    container ->
          let blocks :: Blocks
    blocks = Container -> Blocks
    finalizeChildren Container
    container
              secid :: Maybe ByteString
    secid = case Container -> ContainerData
    containerData Container
    container of
                        SectionData Int
    _ Maybe ByteString
    ident -> Maybe ByteString
    ident
                        ContainerData
    _ -> [Char] -> Maybe ByteString
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Missing SectionData"
          in Container -> Blocks -> Blocks
    addSourcePos Container
    container (Blocks -> Blocks) -> Blocks -> Blocks
    forall a b. (a -> b) -> a -> b
    $
              (Node Block -> Node Block)
    -> (ByteString -> Node Block -> Node Block)
    -> Maybe ByteString
    -> Node Block
    -> Node Block
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Node Block -> Node Block
    forall a. a -> a
    id (\ByteString
    ident -> Attr -> Node Block -> Node Block
    forall a. Attr -> Node a -> Node a
    addAttr ([(ByteString, ByteString)] -> Attr
    Attr [(ByteString
    "id", ByteString
    ident)])) Maybe ByteString
    secid
               (Node Block -> Node Block) -> Blocks -> Blocks
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Blocks -> Blocks
    section Blocks
    blocks
      }

    blockQuoteSpec :: BlockSpec
    blockQuoteSpec :: BlockSpec
    blockQuoteSpec =
      BlockSpec
      { blockName :: [Char]
    blockName = [Char]
    "BlockQuote"
      , blockType :: BlockType
    blockType = BlockType
    Normal
      , blockStart :: P ()
    blockStart = do
          ind <- Parser PState Int
    forall st. Parser st Int
    sourceColumn
          asciiChar '>'
          followedByWhitespace
          skipMany spaceOrTab
          addContainer blockQuoteSpec ind NoData
      , blockContinue :: Container -> P Bool
    blockContinue = \Container
    _ -> do
          P () -> P ()
    forall s a. Parser s a -> Parser s ()
    skipMany P ()
    forall s. Parser s ()
    spaceOrTab
          Char -> P ()
    forall s. Char -> Parser s ()
    asciiChar Char
    '>'
          P ()
    forall s. Parser s ()
    followedByWhitespace
          Bool -> P Bool
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True
      , blockContainsBlock :: Maybe BlockType
    blockContainsBlock = BlockType -> Maybe BlockType
    forall a. a -> Maybe a
    Just BlockType
    Normal
      , blockContainsLines :: Bool
    blockContainsLines = Bool
    False
      , blockClose :: Container -> P Container
    blockClose = Container -> P Container
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      , blockFinalize :: Container -> Blocks
    blockFinalize = \Container
    container ->
          Container -> Blocks -> Blocks
    addSourcePos Container
    container (Blocks -> Blocks) -> Blocks -> Blocks
    forall a b. (a -> b) -> a -> b
    $ Blocks -> Blocks
    blockQuote (Blocks -> Blocks) -> Blocks -> Blocks
    forall a b. (a -> b) -> a -> b
    $ Container -> Blocks
    finalizeChildren Container
    container
      }

    tableSpec :: BlockSpec
    tableSpec :: BlockSpec
    tableSpec =
      BlockSpec
      { blockName :: [Char]
    blockName = [Char]
    "Table"
      , blockType :: BlockType
    blockType = BlockType
    Normal
      , blockStart :: P ()
    blockStart = do
          P () -> P ()
    forall s a. Parser s a -> Parser s a
    lookahead P ()
    pRawTableRow
          ind <- Parser PState Int
    forall st. Parser st Int
    sourceColumn
          addContainer tableSpec ind (TableData mempty)
      , blockContinue :: Container -> P Bool
    blockContinue = \Container
    container -> do
          P () -> P ()
    forall s a. Parser s a -> Parser s ()
    skipMany P ()
    forall s. Parser s ()
    spaceOrTab
          -- TODO: this is inefficient; we parse the inline contents
          -- twice. Find a better way.
          let parsedBlankOrCaption :: Bool
    parsedBlankOrCaption =
                case Seq Chunk -> ViewR Chunk
    forall a. Seq a -> ViewR a
    Seq.viewr (Container -> Seq Chunk
    containerText Container
    container) of
                  Seq Chunk
    _ Seq.:> Chunk
    c -> Bool -> Bool
    not ((Char -> Bool) -> ByteString -> Bool
    B8.any (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '|') (Chunk -> ByteString
    chunkBytes Chunk
    c))
                  ViewR Chunk
    Seq.EmptyR -> Bool
    False
          (Bool
    True Bool -> P () -> P Bool
    forall a b. a -> Parser PState b -> Parser PState a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ -- if we just parsed a blank or caption line, no more table rows
              (Bool -> P ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Bool
    not Bool
    parsedBlankOrCaption) P () -> P () -> P ()
    forall a b. Parser PState a -> Parser PState b -> Parser PState a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* P () -> P ()
    forall s a. Parser s a -> Parser s a
    lookahead P ()
    pRawTableRow))
          P Bool -> P Bool -> P Bool
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (Bool
    True Bool -> P () -> P Bool
    forall a b. a -> Parser PState b -> Parser PState a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ P ()
    forall s. Parser s ()
    followedByBlankLine)
          P Bool -> P Bool -> P Bool
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (Bool
    True Bool -> P () -> P Bool
    forall a b. a -> Parser PState b -> Parser PState a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$
                (P () -> P ()
    forall s a. Parser s a -> Parser s ()
    skipMany P ()
    forall s. Parser s ()
    spaceOrTab P () -> P () -> P ()
    forall a b. Parser PState a -> Parser PState b -> Parser PState b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> P () -> P ()
    forall s a. Parser s a -> Parser s a
    lookahead (Char -> P ()
    forall s. Char -> Parser s ()
    asciiChar Char
    '^' P () -> P () -> P ()
    forall a b. Parser PState a -> Parser PState b -> Parser PState b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> P ()
    forall s. Parser s ()
    spaceOrTab)))
          P Bool -> P Bool -> P Bool
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (Bool
    True Bool -> P () -> P Bool
    forall a b. a -> Parser PState b -> Parser PState a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Bool -> P ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Bool
    not (Seq Container -> Bool
    forall a. Seq a -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (Container -> Seq Container
    containerChildren Container
    container))))
      , blockContainsBlock :: Maybe BlockType
    blockContainsBlock = BlockType -> Maybe BlockType
    forall a. a -> Maybe a
    Just BlockType
    CaptionBlock
      , blockContainsLines :: Bool
    blockContainsLines = Bool
    True
      , blockClose :: Container -> P Container
    blockClose = \Container
    container -> do
          let lns :: Seq Chunk
    lns = Container -> Seq Chunk
    containerText Container
    container
          rows <- [[Cell]] -> [[Cell]]
    forall a. [a] -> [a]
    reverse ([[Cell]] -> [[Cell]])
    -> (([Align], [[Cell]]) -> [[Cell]])
    -> ([Align], [[Cell]])
    -> [[Cell]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Align], [[Cell]]) -> [[Cell]]
    forall a b. (a, b) -> b
    snd (([Align], [[Cell]]) -> [[Cell]])
    -> Parser PState ([Align], [[Cell]]) -> Parser PState [[Cell]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (([Align], [[Cell]]) -> Chunk -> Parser PState ([Align], [[Cell]]))
    -> ([Align], [[Cell]])
    -> Seq Chunk
    -> Parser PState ([Align], [[Cell]])
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM ([Align], [[Cell]]) -> Chunk -> Parser PState ([Align], [[Cell]])
    parseTableRow ([], []) Seq Chunk
    lns
          pure $ container{ containerData = TableData rows }
      , blockFinalize :: Container -> Blocks
    blockFinalize = \Container
    container ->
          let rows :: [[Cell]]
    rows = case Container -> ContainerData
    containerData Container
    container of
                       TableData [[Cell]]
    rs -> [[Cell]]
    rs
                       ContainerData
    _ -> [Char] -> [[Cell]]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Missing TableData"
              mbCaption :: Maybe Caption
    mbCaption =
                case Seq Container -> ViewR Container
    forall a. Seq a -> ViewR a
    Seq.viewr (Container -> Seq Container
    containerChildren Container
    container) of
                  ViewR Container
    Seq.EmptyR -> Maybe Caption
    forall a. Maybe a
    Nothing
                  Seq Container
    _ Seq.:> Container
    x -> Caption -> Maybe Caption
    forall a. a -> Maybe a
    Just (Caption -> Maybe Caption)
    -> (Blocks -> Caption) -> Blocks -> Maybe Caption
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Blocks -> Caption
    Caption (Blocks -> Maybe Caption) -> Blocks -> Maybe Caption
    forall a b. (a -> b) -> a -> b
    $ BlockSpec -> Container -> Blocks
    blockFinalize (Container -> BlockSpec
    containerSpec Container
    x) Container
    x
          in  Container -> Blocks -> Blocks
    addSourcePos Container
    container (Blocks -> Blocks) -> Blocks -> Blocks
    forall a b. (a -> b) -> a -> b
    $ Maybe Caption -> [[Cell]] -> Blocks
    table Maybe Caption
    mbCaption [[Cell]]
    rows
      }

    parseTableRow :: ([Align], [[Cell]])
                  -> Chunk
                  -> P ([Align], [[Cell]])
    parseTableRow :: ([Align], [[Cell]]) -> Chunk -> Parser PState ([Align], [[Cell]])
    parseTableRow ([Align]
    aligns, [[Cell]]
    rows) Chunk
    chunk =
      case ByteString -> Maybe (Char, ByteString)
    B8.uncons (ByteString -> ByteString
    B8.strip (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Chunk -> ByteString
    chunkBytes Chunk
    chunk) of
        Just (Char
    '|',ByteString
    _) -> do
          res <- [Align] -> Chunk -> P (Either [Align] [Cell])
    pTableCells [Align]
    aligns Chunk
    chunk
          case res of
            Left [Align]
    aligns' -> ([Align], [[Cell]]) -> Parser PState ([Align], [[Cell]])
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([Align]
    aligns',
                                   case [[Cell]]
    rows of
                                     [Cell]
    r:[[Cell]]
    rs -> (Align -> Cell -> Cell) -> [Align] -> [Cell] -> [Cell]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Align -> Cell -> Cell
    toHeadCell [Align]
    aligns' [Cell]
    r [Cell] -> [[Cell]] -> [[Cell]]
    forall a. a -> [a] -> [a]
    : [[Cell]]
    rs
                                     [] -> [] )
            Right [Cell]
    cells -> ([Align], [[Cell]]) -> Parser PState ([Align], [[Cell]])
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([Align]
    aligns, [Cell]
    cells [Cell] -> [[Cell]] -> [[Cell]]
    forall a. a -> [a] -> [a]
    : [[Cell]]
    rows)
        Maybe (Char, ByteString)
    Nothing -> ([Align], [[Cell]]) -> Parser PState ([Align], [[Cell]])
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([Align]
    aligns, [[Cell]]
    rows)
        Just (Char
    _,ByteString
    _) -> Parser PState ([Align], [[Cell]])
    forall a. Parser PState a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
     where
       toHeadCell :: Align -> Cell -> Cell
    toHeadCell Align
    align' (Cell CellType
    _ Align
    _ Inlines
    ils) = CellType -> Align -> Inlines -> Cell
    Cell CellType
    HeadCell Align
    align' Inlines
    ils

    pTableCells :: [Align] -> Chunk -> P (Either [Align] [Cell])
    pTableCells :: [Align] -> Chunk -> P (Either [Align] [Cell])
    pTableCells [Align]
    aligns Chunk
    chunk =
      case Parser () [Align] -> () -> [Chunk] -> Maybe [Align]
    forall s a. Parser s a -> s -> [Chunk] -> Maybe a
    parse Parser () [Align]
    pTableSeps () [Chunk
    chunk] of
        Just [Align]
    aligns' -> Either [Align] [Cell] -> P (Either [Align] [Cell])
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either [Align] [Cell] -> P (Either [Align] [Cell]))
    -> Either [Align] [Cell] -> P (Either [Align] [Cell])
    forall a b. (a -> b) -> a -> b
    $ [Align] -> Either [Align] [Cell]
    forall a b. a -> Either a b
    Left [Align]
    aligns'
        Maybe [Align]
    Nothing -> do
          opts <- PState -> ParseOptions
    psParseOptions (PState -> ParseOptions)
    -> Parser PState PState -> Parser PState ParseOptions
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser PState PState
    forall s. Parser s s
    getState
          case parseTableCells opts chunk of
            Right [Inlines]
    cs ->
              Either [Align] [Cell] -> P (Either [Align] [Cell])
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either [Align] [Cell] -> P (Either [Align] [Cell]))
    -> Either [Align] [Cell] -> P (Either [Align] [Cell])
    forall a b. (a -> b) -> a -> b
    $ [Cell] -> Either [Align] [Cell]
    forall a b. b -> Either a b
    Right ([Cell] -> Either [Align] [Cell])
    -> [Cell] -> Either [Align] [Cell]
    forall a b. (a -> b) -> a -> b
    $
                (Align -> Inlines -> Cell) -> [Align] -> [Inlines] -> [Cell]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (CellType -> Align -> Inlines -> Cell
    Cell CellType
    BodyCell) ([Align]
    aligns [Align] -> [Align] -> [Align]
    forall a. [a] -> [a] -> [a]
    ++ Align -> [Align]
    forall a. a -> [a]
    repeat Align
    AlignDefault) [Inlines]
    cs
            Left [Char]
    _ -> P (Either [Align] [Cell])
    forall a. Parser PState a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero

    pTableSeps :: Parser () [Align]
    pTableSeps :: Parser () [Align]
    pTableSeps = do
      Parser () () -> Parser () ()
    forall s a. Parser s a -> Parser s ()
    skipMany Parser () ()
    forall s. Parser s ()
    spaceOrTab
      Char -> Parser () ()
    forall s. Char -> Parser s ()
    asciiChar Char
    '|'
      Parser () Align -> Parser () [Align]
    forall a. Parser () a -> Parser () [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many Parser () Align
    forall {s}. Parser s Align
    pTableSep Parser () [Align] -> Parser () () -> Parser () [Align]
    forall a b. Parser () a -> Parser () b -> Parser () a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser () () -> Parser () ()
    forall s a. Parser s a -> Parser s ()
    skipMany Parser () ()
    forall s. Parser s ()
    ws Parser () [Align] -> Parser () () -> Parser () [Align]
    forall a b. Parser () a -> Parser () b -> Parser () a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser () ()
    forall s. Parser s ()
    eof
     where
       pTableSep :: Parser s Align
    pTableSep = do
         Parser s () -> Parser s ()
    forall s a. Parser s a -> Parser s ()
    skipMany Parser s ()
    forall s. Parser s ()
    spaceOrTab
         start <- (Bool
    True Bool -> Parser s () -> Parser s Bool
    forall a b. a -> Parser s b -> Parser s a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Char -> Parser s ()
    forall s. Char -> Parser s ()
    asciiChar Char
    ':') Parser s Bool -> Parser s Bool -> Parser s Bool
    forall a. Parser s a -> Parser s a -> Parser s a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Bool -> Parser s Bool
    forall a. a -> Parser s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
         skipSome (asciiChar '-')
         end <- (True <$ asciiChar ':') <|> pure False
         skipMany spaceOrTab
         asciiChar '|'
         pure $ case (start, end) of
                  (Bool
    True, Bool
    True) -> Align
    AlignCenter
                  (Bool
    True, Bool
    False) -> Align
    AlignLeft
                  (Bool
    False, Bool
    True) -> Align
    AlignRight
                  (Bool
    False, Bool
    False) -> Align
    AlignDefault

    pRawTableRow :: P ()
    pRawTableRow :: P ()
    pRawTableRow = do
      P () -> P ()
    forall s a. Parser s a -> Parser s a
    lookahead (P () -> P ()) -> P () -> P ()
    forall a b. (a -> b) -> a -> b
    $ Char -> P ()
    forall s. Char -> Parser s ()
    asciiChar Char
    '|'
      curline <- Parser PState Int
    forall st. Parser st Int
    sourceLine
      curcolumn <- sourceColumn
      bs <- restOfLine
      void $ parseTableRow ([],[]) Chunk{ chunkLine = curline
                                        , chunkColumn = curcolumn
                                        , chunkBytes = bs }

    captionSpec :: BlockSpec
    captionSpec :: BlockSpec
    captionSpec =
      BlockSpec
      { blockName :: [Char]
    blockName = [Char]
    "Caption"
      , blockType :: BlockType
    blockType = BlockType
    CaptionBlock
      , blockStart :: P ()
    blockStart = do
          ind <- Parser PState Int
    forall st. Parser st Int
    sourceColumn
          asciiChar '^'
          void spaceOrTab
          addContainer captionSpec ind $ CaptionData ind
      , blockContinue :: Container -> P Bool
    blockContinue = \Container
    container -> (do
          P () -> P ()
    forall s a. Parser s a -> Parser s ()
    skipMany P ()
    forall s. Parser s ()
    spaceOrTab
          curind <- Parser PState Int
    forall st. Parser st Int
    sourceColumn
          let ind = case Container -> ContainerData
    containerData Container
    container of
                      CaptionData Int
    i -> Int
    i
                      ContainerData
    _ -> [Char] -> Int
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Missing CaptionData"
          guard (curind > ind) <|> followedByBlankLine
          pure True) P Bool -> P Bool -> P Bool
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Bool -> P Bool
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
      , blockContainsBlock :: Maybe BlockType
    blockContainsBlock = BlockType -> Maybe BlockType
    forall a. a -> Maybe a
    Just BlockType
    Normal
      , blockContainsLines :: Bool
    blockContainsLines = Bool
    False
      , blockClose :: Container -> P Container
    blockClose = Container -> P Container
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      , blockFinalize :: Container -> Blocks
    blockFinalize = Container -> Blocks
    finalizeChildren
      }

    thematicBreakSpec :: BlockSpec
    thematicBreakSpec :: BlockSpec
    thematicBreakSpec =
      BlockSpec
      { blockName :: [Char]
    blockName = [Char]
    "ThematicBreak"
      , blockType :: BlockType
    blockType = BlockType
    Normal
      , blockStart :: P ()
    blockStart = do
          let breakChar :: Parser s ()
    breakChar = (Char -> Bool) -> Parser s ()
    forall s. (Char -> Bool) -> Parser s ()
    skipSatisfyByte (\Char
    c -> Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '-' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '*')
                            Parser s () -> Parser s () -> Parser s ()
    forall a b. Parser s a -> Parser s b -> Parser s b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser s () -> Parser s ()
    forall s a. Parser s a -> Parser s ()
    skipMany Parser s ()
    forall s. Parser s ()
    spaceOrTab
          ind <- Parser PState Int
    forall st. Parser st Int
    sourceColumn
          breakChar *> breakChar *> breakChar *> skipMany breakChar
          lookahead endline
          addContainer thematicBreakSpec ind NoData
      , blockContinue :: Container -> P Bool
    blockContinue = \Container
    _ -> Bool -> P Bool
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
      , blockContainsBlock :: Maybe BlockType
    blockContainsBlock = Maybe BlockType
    forall a. Maybe a
    Nothing
      , blockContainsLines :: Bool
    blockContainsLines = Bool
    True
      , blockClose :: Container -> P Container
    blockClose = Container -> P Container
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      , blockFinalize :: Container -> Blocks
    blockFinalize = \Container
    container -> Container -> Blocks -> Blocks
    addSourcePos Container
    container Blocks
    thematicBreak
      }

    headingSpec :: BlockSpec
    headingSpec :: BlockSpec
    headingSpec =
      BlockSpec
      { blockName :: [Char]
    blockName = [Char]
    "Heading"
      , blockType :: BlockType
    blockType = BlockType
    Normal
      , blockStart :: P ()
    blockStart = do
          ind <- Parser PState Int
    forall st. Parser st Int
    sourceColumn
          lev <- length <$> some (asciiChar '#')
          followedByWhitespace
          skipMany spaceOrTab
          closeContainingSections lev
          addContainer sectionSpec ind $ SectionData lev Nothing
          addContainer headingSpec ind $ HeadingData lev mempty
      , blockContinue :: Container -> P Bool
    blockContinue = \Container
    container -> do
           do P () -> P ()
    forall s a. Parser s a -> Parser s ()
    skipMany P ()
    forall s. Parser s ()
    spaceOrTab
              let lev :: Int
    lev = case Container -> ContainerData
    containerData Container
    container of
                          HeadingData Int
    n Inlines
    _ -> Int
    n
                          ContainerData
    _ -> [Char] -> Int
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Missing HeadingData"
              (Bool
    True Bool -> P () -> P Bool
    forall a b. a -> Parser PState b -> Parser PState a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ (do lev' <- [()] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([()] -> Int) -> Parser PState [()] -> Parser PState Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> P () -> Parser PState [()]
    forall a. Parser PState a -> Parser PState [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    some (Char -> P ()
    forall s. Char -> Parser s ()
    asciiChar Char
    '#')
                           guard (lev' == lev)
                           skipMany spaceOrTab))
                P Bool -> P Bool -> P Bool
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (Bool
    False Bool -> P () -> P Bool
    forall a b. a -> Parser PState b -> Parser PState a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ do
                        P () -> P ()
    forall s a. Parser s a -> Parser s a
    lookahead (Char -> P ()
    forall s. Char -> Parser s ()
    asciiChar Char
    '#' P () -> P () -> P ()
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> P ()
    forall s. Parser s ()
    endline P () -> P () -> P ()
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> P ()
    forall s. Parser s ()
    eof))
                P Bool -> P Bool -> P Bool
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Bool -> P Bool
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True
      , blockContainsBlock :: Maybe BlockType
    blockContainsBlock = Maybe BlockType
    forall a. Maybe a
    Nothing
      , blockContainsLines :: Bool
    blockContainsLines = Bool
    True
      , blockClose :: Container -> P Container
    blockClose = \Container
    container -> do
          ils <- Container -> P Inlines
    parseTextLines Container
    container
          let lev = case Container -> ContainerData
    containerData Container
    container of
                      HeadingData Int
    n Inlines
    _ -> Int
    n
                      ContainerData
    _ -> [Char] -> Int
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Missing HeadingData"
          pure $ container{ containerData = HeadingData lev ils }
      , blockFinalize :: Container -> Blocks
    blockFinalize = \Container
    container ->
          let (Int
    lev, Inlines
    title) =
                case Container -> ContainerData
    containerData Container
    container of
                  HeadingData Int
    l Inlines
    t -> (Int
    l, Inlines
    t)
                  ContainerData
    _ -> [Char] -> (Int, Inlines)
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Missing HeadingData"
          in  Container -> Blocks -> Blocks
    addSourcePos Container
    container (Blocks -> Blocks) -> Blocks -> Blocks
    forall a b. (a -> b) -> a -> b
    $ Int -> Inlines -> Blocks
    heading Int
    lev Inlines
    title
      }

    codeBlockSpec :: BlockSpec
    codeBlockSpec :: BlockSpec
    codeBlockSpec =
      BlockSpec
      { blockName :: [Char]
    blockName = [Char]
    "CodeBlock"
      , blockType :: BlockType
    blockType = BlockType
    Normal
      , blockStart :: P ()
    blockStart = do
          indent <- Parser PState Int
    forall st. Parser st Int
    sourceColumn
          ticks <- byteStringOf $ asciiChar '`' *> asciiChar '`' *> skipSome (asciiChar '`')
          skipMany spaceOrTab
          lang <- (byteStringOf
                     (skipSome $ skipSatisfyByte (\Char
    c -> Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '`' Bool -> Bool -> Bool
    && Bool -> Bool
    not (Char -> Bool
    isWs Char
    c)))
                      <* skipMany spaceOrTab)
                 <|> pure ""
          lookahead endline
          addContainer codeBlockSpec indent (CodeBlockData ticks lang indent)
      , blockContinue :: Container -> P Bool
    blockContinue = \Container
    container -> do
          let (ByteString
    ticks, Int
    indent) = case Container -> ContainerData
    containerData Container
    container of
                                  CodeBlockData ByteString
    t ByteString
    _ Int
    i -> (ByteString
    t, Int
    i)
                                  ContainerData
    _ -> [Char] -> (ByteString, Int)
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Missing CodeBlockData"
          Int -> P ()
    gobbleSpaceToIndent Int
    indent
          (do P () -> P ()
    forall s a. Parser s a -> Parser s ()
    skipMany P ()
    forall s. Parser s ()
    spaceOrTab
              ByteString -> P ()
    forall s. ByteString -> Parser s ()
    byteString ByteString
    ticks
              P () -> P ()
    forall s a. Parser s a -> Parser s ()
    skipMany (Char -> P ()
    forall s. Char -> Parser s ()
    asciiChar Char
    '`')
              P () -> P ()
    forall s a. Parser s a -> Parser s ()
    skipMany P ()
    forall s. Parser s ()
    spaceOrTab
              P () -> P ()
    forall s a. Parser s a -> Parser s a
    lookahead P ()
    forall s. Parser s ()
    endline
              Bool -> P Bool
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False)
            P Bool -> P Bool -> P Bool
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Bool -> P Bool
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True
      , blockContainsBlock :: Maybe BlockType
    blockContainsBlock = Maybe BlockType
    forall a. Maybe a
    Nothing
      , blockContainsLines :: Bool
    blockContainsLines = Bool
    True
      , blockClose :: Container -> P Container
    blockClose = Container -> P Container
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      , blockFinalize :: Container -> Blocks
    blockFinalize = \Container
    container ->
          let lang :: ByteString
    lang = case Container -> ContainerData
    containerData Container
    container of
                       CodeBlockData ByteString
    _ ByteString
    l Int
    _ -> ByteString
    l
                       ContainerData
    _ -> [Char] -> ByteString
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Missing CodeBlockData"
          -- drop first line which should be empty
              bs :: ByteString
    bs = (Chunk -> ByteString) -> Seq Chunk -> ByteString
    forall m a. Monoid m => (a -> m) -> Seq a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Chunk -> ByteString
    chunkBytes (Int -> Seq Chunk -> Seq Chunk
    forall a. Int -> Seq a -> Seq a
    Seq.drop Int
    1 (Seq Chunk -> Seq Chunk) -> Seq Chunk -> Seq Chunk
    forall a b. (a -> b) -> a -> b
    $ Container -> Seq Chunk
    containerText Container
    container)
          in  Container -> Blocks -> Blocks
    addSourcePos Container
    container (Blocks -> Blocks) -> Blocks -> Blocks
    forall a b. (a -> b) -> a -> b
    $
              case ByteString -> Maybe (Char, ByteString)
    B8.uncons ByteString
    lang of
                Just (Char
    '=', ByteString
    fmt) -> Format -> ByteString -> Blocks
    rawBlock (ByteString -> Format
    Format ByteString
    fmt) ByteString
    bs
                Maybe (Char, ByteString)
    _ -> ByteString -> ByteString -> Blocks
    codeBlock ByteString
    lang ByteString
    bs
      }

    divSpec :: BlockSpec
    divSpec :: BlockSpec
    divSpec =
      BlockSpec
      { blockName :: [Char]
    blockName = [Char]
    "Div"
      , blockType :: BlockType
    blockType = BlockType
    Normal
      , blockStart :: P ()
    blockStart = do
          ind <- Parser PState Int
    forall st. Parser st Int
    sourceColumn
          colons <- byteStringOf $
            asciiChar ':' *> asciiChar ':' *> skipSome (asciiChar ':')
          skipMany spaceOrTab
          label <- byteStringOf $ skipMany $ skipSatisfyByte (not . isWs)
          skipMany spaceOrTab
          lookahead endline
          addContainer divSpec ind (DivData colons label)
      , blockContinue :: Container -> P Bool
    blockContinue = \Container
    container -> (do
          tip <- P Container
    getTip
          -- see jgm/djot.js#109
          guard $ blockName (containerSpec tip) /= "CodeBlock"
          skipMany spaceOrTab
          let colons = case Container -> ContainerData
    containerData Container
    container of
                         DivData ByteString
    c ByteString
    _ -> ByteString
    c
                         ContainerData
    _ -> [Char] -> ByteString
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Missing DivData"
          byteString colons
          skipMany (asciiChar ':')
          skipMany spaceOrTab
          lookahead endline
          pure False) P Bool -> P Bool -> P Bool
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Bool -> P Bool
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True
      , blockContainsBlock :: Maybe BlockType
    blockContainsBlock = BlockType -> Maybe BlockType
    forall a. a -> Maybe a
    Just BlockType
    Normal
      , blockContainsLines :: Bool
    blockContainsLines = Bool
    False
      , blockClose :: Container -> P Container
    blockClose = Container -> P Container
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      , blockFinalize :: Container -> Blocks
    blockFinalize = \Container
    container ->
          let label :: ByteString
    label = case Container -> ContainerData
    containerData Container
    container of
                         DivData ByteString
    _ ByteString
    l -> ByteString
    l
                         ContainerData
    _ -> [Char] -> ByteString
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Missing DivData"
          -- drop first line which should be empty
              bls :: Blocks
    bls = Container -> Blocks
    finalizeChildren Container
    container
          in  (if ByteString -> Bool
    B.null ByteString
    label
                  then Node Block -> Node Block
    forall a. a -> a
    id
                  else Attr -> Node Block -> Node Block
    forall a. Attr -> Node a -> Node a
    addAttr ([(ByteString, ByteString)] -> Attr
    Attr [(ByteString
    "class", ByteString
    label)])) (Node Block -> Node Block) -> Blocks -> Blocks
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
              Container -> Blocks -> Blocks
    addSourcePos Container
    container (Blocks -> Blocks
    div Blocks
    bls)
      }

    attrSpec :: BlockSpec
    attrSpec :: BlockSpec
    attrSpec =
      BlockSpec
      { blockName :: [Char]
    blockName = [Char]
    "Attributes"
      , blockType :: BlockType
    blockType = BlockType
    Normal
      , blockStart :: P ()
    blockStart = do
          ind <- Parser PState Int
    forall st. Parser st Int
    sourceColumn
          lookahead $ asciiChar '{'
          addContainer attrSpec ind $ AttributeData ind
      , blockContinue :: Container -> P Bool
    blockContinue = \Container
    container -> do
          let ind :: Int
    ind = case Container -> ContainerData
    containerData Container
    container of
                      AttributeData Int
    i -> Int
    i
                      ContainerData
    _ -> [Char] -> Int
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Missing AttributeData"
          P () -> P ()
    forall s a. Parser s a -> Parser s ()
    skipMany P ()
    forall s. Parser s ()
    spaceOrTab
          curind <- Parser PState Int
    forall st. Parser st Int
    sourceColumn
          mbapstate <- psAttrParserState <$> getState
          if curind <= ind
             then pure False
             else do
               let lastLine = case Seq Chunk -> ViewR Chunk
    forall a. Seq a -> ViewR a
    Seq.viewr (Container -> Seq Chunk
    containerText Container
    container) of
                                 Seq Chunk
    _ Seq.:> Chunk
    ll -> Chunk -> ByteString
    chunkBytes Chunk
    ll
                                 ViewR Chunk
    _ -> ByteString
    forall a. Monoid a => a
    mempty
               case parseAttributes mbapstate lastLine of
                 Done (Attr, Int)
    _ -> Bool -> P Bool
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
                 Partial AttrParserState
    apstate' -> do
                   (PState -> PState) -> P ()
    forall s. (s -> s) -> Parser s ()
    updateState ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
    forall a b. (a -> b) -> a -> b
    $ \PState
    st -> PState
    st{ psAttrParserState = Just apstate' }
                   Bool -> P Bool
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True
                 Failed Int
    _ -> Bool -> P Bool
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True -- not yet: keep going!
      , blockContainsBlock :: Maybe BlockType
    blockContainsBlock = Maybe BlockType
    forall a. Maybe a
    Nothing
      , blockContainsLines :: Bool
    blockContainsLines = Bool
    True
      , blockClose :: Container -> P Container
    blockClose = \Container
    container -> do
          let bs :: ByteString
    bs = (Chunk -> ByteString) -> Seq Chunk -> ByteString
    forall m a. Monoid m => (a -> m) -> Seq a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Chunk -> ByteString
    chunkBytes (Seq Chunk -> ByteString) -> Seq Chunk -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Container -> Seq Chunk
    containerText Container
    container
          case Maybe AttrParserState -> ByteString -> AttrParseResult
    parseAttributes Maybe AttrParserState
    forall a. Maybe a
    Nothing ByteString
    bs of
            Done (Attr
    attr, Int
    off)
              | (Char -> Bool) -> ByteString -> Bool
    B8.all Char -> Bool
    isWs (Int -> ByteString -> ByteString
    B8.drop Int
    off ByteString
    bs) -> do
                 (PState -> PState) -> P ()
    forall s. (s -> s) -> Parser s ()
    updateState ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
    forall a b. (a -> b) -> a -> b
    $ \PState
    st -> PState
    st{ psAttributes = psAttributes st <> attr }
                 Container -> P Container
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Container
    container
              | Bool
    otherwise -> do
                 ils <- Container -> P Inlines
    parseTextLines Container
    container
                 pure $ container{ containerSpec = paraSpec
                                 , containerInlines = ils }
            AttrParseResult
    _ -> do  -- could not parse lines as attribute, treat as Para
              ils <- Container -> P Inlines
    parseTextLines Container
    container
              pure $ container{ containerSpec = paraSpec
                              , containerInlines = ils }
      , blockFinalize :: Container -> Blocks
    blockFinalize = Blocks -> Container -> Blocks
    forall a b. a -> b -> a
    const Blocks
    forall a. Monoid a => a
    mempty
      }

    referenceDefinitionSpec :: BlockSpec
    referenceDefinitionSpec :: BlockSpec
    referenceDefinitionSpec =
      BlockSpec
      { blockName :: [Char]
    blockName = [Char]
    "ReferenceDefinition"
      , blockType :: BlockType
    blockType = BlockType
    Normal
      , blockStart :: P ()
    blockStart = do
          ind <- Parser PState Int
    forall st. Parser st Int
    sourceColumn
          asciiChar '['
          fails (asciiChar '^') -- footnote
          label <- byteStringOf
                    (some (skipSatisfyByte (\Char
    c -> Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ']' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\n')))
          asciiChar ']'
          asciiChar ':'
          skipMany spaceOrTab
          addContainer referenceDefinitionSpec ind
            (ReferenceData (normalizeLabel label))
      , blockContinue :: Container -> P Bool
    blockContinue = \Container
    _ ->
          Bool
    True Bool -> P () -> P Bool
    forall a b. a -> Parser PState b -> Parser PState a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ P () -> P ()
    forall s a. Parser s a -> Parser s ()
    skipSome P ()
    forall s. Parser s ()
    spaceOrTab P () -> P () -> P ()
    forall s a b. Parser s a -> Parser s b -> Parser s a
    `notFollowedBy` P ()
    forall s. Parser s ()
    endline
      , blockContainsBlock :: Maybe BlockType
    blockContainsBlock = Maybe BlockType
    forall a. Maybe a
    Nothing
      , blockContainsLines :: Bool
    blockContainsLines = Bool
    True
      , blockClose :: Container -> P Container
    blockClose = \Container
    container -> do
          let label :: ByteString
    label = case Container -> ContainerData
    containerData Container
    container of
                        ReferenceData ByteString
    l -> ByteString
    l
                        ContainerData
    _ -> [Char] -> ByteString
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Missing ReferenceData"
          let attr :: Attr
    attr = Container -> Attr
    containerAttr Container
    container
          let dest :: ByteString
    dest = (Word8 -> Bool) -> ByteString -> ByteString
    B.filter (Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word8
    32) (ByteString -> ByteString)
    -> (Seq Chunk -> ByteString) -> Seq Chunk -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Chunk -> ByteString) -> Seq Chunk -> ByteString
    forall m a. Monoid m => (a -> m) -> Seq a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Chunk -> ByteString
    chunkBytes (Seq Chunk -> ByteString) -> Seq Chunk -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Container -> Seq Chunk
    containerText Container
    container
          (PState -> PState) -> P ()
    forall s. (s -> s) -> Parser s ()
    updateState ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
    forall a b. (a -> b) -> a -> b
    $ \PState
    st ->
            PState
    st{ psReferenceMap = insertReference label (dest, attr)
                                     (psReferenceMap st) }
          Container -> P Container
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Container
    container
      , blockFinalize :: Container -> Blocks
    blockFinalize = Blocks -> Container -> Blocks
    forall a b. a -> b -> a
    const Blocks
    forall a. Monoid a => a
    mempty
      }

    footnoteSpec :: BlockSpec
    footnoteSpec :: BlockSpec
    footnoteSpec =
      BlockSpec
      { blockName :: [Char]
    blockName = [Char]
    "Footnote"
      , blockType :: BlockType
    blockType = BlockType
    Normal
      , blockStart :: P ()
    blockStart = do
          ind <- Parser PState Int
    forall st. Parser st Int
    sourceColumn
          asciiChar '['
          asciiChar '^'
          label <- byteStringOf
                    (some (skipSatisfyByte (\Char
    c -> Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ']' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\n')))
          asciiChar ']'
          asciiChar ':'
          skipMany spaceOrTab
          addContainer footnoteSpec ind $ FootnoteData ind (normalizeLabel label)
      , blockContinue :: Container -> P Bool
    blockContinue = \Container
    container -> (do
          P () -> P ()
    forall s a. Parser s a -> Parser s ()
    skipMany P ()
    forall s. Parser s ()
    spaceOrTab
          curind <- Parser PState Int
    forall st. Parser st Int
    sourceColumn
          let ind = case Container -> ContainerData
    containerData Container
    container of
                      FootnoteData Int
    i ByteString
    _ -> Int
    i
                      ContainerData
    _ -> [Char] -> Int
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Missing FootnoteData"
          guard (curind > ind) <|> followedByBlankLine
          pure True) P Bool -> P Bool -> P Bool
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Bool -> P Bool
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
      , blockContainsBlock :: Maybe BlockType
    blockContainsBlock = BlockType -> Maybe BlockType
    forall a. a -> Maybe a
    Just BlockType
    Normal
      , blockContainsLines :: Bool
    blockContainsLines = Bool
    True
      , blockClose :: Container -> P Container
    blockClose = \Container
    container -> do
          let label :: ByteString
    label = case Container -> ContainerData
    containerData Container
    container of
                         FootnoteData Int
    _ ByteString
    l -> ByteString
    l
                         ContainerData
    _ -> [Char] -> ByteString
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Missing FootnoteData"
          let bls :: Blocks
    bls = Container -> Blocks
    finalizeChildren Container
    container
          (PState -> PState) -> P ()
    forall s. (s -> s) -> Parser s ()
    updateState ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
    forall a b. (a -> b) -> a -> b
    $ \PState
    st -> PState
    st{ psNoteMap = insertNote label bls (psNoteMap st) }
          Container -> P Container
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Container
    container
      , blockFinalize :: Container -> Blocks
    blockFinalize = Blocks -> Container -> Blocks
    forall a b. a -> b -> a
    const Blocks
    forall a. Monoid a => a
    mempty
      }

    paraSpec :: BlockSpec
    paraSpec :: BlockSpec
    paraSpec =
      BlockSpec
      { blockName :: [Char]
    blockName = [Char]
    "Para"
      , blockType :: BlockType
    blockType = BlockType
    Normal
      , blockStart :: P ()
    blockStart = do
          P () -> P ()
    forall s a. Parser s a -> Parser s ()
    fails P ()
    forall s. Parser s ()
    followedByBlankLine
          ind <- Parser PState Int
    forall st. Parser st Int
    sourceColumn
          addContainer paraSpec ind NoData
      , blockContinue :: Container -> P Bool
    blockContinue = \Container
    _ -> do
          P () -> P ()
    forall s a. Parser s a -> Parser s ()
    skipMany P ()
    forall s. Parser s ()
    spaceOrTab
          (Bool
    False Bool -> P () -> P Bool
    forall a b. a -> Parser PState b -> Parser PState a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ P () -> P ()
    forall s a. Parser s a -> Parser s a
    lookahead (P ()
    forall s. Parser s ()
    endline P () -> P () -> P ()
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> P ()
    forall s. Parser s ()
    eof)) P Bool -> P Bool -> P Bool
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Bool -> P Bool
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True
      , blockContainsBlock :: Maybe BlockType
    blockContainsBlock = Maybe BlockType
    forall a. Maybe a
    Nothing
      , blockContainsLines :: Bool
    blockContainsLines = Bool
    True
      , blockClose :: Container -> P Container
    blockClose = \Container
    container -> do
          ils <- Container -> P Inlines
    parseTextLines Container
    container
          pure $ container{ containerInlines = ils }
      , blockFinalize :: Container -> Blocks
    blockFinalize = \Container
    container ->
          Container -> Blocks -> Blocks
    addSourcePos Container
    container (Blocks -> Blocks) -> (Inlines -> Blocks) -> Inlines -> Blocks
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Inlines -> Blocks
    para (Inlines -> Blocks) -> Inlines -> Blocks
    forall a b. (a -> b) -> a -> b
    $ Container -> Inlines
    containerInlines Container
    container
      }

    parseTextLines :: Container -> P Inlines
    parseTextLines :: Container -> P Inlines
    parseTextLines Container
    cont = do
      opts <- PState -> ParseOptions
    psParseOptions (PState -> ParseOptions)
    -> Parser PState PState -> Parser PState ParseOptions
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser PState PState
    forall s. Parser s s
    getState
      either error pure . parseInlines opts $ containerText cont

    emptyContainer :: Container
    emptyContainer :: Container
    emptyContainer =
      Container { containerSpec :: BlockSpec
    containerSpec = BlockSpec
    docSpec
                , containerChildren :: Seq Container
    containerChildren = Seq Container
    forall a. Monoid a => a
    mempty
                , containerText :: Seq Chunk
    containerText = Seq Chunk
    forall a. Monoid a => a
    mempty
                , containerInlines :: Inlines
    containerInlines = Inlines
    forall a. Monoid a => a
    mempty
                , containerStartLine :: Int
    containerStartLine = Int
    1
                , containerStartColumn :: Int
    containerStartColumn = Int
    0
                , containerEndLine :: Int
    containerEndLine = Int
    1
                , containerEndColumn :: Int
    containerEndColumn = Int
    0
                , containerData :: ContainerData
    containerData = ContainerData
    NoData
                , containerAttr :: Attr
    containerAttr = Attr
    forall a. Monoid a => a
    mempty
                , containerSourcePos :: Bool
    containerSourcePos = Bool
    False
                }

    data Container =
      Container
      { Container -> BlockSpec
    containerSpec      :: BlockSpec
      , Container -> Seq Container
    containerChildren  :: Seq Container
      , Container -> Seq Chunk
    containerText :: Seq Chunk
      , Container -> Inlines
    containerInlines :: Inlines
      , Container -> Int
    containerStartLine :: Int
      , Container -> Int
    containerStartColumn :: Int
      , Container -> Int
    containerEndLine :: Int
      , Container -> Int
    containerEndColumn :: Int
      , Container -> ContainerData
    containerData :: ContainerData
      , Container -> Attr
    containerAttr :: Attr
      , Container -> Bool
    containerSourcePos :: Bool
      }

    data ContainerData =
        NoData
      | ListItemData Int [ListType] Bool
      | SectionData Int (Maybe ByteString)
      | HeadingData Int Inlines
      | CodeBlockData ByteString ByteString Int
      | DivData ByteString ByteString
      | FootnoteData Int ByteString
      | TableData [[Cell]]
      | CaptionData Int
      | AttributeData Int
      | ReferenceData ByteString
      deriving (Int -> ContainerData -> [Char] -> [Char]
    [ContainerData] -> [Char] -> [Char]
    ContainerData -> [Char]
    (Int -> ContainerData -> [Char] -> [Char])
    -> (ContainerData -> [Char])
    -> ([ContainerData] -> [Char] -> [Char])
    -> Show ContainerData
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: Int -> ContainerData -> [Char] -> [Char]
    showsPrec :: Int -> ContainerData -> [Char] -> [Char]
    $cshow :: ContainerData -> [Char]
    show :: ContainerData -> [Char]
    $cshowList :: [ContainerData] -> [Char] -> [Char]
    showList :: [ContainerData] -> [Char] -> [Char]
    Show, ContainerData -> ContainerData -> Bool
    (ContainerData -> ContainerData -> Bool)
    -> (ContainerData -> ContainerData -> Bool) -> Eq ContainerData
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ContainerData -> ContainerData -> Bool
    == :: ContainerData -> ContainerData -> Bool
    $c/= :: ContainerData -> ContainerData -> Bool
    /= :: ContainerData -> ContainerData -> Bool
    Eq, Eq ContainerData
    Eq ContainerData =>
    (ContainerData -> ContainerData -> Ordering)
    -> (ContainerData -> ContainerData -> Bool)
    -> (ContainerData -> ContainerData -> Bool)
    -> (ContainerData -> ContainerData -> Bool)
    -> (ContainerData -> ContainerData -> Bool)
    -> (ContainerData -> ContainerData -> ContainerData)
    -> (ContainerData -> ContainerData -> ContainerData)
    -> Ord ContainerData
    ContainerData -> ContainerData -> Bool
    ContainerData -> ContainerData -> Ordering
    ContainerData -> ContainerData -> ContainerData
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: ContainerData -> ContainerData -> Ordering
    compare :: ContainerData -> ContainerData -> Ordering
    $c< :: ContainerData -> ContainerData -> Bool
    < :: ContainerData -> ContainerData -> Bool
    $c<= :: ContainerData -> ContainerData -> Bool
    <= :: ContainerData -> ContainerData -> Bool
    $c> :: ContainerData -> ContainerData -> Bool
    > :: ContainerData -> ContainerData -> Bool
    $c>= :: ContainerData -> ContainerData -> Bool
    >= :: ContainerData -> ContainerData -> Bool
    $cmax :: ContainerData -> ContainerData -> ContainerData
    max :: ContainerData -> ContainerData -> ContainerData
    $cmin :: ContainerData -> ContainerData -> ContainerData
    min :: ContainerData -> ContainerData -> ContainerData
    Ord, Typeable)

    data ListType =
        Bullet Char
      | Ordered OrderedListAttributes
      | Definition
      | Task TaskStatus
      deriving (Int -> ListType -> [Char] -> [Char]
    [ListType] -> [Char] -> [Char]
    ListType -> [Char]
    (Int -> ListType -> [Char] -> [Char])
    -> (ListType -> [Char])
    -> ([ListType] -> [Char] -> [Char])
    -> Show ListType
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: Int -> ListType -> [Char] -> [Char]
    showsPrec :: Int -> ListType -> [Char] -> [Char]
    $cshow :: ListType -> [Char]
    show :: ListType -> [Char]
    $cshowList :: [ListType] -> [Char] -> [Char]
    showList :: [ListType] -> [Char] -> [Char]
    Show, Eq ListType
    Eq ListType =>
    (ListType -> ListType -> Ordering)
    -> (ListType -> ListType -> Bool)
    -> (ListType -> ListType -> Bool)
    -> (ListType -> ListType -> Bool)
    -> (ListType -> ListType -> Bool)
    -> (ListType -> ListType -> ListType)
    -> (ListType -> ListType -> ListType)
    -> Ord ListType
    ListType -> ListType -> Bool
    ListType -> ListType -> Ordering
    ListType -> ListType -> ListType
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: ListType -> ListType -> Ordering
    compare :: ListType -> ListType -> Ordering
    $c< :: ListType -> ListType -> Bool
    < :: ListType -> ListType -> Bool
    $c<= :: ListType -> ListType -> Bool
    <= :: ListType -> ListType -> Bool
    $c> :: ListType -> ListType -> Bool
    > :: ListType -> ListType -> Bool
    $c>= :: ListType -> ListType -> Bool
    >= :: ListType -> ListType -> Bool
    $cmax :: ListType -> ListType -> ListType
    max :: ListType -> ListType -> ListType
    $cmin :: ListType -> ListType -> ListType
    min :: ListType -> ListType -> ListType
    Ord, ListType -> ListType -> Bool
    (ListType -> ListType -> Bool)
    -> (ListType -> ListType -> Bool) -> Eq ListType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ListType -> ListType -> Bool
    == :: ListType -> ListType -> Bool
    $c/= :: ListType -> ListType -> Bool
    /= :: ListType -> ListType -> Bool
    Eq)

    data PState =
      PState
      { PState -> ParseOptions
    psParseOptions :: ParseOptions
      , PState -> NonEmpty Container
    psContainerStack :: NonEmpty Container
      , PState -> ReferenceMap
    psReferenceMap :: ReferenceMap
      , PState -> ReferenceMap
    psAutoReferenceMap :: ReferenceMap
      , PState -> NoteMap
    psNoteMap :: NoteMap
      , PState -> Attr
    psAttributes :: Attr
      , PState -> Maybe AttrParserState
    psAttrParserState :: Maybe AttrParserState
      , PState -> Set ByteString
    psIds :: Set ByteString
      , PState -> Set ByteString
    psAutoIds :: Set ByteString
      , PState -> Int
    psLastColumnPrevLine :: Int
      , PState -> Int
    psLastLine :: Int
      }

    type P = Parser PState

    pDoc :: P Doc
    pDoc :: Parser PState Doc
    pDoc = do
      bls <- P Blocks
    pBlocks P Blocks -> P () -> P Blocks
    forall a b. Parser PState a -> Parser PState b -> Parser PState a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* P ()
    forall s. Parser s ()
    eof
      st <- getState
      pure $ Doc{ docBlocks = bls
                , docFootnotes = psNoteMap st
                , docReferences = psReferenceMap st
                , docAutoReferences = psAutoReferenceMap st
                , docAutoIdentifiers = psAutoIds st }

    pBlocks :: P Blocks
    pBlocks :: P Blocks
    pBlocks = P ()
    processLines P () -> P Blocks -> P Blocks
    forall a b. Parser PState a -> Parser PState b -> Parser PState b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> P Blocks
    finalizeDocument

    -- | Return value is True if all continuations match.
    checkContinuations :: NonEmpty Container -> P Bool
    checkContinuations :: NonEmpty Container -> P Bool
    checkContinuations = [Container] -> P Bool
    go ([Container] -> P Bool)
    -> (NonEmpty Container -> [Container])
    -> NonEmpty Container
    -> P Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Container] -> [Container]
    forall a. [a] -> [a]
    reverse ([Container] -> [Container])
    -> (NonEmpty Container -> [Container])
    -> NonEmpty Container
    -> [Container]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NonEmpty Container -> [Container]
    forall a. NonEmpty a -> [a]
    NonEmpty.toList
     where
       go :: [Container] -> P Bool
    go [] = Bool -> P Bool
    forall a. a -> Parser PState a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
       go (Container
    c:[Container]
    cs) = do continue <- (Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just (Bool -> Maybe Bool) -> P Bool -> Parser PState (Maybe Bool)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> BlockSpec -> Container -> P Bool
    blockContinue (Container -> BlockSpec
    containerSpec Container
    c) Container
    c)
                                      Parser PState (Maybe Bool)
    -> Parser PState (Maybe Bool) -> Parser PState (Maybe Bool)
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Maybe Bool -> Parser PState (Maybe Bool)
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Bool
    forall a. Maybe a
    Nothing
                      when (continue == Just False) $ do -- early exit
                         curline <- sourceLine
                         curcol <- sourceColumn
                         updateState $ \PState
    st ->
                                         PState
    st{ psLastLine = curline
                                           , psLastColumnPrevLine = curcol - 1 }
                      if fromMaybe False continue
                         then go cs
                         else False <$ -- close len (c:cs) containers
                              replicateM_ (length (c:cs)) closeCurrentContainer

    {-# INLINE processLines #-}
    processLines :: P ()
    processLines :: P ()
    processLines = do
      -- check continuations for open containers and close any that don't match
      containers <- PState -> NonEmpty Container
    psContainerStack (PState -> NonEmpty Container)
    -> Parser PState PState -> Parser PState (NonEmpty Container)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser PState PState
    forall s. Parser s s
    getState
      allContainersMatch <- checkContinuations containers

      -- check for new container starts and open if needed
      newContainersAdded <- tryContainerStarts

      followedByBlankLine <|> do
        -- determine if we have a lazy line
        let isLazy = Bool -> Bool
    not (Bool
    allContainersMatch Bool -> Bool -> Bool
    || Bool
    newContainersAdded) Bool -> Bool -> Bool
    &&
                     BlockSpec -> [Char]
    blockName (Container -> BlockSpec
    containerSpec (NonEmpty Container -> Container
    forall a. NonEmpty a -> a
    NonEmpty.head NonEmpty Container
    containers)) [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    "Para"

        when isLazy $ -- restore original containers
           updateState (\PState
    st -> PState
    st{ psContainerStack = containers })

        tip <- getTip

        case blockContainsBlock (containerSpec tip) of
          Just BlockType
    bt | BlockType
    bt BlockType -> BlockType -> Bool
    forall a. Eq a => a -> a -> Bool
    == BlockType
    Normal Bool -> Bool -> Bool
    || BlockType
    bt BlockType -> BlockType -> Bool
    forall a. Eq a => a -> a -> Bool
    == BlockType
    ListItem -> do
            -- add a paragraph container
            P () -> P ()
    forall s a. Parser s a -> Parser s ()
    skipMany P ()
    forall s. Parser s ()
    spaceOrTab
            BlockSpec -> P ()
    blockStart BlockSpec
    paraSpec
          Maybe BlockType
    _ -> () -> P ()
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

      !curline <- sourceLine
      !curcolumn <- sourceColumn
      restline <- byteStringOf $ do
         skipMany (skipSatisfyByte (\Char
    c -> Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\n' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\r'))
         !lastcolumn <- sourceColumn
         optional_ endline
         updateState $ \PState
    st -> PState
    st{ psLastColumnPrevLine = lastcolumn - 1
                                , psLastLine = curline }

      -- if current container is a line container, add remainder of line
      modifyContainers $
        \(Container
    c :| [Container]
    rest) ->
           if BlockSpec -> Bool
    blockContainsLines (Container -> BlockSpec
    containerSpec Container
    c)
              then Container
    c{ containerText = containerText c Seq.|>
                        Chunk{ chunkLine = curline
                             , chunkColumn = curcolumn
                             , chunkBytes = restline } } Container -> [Container] -> NonEmpty Container
    forall a. a -> [a] -> NonEmpty a
    :| [Container]
    rest
              else Container
    c Container -> [Container] -> NonEmpty Container
    forall a. a -> [a] -> NonEmpty a
    :| [Container]
    rest

      eof <|> processLines

    -- True if new container was started
    tryContainerStarts :: P Bool
    tryContainerStarts :: P Bool
    tryContainerStarts = do
      (c :| _) <- PState -> NonEmpty Container
    psContainerStack (PState -> NonEmpty Container)
    -> Parser PState PState -> Parser PState (NonEmpty Container)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser PState PState
    forall s. Parser s s
    getState
      case blockContainsBlock (containerSpec c) of
        Just BlockType
    bt -> (do
          nextc <- Parser PState Char -> Parser PState Char
    forall s a. Parser s a -> Parser s a
    lookahead ((Char -> Bool) -> Parser PState Char
    forall s. (Char -> Bool) -> Parser s Char
    satisfyByte Char -> Bool
    isAscii)
          next <- if nextc == ' ' || nextc == '\t'
                     then skipMany spaceOrTab *> lookahead (satisfyByte isAscii)
                     else pure nextc
          case next of
            Char
    '>' -> BlockSpec -> P ()
    blockStart BlockSpec
    blockQuoteSpec
            Char
    '#' -> BlockSpec -> P ()
    blockStart BlockSpec
    headingSpec
            Char
    ':' -> BlockSpec -> P ()
    blockStart BlockSpec
    divSpec P () -> P () -> P ()
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> BlockSpec -> P ()
    blockStart BlockSpec
    listItemSpec
            Char
    '*' -> BlockSpec -> P ()
    blockStart BlockSpec
    thematicBreakSpec P () -> P () -> P ()
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> BlockSpec -> P ()
    blockStart BlockSpec
    listItemSpec
            Char
    '-' -> BlockSpec -> P ()
    blockStart BlockSpec
    thematicBreakSpec P () -> P () -> P ()
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> BlockSpec -> P ()
    blockStart BlockSpec
    listItemSpec
            Char
    '`' -> BlockSpec -> P ()
    blockStart BlockSpec
    codeBlockSpec
            Char
    '{' -> BlockSpec -> P ()
    blockStart BlockSpec
    attrSpec
            Char
    '[' -> BlockSpec -> P ()
    blockStart BlockSpec
    referenceDefinitionSpec P () -> P () -> P ()
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> BlockSpec -> P ()
    blockStart BlockSpec
    footnoteSpec
            Char
    '|' | BlockType
    bt BlockType -> BlockType -> Bool
    forall a. Eq a => a -> a -> Bool
    /= BlockType
    CaptionBlock -> BlockSpec -> P ()
    blockStart BlockSpec
    tableSpec
            Char
    '^' | BlockType
    bt BlockType -> BlockType -> Bool
    forall a. Eq a => a -> a -> Bool
    == BlockType
    CaptionBlock -> BlockSpec -> P ()
    blockStart BlockSpec
    captionSpec
            Char
    _ -> BlockSpec -> P ()
    blockStart BlockSpec
    listItemSpec
          True <$ tryContainerStarts) P Bool -> P Bool -> P Bool
    forall a. Parser PState a -> Parser PState a -> Parser PState a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Bool -> P Bool
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
        Maybe BlockType
    _ -> Bool -> P Bool
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False

    -- | Close and finalize containers, returning Blocks.
    finalizeDocument :: P Blocks
    finalizeDocument :: P Blocks
    finalizeDocument = do
      cs <- PState -> NonEmpty Container
    psContainerStack (PState -> NonEmpty Container)
    -> Parser PState PState -> Parser PState (NonEmpty Container)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser PState PState
    forall s. Parser s s
    getState
      case cs of
        Container
    _ :| [] -> P ()
    closeCurrentContainer P () -> P Blocks -> P Blocks
    forall a b. Parser PState a -> Parser PState b -> Parser PState b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Container -> Blocks
    finalize (Container -> Blocks) -> P Container -> P Blocks
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> P Container
    getTip
        NonEmpty Container
    _ -> P ()
    closeCurrentContainer P () -> P Blocks -> P Blocks
    forall a b. Parser PState a -> Parser PState b -> Parser PState b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> P Blocks
    finalizeDocument

    {-# INLINE closeCurrentContainer #-}
    -- | Close container and add to parent container.
    closeCurrentContainer :: P ()
    closeCurrentContainer :: P ()
    closeCurrentContainer = do
      cs <- PState -> NonEmpty Container
    psContainerStack (PState -> NonEmpty Container)
    -> Parser PState PState -> Parser PState (NonEmpty Container)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser PState PState
    forall s. Parser s s
    getState
      cs' <- case cs of
               Container
    _ :| [] -> NonEmpty Container -> Parser PState (NonEmpty Container)
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure NonEmpty Container
    cs
               Container
    c :| [Container]
    rest -> do
                 case Container -> Attr
    containerAttr Container
    c of
                   Attr [(ByteString, ByteString)]
    as | Just ByteString
    ident <- ByteString -> [(ByteString, ByteString)] -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup ByteString
    "id" [(ByteString, ByteString)]
    as
                     -> (PState -> PState) -> P ()
    forall s. (s -> s) -> Parser s ()
    updateState ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
    forall a b. (a -> b) -> a -> b
    $ \PState
    st -> PState
    st{ psIds = Set.insert ident (psIds st) }
                   Attr
    _ -> () -> P ()
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                 c' <- BlockSpec -> Container -> P Container
    blockClose (Container -> BlockSpec
    containerSpec Container
    c) Container
    c
                 pure (c':|rest)
      case cs' of
        Container
    c :| (Container
    d:[Container]
    rest) -> (PState -> PState) -> P ()
    forall s. (s -> s) -> Parser s ()
    updateState ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
    forall a b. (a -> b) -> a -> b
    $
            \PState
    st -> PState
    st{ psContainerStack =
                       d{ containerChildren = containerChildren d Seq.|>
                            c{ containerEndLine = psLastLine st
                             , containerEndColumn = psLastColumnPrevLine st } }
                       :| rest }
        Container
    c :| [] -> (PState -> PState) -> P ()
    forall s. (s -> s) -> Parser s ()
    updateState ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
    forall a b. (a -> b) -> a -> b
    $
            \PState
    st -> PState
    st{ psContainerStack =
                         c{ containerEndLine = psLastLine st
                          , containerEndColumn = psLastColumnPrevLine st } :| [] }

    {-# INLINE modifyContainers #-}
    modifyContainers :: (NonEmpty Container -> NonEmpty Container) -> P ()
    modifyContainers :: (NonEmpty Container -> NonEmpty Container) -> P ()
    modifyContainers NonEmpty Container -> NonEmpty Container
    f =
      (PState -> PState) -> P ()
    forall s. (s -> s) -> Parser s ()
    updateState ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
    forall a b. (a -> b) -> a -> b
    $ \PState
    st -> PState
    st{ psContainerStack = f (psContainerStack st) }

    {-# INLINE addContainer #-}
    addContainer :: BlockSpec -> Int -> ContainerData -> P ()
    addContainer :: BlockSpec -> Int -> ContainerData -> P ()
    addContainer BlockSpec
    bspec Int
    curcol ContainerData
    bdata = do
      curline <- Parser PState Int
    forall st. Parser st Int
    sourceLine
      attr <- psAttributes <$> getState
      opts <- psParseOptions <$> getState
      let newcontainer = Container
    emptyContainer { containerSpec = bspec
                                        , containerStartLine = curline
                                        , containerStartColumn = curcol
                                        , containerEndLine = curline
                                        , containerEndColumn = curcol
                                        , containerData = bdata
                                        , containerAttr = attr
                                        , containerSourcePos = sourcePositions opts /= NoSourcePos }
      unless (blockName bspec == "Attributes") $
        updateState $ \PState
    st -> PState
    st{ psAttributes = mempty }
      closeInappropriateContainers bspec
      modifyContainers (newcontainer NonEmpty.<|)

    closeInappropriateContainers :: BlockSpec -> P ()
    closeInappropriateContainers :: BlockSpec -> P ()
    closeInappropriateContainers BlockSpec
    spec = do
      -- close containers until we get one that can accept this type of container
      cs <- PState -> NonEmpty Container
    psContainerStack (PState -> NonEmpty Container)
    -> Parser PState PState -> Parser PState (NonEmpty Container)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser PState PState
    forall s. Parser s s
    getState
      case cs of
        Container
    c :| [Container]
    _
          | BlockSpec -> Maybe BlockType
    blockContainsBlock (Container -> BlockSpec
    containerSpec Container
    c) Maybe BlockType -> Maybe BlockType -> Bool
    forall a. Eq a => a -> a -> Bool
    == BlockType -> Maybe BlockType
    forall a. a -> Maybe a
    Just (BlockSpec -> BlockType
    blockType BlockSpec
    spec) ->
                  () -> P ()
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
          | Bool
    otherwise -> P ()
    closeCurrentContainer P () -> P () -> P ()
    forall a b. Parser PState a -> Parser PState b -> Parser PState b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> BlockSpec -> P ()
    closeInappropriateContainers BlockSpec
    spec

    finalize :: Container -> Blocks
    finalize :: Container -> Blocks
    finalize Container
    cont =
      Attr -> Node Block -> Node Block
    forall a. Attr -> Node a -> Node a
    addAttr (Container -> Attr
    containerAttr Container
    cont)
        (Node Block -> Node Block) -> Blocks -> Blocks
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> BlockSpec -> Container -> Blocks
    blockFinalize (Container -> BlockSpec
    containerSpec Container
    cont) Container
    cont

    addSourcePos :: Container -> Blocks -> Blocks
    addSourcePos :: Container -> Blocks -> Blocks
    addSourcePos Container
    cont =
       if Container -> Bool
    containerSourcePos Container
    cont
          then (Node Block -> Node Block) -> Blocks -> Blocks
    forall a b. (a -> b) -> Many a -> Many b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap
               (Pos -> Node Block -> Node Block
    forall a. Pos -> Node a -> Node a
    addPos (Int -> Int -> Int -> Int -> Pos
    Pos (Container -> Int
    containerStartLine Container
    cont) (Container -> Int
    containerStartColumn Container
    cont)
                             (Container -> Int
    containerEndLine Container
    cont) (Container -> Int
    containerEndColumn Container
    cont)))
          else Blocks -> Blocks
    forall a. a -> a
    id

    finalizeChildren :: Container -> Blocks
    finalizeChildren :: Container -> Blocks
    finalizeChildren = (Container -> Blocks) -> Seq Container -> Blocks
    forall m a. Monoid m => (a -> m) -> Seq a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Container -> Blocks
    finalize (Seq Container -> Blocks)
    -> (Container -> Seq Container) -> Container -> Blocks
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Container -> Seq Container
    containerChildren

    -- Gobble as much space as possible up to indent.
    gobbleSpaceToIndent :: Int -> P ()
    gobbleSpaceToIndent :: Int -> P ()
    gobbleSpaceToIndent Int
    indent = do
      curindent <- Parser PState Int
    forall st. Parser st Int
    sourceColumn
      when (curindent < indent) $
         optional_ (spaceOrTab *> gobbleSpaceToIndent indent)

    {-# INLINE getTip #-}
    -- Get tip of container stack.
    getTip :: P Container
    getTip :: P Container
    getTip = NonEmpty Container -> Container
    forall a. NonEmpty a -> a
    NonEmpty.head (NonEmpty Container -> Container)
    -> (PState -> NonEmpty Container) -> PState -> Container
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PState -> NonEmpty Container
    psContainerStack (PState -> Container) -> Parser PState PState -> P Container
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser PState PState
    forall s. Parser s s
    getState

    closeContainingSections :: Int -> P ()
    closeContainingSections :: Int -> P ()
    closeContainingSections Int
    lev = do
      tip <- P Container
    getTip
      case containerData tip of
        SectionData Int
    lev' Maybe ByteString
    _ | Int
    lev' Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    lev ->
          P ()
    closeCurrentContainer P () -> P () -> P ()
    forall a b. Parser PState a -> Parser PState b -> Parser PState b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
          Int -> P ()
    closeContainingSections Int
    lev
        ContainerData
    _ -> () -> P ()
    forall a. a -> Parser PState a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

    -- TODO avoid detour through String
    toIdentifier :: ByteString -> ByteString
    toIdentifier :: ByteString -> ByteString
    toIdentifier ByteString
    bs =
      if [[Char]] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[Char]]
    parts
         then ByteString
    "sec"
         else [Char] -> ByteString
    strToUtf8 ([Char] -> ByteString) -> [Char] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [[Char]] -> [Char]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Char]
    "-" [[Char]]
    parts
     where
       isSym :: Char -> Bool
    isSym = (Char -> [Char] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ([Char]
    "][~!@#$%^&*(){}`,.<>\\|=+/" :: [Char]))
       parts :: [[Char]]
    parts = [Char] -> [[Char]]
    words ([Char] -> [[Char]]) -> [Char] -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $ (Char -> Char) -> [Char] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Char
    c -> if Char -> Bool
    isSym Char
    c then Char
    ' ' else Char
    c) ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [Char]
    utf8ToStr ByteString
    bs