]> git.wincent.com - docvim.git/blob - lib/Docvim/Printer/Markdown.hs
a6b3a06bfc8724b0bf60e9a194a4ec3dc7ce29f0
[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 Docvim.AST
6 import Docvim.Parse (rstrip)
7 import Docvim.Visitor.Plugin (getPluginName)
8 import Docvim.Visitor.Symbol (getSymbols)
9
10 data Metadata = Metadata { symbols :: [String]
11                          , pluginName :: Maybe String
12                          }
13 type Env = Reader Metadata String
14
15 data Anchor = Anchor [Attribute] String
16 data Attribute = Attribute { attributeName :: String
17                            , attributeValue :: String
18                            }
19
20 markdown :: Node -> String
21 markdown n = rstrip (runReader (node n) metadata) ++ "\n"
22   where metadata = Metadata (getSymbols n) (getPluginName n)
23
24 nodes :: [Node] -> Env
25 nodes ns = concat <$> mapM node ns
26
27 node :: Node -> Env
28 node n = case n of
29   Blockquote b            -> blockquote b >>= nl >>= nl
30   -- TODO, for readability, this should be "<br />\n" (custom, context-aware separator; see Vim.hs)
31   BreakTag                -> return "<br />"
32   Code c                  -> return $ "`" ++ c ++ "`"
33   CommandsAnnotation      -> return "## Commands\n\n"
34   DocBlock d              -> nodes d
35   Fenced f                -> return $ fenced f ++ "\n\n"
36   FunctionDeclaration {}  -> nodes $ functionBody n
37   FunctionsAnnotation     -> return "## Functions\n\n"
38   HeadingAnnotation h     -> return $ "## " ++ h ++ "\n\n"
39   Link l                  -> link l
40   LinkTargets l           -> return $ linkTargets l ++ "\n"
41   List ls                 -> nodes ls >>= nl
42   ListItem l              -> fmap ("- " ++) (nodes l) >>= nl
43   MappingsAnnotation      -> return "## Mappings\n\n"
44   OptionsAnnotation       -> return "## Options\n\n"
45   Paragraph p             -> nodes p >>= nl >>= nl
46   Plaintext p             -> return p
47   -- TODO: this should be order-independent and always appear at the top.
48   -- Note that I don't really have anywhere to put the description; maybe I should
49   -- scrap it (nope: need it in the Vim help version).
50   PluginAnnotation name _ -> return $ "# " ++ name ++ "\n\n"
51   Project p               -> nodes p
52   Separator               -> return $ "---" ++ "\n\n"
53   SubheadingAnnotation s  -> return $ "### " ++ s ++ "\n\n"
54   Unit u                  -> nodes u
55   Whitespace              -> return " "
56   _                       -> return ""
57
58 -- | Append a newline.
59 nl :: String -> Env
60 nl = return . (++ "\n")
61
62 blockquote :: [Node] -> Env
63 blockquote ps = do
64   ps' <- mapM paragraph ps
65   return $ "> " ++ intercalate "\n>\n> " ps'
66   where
67     -- Strip off trailing newlines from each paragraph.
68     paragraph p = fmap trim (node p)
69     trim contents = take (length contents - 2) contents
70
71 -- TODO: handle "interesting" link text like containing [, ], "
72 link :: String -> Env
73 link l = do
74   metadata <- ask
75   return $ if l `elem` symbols metadata
76            -- TODO: beware names with < ` etc in them
77            then "<strong>[`" ++ l ++ "`](" ++ gitHubAnchor l ++ ")</strong>"
78            else "<strong>`" ++ l ++ "`</strong>" -- TODO:
79                                 -- may want to try producing a link to Vim
80                                 -- online help if I can find a search for it
81
82 fenced :: [String] -> String
83 fenced f = "```\n" ++ code ++ "```"
84   where code = if null f
85                then ""
86                else intercalate "\n" f ++ "\n"
87
88 linkTargets :: [String] -> String
89 linkTargets ls =  "<p align=\"right\">"
90                ++ unwords (map linkify $ sort ls)
91                ++ "</p>"
92   where linkify l = a $ Anchor [ Attribute "name" (sanitizeAnchor l)
93                                , Attribute "href" (gitHubAnchor l)
94                                ]
95                                ("<code>" ++ l ++ "</code>")
96
97 a :: Anchor -> String
98 a (Anchor attributes target) = "<a" ++ attrs ++ ">" ++ target ++ "</a>"
99   where
100     attrs = if not (null attributes)
101             then " " ++ attributesString attributes
102             else ""
103
104 attributesString :: [Attribute] -> String
105 attributesString as = unwords (map attributeToString as)
106   where attributeToString (Attribute name value) = name ++ "=\"" ++ value ++ "\""
107
108 gitHubAnchor :: String -> String
109 gitHubAnchor n = "#user-content-" ++ sanitizeAnchor n