{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Commonmark.Extensions.DefinitionList
  ( definitionListSpec
  , HasDefinitionList(..)
  )
where
import Commonmark.Types
import Commonmark.Syntax
import Commonmark.Blocks
import Commonmark.SourceMap
import Commonmark.TokParsers
import Commonmark.Html
import Control.Monad (mzero)
import Data.Dynamic
import Data.Tree
import Text.Parsec

definitionListSpec :: (Monad m, IsBlock il bl, IsInline il,
                       Typeable il, Typeable bl, HasDefinitionList il bl)
                   => SyntaxSpec m il bl
definitionListSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il, Typeable il, Typeable bl,
 HasDefinitionList il bl) =>
SyntaxSpec m il bl
definitionListSpec = forall a. Monoid a => a
mempty
  { syntaxBlockSpecs :: [BlockSpec m il bl]
syntaxBlockSpecs = [forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il, HasDefinitionList il bl) =>
BlockSpec m il bl
definitionListDefinitionBlockSpec]
  }

definitionListBlockSpec :: (Monad m, IsBlock il bl, HasDefinitionList il bl)
                        => BlockSpec m il bl
definitionListBlockSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, HasDefinitionList il bl) =>
BlockSpec m il bl
definitionListBlockSpec = BlockSpec
     { blockType :: Text
blockType           = Text
"DefinitionList"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = forall (m :: * -> *) a. MonadPlus m => m a
mzero
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = \BlockSpec m il bl
sp -> forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType BlockSpec m il bl
sp forall a. Eq a => a -> a -> Bool
== Text
"DefinitionListItem"
     , blockContainsLines :: Bool
blockContainsLines  = Bool
False
     , blockParagraph :: Bool
blockParagraph      = Bool
False
     , blockContinue :: BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue       = \BlockNode m il bl
n -> (,BlockNode m il bl
n) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = \(Node BlockData m il bl
bdata [BlockNode m il bl]
items) -> do
         let listType :: ListSpacing
listType = forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData BlockData m il bl
bdata) ListSpacing
LooseList
         let getItem :: Tree (BlockData m a b) -> ParsecT [Tok] (BPState m a b) m (a, [b])
getItem item :: Tree (BlockData m a b)
item@(Node BlockData m a b
_ [Tree (BlockData m a b)]
ds) = do
               a
term <- forall (m :: * -> *) il bl.
Monad m =>
[Tok] -> BlockParser m il bl il
runInlineParser (forall (m :: * -> *) il bl. BlockNode m il bl -> [Tok]
getBlockText Tree (BlockData m a b)
item)
               [b]
defs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Tree (BlockData m a b)
c -> forall (m :: * -> *) il bl.
BlockSpec m il bl -> BlockNode m il bl -> BlockParser m il bl bl
blockConstructor (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec Tree (BlockData m a b)
c) Tree (BlockData m a b)
c) [Tree (BlockData m a b)]
ds
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (a
term, [b]
defs)
         forall il bl.
HasDefinitionList il bl =>
ListSpacing -> [(il, [bl])] -> bl
definitionList ListSpacing
listType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *} {a} {b}.
Monad m =>
Tree (BlockData m a b) -> ParsecT [Tok] (BPState m a b) m (a, [b])
getItem [BlockNode m il bl]
items
     , blockFinalize :: BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
blockFinalize       = \(Node BlockData m il bl
cdata [BlockNode m il bl]
children) BlockNode m il bl
parent -> do
          let spacing :: ListSpacing
spacing =
                if forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ListSpacing
LooseList
                     (forall a b. (a -> b) -> [a] -> [b]
map (\BlockNode m il bl
child ->
                            forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (forall a. Tree a -> a
rootLabel BlockNode m il bl
child))
                              ListSpacing
LooseList) [BlockNode m il bl]
children)
                   then ListSpacing
LooseList
                   else ListSpacing
TightList
          forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer (forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
cdata{ blockData :: Dynamic
blockData = forall a. Typeable a => a -> Dynamic
toDyn ListSpacing
spacing } [BlockNode m il bl]
children)
                           BlockNode m il bl
parent
     }

