]> git.wincent.com - docvim.git/blob - lib/Docvim/Printer/Vim.hs
Kill a stray comment
[docvim.git] / lib / Docvim / Printer / Vim.hs
1 module Docvim.Printer.Vim (vimHelp) where
2
3 import Control.Arrow ((***))
4 import Control.Monad (join)
5 import Control.Monad.Reader
6 import Control.Monad.State
7 import Data.Char (isSpace, toLower, toUpper)
8 import Data.List (intercalate, isSuffixOf, span, sort)
9 import Data.List.Split (splitOn)
10 import Data.Maybe (fromMaybe)
11 import Data.Tuple (swap)
12 import Docvim.AST
13 import Docvim.Parse (rstrip)
14 import Docvim.Visitor.Plugin (getPluginName)
15 import Docvim.Visitor.Symbol (getSymbols)
16
17 -- TODO: add indentation here (using local, or just stick it in Context)
18
19 -- Instead of building up a [Char], we build up a list of operations, which
20 -- allows us a mechanism of implementing rollback and therefore hard-wrapping
21 -- (eg. append whitespace " ", then on next node, realize that we will exceed
22 -- line length limit, so rollback the " " and instead append "\n" etc).
23 data Operation = Append String
24                | Delete Int -- unconditional delete count of Char
25                | Slurp String -- delete string if present
26 data Metadata = Metadata { symbols :: [String]
27                          , pluginName :: Maybe String
28                          }
29 data Context = Context { lineBreak :: String
30                        , partialLine :: String
31                        }
32 type Env = ReaderT Metadata (State Context) [Operation]
33
34 textwidth :: Int
35 textwidth = 78
36
37 vimHelp :: Node -> String
38 vimHelp n = suppressTrailingWhitespace output ++ "\n"
39   where metadata = Metadata (getSymbols n) (getPluginName n)
40         context = Context defaultLineBreak ""
41         operations = evalState (runReaderT (node n) metadata) context
42         output = foldl reduce "" operations
43         reduce acc (Append atom) = acc ++ atom
44         reduce acc (Delete count) = take (length acc - count) acc
45         reduce acc (Slurp atom) = if atom `isSuffixOf` acc
46                                   then take (length acc - length atom) acc
47                                   else acc
48         suppressTrailingWhitespace str = rstrip $ intercalate "\n" (map rstrip (splitOn "\n" str))
49
50 -- | Helper function that appends and updates `partialLine` context,
51 -- hard-wrapping if necessary to remain under `textwidth`.
52 append :: String -> Env
53 append string = append' string textwidth
54
55 -- | Helper function that appends and updates `partialLine` context
56 -- uncontitionally (no hard-wrapping).
57 appendNoWrap :: String -> Env
58 appendNoWrap string = append' string (maxBound :: Int)
59
60 append' :: String -> Int -> Env
61 append' string width = do
62   context <- get
63   -- TODO obviously tidy this up
64   let (ops, line) = if length (partialLine context) + length leading >= width
65                     then ( [ Delete (length $ snd $ hardwrap $ partialLine context)
66                            , Slurp " "
67                            , Append (lineBreak context)
68                            , Append (snd $ hardwrap $ partialLine context)
69                            , Append string
70                            ]
71                          , lineBreak context ++ snd (hardwrap $ partialLine context) ++ string
72                          )
73                     else ([Append string], partialLine context ++ string)
74   put (Context (lineBreak context) (end line))
75   return ops
76   where
77     leading = takeWhile (/= '\n') string
78     trailing str = length $ takeWhile isSpace (reverse str)
79     end l = reverse $ takeWhile (/= '\n') (reverse l)
80
81 -- http://stackoverflow.com/a/9723976/2103996
82 mapTuple = join (***)
83
84 -- Given a string, hardwraps it into two parts by splitting it at the rightmost
85 -- whitespace.
86 hardwrap :: String -> (String, String)
87 hardwrap str = swap $ mapTuple reverse split
88   where
89     split = break isSpace (reverse str)
90
91 -- Helper function that deletes `count` elements from the end of the
92 --`partialLine` context.
93 delete :: Int -> Env
94 delete count = do
95   context <- get
96   put (Context (lineBreak context) (partial context))
97   return [Delete count]
98   where
99     partial context = take (length (partialLine context) - count) (partialLine context)
100
101 -- Helper function to conditionally remove a string if it appears at the end of
102 -- the output.
103 slurp :: String -> Env
104 slurp str = do
105   context <- get
106   put (Context (lineBreak context) (partial context))
107   return [Slurp str]
108   where
109     -- eg. (partialLine context) | str        | result
110     --     ----------------------|------------|-------
111     --     ""                    | "\n"       | ""
112     --     "foo"                 | "\n"       | "foo"
113     --     "foo"                 | "bar"      | "foo"
114     --     "abc"                 | "bc"       | "a"
115     --     "abc"                 | "foo\nabc" | ""
116     --
117     -- Note: That last one is unsafe, because we can't guarantee that "foo" is
118     -- there. Caveat emptor!
119     partial context = if str `isSuffixOf` partialLine context
120                       then take (length (partialLine context) - length str) (partialLine context)
121                       else partialLine context
122
123 defaultLineBreak :: String
124 defaultLineBreak = "\n"
125
126 nodes :: [Node] -> Env
127 nodes ns = concat <$> mapM node ns
128
129 node :: Node -> Env
130 node n = case n of
131   Blockquote b               -> blockquote b >>= nl >>= nl
132   BreakTag                   -> breaktag
133   Code c                     -> append $ "`" ++ c ++ "`"
134   CommandsAnnotation         -> heading "commands"
135   DocBlock d                 -> nodes d
136   Fenced f                   -> fenced f
137   FunctionsAnnotation        -> heading "functions"
138   FunctionDeclaration {}     -> nodes $ functionBody n
139   -- TODO: Vim will only highlight this as a heading if it has a trailing
140   -- LinkTarget on the same line; figure out how to handle that; may need to
141   -- address it in the Parser
142   --
143   -- Looking at the Ferret fixtures, seems like I had an idea for this which was
144   -- to auto-gen the targets based on the plugin name + the heading text.
145   --
146   -- I could also just make people specify a target explicitly.
147   HeadingAnnotation h        -> heading h
148   Link l                     -> append $ link l
149   LinkTargets l              -> linkTargets l True
150   List ls                    -> nodes ls >>= nl
151   ListItem l                 -> listitem l
152   MappingsAnnotation         -> heading "mappings"
153   -- TODO: if there is no OptionsAnnotation but there are OptionAnnotations, we
154   -- need to insert a `heading "options"` before the first option (ditto for
155   -- functions, mappings, commands)
156   OptionsAnnotation          -> heading "options"
157   OptionAnnotation {}        -> option n
158   Paragraph p                -> nodes p >>= nl >>= nl
159   Plaintext p                -> plaintext p
160   -- TODO: this should be order-independent and always appear at the top.
161   -- Note that I don't really have anywhere to put the description; maybe I should
162   -- scrap it (nope: need it in the Vim help version).
163   PluginAnnotation name desc -> plugin name desc
164   Project p                  -> nodes p
165   Separator                  -> append $ "---" ++ "\n\n"
166   SubheadingAnnotation s     -> append $ s ++ " ~\n\n"
167   Unit u                     -> nodes u
168   Whitespace                 -> whitespace
169   _                          -> append ""
170
171 -- TODO: add {name}.txt to the symbol table?
172 plugin :: String -> String -> Env
173 plugin name desc = append $
174   "*" ++ name ++ ".txt*" ++
175   "    " ++ desc ++ "      " ++
176   "*" ++ name ++ "*" ++ "\n\n"
177
178 -- | Append a newline.
179 nl :: [Operation] -> Env
180 nl os = liftM2 (++) (return os) (append "\n")
181
182 breaktag :: Env
183 breaktag = do
184   state <- get
185   append $ lineBreak state
186
187 listitem :: [Node] -> Env
188 listitem l = do
189   context <- get
190   -- TODO: consider using lenses to modify records
191   put (Context customLineBreak (partialLine context))
192   item <- liftM2 (++) (append "- ") (nodes l) >>= nl
193   put (Context defaultLineBreak (partialLine context))
194   return item
195   where
196     customLineBreak = "\n  "
197
198 option :: Node -> Env
199 option (OptionAnnotation n t d) = do
200   targets <- linkTargets [n] True
201   opt <- appendNoWrap $ link n
202   ws <- appendNoWrap " "
203   context <- get
204   meta <- appendNoWrap $ aligned context
205   return $ concat [targets, opt, ws, meta]
206   where
207     aligned context = rightAlign context rhs
208     rhs = t ++ " (default: " ++ fromMaybe "none" d ++ ")\n\n"
209
210 whitespace :: Env
211 whitespace =
212   -- if current line > 80 "\n" else " "
213   -- but note, really need to do this BEFORE 80
214   append " "
215
216 blockquote :: [Node] -> Env
217 blockquote ps = do
218   context <- get
219   put (Context customLineBreak (partialLine context))
220   ps' <- mapM paragraph ps
221   put (Context defaultLineBreak (partialLine context))
222   liftM2 (++) (append "    ") (liftM2 intercalate customParagraphBreak (return ps'))
223   where
224     -- Strip off trailing newlines from each paragraph.
225     paragraph p = fmap trim (node p)
226     trim contents = take (length contents - 2) contents
227     customLineBreak = "\n    "
228     customParagraphBreak = append "\n\n    "
229
230 plaintext :: String -> Env
231 plaintext = append
232
233 fenced :: [String] -> Env
234 fenced f = do
235   cut <- slurp "\n"
236   prefix <- append ">\n"
237   body <- if null f
238           then append ""
239           else append $ "    " ++ intercalate "\n    " f ++ "\n"
240   suffix <- append "<\n"
241   return $ concat [cut, prefix, body, suffix]
242
243 heading :: String -> Env
244 heading h = do
245   metadata <- ask
246   heading' <- appendNoWrap $ map toUpper h ++ " "
247   target <- maybe (append "\n") (\x -> linkTargets [target x] False) (pluginName metadata)
248   trailing <- append "\n"
249   return $ concat [heading', target, trailing]
250   where
251     target x = map (toLower . sanitize) $ x ++ "-" ++ h
252     sanitize x = if isSpace x then '-' else x
253
254 link :: String -> String
255 link l = "|" ++ l ++ "|"
256
257 -- TODO: be prepared to wrap these if there are a lot of them
258 -- TODO: fix code smell of passing in `wrap` bool here
259 linkTargets :: [String] -> Bool -> Env
260 linkTargets ls wrap = do
261   context <- get
262   if wrap
263   then append $ aligned context
264   else appendNoWrap $ aligned context
265   where
266     aligned context = rightAlign context (targets ++ "\n")
267     targets = unwords (map linkify $ sort ls)
268     linkify l = "*" ++ l ++ "*"
269
270 rightAlign :: Context -> String -> String
271 rightAlign context string = align (partialLine context)
272   where
273     align used = replicate (count used string) ' ' ++ string
274     count used xs = maximum [textwidth - length xs - length used, 0]