{-# LANGUAGE CPP #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# 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)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup)
import Data.Monoid
#endif
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 :: SyntaxSpec m il bl
definitionListSpec = SyntaxSpec m il bl
forall a. Monoid a => a
mempty
  { syntaxBlockSpecs :: [BlockSpec m il bl]
syntaxBlockSpecs = [BlockSpec m il bl
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 :: BlockSpec m il bl
definitionListBlockSpec = BlockSpec :: forall (m :: * -> *) il bl.
Text
-> BlockParser m il bl BlockStartResult
-> (BlockSpec m il bl -> Bool)
-> Bool
-> Bool
-> (BlockNode m il bl
    -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (BlockNode m il bl -> BlockParser m il bl bl)
-> (BlockNode m il bl
    -> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl))
-> BlockSpec m il bl
BlockSpec
     { blockType :: Text
blockType           = Text
"DefinitionList"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = BlockParser m il bl BlockStartResult
forall (m :: * -> *) a. MonadPlus m => m a
mzero
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = \BlockSpec m il bl
sp -> BlockSpec m il bl -> Text
forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType BlockSpec m il bl
sp Text -> Text -> Bool
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) (SourcePos -> (SourcePos, BlockNode m il bl))
-> ParsecT [Tok] (BPState m il bl) m SourcePos
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m SourcePos
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 Forest (BlockData m il bl)
items) -> do
         let listType :: ListSpacing
listType = Dynamic -> ListSpacing -> ListSpacing
forall a. Typeable a => Dynamic -> a -> a
fromDyn (BlockData m il bl -> Dynamic
forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData BlockData m il bl
bdata) ListSpacing
LooseList
         let getItem :: Tree (BlockData m a bl)
-> ParsecT [Tok] (BPState m a bl) m (a, [bl])
getItem item :: Tree (BlockData m a bl)
item@(Node BlockData m a bl
_ Forest (BlockData m a bl)
ds) = do
               a
term <- [Tok] -> BlockParser m a bl a
forall (m :: * -> *) il bl.
Monad m =>
[Tok] -> BlockParser m il bl il
runInlineParser (Tree (BlockData m a bl) -> [Tok]
forall (m :: * -> *) il bl. BlockNode m il bl -> [Tok]
getBlockText Tree (BlockData m a bl)
item)
               [bl]
defs <- (Tree (BlockData m a bl) -> ParsecT [Tok] (BPState m a bl) m bl)
-> Forest (BlockData m a bl)
-> ParsecT [Tok] (BPState m a bl) m [bl]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Tree (BlockData m a bl)
c -> BlockSpec m a bl
-> Tree (BlockData m a bl) -> ParsecT [Tok] (BPState m a bl) m bl
forall (m :: * -> *) il bl.
BlockSpec m il bl -> BlockNode m il bl -> BlockParser m il bl bl
blockConstructor (Tree (BlockData m a bl) -> BlockSpec m a bl
forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec Tree (BlockData m a bl)
c) Tree (BlockData m a bl)
c) Forest (BlockData m a bl)
ds
               (a, [bl]) -> ParsecT [Tok] (BPState m a bl) m (a, [bl])
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, [bl]) -> ParsecT [Tok] (BPState m a bl) m (a, [bl]))
-> (a, [bl]) -> ParsecT [Tok] (BPState m a bl) m (a, [bl])
forall a b. (a -> b) -> a -> b
$! (a
term, [bl]
defs)
         ListSpacing -> [(il, [bl])] -> bl
forall il bl.
HasDefinitionList il bl =>
ListSpacing -> [(il, [bl])] -> bl
definitionList ListSpacing
listType ([(il, [bl])] -> bl)
-> ParsecT [Tok] (BPState m il bl) m [(il, [bl])]
-> BlockParser m il bl bl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m (il, [bl]))
-> Forest (BlockData m il bl)
-> ParsecT [Tok] (BPState m il bl) m [(il, [bl])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m (il, [bl])
forall (m :: * -> *) a bl.
Monad m =>
Tree (BlockData m a bl)
-> ParsecT [Tok] (BPState m a bl) m (a, [bl])
getItem Forest (BlockData 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 Forest (BlockData m il bl)
children) BlockNode m il bl
parent -> do
          let spacing :: ListSpacing
spacing =
                if ListSpacing -> [ListSpacing] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ListSpacing
LooseList
                     ((BlockNode m il bl -> ListSpacing)
-> Forest (BlockData m il bl) -> [ListSpacing]
forall a b. (a -> b) -> [a] -> [b]
map (\BlockNode m il bl
child ->
                            Dynamic -> ListSpacing -> ListSpacing
forall a. Typeable a => Dynamic -> a -> a
fromDyn (BlockData m il bl -> Dynamic
forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
child))
                              ListSpacing
LooseList) Forest (BlockData m il bl)
children)
                   then ListSpacing