definitionListItemBlockSpec ::
   (Monad m, IsBlock il bl, IsInline il, HasDefinitionList il bl)
   => BlockSpec m il bl
definitionListItemBlockSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il, HasDefinitionList il bl) =>
BlockSpec m il bl
definitionListItemBlockSpec = BlockSpec
     { blockType :: Text
blockType           = Text
"DefinitionListItem"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = forall (m :: * -> *) a. MonadPlus m => m a
mzero
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = \BlockSpec m il bl
sp -> forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType BlockSpec m il bl
sp forall a. Eq a => a -> a -> Bool
== Text
"DefinitionListDefinition"
     , blockContainsLines :: Bool
blockContainsLines  = Bool
False
     , blockParagraph :: Bool
blockParagraph      = Bool
False
     , blockContinue :: BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue       = \BlockNode m il bl
n -> (,BlockNode m il bl
n) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = \BlockNode m il bl
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
     , blockFinalize :: BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
blockFinalize       = \(Node BlockData m il bl
cdata [BlockNode m il bl]
children) BlockNode m il bl
parent -> do
         let listSpacing :: ListSpacing
listSpacing   = forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData BlockData m il bl
cdata) ListSpacing
LooseList
         let totight :: Tree (BlockData m il bl) -> Tree (BlockData m il bl)
totight (Node BlockData m il bl
nd [Tree (BlockData m il bl)]
cs)
               | forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType (forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec BlockData m il bl
nd) forall a. Eq a => a -> a -> Bool
== Text
"Paragraph"
                           = forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
nd{ blockSpec :: BlockSpec m il bl
blockSpec = forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
plainSpec } [Tree (BlockData m il bl)]
cs
               | Bool
otherwise = forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
nd [Tree (BlockData m il bl)]
cs
         let childrenToTight :: Tree (BlockData m il bl) -> Tree (BlockData m il bl)
childrenToTight (Node BlockData m il bl
nd [Tree (BlockData m il bl)]
cs) = forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
nd (forall a b. (a -> b) -> [a] -> [b]
map forall {m :: * -> *} {il} {bl}.
(Monad m, IsBlock il bl) =>
Tree (BlockData m il bl) -> Tree (BlockData m il bl)
totight [Tree (BlockData m il bl)]
cs)
         let children' :: [BlockNode m il bl]
children' =
                case ListSpacing
listSpacing of
                  ListSpacing
TightList -> forall a b. (a -> b) -> [a] -> [b]
map forall {m :: * -> *} {il} {bl}.
(Monad m, IsBlock il bl) =>
Tree (BlockData m il bl) -> Tree (BlockData m il bl)
childrenToTight [BlockNode m il bl]
children
                  ListSpacing
LooseList -> [BlockNode m il bl]
children
         forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer (forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
cdata [BlockNode m il bl]
children') BlockNode m il bl
parent
     }


definitionListDefinitionBlockSpec ::
   (Monad m, IsBlock il bl, IsInline il, HasDefinitionList il bl)
   => BlockSpec m il bl
definitionListDefinitionBlockSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il, HasDefinitionList il bl) =>
BlockSpec m il bl
definitionListDefinitionBlockSpec = BlockSpec
     { blockType :: Text
blockType           = Text
"DefinitionListDefinition"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
         Int
initcol <- SourcePos -> Int
sourceColumn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
         forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleUpToSpaces Int
3
         SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
         forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
':' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'~'
         forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleUpToSpaces Int
4 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace)
           forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleSpaces Int
1
           forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int
1 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd
         Int
finalcol <- SourcePos -> Int
sourceColumn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
         (Node BlockData m il bl
bdata [BlockNode m il bl]
children : [BlockNode m il bl]
rest) <- forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
         let definitionIndent :: Int
             definitionIndent :: Int
definitionIndent = Int
finalcol forall a. Num a => a -> a -> a
- Int
initcol
         let defnode :: BlockNode m il bl
defnode = forall a. a -> [Tree a] -> Tree a
Node (forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData
                              forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il, HasDefinitionList il bl) =>
BlockSpec m il bl
definitionListDefinitionBlockSpec){
                                  blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos],
                                  blockData :: Dynamic
