1{-# LANGUAGE DeriveFunctor, ScopedTypeVariables #-}
2{-# OPTIONS_GHC -fwarn-incomplete-patterns -Werror #-}
4-- | Wrapper around Markdown library
5module Idris.Docstrings (
6 Docstring(..), Block(..), Inline(..), parseDocstring, renderDocstring, emptyDocstring, nullDocstring, noDocs,
7 overview, containsText, renderHtml, annotCode, DocTerm(..), renderDocTerm, checkDocstring
10import qualified Cheapskate as C
11import qualified Cheapskate.Types as CT
12import Cheapskate.Html (renderDoc)
16import Idris.Core.TT (OutputAnnotation(..), TextFormatting(..), Name, Term, Err)
18import qualified Data.Text as T
19import qualified Data.Foldable as F
20import Data.Foldable (Foldable)
21import Data.Traversable (Traversable)
22import qualified Data.Sequence as S
24import Control.DeepSeq (NFData(..))
26import Text.Blaze.Html (Html)
28-- | The various kinds of code samples that can be embedded in docs
29data DocTerm = Unchecked
35-- | Render a term in the documentation
36renderDocTerm :: (Term -> Doc OutputAnnotation) -> (Term -> Term) -> DocTerm -> String -> Doc OutputAnnotation
37renderDocTerm pp norm Unchecked src = text src
38renderDocTerm pp norm (Checked tm) src = pp tm
39renderDocTerm pp norm (Example tm) src = align $
40 text ">" <+> align (pp tm) <$>
42renderDocTerm pp norm (Failing err) src = annotate (AnnErr err) $ text src
44-- | Representation of Idris's inline documentation. The type paramter
45-- represents the type of terms that are associated with code blocks.
46data Docstring a = DocString CT.Options (Blocks a)
47 deriving (Show, Functor, Foldable, Traversable)
49type Blocks a = S.Seq (Block a)
51-- | Block-level elements.
52data Block a = Para (Inlines a)
53 | Header Int (Inlines a)
54 | Blockquote (Blocks a)
55 | List Bool CT.ListType [Blocks a]
56 | CodeBlock CT.CodeAttr T.Text a
59 deriving (Show, Functor, Foldable, Traversable)
61data Inline a = Str T.Text
68 | Link (Inlines a) T.Text T.Text
69 | Image (Inlines a) T.Text T.Text
72 deriving (Show, Functor, Foldable, Traversable)
74type Inlines a = S.Seq (Inline a)
77-- | Run some kind of processing step over code in a Docstring. The code
78-- processor gets the language and annotations as parameters, along with the
79-- source and the original annotation.
80checkDocstring :: forall a b. (String -> [String] -> String -> a -> b) -> Docstring a -> Docstring b
81checkDocstring f (DocString opts blocks) = DocString opts (fmap (checkBlock f) blocks)
82 where checkBlock :: (String -> [String] -> String -> a -> b) -> Block a -> Block b
83 checkBlock f (Para inlines) = Para (fmap (checkInline f) inlines)
84 checkBlock f (Header i inlines) = Header i (fmap (checkInline f) inlines)
85 checkBlock f (Blockquote bs) = Blockquote (fmap (checkBlock f) bs)
86 checkBlock f (List b t blocks) = List b t (fmap (fmap (checkBlock f)) blocks)
87 checkBlock f (CodeBlock attrs src tm) = CodeBlock attrs src
88 (f (T.unpack $ CT.codeLang attrs)
89 (words . T.unpack $ CT.codeInfo attrs)
92 checkBlock f (HtmlBlock src) = HtmlBlock src
93 checkBlock f HRule = HRule
95 checkInline :: (String -> [String] -> String -> a -> b) -> Inline a -> Inline b
96 checkInline f (Str txt) = Str txt
97 checkInline f Space = Space
98 checkInline f SoftBreak = SoftBreak
99 checkInline f LineBreak = LineBreak
100 checkInline f (Emph is) = Emph (fmap (checkInline f) is)
101 checkInline f (Strong is) = Strong (fmap (checkInline f) is)
102 checkInline f (Code src x) = Code src (f "" [] (T.unpack src) x)
103 checkInline f (Link is url title) = Link (fmap (checkInline f) is) url title
104 checkInline f (Image is url title) = Image (fmap (checkInline f) is) url title
105 checkInline f (Entity txt) = Entity txt
106 checkInline f (RawHtml src) = RawHtml src
108-- | Construct a docstring from a Text that contains Markdown-formatted docs
109parseDocstring :: T.Text -> Docstring ()
110parseDocstring = toDocstring . C.markdown options
111 where toDocstring :: CT.Doc -> Docstring ()
112 toDocstring (CT.Doc opts blocks) = DocString opts (fmap toBlock blocks)
114 toBlock :: CT.Block -> Block ()
115 toBlock (CT.Para inlines) = Para (fmap toInline inlines)
116 toBlock (CT.Header i inlines) = Header i (fmap toInline inlines)
117 toBlock (CT.Blockquote blocks) = Blockquote (fmap toBlock blocks)
118 toBlock (CT.List b t blocks) = List b t (fmap (fmap toBlock) blocks)
119 toBlock (CT.CodeBlock attrs text) = CodeBlock attrs text ()
120 toBlock (CT.HtmlBlock src) = HtmlBlock src
121 toBlock CT.HRule = HRule
123 toInline :: CT.Inline -> Inline ()
124 toInline (CT.Str t) = Str t
125 toInline CT.Space = Space
126 toInline CT.SoftBreak = SoftBreak
127 toInline CT.LineBreak = LineBreak
128 toInline (CT.Emph is) = Emph (fmap toInline is)
129 toInline (CT.Strong is) = Strong (fmap toInline is)
130 toInline (CT.Code src) = Code src ()
131 toInline (CT.Link is url title) = Link (fmap toInline is) url title
132 toInline (CT.Image is url title) = Image (fmap toInline is) url title
133 toInline (CT.Entity txt) = Entity txt
134 toInline (CT.RawHtml src) = RawHtml src
137options = CT.Options { CT.sanitize = True
138 , CT.allowRawHtml = False
139 , CT.preserveHardBreaks = True
143-- | Convert a docstring to be shown by the pretty-printer
144renderDocstring :: (a -> String -> Doc OutputAnnotation) -> Docstring a -> Doc OutputAnnotation
145renderDocstring pp (DocString _ blocks) = renderBlocks pp blocks
147-- | Construct a docstring consisting of the first block-level element of the
148-- argument docstring, for use in summaries.
149overview :: Docstring a -> Docstring a
150overview (DocString opts blocks) = DocString opts (S.take 1 blocks)
152renderBlocks :: (a -> String -> Doc OutputAnnotation)
153 -> Blocks a -> Doc OutputAnnotation
154renderBlocks pp blocks | S.length blocks > 1 = F.foldr1 (\b1 b2 -> b1 <> line <> line <> b2) $
155 fmap (renderBlock pp) blocks
156 | S.length blocks == 1 = renderBlock pp (S.index blocks 0)
159renderBlock :: (a -> String -> Doc OutputAnnotation)
160 -> Block a -> Doc OutputAnnotation
161renderBlock pp (Para inlines) = renderInlines pp inlines
162renderBlock pp (Header lvl inlines) = renderInlines pp inlines <+> parens (text (show lvl))
163renderBlock pp (Blockquote blocks) = indent 8 $ renderBlocks pp blocks
164renderBlock pp (List b ty blockss) = renderList pp b ty blockss
165renderBlock pp (CodeBlock attr src tm) = indent 4 $ pp tm (T.unpack src)
166renderBlock pp (HtmlBlock txt) = text "<html block>" -- TODO
167renderBlock pp HRule = text "----------------------"
169renderList :: (a -> String -> Doc OutputAnnotation)
170 -> Bool -> CT.ListType -> [Blocks a] -> Doc OutputAnnotation
171renderList pp b (CT.Bullet c) blockss = vsep $ map (hang 4 . (char c <+>) . renderBlocks pp) blockss
172renderList pp b (CT.Numbered nw i) blockss =
174 zipWith3 (\n p txt -> hang 4 $ text (show n) <> p <+> txt)
175 [i..] (repeat punc) (map (renderBlocks pp) blockss)
176 where punc = case nw of
177 CT.PeriodFollowing -> char '.'
178 CT.ParenFollowing -> char '('
180renderInlines :: (a -> String -> Doc OutputAnnotation) -> Inlines a -> Doc OutputAnnotation
181renderInlines pp = F.foldr (<>) empty . fmap (renderInline pp)
183renderInline :: (a -> String -> Doc OutputAnnotation) -> Inline a -> Doc OutputAnnotation
184renderInline pp (Str s) = text $ T.unpack s
185renderInline pp Space = softline
186renderInline pp SoftBreak = softline
187renderInline pp LineBreak = line
188renderInline pp (Emph txt) = annotate (AnnTextFmt ItalicText) $ renderInlines pp txt
189renderInline pp (Strong txt) = annotate (AnnTextFmt BoldText) $ renderInlines pp txt
190renderInline pp (Code txt tm) = pp tm $ T.unpack txt
191renderInline pp (Link body url title) = annotate (AnnTextFmt UnderlineText) (renderInlines pp body) <+>
192 parens (text $ T.unpack url)
193renderInline pp (Image body url title) = text "<image>" -- TODO
194renderInline pp (Entity a) = text $ "<entity " ++ T.unpack a ++ ">" -- TODO
195renderInline pp (RawHtml txt) = text "<html content>" --TODO
197-- | The empty docstring
198emptyDocstring :: Docstring a
199emptyDocstring = DocString options S.empty
201-- | Check whether a docstring is emtpy
202nullDocstring :: Docstring a -> Bool
203nullDocstring (DocString _ blocks) = S.null blocks
205-- | Empty documentation for a definition
206noDocs :: (Docstring a, [(Name, Docstring a)])
207noDocs = (emptyDocstring, [])
209-- | Does a string occur in the docstring?
210containsText :: T.Text -> Docstring a -> Bool
211containsText str (DocString _ blocks) = F.any (blockContains (T.toLower str)) blocks
212 -- blockContains and inlineContains should always be called with a lower-case search string
213 where blockContains :: T.Text -> Block a -> Bool
214 blockContains str (Para inlines) = F.any (inlineContains str) inlines
215 blockContains str (Header lvl inlines) = F.any (inlineContains str) inlines
216 blockContains str (Blockquote blocks) = F.any (blockContains str) blocks
217 blockContains str (List b ty blockss) = F.any (F.any (blockContains str)) blockss
218 blockContains str (CodeBlock attr src _) = T.isInfixOf str (T.toLower src)
219 blockContains str (HtmlBlock txt) = False -- TODO
220 blockContains str HRule = False
222 inlineContains :: T.Text -> Inline a -> Bool
223 inlineContains str (Str s) = T.isInfixOf str (T.toLower s)
224 inlineContains str Space = False
225 inlineContains str SoftBreak = False
226 inlineContains str LineBreak = False
227 inlineContains str (Emph txt) = F.any (inlineContains str) txt
228 inlineContains str (Strong txt) = F.any (inlineContains str) txt
229 inlineContains str (Code txt _) = T.isInfixOf str (T.toLower txt)
230 inlineContains str (Link body url title) = F.any (inlineContains str) body
231 inlineContains str (Image body url title) = False
232 inlineContains str (Entity a) = False
233 inlineContains str (RawHtml txt) = T.isInfixOf str (T.toLower txt)
236renderHtml :: Docstring DocTerm -> Html
237renderHtml = renderDoc . fromDocstring
239 fromDocstring :: Docstring DocTerm -> CT.Doc
240 fromDocstring (DocString opts blocks) = CT.Doc opts (fmap fromBlock blocks)
242 fromBlock :: Block DocTerm -> CT.Block
243 fromBlock (Para inlines) = CT.Para (fmap fromInline inlines)
244 fromBlock (Header i inlines) = CT.Header i (fmap fromInline inlines)
245 fromBlock (Blockquote blocks) = CT.Blockquote (fmap fromBlock blocks)
246 fromBlock (List b t blocks) = CT.List b t (fmap (fmap fromBlock) blocks)
247 fromBlock (CodeBlock attrs text _) = CT.CodeBlock attrs text
248 fromBlock (HtmlBlock src) = CT.HtmlBlock src
249 fromBlock HRule = CT.HRule
251 fromInline :: Inline DocTerm -> CT.Inline
252 fromInline (Str t) = CT.Str t
253 fromInline Space = CT.Space
254 fromInline SoftBreak = CT.SoftBreak
255 fromInline LineBreak = CT.LineBreak
256 fromInline (Emph is) = CT.Emph (fmap fromInline is)
257 fromInline (Strong is) = CT.Strong (fmap fromInline is)
258 fromInline (Code src _) = CT.Code src
259 fromInline (Link is url title) = CT.Link (fmap fromInline is) url title
260 fromInline (Image is url title) = CT.Image (fmap fromInline is) url title
261 fromInline (Entity txt) = CT.Entity txt
262 fromInline (RawHtml src) = CT.RawHtml src
265-- | Annotate the code samples in a docstring
266annotCode :: forall a b. (String -> b) -- ^ How to annotate code samples
269annotCode annot (DocString opts blocks)
270 = DocString opts $ fmap annotCodeBlock blocks
272 annotCodeBlock :: Block a -> Block b
273 annotCodeBlock (Para inlines) = Para (fmap annotCodeInline inlines)
274 annotCodeBlock (Header i inlines) = Header i (fmap annotCodeInline inlines)
275 annotCodeBlock (Blockquote blocks) = Blockquote (fmap annotCodeBlock blocks)
276 annotCodeBlock (List b t blocks) = List b t (fmap (fmap annotCodeBlock) blocks)
277 annotCodeBlock (CodeBlock attrs src _) = CodeBlock attrs src (annot (T.unpack src))
278 annotCodeBlock (HtmlBlock src) = HtmlBlock src
279 annotCodeBlock HRule = HRule
281 annotCodeInline :: Inline a -> Inline b
282 annotCodeInline (Str t) = Str t
283 annotCodeInline Space = Space
284 annotCodeInline SoftBreak = SoftBreak
285 annotCodeInline LineBreak = LineBreak
286 annotCodeInline (Emph is) = Emph (fmap annotCodeInline is)
287 annotCodeInline (Strong is) = Strong (fmap annotCodeInline is)
288 annotCodeInline (Code src _) = Code src (annot (T.unpack src))
289 annotCodeInline (Link is url title) = Link (fmap annotCodeInline is) url title
290 annotCodeInline (Image is url title) = Image (fmap annotCodeInline is) url title
291 annotCodeInline (Entity txt) = Entity txt
292 annotCodeInline (RawHtml src) = RawHtml src
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list