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