LooseList
                   else ListSpacing
TightList
          BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer (BlockData m il bl
-> Forest (BlockData m il bl) -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node BlockData m il bl
cdata{ blockData :: Dynamic
blockData = ListSpacing -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn ListSpacing
spacing } Forest (BlockData 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 :: BlockSpec m il bl
definitionListItemBlockSpec = BlockSpec :: forall (m :: * -> *) il bl.
Text
-> BlockParser m il bl BlockStartResult
-> (BlockSpec m il bl -> Bool)
-> Bool
-> Bool
-> (BlockNode m il bl
    -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (BlockNode m il bl -> BlockParser m il bl bl)
-> (BlockNode m il bl
    -> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl))
-> BlockSpec m il bl
BlockSpec
     { blockType :: Text
blockType           = Text
"DefinitionListItem"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = BlockParser m il bl BlockStartResult
forall (m :: * -> *) a. MonadPlus m => m a
mzero
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = \BlockSpec m il bl
sp -> BlockSpec m il bl -> Text
forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType BlockSpec m il bl
sp Text -> Text -> Bool
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) (SourcePos -> (SourcePos, BlockNode m il bl))
-> ParsecT [Tok] (BPState m il bl) m SourcePos
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m SourcePos
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
_ -> BlockParser m il bl 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 Forest (BlockData m il bl)
children) BlockNode m il bl
parent -> do
         let listSpacing :: ListSpacing
listSpacing   = Dynamic -> ListSpacing -> ListSpacing
forall a. Typeable a => Dynamic -> a -> a
fromDyn (BlockData m il bl -> Dynamic
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 Forest (BlockData m il bl)
cs)
               | BlockSpec m il bl -> Text
forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType (BlockData m il bl -> BlockSpec m il bl
forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec BlockData m il bl
nd) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Paragraph"
                           = BlockData m il bl
-> Forest (BlockData m il bl) -> Tree (BlockData m il bl)
forall a. a -> Forest a -> Tree a
Node BlockData m il bl
nd{ blockSpec :: BlockSpec m il bl
blockSpec = BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
plainSpec } Forest (BlockData m il bl)
cs
               | Bool
otherwise = BlockData m il bl
-> Forest (BlockData m il bl) -> Tree (BlockData m il bl)
forall a. a -> Forest a -> Tree a
Node BlockData m il bl
nd Forest (BlockData m il bl)
cs
         let childrenToTight :: Tree (BlockData m il bl) -> Tree (BlockData m il bl)
childrenToTight (Node BlockData m il bl
nd Forest (BlockData m il bl)
cs) = BlockData m il bl
-> Forest (BlockData m il bl) -> Tree (BlockData m il bl)
forall a. a -> Forest a -> Tree a
Node BlockData m il bl
nd ((Tree (BlockData m il bl) -> Tree (BlockData m il bl))
-> Forest (BlockData m il bl) -> Forest (BlockData m il bl)
forall a b. (a -> b) -> [a] -> [b]
map Tree (BlockData m il bl) -> Tree (BlockData m il bl)
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
Tree (BlockData m il bl) -> Tree (BlockData m il bl)
totight Forest (BlockData m il bl)
cs)
         let children' :: Forest (BlockData m il bl)
children' =
                case ListSpacing
listSpacing of
                  ListSpacing
TightList -> (BlockNode m il bl -> BlockNode m il bl)
-> Forest (BlockData m il bl) -> Forest (BlockData m il bl)
forall a b. (a -> b) -> [a] -> [b]
map BlockNode m il bl -> BlockNode m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
Tree (BlockData m il bl) -> Tree (BlockData m il bl)
childrenToTight Forest (BlockData m il bl)
children
                  ListSpacing
LooseList -> Forest (BlockData m il bl)
children
         BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer (BlockData m il bl
-> Forest (BlockData m il bl) -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node BlockData m il bl
cdata Forest (BlockData 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 :: BlockSpec m il bl
definitionListDefinitionBlockSpec = BlockSpec :: forall (m :: * -> *) il bl.
Text
-> BlockParser m il bl BlockStartResult
-> (BlockSpec m il bl -> Bool)
-> Bool
-> Bool
-> (BlockNode m il bl
    -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (BlockNode m il bl -> BlockParser m il bl bl)
-> (BlockNode m il bl
    -> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl))
-> BlockSpec m il bl
BlockSpec
     { blockType :: Text
blockType           = Text
"DefinitionListDefinition"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = BlockParser m il bl BlockStartResult
-> BlockParser m il bl BlockStartResult
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (BlockParser m il bl BlockStartResult
 -> BlockParser m il bl BlockStartResult)
-> BlockParser m il bl BlockStartResult
-> BlockParser m il bl BlockStartResult
forall a b. (a -> b) -> a -> b
$ do
         Int
n <- Int -> ParsecT [Tok] (BPState m il bl) m Int
forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleUpToSpaces Int
3
         SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
         Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
':' ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'~'
         Int -> ParsecT [Tok] (BPState m il bl) m Int
forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleSpaces (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
1 (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n))
         (Node BlockData m il bl
bdata [BlockNode m il bl]
children : [BlockNode m il bl]
rest) <- BPState m il bl -> [BlockNode m il bl]
forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack (BPState m il bl -> [BlockNode m il bl])
-> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m [BlockNode m il bl]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
         let defnode :: BlockNode m il bl
defnode = BlockData m il bl -> [BlockNode m il bl] -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node (BlockSpec m il bl -> BlockData m il bl
forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData
                              BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il, HasDefinitionList il bl) =>
BlockSpec m il bl
definitionListDefinitionBlockSpec){
                                  blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } []
         if BlockSpec m il bl -> Text
forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType (BlockData m il bl -> BlockSpec m il bl
forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec BlockData m il bl
bdata) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"DefinitionListItem"
            then BlockNode m il bl -> BlockParser m il bl ()
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 BlockSpec m il bl -> Bool
forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockParagraph (BlockData m il bl -> BlockSpec m il bl
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
                   (BPState m il bl -> BPState m il bl) -> BlockParser m il bl ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((BPState m il bl -> BPState m il bl) -> BlockParser m il bl ())
-> (BPState m il bl -> BPState m il bl) -> BlockParser m il bl ()
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 }
                   BlockNode m il bl
-> ParsecT [Tok] (BPState m il bl) m (BlockNode m il bl)
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockNode m il bl
 -> ParsecT [Tok] (BPState m il bl) m (BlockNode m il bl))
-> BlockNode m il bl
-> ParsecT [Tok] (BPState m il bl) m (BlockNode m il bl)
forall a b. (a -> b) -> a -> b
$! BlockData m il bl -> [BlockNode m il bl] -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node (BlockSpec m il bl -> BlockData m il bl
forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il, HasDefinitionList il bl) =>
BlockSpec m il bl
definitionListItemBlockSpec)
                            { blockData :: Dynamic
blockData = ListSpacing -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn ListSpacing
TightList
                            , blockLines :: [[Tok]]
blockLines = BlockData m il bl -> [[Tok]]
forall (m :: * -> *) il bl. BlockData m il bl -> [[Tok]]
blockLines BlockData m il bl
bdata
                            , blockStartPos :: [SourcePos]
blockStartPos = BlockData m il bl -> [SourcePos]
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')
                       | BlockSpec m il bl -> Bool
forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockParagraph (BlockNode m il bl -> BlockSpec m il bl
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
                         (BPState m il bl -> BPState m il bl) -> BlockParser m il bl ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((BPState m il bl -> BPState m il bl) -> BlockParser m il bl ())
-> (BPState m il bl -> BPState m il bl) -> BlockParser m il bl ()
forall a b. (a -> b) -> a -> b
$ \BPState m il bl
st -> BPState m il bl
st{ nodeStack :: [BlockNode m il bl]
nodeStack =
                              BlockData m il bl -> [BlockNode m il bl] -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node BlockData m il bl
bdata [BlockNode m il bl]
rest' BlockNode m il bl -> [BlockNode m il bl] -> [BlockNode m il bl]
forall a. a -> [a] -> [a]
: [BlockNode m il bl]
rest }
                         BlockNode m il bl
-> ParsecT [Tok] (BPState m il bl) m (BlockNode m il bl)
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockNode m il bl
 -> ParsecT [Tok] (BPState m il bl) m (BlockNode m il bl))
-> BlockNode m il bl
-> ParsecT [Tok] (BPState m il bl) m (BlockNode m il bl)
forall a b. (a -> b) -> a -> b
$! BlockData m il bl -> [BlockNode m il bl] -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node (BlockSpec m il bl -> BlockData m il bl
forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData
                                    BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il, HasDefinitionList il bl) =>
BlockSpec m il bl
definitionListItemBlockSpec)
                                  { blockData :: Dynamic
blockData = ListSpacing -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn ListSpacing
LooseList
                                  , blockStartPos :: [SourcePos]
blockStartPos = BlockData m il bl -> [SourcePos]
forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos
                                                     (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
lastChild)
                                  , blockLines :: [[Tok]]
blockLines = BlockData m il bl -> [[Tok]]
forall (m :: * -> *) il bl. BlockData m il bl -> [[Tok]]
blockLines
                                        (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
lastChild)
                                  } []
                     [BlockNode m il bl]
_ -> ParsecT [Tok] (BPState m il bl) m (BlockNode m il bl)
forall (m :: * -> *) a. MonadPlus m => m a
mzero

             let listnode :: BlockNode m il bl
listnode = BlockData m il bl -> [BlockNode m il bl] -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node (BlockSpec m il bl -> BlockData m il bl
forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, HasDefinitionList il bl) =>
BlockSpec m il bl
definitionListBlockSpec){
                                blockStartPos :: [SourcePos]
blockStartPos = BlockData m il bl -> [SourcePos]
forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos
                                             (BlockNode m il bl -> BlockData m il bl
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') <- BPState m il bl -> [BlockNode m il bl]
forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack (BPState m il bl -> [BlockNode m il bl])
-> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m [BlockNode m il bl]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
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 | BlockSpec m il bl -> Text
forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType (BlockData m il bl -> BlockSpec m il bl
forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
m)) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"DefinitionList"
                   -> (BPState m il bl -> BPState m il bl) -> BlockParser m il bl ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((BPState m il bl -> BPState m il bl) -> BlockParser m il bl ())
-> (BPState m il bl -> BPState m il bl) -> BlockParser m il bl ()
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 BlockNode m il bl -> [BlockNode m il bl] -> [BlockNode m il bl]
forall a. a -> [a] -> [a]
: BlockData m il bl -> [BlockNode m il bl] -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node BlockData m il bl
bdata' [BlockNode m il bl]
ms BlockNode m il bl -> [BlockNode m il bl] -> [BlockNode m il bl]
forall a. a -> [a] -> [a]
: [BlockNode m il bl]
rest' }
               [BlockNode m il bl]
_ -> () -> BlockParser 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]
_) <- BPState m il bl -> [BlockNode m il bl]
forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack (BPState m il bl -> [BlockNode m il bl])
-> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m [BlockNode m il bl]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
             case BlockSpec m il bl -> Text
forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType (BlockData m il bl -> BlockSpec m il bl
forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec BlockData m il bl
bdata'') of
                  Text
"DefinitionList"
                    -> BlockNode m il bl -> BlockParser m il bl ()
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack BlockNode m il bl
linode BlockParser m il bl ()
-> BlockParser m il bl () -> BlockParser m il bl ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BlockNode m il bl -> BlockParser m il bl ()
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack BlockNode m il bl
defnode
                  Text
_ -> BlockNode m il bl -> BlockParser m il bl ()
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack BlockNode m il bl
listnode BlockParser m il bl ()
-> BlockParser m il bl () -> BlockParser m il bl ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BlockNode m il bl -> BlockParser m il bl ()
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack BlockNode m il bl
linode BlockParser m il bl ()
-> BlockParser m il bl () -> BlockParser m il bl ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                       BlockNode m il bl -> BlockParser m il bl ()
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack BlockNode m il bl
defnode
         BlockStartResult -> BlockParser m il bl BlockStartResult
forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = Bool -> BlockSpec m il bl -> Bool
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       = \BlockNode m il bl
node -> do
         SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
         Int -> ParsecT [Tok] (BPState m il bl) m Int
forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleSpaces Int
4 ParsecT [Tok] (BPState m il bl) m Int
-> ParsecT [Tok] (BPState m il bl) m Int
-> ParsecT [Tok] (BPState m il bl) m Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int
0 Int
-> BlockParser m il bl () -> ParsecT [Tok] (BPState m il bl) m Int
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ BlockParser m il bl () -> BlockParser m il bl ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead BlockParser m il bl ()
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
         (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall (m :: * -> *) a. Monad m => a -> m a
return ((SourcePos, BlockNode m il bl)
 -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
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    = ([bl] -> bl)
-> ParsecT [Tok] (BPState m il bl) m [bl] -> BlockParser m il bl bl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [bl] -> bl
forall a. Monoid a => [a] -> a
mconcat (ParsecT [Tok] (BPState m il bl) m [bl] -> BlockParser m il bl bl)
-> (BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m [bl])
-> BlockNode m il bl
-> BlockParser m il bl bl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m [bl]
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       = BlockNode m il bl
-> BlockNode m il bl
-> ParsecT [Tok] (BPState m il bl) m (BlockNode m il bl)
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 =
    Text -> Maybe (Html a) -> Html a
forall a. Text -> Maybe (Html a) -> Html a
htmlBlock Text
"dl" (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
forall a b. (a -> b) -> a -> b
$ Html a -> Maybe (Html a)
forall a. a -> Maybe a
Just (Html a -> Maybe (Html a)) -> Html a -> Maybe (Html a)
forall a b. (a -> b) -> a -> b
$ Text -> Html a
forall a. Text -> Html a
htmlRaw Text
"\n" Html a -> Html a -> Html a
forall a. Semigroup a => a -> a -> a
<>
       [Html a] -> Html a
forall a. Monoid a => [a] -> a
mconcat (((Html a, [Html a]) -> Html a) -> [(Html a, [Html a])] -> [Html a]
forall a b. (a -> b) -> [a] -> [b]
map (ListSpacing -> (Html a, [Html a]) -> Html a
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 :: ListSpacing -> (Html a, [Html a]) -> Html a
definitionListItem ListSpacing
spacing (Html a
term, [Html a]
defns) =
  Text -> Maybe (Html a) -> Html a
forall a. Text -> Maybe (Html a) -> Html a
htmlBlock Text
"dt" (Html a -> Maybe (Html a)
forall a. a -> Maybe a
Just Html a
term) Html a -> Html a -> Html a
forall a. Semigroup a => a -> a -> a
<>
   [Html a] -> Html a
forall a. Monoid a => [a] -> a
mconcat ((Html a -> Html a) -> [Html a] -> [Html a]
forall a b. (a -> b) -> [a] -> [b]
map (\Html a
defn ->
            case ListSpacing
spacing of
              ListSpacing
LooseList -> Text -> Maybe (Html a) -> Html a
forall a. Text -> Maybe (Html a) -> Html a
htmlBlock Text
"dd" (Html a -> Maybe (Html a)
forall a. a -> Maybe a
Just (Text -> Html a
forall a. Text -> Html a
htmlRaw Text
"\n" Html a -> Html a -> Html a
forall a. Semigroup a => a -> a -> a
<> Html a
defn))
              ListSpacing
TightList -> Text -> Maybe (Html a) -> Html a
forall a. Text -> Maybe (Html a) -> Html a
htmlBlock Text
"dd" (Html a -> Maybe (Html a)
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) = [(WithSourceMap il, [WithSourceMap bl])]
-> ([WithSourceMap il], [[WithSourceMap bl]])
forall a b. [(a, b)] -> ([a], [b])
unzip [(WithSourceMap il, [WithSourceMap bl])]
items
    [il]
terms' <- [WithSourceMap il] -> WithSourceMap [il]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [WithSourceMap il]
terms
    [[bl]]
defs' <- ([WithSourceMap bl] -> WithSourceMap [bl])
-> [[WithSourceMap bl]] -> WithSourceMap [[bl]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [WithSourceMap bl] -> WithSourceMap [bl]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [[WithSourceMap bl]]
defs
    let res :: bl
res = ListSpacing -> [(il, [bl])] -> bl
forall il bl.
HasDefinitionList il bl =>
ListSpacing -> [(il, [bl])] -> bl
definitionList ListSpacing
spacing ([il] -> [[bl]] -> [(il, [bl])]
forall a b. [a] -> [b] -> [(a, b)]
zip [il]
terms' [[bl]]
defs')
    Text -> WithSourceMap ()
addName Text
"definitionList"
    bl -> WithSourceMap bl
forall (m :: * -> *) a. Monad m => a -> m a
return bl
res