]> git.wincent.com - docvim.git/blob - lib/Docvim/Printer/Markdown.hs
Teach Markdown printer about @mapping and @command
[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 "## Commands\n\n"
36   DocBlock d              -> nodes d
37   Fenced f                -> return $ fenced f ++ "\n\n"
38   FunctionDeclaration {}  -> nodes $ functionBody n
39   FunctionsAnnotation     -> return "## Functions\n\n"
40   HeadingAnnotation h     -> return $ "## " ++ h ++ "\n\n"
41   Link l                  -> link l
42   LinkTargets l           -> return $ linkTargets l ++ "\n"
43   List ls                 -> nodes ls >>= nl
44   ListItem l              -> fmap ("- " ++) (nodes l) >>= nl
45   MappingAnnotation m     -> return $ mapping m
46   MappingsAnnotation      -> return "## Mappings\n\n"
47   -- TODO: handle OptionAnnotation
48   OptionsAnnotation       -> return "## Options\n\n"
49   Paragraph p             -> nodes p >>= nl >>= nl
50   Plaintext p             -> return p
51   -- TODO: this should be order-independent and always appear at the top.
52   -- Note that I don't really have anywhere to put the description; maybe I should
53   -- scrap it (nope: need it in the Vim help version).
54   PluginAnnotation name _ -> return $ "# " ++ name ++ "\n\n"
55   Project p               -> nodes p
56   Separator               -> return $ "---" ++ "\n\n"
57   SubheadingAnnotation s  -> return $ "### " ++ s ++ "\n\n"
58   Unit u                  -> nodes u
59   Whitespace              -> return " "
60   _                       -> return ""
61
62 -- | Append a newline.
63 nl :: String -> Env
64 nl = return . (++ "\n")
65
66 blockquote :: [Node] -> Env
67 blockquote ps = do
68   ps' <- mapM paragraph ps
69   return $ "> " ++ intercalate "\n>\n> " ps'
70   where
71     -- Strip off trailing newlines from each paragraph.
72     paragraph p = fmap trim (node p)
73     trim contents = take (length contents - 2) contents
74
75 -- TODO: handle "interesting" link text like containing [, ], "
76 link :: String -> Env
77 link l = do
78   metadata <- ask
79   return $ if l `elem` symbols metadata
80            -- TODO: beware names with < ` etc in them
81            then "<strong>[`" ++ l ++ "`](" ++ gitHubAnchor l ++ ")</strong>"
82            else "<strong>`" ++ l ++ "`</strong>" -- TODO:
83                                 -- may want to try producing a link to Vim
84                                 -- online help if I can find a search for it
85
86 fenced :: [String] -> String
87 fenced f = "```\n" ++ code ++ "```"
88   where code = if null f
89                then ""
90                else intercalate "\n" f ++ "\n"
91
92 linkTargets :: [String] -> String
93 linkTargets ls =  "<p align=\"right\">"
94                ++ unwords (map linkify $ sort ls)
95                ++ "</p>"
96   where linkify l = a $ Anchor [ Attribute "name" (sanitizeAnchor l)
97                                , Attribute "href" (gitHubAnchor l)
98                                ]
99                                ("<code>" ++ l ++ "</code>")
100
101 a :: Anchor -> String
102 a (Anchor attributes target) = "<a" ++ attrs ++ ">" ++ target ++ "</a>"
103   where
104     attrs = if not (null attributes)
105             then " " ++ attributesString attributes
106             else ""
107
108 attributesString :: [Attribute] -> String
109 attributesString as = unwords (map attributeToString as)
110   where attributeToString (Attribute name value) = name ++ "=\"" ++ value ++ "\""
111
112 gitHubAnchor :: String -> String
113 gitHubAnchor n = "#user-content-" ++ sanitizeAnchor n
114
115 -- TODO: make sure symbol table knows about mapping targets and command targets
116 -- and option targets
117 command :: Node -> String
118 command (CommandAnnotation name params) = (rstrip heading) ++ "`\n\n"
119   where heading = "### `:" ++ name ++ " " ++ fromMaybe "" params
120
121 mapping :: String -> String
122 mapping name = "### `" ++ name ++ "`\n\n"