blockData = forall a. Typeable a => a -> Dynamic
toDyn Int
definitionIndent } []
         if forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType (forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec BlockData m il bl
bdata) forall a. Eq a => a -> a -> Bool
== Text
"DefinitionListItem"
            then forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack BlockNode m il bl
defnode
            else do
             BlockNode m il bl
linode <-
               if forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockParagraph (forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec BlockData m il bl
bdata)
                 then do
                   -- a) we're in a paragraph -> TightList
                   --    make cur a DefinitionListItem instead
                   --    keep the tokens; they will be the term
                   -- remove paragraph from stack
                   forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \BPState m il bl
st -> BPState m il bl
st{ nodeStack :: [BlockNode m il bl]
nodeStack = [BlockNode m il bl]
rest }
                   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> [Tree a] -> Tree a
Node (forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il, HasDefinitionList il bl) =>
BlockSpec m il bl
definitionListItemBlockSpec)
                            { blockData :: Dynamic
blockData = forall a. Typeable a => a -> Dynamic
toDyn ListSpacing
TightList
                            , blockLines :: [[Tok]]
blockLines = forall (m :: * -> *) il bl. BlockData m il bl -> [[Tok]]
blockLines BlockData m il bl
bdata
                            , blockStartPos :: [SourcePos]
blockStartPos = forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos BlockData m il bl
bdata
                            } []
                 else
                   case [BlockNode m il bl]
children of
                     (BlockNode m il bl
lastChild : [BlockNode m il bl]
rest')
                       | forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockParagraph (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m il bl
lastChild) -> do
                         -- b) previous sibling is a paragraph -> LooseList
                         --    last child of cur is a Paragraph
                         --    remove this child and mk new child with its
                         --    content and position.  tokens will be term.
                         -- remove paragraph from stack
                         forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \BPState m il bl
st -> BPState m il bl
st{ nodeStack :: [BlockNode m il bl]
nodeStack =
                              forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
bdata [BlockNode m il bl]
rest' forall a. a -> [a] -> [a]
: [BlockNode m il bl]
rest }
                         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> [Tree a] -> Tree a
Node (forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData
                                    forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il, HasDefinitionList il bl) =>
BlockSpec m il bl
definitionListItemBlockSpec)
                                  { blockData :: Dynamic
blockData = forall a. Typeable a => a -> Dynamic
toDyn ListSpacing
LooseList
                                  , blockStartPos :: [SourcePos]
blockStartPos = forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos
                                                     (forall a. Tree a -> a
rootLabel BlockNode m il bl
lastChild)
                                  , blockLines :: [[Tok]]
blockLines = forall (m :: * -> *) il bl. BlockData m il bl -> [[Tok]]
blockLines
                                        (forall a. Tree a -> a
rootLabel BlockNode m il bl
lastChild)
                                  } []
                     [BlockNode m il bl]
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

             let listnode :: BlockNode m il bl
listnode = forall a. a -> [Tree a] -> Tree a
Node (forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, HasDefinitionList il bl) =>
BlockSpec m il bl
definitionListBlockSpec){
                                blockStartPos :: [SourcePos]
blockStartPos = forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos
                                             (forall a. Tree a -> a
rootLabel BlockNode m il bl
linode) } []
             (Node BlockData m il bl
bdata' [BlockNode m il bl]
children' : [BlockNode m il bl]
rest') <- forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
             -- if last child was DefinitionList, set that to current
             case [BlockNode m il bl]
children' of
               BlockNode m il bl
m:[BlockNode m il bl]
ms | forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType (forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec (forall a. Tree a -> a
rootLabel BlockNode m il bl
m)) forall a. Eq a => a -> a -> Bool
== Text
"DefinitionList"
                   -> forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \BPState m il bl
st -> BPState m il bl
st{ nodeStack :: [BlockNode m il bl]
nodeStack =
                        BlockNode m il bl
m forall a. a -> [a] -> [a]
: forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
bdata' [BlockNode m il bl]
ms forall a. a -> [a] -> [a]
: [BlockNode m il bl]
rest' }
               [BlockNode m il bl]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
             (Node BlockData m il bl
bdata'' [BlockNode m il bl]
_ : [BlockNode m il bl]
_) <- forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
             case forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType (forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec BlockData m il bl
bdata'') of
                  Text
"DefinitionList"
                    -> forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack BlockNode m il bl
linode forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack BlockNode m il bl
defnode
                  Text
_ -> forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack BlockNode m il bl
listnode forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack BlockNode m il bl
linode forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                       forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack BlockNode m il bl
defnode
         forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = forall a b. a -> b -> a
const Bool
True
     , blockContainsLines :: Bool
blockContainsLines  = Bool
False
     , blockParagraph :: Bool
blockParagraph      = Bool
False
     , blockContinue :: BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue       = \node :: BlockNode m il bl
node@(Node BlockData m il bl
ndata [BlockNode m il bl]
_cs) -> do
         SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
         let definitionIndent :: Int
definitionIndent = forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData BlockData m il bl
ndata) Int
0
         forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleSpaces Int
definitionIndent forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int
0 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (SourcePos
pos, BlockNode m il bl
node)
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockNode m il bl -> BlockParser m il bl [bl]
renderChildren
     , blockFinalize :: BlockNode m il bl
-> BlockNode m il bl
-> ParsecT [Tok] (BPState m il bl) m (BlockNode m il bl)
blockFinalize       = forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer
     }

