]> git.wincent.com - docvim.git/blob - lib/Docvim/Printer/Markdown.hs
Remove unnecessary explicit anchors in headings
[docvim.git] / lib / Docvim / Printer / Markdown.hs
1 module Docvim.Printer.Markdown (markdown) where
2
3 import Control.Monad.Reader
4 import Data.List (intercalate, sort)
5 import Data.Maybe (fromMaybe)
6 import Docvim.AST
7 import Docvim.Parse (rstrip)
8 import Docvim.Visitor.Plugin (getPluginName)
9 import Docvim.Visitor.Symbol (getSymbols)
10
11 data Metadata = Metadata { symbols :: [String]
12                          , pluginName :: Maybe String
13                          }
14 type Env = Reader Metadata String
15
16 data Anchor = Anchor [Attribute] String
17 data Attribute = Attribute { attributeName :: String
18                            , attributeValue :: String
19                            }
20
21 markdown :: Node -> String
22 markdown n = rstrip (runReader (node n) metadata) ++ "\n"
23   where metadata = Metadata (getSymbols n) (getPluginName n)
24
25 nodes :: [Node] -> Env
26 nodes ns = concat <$> mapM node ns
27
28 node :: Node -> Env
29 node n = case n of
30   Blockquote b            -> blockquote b >>= nl >>= nl
31   -- TODO, for readability, this should be "<br />\n" (custom, context-aware separator; see Vim.hs)
32   BreakTag                -> return "<br />"
33   Code c                  -> return $ "`" ++ c ++ "`"
34   CommandAnnotation {}    -> return $ command n
35   CommandsAnnotation      -> return $ h2 "Commands" -- TODO link to foocommands
36   DocBlock d              -> nodes d
37   Fenced f                -> return $ fenced f ++ "\n\n"
38   FunctionDeclaration {}  -> nodes $ functionBody n
39   FunctionsAnnotation     -> return $ h2 "Functions" -- TODO link to foofunctions
40   -- TODO: add an anchor here
41   HeadingAnnotation h     -> return $ h2 h -- TODO link?
42   Link l                  -> link l
43   LinkTargets l           -> return $ linkTargets l ++ "\n"
44   List ls                 -> nodes ls >>= nl
45   ListItem l              -> fmap ("- " ++) (nodes l) >>= nl
46   MappingAnnotation m     -> return $ mapping m
47   MappingsAnnotation      -> return $ h2 "Mappings" -- TODO link to foomappings
48   -- TODO: handle OptionAnnotation
49   OptionsAnnotation       -> return $ h2 "Options" -- TODO link to foooptions
50   Paragraph p             -> nodes p >>= nl >>= nl
51   Plaintext p             -> return p
52   -- TODO: this should be order-independent and always appear at the top.
53   -- Note that I don't really have anywhere to put the description; maybe I should
54   -- scrap it (nope: need it in the Vim help version).
55   PluginAnnotation name _ -> return $ h1 name
56   Project p               -> nodes p
57   Separator               -> return $ "---" ++ "\n\n"
58   SubheadingAnnotation s  -> return $ h3 s
59   Unit u                  -> nodes u
60   Whitespace              -> return " "
61   _                       -> return ""
62
63 -- | Append a newline.
64 nl :: String -> Env
65 nl = return . (++ "\n")
66
67 blockquote :: [Node] -> Env
68 blockquote ps = do
69   ps' <- mapM paragraph ps
70   return $ "> " ++ intercalate "\n>\n> " ps'
71   where
72     -- Strip off trailing newlines from each paragraph.
73     paragraph p = fmap trim (node p)
74     trim contents = take (length contents - 2) contents
75
76 -- TODO: handle "interesting" link text like containing [, ], "
77 link :: String -> Env
78 link l = do
79   metadata <- ask
80   return $ if l `elem` symbols metadata
81            -- TODO: beware names with < ` etc in them
82            -- TODO: consider not using <strong>
83            then "<strong>[`" ++ l ++ "`](" ++ gitHubAnchor l ++ ")</strong>"
84            else "<strong>`" ++ l ++ "`</strong>" -- TODO:
85                                 -- may want to try producing a link to Vim
86                                 -- online help if I can find a search for it
87
88 fenced :: [String] -> String
89 fenced f = "```\n" ++ code ++ "```"
90   where code = if null f
91                then ""
92                else intercalate "\n" f ++ "\n"
93
94 linkTargets :: [String] -> String
95 linkTargets ls =  "<p align=\"right\">"
96                ++ unwords (map linkify $ sort ls)
97                ++ "</p>"
98   where
99     linkify l = a $ Anchor [ Attribute "name" (sanitizeAnchor l)
100                            , Attribute "href" (gitHubAnchor l)
101                            ]
102                            (codify l)
103
104 h1 :: String -> String
105 h1 = heading 1
106
107 h2 :: String -> String
108 h2 = heading 2
109
110 h3 :: String -> String
111 h3 = heading 3
112
113 heading :: Int -> String -> String
114 heading level string = replicate level '#' ++ " " ++ string ++ "\n\n"
115
116 -- | Wraps a string in `<code>`/`</code>` tags.
117 -- TODO: remember why I'm not using backticks here.
118 codify :: String -> String
119 codify s = "<code>" ++ s ++ "</code>"
120
121 a :: Anchor -> String
122 a (Anchor attributes target) = "<a" ++ attrs ++ ">" ++ target ++ "</a>"
123   where
124     attrs = if not (null attributes)
125             then " " ++ attributesString attributes
126             else ""
127
128 attributesString :: [Attribute] -> String
129 attributesString as = unwords (map attributeToString as)
130   where attributeToString (Attribute name value) = name ++ "=\"" ++ value ++ "\""
131
132 gitHubAnchor :: String -> String
133 gitHubAnchor n = "#user-content-" ++ sanitizeAnchor n
134
135 -- TODO: make sure symbol table knows about option targets too
136 command :: Node -> String
137 command (CommandAnnotation name params) = content
138   where content = h3 $ "`:" ++ annotation ++ "`"
139         annotation = rstrip $ name ++ " " ++ fromMaybe "" params
140
141 mapping :: String -> String
142 mapping name = h3 $ "`" ++ name ++ "`"