git.iko.soy/Idris-dev
on 9302221 help sign in
Idris-dev/src/Idris/Docstrings.hs
119 lines 5.4 kB history raw
1-- | Wrapper around Markdown library
2module Idris.Docstrings (
3 Docstring, parseDocstring, renderDocstring, emptyDocstring, nullDocstring, noDocs,
4 overview, containsText
5 ) where
7import qualified Cheapskate as C
8import qualified Cheapskate.Types as CT
10import Util.Pretty
12import Idris.Core.TT (OutputAnnotation(..), TextFormatting(..), Name)
14import qualified Data.Text as T
15import qualified Data.Foldable as F
16import qualified Data.Sequence as S
18-- | Representation of Idris's inline documentation
19type Docstring = CT.Doc
21-- | Construct a docstring from a Text that contains Markdown-formatted docs
22parseDocstring :: T.Text -> CT.Doc
23parseDocstring = C.markdown options
26options = CT.Options { CT.sanitize = True
27 , CT.allowRawHtml = False
28 , CT.preserveHardBreaks = True
29 , CT.debug = False
30 }
32-- | Convert a docstring to be shown by the pretty-printer
33renderDocstring :: Docstring -> Doc OutputAnnotation
34renderDocstring (CT.Doc _ blocks) = renderBlocks blocks
36-- | Construct a docstring consisting of the first block-level element of the
37-- argument docstring, for use in summaries.
38overview :: Docstring -> Docstring
39overview (CT.Doc opts blocks) = CT.Doc opts (S.take 1 blocks)
41renderBlocks :: CT.Blocks -> Doc OutputAnnotation
42renderBlocks blocks | S.length blocks > 1 = F.foldr1 (\b1 b2 -> b1 <> line <> line <> b2) $
43 fmap renderBlock blocks
44 | S.length blocks == 1 = renderBlock (S.index blocks 0)
45 | otherwise = empty
47renderBlock :: CT.Block -> Doc OutputAnnotation
48renderBlock (CT.Para inlines) = renderInlines inlines
49renderBlock (CT.Header lvl inlines) = renderInlines inlines <+> parens (text (show lvl))
50renderBlock (CT.Blockquote blocks) = indent 8 $ renderBlocks blocks
51renderBlock (CT.List b ty blockss) = renderList b ty blockss
52renderBlock (CT.CodeBlock attr src) = indent 8 $ text (T.unpack src)
53renderBlock (CT.HtmlBlock txt) = text "<html block>" -- TODO
54renderBlock CT.HRule = text "----------------------"
56renderList :: Bool -> CT.ListType -> [CT.Blocks] -> Doc OutputAnnotation
57renderList b (CT.Bullet c) blockss = vsep $ map (hang 4 . (char c <+>) . renderBlocks) blockss
58renderList b (CT.Numbered nw i) blockss =
59 vsep $
60 zipWith3 (\n p txt -> hang 4 $ text (show n) <> p <+> txt)
61 [i..] (repeat punc) (map renderBlocks blockss)
62 where punc = case nw of
63 CT.PeriodFollowing -> char '.'
64 CT.ParenFollowing -> char '('
66renderInlines :: CT.Inlines -> Doc OutputAnnotation
67renderInlines = F.foldr (<>) empty . fmap renderInline
69renderInline :: CT.Inline -> Doc OutputAnnotation
70renderInline (CT.Str s) = text $ T.unpack s
71renderInline CT.Space = space
72renderInline CT.SoftBreak = softline
73renderInline CT.LineBreak = line
74renderInline (CT.Emph txt) = annotate (AnnTextFmt ItalicText) $ renderInlines txt -- TODO
75renderInline (CT.Strong txt) = annotate (AnnTextFmt BoldText) $ renderInlines txt -- TODO
76renderInline (CT.Code txt) = text $ T.unpack txt
77renderInline (CT.Link body url title) = annotate (AnnTextFmt UnderlineText) (renderInlines body) <+>
78 parens (text $ T.unpack url)
79renderInline (CT.Image body url title) = text "<image>" -- TODO
80renderInline (CT.Entity a) = text $ "<entity " ++ T.unpack a ++ ">" -- TODO
81renderInline (CT.RawHtml txt) = text "<html content>" --TODO
83-- | The empty docstring
84emptyDocstring :: Docstring
85emptyDocstring = CT.Doc options S.empty
87-- | Check whether a docstring is emtpy
88nullDocstring :: Docstring -> Bool
89nullDocstring (CT.Doc _ blocks) = S.null blocks
91-- | Empty documentation for a definition
92noDocs :: (Docstring, [(Name, Docstring)])
93noDocs = (emptyDocstring, [])
95-- | Does a string occur in the docstring?
96containsText :: T.Text -> Docstring -> Bool
97containsText str (CT.Doc _ blocks) = F.any (blockContains (T.toLower str)) blocks
98 -- blockContains and inlineContains should always be called with a lower-case search string
99 where blockContains :: T.Text -> CT.Block -> Bool
100 blockContains str (CT.Para inlines) = F.any (inlineContains str) inlines
101 blockContains str (CT.Header lvl inlines) = F.any (inlineContains str) inlines
102 blockContains str (CT.Blockquote blocks) = F.any (blockContains str) blocks
103 blockContains str (CT.List b ty blockss) = F.any (F.any (blockContains str)) blockss
104 blockContains str (CT.CodeBlock attr src) = T.isInfixOf str (T.toLower src)
105 blockContains str (CT.HtmlBlock txt) = False -- TODO
106 blockContains str CT.HRule = False
108 inlineContains :: T.Text -> CT.Inline -> Bool
109 inlineContains str (CT.Str s) = T.isInfixOf str (T.toLower s)
110 inlineContains str CT.Space = False
111 inlineContains str CT.SoftBreak = False
112 inlineContains str CT.LineBreak = False
113 inlineContains str (CT.Emph txt) = F.any (inlineContains str) txt
114 inlineContains str (CT.Strong txt) = F.any (inlineContains str) txt
115 inlineContains str (CT.Code txt) = T.isInfixOf str (T.toLower txt)
116 inlineContains str (CT.Link body url title) = F.any (inlineContains str) body
117 inlineContains str (CT.Image body url title) = False
118 inlineContains str (CT.Entity a) = False
119 inlineContains str (CT.RawHtml txt) = T.isInfixOf str (T.toLower txt)