git.iko.soy/Idris-dev
on cfb0cd7 help sign in
Idris-dev/src/Idris/Docstrings.hs
301 lines 15 kB history raw
1{-|
2Module : Idris.Docstrings
3Description : Wrapper around Markdown library.
5License : BSD3
6Maintainer : The Idris Community.
7-}
9{-# LANGUAGE CPP, DeriveFoldable, DeriveFunctor, DeriveGeneric,
10 DeriveTraversable, ScopedTypeVariables #-}
11{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
12module Idris.Docstrings (
13 Docstring(..), Block(..), Inline(..), parseDocstring, renderDocstring
14 , emptyDocstring, nullDocstring, noDocs, overview, containsText
15 , renderHtml, annotCode, DocTerm(..), renderDocTerm, checkDocstring
16 ) where
18import Idris.Core.TT (Err, Name, OutputAnnotation(..), Term, TextFormatting(..))
20import Util.Pretty
22#if (MIN_VERSION_base(4,11,0))
23import Prelude hiding ((<$>), (<>))
24#else
25import Prelude hiding ((<$>))
26#endif
27import qualified Cheapskate as C
28import Cheapskate.Html (renderDoc)
29import qualified Cheapskate.Types as CT
30import Data.Foldable (Foldable)
31import qualified Data.Foldable as F
32import qualified Data.Sequence as S
33import qualified Data.Text as T
34import Data.Traversable (Traversable)
35import GHC.Generics (Generic)
36import Text.Blaze.Html (Html)
38-- | The various kinds of code samples that can be embedded in docs
39data DocTerm = Unchecked
40 | Checked Term
41 | Example Term
42 | Failing Err
43 deriving (Show, Generic)
45-- | Render a term in the documentation
46renderDocTerm :: (Term -> Doc OutputAnnotation) -> (Term -> Term) -> DocTerm -> String -> Doc OutputAnnotation
47renderDocTerm pp norm Unchecked src = text src
48renderDocTerm pp norm (Checked tm) src = pp tm
49renderDocTerm pp norm (Example tm) src = align $
50 text ">" <+> align (pp tm) <$>
51 pp (norm tm)
52renderDocTerm pp norm (Failing err) src = annotate (AnnErr err) $ text src
54-- | Representation of Idris's inline documentation. The type paramter
55-- represents the type of terms that are associated with code blocks.
56data Docstring a = DocString CT.Options (Blocks a)
57 deriving (Show, Functor, Foldable, Traversable, Generic)
59type Blocks a = S.Seq (Block a)
61-- | Block-level elements.
62data Block a = Para (Inlines a)
63 | Header Int (Inlines a)
64 | Blockquote (Blocks a)
65 | List Bool CT.ListType [Blocks a]
66 | CodeBlock CT.CodeAttr T.Text a
67 | HtmlBlock T.Text
68 | HRule
69 deriving (Show, Functor, Foldable, Traversable, Generic)
71data Inline a = Str T.Text
72 | Space
73 | SoftBreak
74 | LineBreak
75 | Emph (Inlines a)
76 | Strong (Inlines a)
77 | Code T.Text a
78 | Link (Inlines a) T.Text T.Text
79 | Image (Inlines a) T.Text T.Text
80 | Entity T.Text
81 | RawHtml T.Text
82 deriving (Show, Functor, Foldable, Traversable, Generic)
84type Inlines a = S.Seq (Inline a)
87-- | Run some kind of processing step over code in a Docstring. The code
88-- processor gets the language and annotations as parameters, along with the
89-- source and the original annotation.
90checkDocstring :: forall a b. (String -> [String] -> String -> a -> b) -> Docstring a -> Docstring b
91checkDocstring f (DocString opts blocks) = DocString opts (fmap (checkBlock f) blocks)
92 where checkBlock :: (String -> [String] -> String -> a -> b) -> Block a -> Block b
93 checkBlock f (Para inlines) = Para (fmap (checkInline f) inlines)
94 checkBlock f (Header i inlines) = Header i (fmap (checkInline f) inlines)
95 checkBlock f (Blockquote bs) = Blockquote (fmap (checkBlock f) bs)
96 checkBlock f (List b t blocks) = List b t (fmap (fmap (checkBlock f)) blocks)
97 checkBlock f (CodeBlock attrs src tm) = CodeBlock attrs src
98 (f (T.unpack $ CT.codeLang attrs)
99 (words . T.unpack $ CT.codeInfo attrs)
100 (T.unpack src)
101 tm)
102 checkBlock f (HtmlBlock src) = HtmlBlock src
103 checkBlock f HRule = HRule
105 checkInline :: (String -> [String] -> String -> a -> b) -> Inline a -> Inline b
106 checkInline f (Str txt) = Str txt
107 checkInline f Space = Space
108 checkInline f SoftBreak = SoftBreak
109 checkInline f LineBreak = LineBreak
110 checkInline f (Emph is) = Emph (fmap (checkInline f) is)
111 checkInline f (Strong is) = Strong (fmap (checkInline f) is)
112 checkInline f (Code src x) = Code src (f "" [] (T.unpack src) x)
113 checkInline f (Link is url title) = Link (fmap (checkInline f) is) url title
114 checkInline f (Image is url title) = Image (fmap (checkInline f) is) url title
115 checkInline f (Entity txt) = Entity txt
116 checkInline f (RawHtml src) = RawHtml src
118-- | Construct a docstring from a Text that contains Markdown-formatted docs
119parseDocstring :: T.Text -> Docstring ()
120parseDocstring = toDocstring . C.markdown options
121 where toDocstring :: CT.Doc -> Docstring ()
122 toDocstring (CT.Doc opts blocks) = DocString opts (fmap toBlock blocks)
124 toBlock :: CT.Block -> Block ()
125 toBlock (CT.Para inlines) = Para (fmap toInline inlines)
126 toBlock (CT.Header i inlines) = Header i (fmap toInline inlines)
127 toBlock (CT.Blockquote blocks) = Blockquote (fmap toBlock blocks)
128 toBlock (CT.List b t blocks) = List b t (fmap (fmap toBlock) blocks)
129 toBlock (CT.CodeBlock attrs text) = CodeBlock attrs text ()
130 toBlock (CT.HtmlBlock src) = HtmlBlock src
131 toBlock CT.HRule = HRule
133 toInline :: CT.Inline -> Inline ()
134 toInline (CT.Str t) = Str t
135 toInline CT.Space = Space
136 toInline CT.SoftBreak = SoftBreak
137 toInline CT.LineBreak = LineBreak
138 toInline (CT.Emph is) = Emph (fmap toInline is)
139 toInline (CT.Strong is) = Strong (fmap toInline is)
140 toInline (CT.Code src) = Code src ()
141 toInline (CT.Link is url title) = Link (fmap toInline is) url title
142 toInline (CT.Image is url title) = Image (fmap toInline is) url title
143 toInline (CT.Entity txt) = Entity txt
144 toInline (CT.RawHtml src) = RawHtml src
147options = CT.Options { CT.sanitize = True
148 , CT.allowRawHtml = False
149 , CT.preserveHardBreaks = True
150 , CT.debug = False
151 }
153-- | Convert a docstring to be shown by the pretty-printer
154renderDocstring :: (a -> String -> Doc OutputAnnotation) -> Docstring a -> Doc OutputAnnotation
155renderDocstring pp (DocString _ blocks) = renderBlocks pp blocks
157-- | Construct a docstring consisting of the first block-level element of the
158-- argument docstring, for use in summaries.
159overview :: Docstring a -> Docstring a
160overview (DocString opts blocks) = DocString opts (S.take 1 blocks)
162renderBlocks :: (a -> String -> Doc OutputAnnotation)
163 -> Blocks a -> Doc OutputAnnotation
164renderBlocks pp blocks | S.length blocks > 1 = F.foldr1 (\b1 b2 -> b1 <> line <> line <> b2) $
165 fmap (renderBlock pp) blocks
166 | S.length blocks == 1 = renderBlock pp (S.index blocks 0)
167 | otherwise = empty
169renderBlock :: (a -> String -> Doc OutputAnnotation)
170 -> Block a -> Doc OutputAnnotation
171renderBlock pp (Para inlines) = renderInlines pp inlines
172renderBlock pp (Header lvl inlines) = renderInlines pp inlines <+> parens (text (show lvl))
173renderBlock pp (Blockquote blocks) = indent 8 $ renderBlocks pp blocks
174renderBlock pp (List b ty blockss) = renderList pp b ty blockss
175renderBlock pp (CodeBlock attr src tm) = indent 4 $ pp tm (T.unpack src)
176renderBlock pp (HtmlBlock txt) = text "<html block>" -- TODO
177renderBlock pp HRule = text "----------------------"
179renderList :: (a -> String -> Doc OutputAnnotation)
180 -> Bool -> CT.ListType -> [Blocks a] -> Doc OutputAnnotation
181renderList pp b (CT.Bullet c) blockss = vsep $ map (hang 4 . (char c <+>) . renderBlocks pp) blockss
182renderList pp b (CT.Numbered nw i) blockss =
183 vsep $
184 zipWith3 (\n p txt -> hang 4 $ text (show n) <> p <+> txt)
185 [i..] (repeat punc) (map (renderBlocks pp) blockss)
186 where punc = case nw of
187 CT.PeriodFollowing -> char '.'
188 CT.ParenFollowing -> char '('
190renderInlines :: (a -> String -> Doc OutputAnnotation) -> Inlines a -> Doc OutputAnnotation
191renderInlines pp = F.foldr (<>) empty . fmap (renderInline pp)
193renderInline :: (a -> String -> Doc OutputAnnotation) -> Inline a -> Doc OutputAnnotation
194renderInline pp (Str s) = text $ T.unpack s
195renderInline pp Space = softline
196renderInline pp SoftBreak = softline
197renderInline pp LineBreak = line
198renderInline pp (Emph txt) = annotate (AnnTextFmt ItalicText) $ renderInlines pp txt
199renderInline pp (Strong txt) = annotate (AnnTextFmt BoldText) $ renderInlines pp txt
200renderInline pp (Code txt tm) = pp tm $ T.unpack txt
201renderInline pp (Link body url title) = annotate (AnnLink (T.unpack url)) (renderInlines pp body)
202renderInline pp (Image body url title) = text "<image>" -- TODO
203renderInline pp (Entity a) = text $ "<entity " ++ T.unpack a ++ ">" -- TODO
204renderInline pp (RawHtml txt) = text "<html content>" --TODO
206-- | The empty docstring
207emptyDocstring :: Docstring a
208emptyDocstring = DocString options S.empty
210-- | Check whether a docstring is emtpy
211nullDocstring :: Docstring a -> Bool
212nullDocstring (DocString _ blocks) = S.null blocks
214-- | Empty documentation for a definition
215noDocs :: (Docstring a, [(Name, Docstring a)])
216noDocs = (emptyDocstring, [])
218-- | Does a string occur in the docstring?
219containsText :: T.Text -> Docstring a -> Bool
220containsText str (DocString _ blocks) = F.any (blockContains (T.toLower str)) blocks
221 -- blockContains and inlineContains should always be called with a lower-case search string
222 where blockContains :: T.Text -> Block a -> Bool
223 blockContains str (Para inlines) = F.any (inlineContains str) inlines
224 blockContains str (Header lvl inlines) = F.any (inlineContains str) inlines
225 blockContains str (Blockquote blocks) = F.any (blockContains str) blocks
226 blockContains str (List b ty blockss) = F.any (F.any (blockContains str)) blockss
227 blockContains str (CodeBlock attr src _) = T.isInfixOf str (T.toLower src)
228 blockContains str (HtmlBlock txt) = False -- TODO
229 blockContains str HRule = False
231 inlineContains :: T.Text -> Inline a -> Bool
232 inlineContains str (Str s) = T.isInfixOf str (T.toLower s)
233 inlineContains str Space = False
234 inlineContains str SoftBreak = False
235 inlineContains str LineBreak = False
236 inlineContains str (Emph txt) = F.any (inlineContains str) txt
237 inlineContains str (Strong txt) = F.any (inlineContains str) txt
238 inlineContains str (Code txt _) = T.isInfixOf str (T.toLower txt)
239 inlineContains str (Link body url title) = F.any (inlineContains str) body
240 inlineContains str (Image body url title) = False
241 inlineContains str (Entity a) = False
242 inlineContains str (RawHtml txt) = T.isInfixOf str (T.toLower txt)
245renderHtml :: Docstring DocTerm -> Html
246renderHtml = renderDoc . fromDocstring
247 where
248 fromDocstring :: Docstring DocTerm -> CT.Doc
249 fromDocstring (DocString opts blocks) = CT.Doc opts (fmap fromBlock blocks)
251 fromBlock :: Block DocTerm -> CT.Block
252 fromBlock (Para inlines) = CT.Para (fmap fromInline inlines)
253 fromBlock (Header i inlines) = CT.Header i (fmap fromInline inlines)
254 fromBlock (Blockquote blocks) = CT.Blockquote (fmap fromBlock blocks)
255 fromBlock (List b t blocks) = CT.List b t (fmap (fmap fromBlock) blocks)
256 fromBlock (CodeBlock attrs text _) = CT.CodeBlock attrs text
257 fromBlock (HtmlBlock src) = CT.HtmlBlock src
258 fromBlock HRule = CT.HRule
260 fromInline :: Inline DocTerm -> CT.Inline
261 fromInline (Str t) = CT.Str t
262 fromInline Space = CT.Space
263 fromInline SoftBreak = CT.SoftBreak
264 fromInline LineBreak = CT.LineBreak
265 fromInline (Emph is) = CT.Emph (fmap fromInline is)
266 fromInline (Strong is) = CT.Strong (fmap fromInline is)
267 fromInline (Code src _) = CT.Code src
268 fromInline (Link is url title) = CT.Link (fmap fromInline is) url title
269 fromInline (Image is url title) = CT.Image (fmap fromInline is) url title
270 fromInline (Entity txt) = CT.Entity txt
271 fromInline (RawHtml src) = CT.RawHtml src
274-- | Annotate the code samples in a docstring
275annotCode :: forall a b. (String -> b) -- ^ How to annotate code samples
276 -> Docstring a
277 -> Docstring b
278annotCode annot (DocString opts blocks)
279 = DocString opts $ fmap annotCodeBlock blocks
280 where
281 annotCodeBlock :: Block a -> Block b
282 annotCodeBlock (Para inlines) = Para (fmap annotCodeInline inlines)
283 annotCodeBlock (Header i inlines) = Header i (fmap annotCodeInline inlines)
284 annotCodeBlock (Blockquote blocks) = Blockquote (fmap annotCodeBlock blocks)
285 annotCodeBlock (List b t blocks) = List b t (fmap (fmap annotCodeBlock) blocks)
286 annotCodeBlock (CodeBlock attrs src _) = CodeBlock attrs src (annot (T.unpack src))
287 annotCodeBlock (HtmlBlock src) = HtmlBlock src
288 annotCodeBlock HRule = HRule
290 annotCodeInline :: Inline a -> Inline b
291 annotCodeInline (Str t) = Str t
292 annotCodeInline Space = Space
293 annotCodeInline SoftBreak = SoftBreak
294 annotCodeInline LineBreak = LineBreak
295 annotCodeInline (Emph is) = Emph (fmap annotCodeInline is)
296 annotCodeInline (Strong is) = Strong (fmap annotCodeInline is)
297 annotCodeInline (Code src _) = Code src (annot (T.unpack src))
298 annotCodeInline (Link is url title) = Link (fmap annotCodeInline is) url title
299 annotCodeInline (Image is url title) = Image (fmap annotCodeInline is) url title
300 annotCodeInline (Entity txt) = Entity txt
301 annotCodeInline (RawHtml src) = RawHtml src