class IsBlock il bl => HasDefinitionList il bl | il -> bl where
  definitionList :: ListSpacing -> [(il,[bl])] -> bl

instance Rangeable (Html a) =>
         HasDefinitionList (Html a) (Html a) where
  definitionList :: ListSpacing -> [(Html a, [Html a])] -> Html a
definitionList ListSpacing
spacing [(Html a, [Html a])]
items =
    forall a. Text -> Maybe (Html a) -> Html a
htmlBlock Text
"dl" forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Text -> Html a
htmlRaw Text
"\n" forall a. Semigroup a => a -> a -> a
<>
       forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (forall a. ListSpacing -> (Html a, [Html a]) -> Html a
definitionListItem ListSpacing
spacing) [(Html a, [Html a])]
items)

definitionListItem :: ListSpacing -> (Html a, [Html a]) -> Html a
definitionListItem :: forall a. ListSpacing -> (Html a, [Html a]) -> Html a
definitionListItem ListSpacing
spacing (Html a
term, [Html a]
defns) =
  forall a. Text -> Maybe (Html a) -> Html a
htmlBlock Text
"dt" (forall a. a -> Maybe a
Just Html a
term) forall a. Semigroup a => a -> a -> a
<>
   forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (\Html a
defn ->
            case ListSpacing
spacing of
              ListSpacing
LooseList -> forall a. Text -> Maybe (Html a) -> Html a
htmlBlock Text
"dd" (forall a. a -> Maybe a
Just (forall a. Text -> Html a
htmlRaw Text
"\n" forall a. Semigroup a => a -> a -> a
<> Html a
defn))
              ListSpacing
TightList -> forall a. Text -> Maybe (Html a) -> Html a
htmlBlock Text
"dd" (forall a. a -> Maybe a
Just Html a
defn)) [Html a]
defns)

instance (HasDefinitionList il bl, Semigroup bl, Semigroup il)
        => HasDefinitionList (WithSourceMap il) (WithSourceMap bl) where
  definitionList :: ListSpacing
-> [(WithSourceMap il, [WithSourceMap bl])] -> WithSourceMap bl
definitionList ListSpacing
spacing [(WithSourceMap il, [WithSourceMap bl])]
items = do
    let ([WithSourceMap il]
terms, [[WithSourceMap bl]]
defs) = forall a b. [(a, b)] -> ([a], [b])
unzip [(WithSourceMap il, [WithSourceMap bl])]
items
    [il]
terms' <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [WithSourceMap il]
terms
    [[bl]]
defs' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [[WithSourceMap bl]]
defs
    let res :: bl
res = forall il bl.
HasDefinitionList il bl =>
ListSpacing -> [(il, [bl])] -> bl
definitionList ListSpacing
spacing (forall a b. [a] -> [b] -> [(a, b)]
zip [il]
terms' [[bl]]
defs')
    Text -> WithSourceMap ()
addName Text
"definitionList"
    forall (m :: * -> *) a. Monad m => a -> m a
return bl
res