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