@@ -94,36 +94,44 @@ options = CT.Options { CT.sanitize = True
9494 }
9595
9696-- | Convert a docstring to be shown by the pretty-printer
97−renderDocstring :: (a -> Doc OutputAnnotation) -> Docstring (Maybe a) -> Doc OutputAnnotation
98−renderDocstring pp (DocString _ blocks) = renderBlocks pp blocks
97+renderDocstring :: (a -> Doc OutputAnnotation) -> (a -> a) -> Docstring (Maybe a) -> Doc OutputAnnotation
98+renderDocstring pp norm (DocString _ blocks) = renderBlocks pp norm blocks
9999
100100-- | Construct a docstring consisting of the first block-level element of the
101101-- argument docstring, for use in summaries.
102102overview :: Docstring a -> Docstring a
103103overview (DocString opts blocks) = DocString opts (S.take 1 blocks)
104104
105−renderBlocks :: (a -> Doc OutputAnnotation) -> Blocks (Maybe a) -> Doc OutputAnnotation
106−renderBlocks pp blocks | S.length blocks > 1 = F.foldr1 (\b1 b2 -> b1 <> line <> line <> b2) $
107− fmap (renderBlock pp) blocks
108− | S.length blocks == 1 = renderBlock pp (S.index blocks 0)
105+renderBlocks :: (a -> Doc OutputAnnotation) -> (a -> a)
106+ -> Blocks (Maybe a) -> Doc OutputAnnotation
107+renderBlocks pp norm blocks | S.length blocks > 1 = F.foldr1 (\b1 b2 -> b1 <> line <> line <> b2) $
108+ fmap (renderBlock pp norm) blocks
109+ | S.length blocks == 1 = renderBlock pp norm (S.index blocks 0)
109110 | otherwise = empty
110111
111−renderBlock :: (a -> Doc OutputAnnotation) -> Block (Maybe a) -> Doc OutputAnnotation
112−renderBlock pp (Para inlines) = renderInlines pp inlines
113−renderBlock pp (Header lvl inlines) = renderInlines pp inlines <+> parens (text (show lvl))
114−renderBlock pp (Blockquote blocks) = indent 8 $ renderBlocks pp blocks
115−renderBlock pp (List b ty blockss) = renderList pp b ty blockss
116−renderBlock pp (CodeBlock attr src Nothing) = indent 8 $ text (T.unpack src)
117−renderBlock pp (CodeBlock attr src (Just tm)) = indent 8 $ pp tm
118−renderBlock pp (HtmlBlock txt) = text "<html block>" -- TODO
119−renderBlock pp HRule = text "----------------------"
120−
121−renderList :: (a -> Doc OutputAnnotation) -> Bool -> CT.ListType -> [Blocks (Maybe a)] -> Doc OutputAnnotation
122−renderList pp b (CT.Bullet c) blockss = vsep $ map (hang 4 . (char c <+>) . renderBlocks pp) blockss
123−renderList pp b (CT.Numbered nw i) blockss =
112+renderBlock :: (a -> Doc OutputAnnotation) -> (a -> a)
113+ -> Block (Maybe a) -> Doc OutputAnnotation
114+renderBlock pp norm (Para inlines) = renderInlines pp inlines
115+renderBlock pp norm (Header lvl inlines) = renderInlines pp inlines <+> parens (text (show lvl))
116+renderBlock pp norm (Blockquote blocks) = indent 8 $ renderBlocks pp norm blocks
117+renderBlock pp norm (List b ty blockss) = renderList pp norm b ty blockss
118+renderBlock pp norm (CodeBlock attr src Nothing) = indent 8 $ text (T.unpack src)
119+renderBlock pp norm (CodeBlock attr src (Just tm))
120+ | isExample attr = indent 4 $
121+ text ">" <+> align (group (pp tm)) <$>
122+ align (group (pp (norm tm)))
123+ | otherwise = indent 4 $ pp tm
124+ where isExample (CT.CodeAttr lang info) = T.pack "example" `elem` lang : T.words info
125+renderBlock pp norm (HtmlBlock txt) = text "<html block>" -- TODO
126+renderBlock pp norm HRule = text "----------------------"
127+
128+renderList :: (a -> Doc OutputAnnotation) -> (a -> a)
129+ -> Bool -> CT.ListType -> [Blocks (Maybe a)] -> Doc OutputAnnotation
130+renderList pp norm b (CT.Bullet c) blockss = vsep $ map (hang 4 . (char c <+>) . renderBlocks pp norm) blockss
131+renderList pp norm b (CT.Numbered nw i) blockss =
124132 vsep $
125133 zipWith3 (\n p txt -> hang 4 $ text (show n) <> p <+> txt)
126− [i..] (repeat punc) (map (renderBlocks pp) blockss)
134+ [i..] (repeat punc) (map (renderBlocks pp norm) blockss)
127135 where punc = case nw of
128136 CT.PeriodFollowing -> char '.'
129137 CT.ParenFollowing -> char '('