]> git.wincent.com - docvim.git/blob - lib/Docvim/Printer/Vim.hs
3d12f4cd255a47740dfc8477950cade818fbb681
[docvim.git] / lib / Docvim / Printer / Vim.hs
1 module Docvim.Printer.Vim
2   ( vimHelp
3   , ppv
4   , pv
5   ) where
6
7 import Control.Monad.Reader
8 import Control.Monad.State
9 import Data.Char (isSpace, toUpper)
10 import Data.List (intercalate, isSuffixOf, sort)
11 import Docvim.AST
12 import Docvim.Parse (parseUnit, 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 = rstrip 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 isSuffixOf atom acc
45                                   then take (length acc - length atom) acc
46                                   else acc
47
48 -- Helper function that appends and updates `partialLine` context.
49 append :: String -> Env
50 append string = do
51   context <- get
52   -- TODO make that >=
53   -- TODO obviously tidy this up
54   -- TODO instead of deleting trailing whitespace (might not actually be any)
55   -- delete back to whitespace, then replay non-whitespace bits; should fix bad
56   -- output like this:
57   --     Searches for {pattern} in all the files under the current directory (see :pwd
58   --     ), unless otherwise overridden via {options}, and displays the results in the
59   -- TODO: always suppress trailing whitespace (some of it is making it into the
60   -- output)
61   let (ops, line) = if length (partialLine context) + length string >= textwidth
62                     then ([Delete (trailing $ partialLine context), Append (lineBreak context), Append $ slurpWhitespace string], lineBreak context ++ slurpWhitespace string)
63                     else ([Append string], partialLine context ++ string)
64   put (Context (lineBreak context) (end line))
65   return ops
66   where
67     trailing str = length $ takeWhile isSpace (reverse str)
68     end l = reverse $ takeWhile (/= '\n') (reverse l)
69     slurpWhitespace atom = if atom == " "
70                            then ""
71                            else atom
72
73 -- Helper function that deletes `count` elements from the end of the
74 --`partialLine` context.
75 delete :: Int -> Env
76 delete count = do
77   context <- get
78   put (Context (lineBreak context) (partial context))
79   return [Delete count]
80   where
81     partial context = take (length (partialLine context) - count) (partialLine context)
82
83 -- Helper function to conditionally remove a string if it appears at the end of
84 -- the output.
85 slurp :: String -> Env
86 slurp str = do
87   context <- get
88   put (Context (lineBreak context) (partial context))
89   return [Slurp str]
90   where
91     -- eg. (partialLine context) | str        | result
92     --     ----------------------|------------|-------
93     --     ""                    | "\n"       | ""
94     --     "foo"                 | "\n"       | "foo"
95     --     "foo"                 | "bar"      | "foo"
96     --     "abc"                 | "bc"       | "a"
97     --     "abc"                 | "foo\nabc" | ""
98     --
99     -- Note: That last one is unsafe, because we can't guarantee that "foo" is
100     -- there. Caveat emptor!
101     partial context = if isSuffixOf str (partialLine context)
102                       then take (length (partialLine context) - length str) (partialLine context)
103                       else (partialLine context)
104
105 defaultLineBreak :: String
106 defaultLineBreak = "\n"
107
108 nodes :: [Node] -> Env
109 nodes ns = concat <$> mapM node ns
110
111 -- TODO: deal with hard-wrapping (still some overlength lines and edge cases to
112 -- deal with)
113 node :: Node -> Env
114 node n = case n of
115   Blockquote b               -> blockquote b >>= nl >>= nl
116   BreakTag                   -> breaktag
117   Code c                     -> append $ "`" ++ c ++ "`"
118   DocBlock d                 -> nodes d
119   Fenced f                   -> fenced f
120   FunctionDeclaration {}     -> nodes $ functionBody n
121   -- TODO: Vim will only highlight this as a heading if it has a trailing
122   -- LinkTarget on the same line; figure out how to handle that; may need to
123   -- address it in the Parser
124   --
125   -- Looking at the Ferret fixtures, seems like I had an idea for this which was
126   -- to auto-gen the targets based on the plugin name + the heading text.
127   --
128   -- I could also just make people specify a target explicitly.
129   HeadingAnnotation h        -> append $ map toUpper h ++ "\n\n"
130   Link l                     -> append $ "|" ++ l ++ "|"
131   LinkTargets l              -> linkTargets l
132   List ls                    -> nodes ls >>= nl
133   ListItem l                 -> listitem l
134   Paragraph p                -> nodes p >>= nl >>= nl
135   Plaintext p                -> plaintext p
136   -- TODO: this should be order-independent and always appear at the top.
137   -- Note that I don't really have anywhere to put the description; maybe I should
138   -- scrap it (nope: need it in the Vim help version).
139   PluginAnnotation name desc -> plugin name desc
140   Project p                  -> nodes p
141   Separator                  -> append $ "---" ++ "\n\n"
142   SubheadingAnnotation s     -> append $ s ++ " ~\n\n"
143   Unit u                     -> nodes u
144   Whitespace                 -> whitespace
145   _                          -> append ""
146
147 -- TODO: right-align trailing link target
148 -- TODO: add {name}.txt to the symbol table?
149 plugin :: String -> String -> Env
150 plugin name desc = append $
151   "*" ++ name ++ ".txt*" ++
152   "    " ++ desc ++ "      " ++
153   "*" ++ name ++ "*" ++ "\n\n"
154
155 -- | Append a newline.
156 nl :: [Operation] -> Env
157 nl os = liftM2 (++) (return os) (append "\n")
158
159 breaktag :: Env
160 breaktag = do
161   state <- get
162   append $ lineBreak state
163
164 listitem :: [Node] -> Env
165 listitem l = do
166   context <- get
167   -- TODO: consider using lenses to modify records
168   put (Context customLineBreak (partialLine context))
169   item <- liftM2 (++) (append "- ") (nodes l) >>= nl
170   put (Context defaultLineBreak (partialLine context))
171   return item
172   where
173     customLineBreak = "\n  "
174
175 whitespace :: Env
176 whitespace =
177   -- if current line > 80 "\n" else " "
178   -- but note, really need to do this BEFORE 80
179   append " "
180
181 blockquote :: [Node] -> Env
182 blockquote ps = do
183   context <- get
184   put (Context customLineBreak (partialLine context))
185   ps' <- mapM paragraph ps
186   put (Context defaultLineBreak (partialLine context))
187   liftM2 (++) (append "    ") (liftM2 intercalate customParagraphBreak (return ps'))
188   where
189     -- Strip off trailing newlines from each paragraph.
190     paragraph p = fmap trim (node p)
191     trim contents = take (length contents - 2) contents
192     customLineBreak = "\n    "
193     customParagraphBreak = append "\n\n    "
194
195 plaintext :: String -> Env
196 plaintext = append
197
198 fenced :: [String] -> Env
199 fenced f = do
200   cut <- slurp "\n"
201   prefix <- append ">\n"
202   body <- if null f
203           then append ""
204           else append $ "    " ++ intercalate "\n    " f ++ "\n"
205   suffix <- append "<\n"
206   return $ concat [cut, prefix, body, suffix]
207
208 -- TODO: be prepared to wrap these if there are a lot of them
209 linkTargets :: [String] -> Env
210 linkTargets ls = append $ rightAlign targets ++ "\n"
211   where
212     targets = unwords (map linkify $ sort ls)
213     linkify l = "*" ++ l ++ "*"
214     rightAlign ws = replicate (count ws) ' ' ++ ws
215     count xs = maximum [textwidth - length xs, 0]
216
217 -- | For unit testing.
218 pv :: String -> String
219 pv input = case parseUnit input of
220             Left error -> show error
221             Right ast -> vimHelp ast
222
223 -- | For logging in the REPL.
224 ppv :: String -> IO ()
225 ppv = putStr . pv