]> git.wincent.com - docvim.git/blob - lib/Docvim/Printer/Markdown.hs
6e2aa97fa6b21e35bff034e220b23ae30a66a19b
[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   -- TODO: handle OptionAnnotation
45   OptionsAnnotation       -> return "## Options\n\n"
46   Paragraph p             -> nodes p >>= nl >>= nl
47   Plaintext p             -> return p
48   -- TODO: this should be order-independent and always appear at the top.
49   -- Note that I don't really have anywhere to put the description; maybe I should
50   -- scrap it (nope: need it in the Vim help version).
51   PluginAnnotation name _ -> return $ "# " ++ name ++ "\n\n"
52   Project p               -> nodes p
53   Separator               -> return $ "---" ++ "\n\n"
54   SubheadingAnnotation s  -> return $ "### " ++ s ++ "\n\n"
55   Unit u                  -> nodes u
56   Whitespace              -> return " "
57   _                       -> return ""
58
59 -- | Append a newline.
60 nl :: String -> Env
61 nl = return . (++ "\n")
62
63 blockquote :: [Node] -> Env
64 blockquote ps = do
65   ps' <- mapM paragraph ps
66   return $ "> " ++ intercalate "\n>\n> " ps'
67   where
68     -- Strip off trailing newlines from each paragraph.
69     paragraph p = fmap trim (node p)
70     trim contents = take (length contents - 2) contents
71
72 -- TODO: handle "interesting" link text like containing [, ], "
73 link :: String -> Env
74 link l = do
75   metadata <- ask
76   return $ if l `elem` symbols metadata
77            -- TODO: beware names with < ` etc in them
78            then "<strong>[`" ++ l ++ "`](" ++ gitHubAnchor l ++ ")</strong>"
79            else "<strong>`" ++ l ++ "`</strong>" -- TODO:
80                                 -- may want to try producing a link to Vim
81                                 -- online help if I can find a search for it
82
83 fenced :: [String] -> String
84 fenced f = "```\n" ++ code ++ "```"
85   where code = if null f
86                then ""
87                else intercalate "\n" f ++ "\n"
88
89 linkTargets :: [String] -> String
90 linkTargets ls =  "<p align=\"right\">"
91                ++ unwords (map linkify $ sort ls)
92                ++ "</p>"
93   where linkify l = a $ Anchor [ Attribute "name" (sanitizeAnchor l)
94                                , Attribute "href" (gitHubAnchor l)
95                                ]
96                                ("<code>" ++ l ++ "</code>")
97
98 a :: Anchor -> String
99 a (Anchor attributes target) = "<a" ++ attrs ++ ">" ++ target ++ "</a>"
100   where
101     attrs = if not (null attributes)
102             then " " ++ attributesString attributes
103             else ""
104
105 attributesString :: [Attribute] -> String
106 attributesString as = unwords (map attributeToString as)
107   where attributeToString (Attribute name value) = name ++ "=\"" ++ value ++ "\""
108
109 gitHubAnchor :: String -> String
110 gitHubAnchor n = "#user-content-" ++ sanitizeAnchor n