{-# 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 = SyntaxSpec m il bl
forall a. Monoid a => a
mempty
  { syntaxBlockSpecs = [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          = BlockParser m il bl BlockStartResult
forall a. ParsecT [Tok] (BPState m il bl) m a
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 [BlockNode 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 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 <- [Tok] -> BlockParser m a b a
forall (m :: * -> *) il bl.
Monad m =>
[Tok] -> BlockParser m il bl il
runInlineParser (Tree (BlockData m a b) -> [Tok]
forall (m :: * -> *) il bl. BlockNode m il bl -> [Tok]
getBlockText Tree (BlockData m a b)
item)
               [b]
defs <- (Tree (BlockData m a b) -> ParsecT [Tok] (BPState m a b) m b)
-> [Tree (BlockData m a b)] -> ParsecT [Tok] (BPState m a b) m [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Tree (BlockData m a b)
c -> BlockSpec m a b
-> Tree (BlockData m a b) -> ParsecT [Tok] (BPState m a b) m b
forall (m :: * -> *) il bl.
BlockSpec m il bl -> BlockNode m il bl -> BlockParser m il bl bl
blockConstructor (Tree (BlockData m a b) -> BlockSpec m a b
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
               (a, [b]) -> ParsecT [Tok] (BPState m a b) m (a, [b])
forall a. a -> ParsecT [Tok] (BPState m a b) m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, [b]) -> ParsecT [Tok] (BPState m a b) m (a, [b]))
-> (a, [b]) -> ParsecT [Tok] (BPState m a b) m (a, [b])
forall a b. (a -> b) -> a -> b
$! (a
term, [b]
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]))
-> [BlockNode 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m (il, [bl])
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 ListSpacing -> [ListSpacing] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ListSpacing
LooseList
                     ((BlockNode m il bl -> ListSpacing)
-> [BlockNode 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) [BlockNode 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 -> [BlockNode m il bl] -> BlockNode m il bl
forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
cdata{ blockData = toDyn 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          = BlockParser m il bl BlockStartResult
forall a. ParsecT [Tok] (BPState m il bl) m a
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 a. ParsecT [Tok] (BPState m il bl) m a
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   = 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 [Tree (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
-> [Tree (BlockData m il bl)] -> Tree (BlockData m il bl)
forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
nd{ blockSpec = plainSpec } [Tree (BlockData m il bl)]
cs
               | Bool
otherwise = BlockData m il bl
-> [Tree (BlockData m il bl)] -> Tree (BlockData m il bl)
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) = BlockData m il bl
-> [Tree (BlockData m il bl)] -> Tree (BlockData m il bl)
forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
nd ((Tree (BlockData m il bl) -> Tree (BlockData m il bl))
-> [Tree (BlockData m il bl)] -> [Tree (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 [Tree (BlockData m il bl)]
cs)
         let children' :: [BlockNode m il bl]
children' =
                case ListSpacing
listSpacing of
                  ListSpacing
TightList -> (BlockNode m il bl -> BlockNode m il bl)
-> [BlockNode m il bl] -> [BlockNode 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 [BlockNode m il bl]
children
                  ListSpacing
LooseList -> [BlockNode 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 -> [BlockNode m il bl] -> BlockNode m il bl
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          = 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
initcol <- SourcePos -> Int
sourceColumn (SourcePos -> Int)
-> ParsecT [Tok] (BPState m il bl) m SourcePos
-> ParsecT [Tok] (BPState m il bl) m Int
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
         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
'~'
         ParsecT [Tok] (BPState m il bl) m [Tok]
-> ParsecT [Tok] (BPState m il bl) m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT [Tok] (BPState m il bl) m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
         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
try (Int -> ParsecT [Tok] (BPState m il bl) m Int
forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleUpToSpaces Int
4 ParsecT [Tok] (BPState m il bl) m Int
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m Int
forall a b.
ParsecT [Tok] (BPState m il bl) m a
-> ParsecT [Tok] (BPState m il bl) m b
-> ParsecT [Tok] (BPState m il bl) m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] (BPState m il bl) m [Tok]
-> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT [Tok] (BPState m il bl) m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace)
           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 -> ParsecT [Tok] (BPState m il bl) m Int
forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleSpaces Int
1
           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
1 Int
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Int
forall a b.
a
-> ParsecT [Tok] (BPState m il bl) m b
-> ParsecT [Tok] (BPState m il bl) m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd
         Int
finalcol <- SourcePos -> Int
sourceColumn (SourcePos -> Int)
-> ParsecT [Tok] (BPState m il bl) m SourcePos
-> ParsecT [Tok] (BPState m il bl) m Int
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
         (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 definitionIndent :: Int
             definitionIndent :: Int
definitionIndent = Int
finalcol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
initcol
         let defnode :: BlockNode m il bl
defnode = BlockData m il bl -> [BlockNode m il bl] -> BlockNode m il bl
forall a. a -> [Tree 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 = [pos],
                                  blockData = toDyn definitionIndent } []
         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 -> ParsecT [Tok] (BPState m il bl) m ()
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)
-> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((BPState m il bl -> BPState m il bl)
 -> ParsecT [Tok] (BPState m il bl) m ())
-> (BPState m il bl -> BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ \BPState m il bl
st -> BPState m il bl
st{ nodeStack = rest }
                   BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl))
-> BlockNode m il bl -> BlockParser m il bl (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 -> [Tree 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 = toDyn TightList
                            , blockLines = blockLines bdata
                            , blockStartPos = blockStartPos 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)
-> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((BPState m il bl -> BPState m il bl)
 -> ParsecT [Tok] (BPState m il bl) m ())
-> (BPState m il bl -> BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ \BPState m il bl
st -> BPState m il bl
st{ nodeStack =
                              Node bdata rest' : rest }
                         BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl))
-> BlockNode m il bl -> BlockParser m il bl (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 -> [Tree 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 = toDyn LooseList
                                  , blockStartPos = blockStartPos
                                                     (rootLabel lastChild)
                                  , blockLines = blockLines
                                        (rootLabel lastChild)
                                  } []
                     [BlockNode m il bl]
_ -> BlockParser m il bl (BlockNode m il bl)
forall a. ParsecT [Tok] (BPState m il bl) m a
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 -> [Tree 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 = blockStartPos
                                             (rootLabel 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)
-> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((BPState m il bl -> BPState m il bl)
 -> ParsecT [Tok] (BPState m il bl) m ())
-> (BPState m il bl -> BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ \BPState m il bl
st -> BPState m il bl
st{ nodeStack =
                        m : Node bdata' ms : rest' }
               [BlockNode m il bl]
_ -> () -> ParsecT [Tok] (BPState m il bl) m ()
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
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 -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack BlockNode m il bl
linode ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b.
ParsecT [Tok] (BPState m il bl) m a
-> ParsecT [Tok] (BPState m il bl) m b
-> ParsecT [Tok] (BPState m il bl) m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
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 -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack BlockNode m il bl
listnode ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b.
ParsecT [Tok] (BPState m il bl) m a
-> ParsecT [Tok] (BPState m il bl) m b
-> ParsecT [Tok] (BPState m il bl) m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack BlockNode m il bl
linode ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b.
ParsecT [Tok] (BPState m il bl) m a
-> ParsecT [Tok] (BPState m il bl) m b
-> ParsecT [Tok] (BPState m il bl) m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                       BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
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 a. a -> ParsecT [Tok] (BPState m il bl) m a
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       = \node :: BlockNode m il bl
node@(Node BlockData m il bl
ndata [BlockNode m il bl]
_cs) -> do
         SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
         let definitionIndent :: Int
definitionIndent = Dynamic -> Int -> Int
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
ndata) Int
0
         Int -> ParsecT [Tok] (BPState m il bl) m Int
forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleSpaces Int
definitionIndent 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
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m Int
forall a b.
a
-> ParsecT [Tok] (BPState m il bl) m b
-> ParsecT [Tok] (BPState m il bl) m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT [Tok] (BPState m il bl) m ()
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 a. a -> ParsecT [Tok] (BPState m il bl) m a
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 a b.
(a -> b)
-> ParsecT [Tok] (BPState m il bl) m a
-> ParsecT [Tok] (BPState m il bl) m b
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 -> BlockParser m il bl (BlockNode m il bl)
blockFinalize       = 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
     }

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 :: forall a. 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)
forall (m :: * -> *) a. Monad m => [m a] -> m [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [WithSourceMap bl] -> WithSourceMap [bl]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [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 a. a -> WithSourceMap a
forall (m :: * -> *) a. Monad m => a -> m a
return bl
res