{-# 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 (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]
whitespace
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
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
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
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