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