@@ -17,8 +17,6 @@ module Ormolu.Printer.Internal
1717 , atom
1818 , space
1919 , newline
20− , modNewline
21− , isNewlineModified
2220 , isLineDirty
2321 , inci
2422 , sitcc
@@ -30,14 +28,15 @@ module Ormolu.Printer.Internal
3028 , dontUseBraces
3129 , canUseBraces
3230 -- * Special helpers for comment placement
31+ , CommentPosition (..)
32+ , registerPendingCommentLine
3333 , trimSpanStream
3434 , nextEltSpan
3535 , popComment
36− , hasMoreComments
37− , getIndent
38− , setIndent
3936 , getEnclosingSpan
4037 , withEnclosingSpan
38+ , setLastCommentSpan
39+ , getLastCommentSpan
4140 -- * Annotations
4241 , getAnns
4342 )
@@ -47,10 +46,9 @@ import Control.Monad.Reader
4746import Control.Monad.State.Strict
4847import Data.Bool (bool)
4948import Data.Coerce
50−import Data.Maybe (fromMaybe, isJust, listToMaybe)
49+import Data.Maybe (listToMaybe)
5150import Data.Text (Text)
5251import Data.Text.Lazy.Builder
53−import Debug.Trace
5452import GHC
5553import Ormolu.Parser.Anns
5654import Ormolu.Parser.CommentStream
@@ -70,16 +68,15 @@ import qualified Data.Text.Lazy as TL
7068newtype R a = R (ReaderT RC (State SC) a)
7169 deriving (Functor, Applicative, Monad)
7270
73−-- | Reader context of 'R'.
71+-- | Reader context of 'R'. This should be used when we control rendering by
72+-- enclosing certain expressions with wrappers.
7473
7574data RC = RC
7675 { rcIndent :: !Int
77− -- ^ Indentation level, as the column index we need to start from after a
78− -- newline if we break lines
76+ -- ^ Indentation level, as the column index we need to start from after
77+ -- a newline if we break lines
7978 , rcLayout :: Layout
8079 -- ^ Current layout
81− , rcDebug :: Bool
82− -- ^ Whether to print debugging info as we go
8380 , rcEnclosingSpans :: [RealSrcSpan]
8481 -- ^ Spans of enclosing elements of AST
8582 , rcAnns :: Anns
@@ -99,14 +96,28 @@ data SC = SC
9996 -- ^ Span stream
10097 , scCommentStream :: CommentStream
10198 -- ^ Comment stream
102− , scNewline :: Maybe (R ())
103− -- ^ What to render as newline, or 'Nothing' ('newlineRaw' will be used)
99+ , scPendingComments :: ![(CommentPosition, Int, Text)]
100+ -- ^ Pending comment lines (in reverse order) to be inserted before next
101+ -- newline, 'Int' is the indentation level
104102 , scDirtyLine :: !Bool
105− -- ^ Whether the current line is “dirty”
106− , scSpace :: !Bool
103+ -- ^ Whether the current line is “dirty”, that is, already contains
104+ -- atoms that can have comments attached to them
105+ , scRequestedDelimiter :: !RequestedDelimiter
107106 -- ^ Whether to output a space before the next output
107+ , scLastCommentSpan :: !(Maybe RealSrcSpan)
108+ -- ^ Span of last output comment
108109 }
109110
111+-- | Make sure next output is delimited by one of the following.
112+
113+data RequestedDelimiter
114+ = RequestedSpace -- ^ A space
115+ | RequestedNewline -- ^ A newline
116+ | RequestedNothing -- ^ Nothing
117+ | AfterNewline -- ^ We just output a newline
118+ | VeryBeginning -- ^ We haven't printed anything yet
119+ deriving (Eq, Show)
120+
110121-- | 'Layout' options.
111122
112123data Layout
@@ -114,22 +125,27 @@ data Layout
114125 | MultiLine -- ^ Use multiple lines
115126 deriving (Eq, Show)
116127
128+-- | Modes for rendering of pending comments.
129+
130+data CommentPosition
131+ = OnTheSameLine -- ^ Put the comment on the same line
132+ | OnNextLine -- ^ Put the comment on next line
133+ deriving (Eq, Show)
134+
117135-- | Run an 'R' monad.
118136
119137runR
120− :: Bool -- ^ Whether to print debugging info
121− -> R () -- ^ Monad to run
138+ :: R () -- ^ Monad to run
122139 -> SpanStream -- ^ Span stream
123140 -> CommentStream -- ^ Comment stream
124141 -> Anns -- ^ Annotations
125142 -> Text -- ^ Resulting rendition
126−runR debug (R m) sstream cstream anns =
143+runR (R m) sstream cstream anns =
127144 TL.toStrict . toLazyText . scBuilder $ execState (runReaderT m rc) sc
128145 where
129146 rc = RC
130147 { rcIndent = 0
131148 , rcLayout = MultiLine
132− , rcDebug = debug
133149 , rcEnclosingSpans = []
134150 , rcAnns = anns
135151 , rcCanUseBraces = False
@@ -139,9 +155,10 @@ runR debug (R m) sstream cstream anns =
139155 , scBuilder = mempty
140156 , scSpanStream = sstream
141157 , scCommentStream = cstream
142− , scNewline = Nothing
158+ , scPendingComments = []
143159 , scDirtyLine = False
144− , scSpace = False
160+ , scRequestedDelimiter = VeryBeginning
161+ , scLastCommentSpan = Nothing
145162 }
146163
147164----------------------------------------------------------------------------
@@ -156,9 +173,9 @@ runR debug (R m) sstream cstream anns =
156173-- 'atom'.
157174
158175txt
159− :: Text -- ^ 'Text' to output
176+ :: Text -- ^ 'Text' to output
160177 -> R ()
161−txt = spit False
178+txt = spit False False
162179
163180-- | Output 'Outputable' fragment of AST. This can be used to output numeric
164181-- literals and similar. Everything that doesn't have inner structure but
@@ -168,28 +185,43 @@ atom
168185 :: Outputable a
169186 => a
170187 -> R ()
171−atom = spit True . T.pack . showOutputable
188+atom = spit True False . T.pack . showOutputable
172189
173190-- | Low-level non-public helper to define 'txt' and 'atom'.
174191
175−spit :: Bool -> Text -> R ()
176−spit dirty x' = do
177− i <- R (asks rcIndent)
178− c <- R (gets scColumn)
179− needsSpace <- R (gets scSpace)
180− let spaces =
181− if (c < i)
182− then T.replicate (i - c) " "
183− else bool mempty " " needsSpace
184− x = spaces <> x'
185− traceR "spit_before" (Just x)
186− R . modify $ \sc -> sc
187− { scBuilder = scBuilder sc <> fromText x
188− , scColumn = scColumn sc + T.length x
189− , scDirtyLine = scDirtyLine sc || dirty
190− , scSpace = False
191− }
192− traceR "spit_after" Nothing
192+spit
193+ :: Bool -- ^ Should we mark the line as dirty?
194+ -> Bool -- ^ Used during outputting of pending comments?
195+ -> Text -- ^ 'Text' to output
196+ -> R ()
197+spit dirty printingComments txt' = do
198+ requestedDel <- R (gets scRequestedDelimiter)
199+ case requestedDel of
200+ RequestedNewline -> do
201+ R . modify $ \sc -> sc
202+ { scRequestedDelimiter = RequestedNothing }
203+ if printingComments
204+ then newlineRaw
205+ else newline
206+ _ -> return ()
207+ R $ do
208+ i <- asks rcIndent
209+ c <- gets scColumn
210+ let spaces =
211+ if c < i
212+ then T.replicate (i - c) " "
213+ else bool mempty " " (requestedDel == RequestedSpace)
214+ indentedTxt = spaces <> txt'
215+ modify $ \sc -> sc
216+ { scBuilder = scBuilder sc <> fromText indentedTxt
217+ , scColumn = scColumn sc + T.length indentedTxt
218+ , scDirtyLine = scDirtyLine sc || dirty
219+ , scRequestedDelimiter = RequestedNothing
220+ , scLastCommentSpan =
221+ if printingComments
222+ then scLastCommentSpan sc
223+ else Nothing
224+ }
193225
194226-- | This primitive /does not/ necessarily output a space. It just ensures
195227-- that the next thing that will be printed on the same line will be
@@ -202,55 +234,68 @@ spit dirty x' = do
202234
203235space :: R ()
204236space = R . modify $ \sc -> sc
205− { scSpace = True
237+ { scRequestedDelimiter =
238+ case scRequestedDelimiter sc of
239+ RequestedNothing -> RequestedSpace
240+ other -> other
206241 }
207242
208−-- | Output a newline.
243+-- | Output a newline. First time 'newline' is used after some non-'newline'
244+-- output it gets inserted immediately. Second use of 'newline' does not
245+-- output anything but makes sure that the next non-white space output will
246+-- be prefixed by a newline. Using 'newline' more than twice in a row has no
247+-- effect. Also, using 'newline' at the very beginning has no effect, this
248+-- is to avoid leading whitespace.
249+--
250+-- Similarly to 'space', this design prevents trailing newlines and makes it
251+-- hard to output more than one blank newline in a row.
209252
210253newline :: R ()
211254newline = do
212− n <- R (gets scNewline)
213− R . modify $ \sc -> sc
214− { scNewline = Nothing
215− }
216− fromMaybe newlineRaw n
255+ cs <- reverse <$> R (gets scPendingComments)
256+ case cs of
257+ [] -> newlineRaw
258+ ((position, _, _):_) -> do
259+ case position of
260+ OnTheSameLine -> space
261+ OnNextLine -> newlineRaw
262+ R . forM_ cs $ \(_, indent, txt') ->
263+ let modRC rc = rc
264+ { rcIndent = indent
265+ }
266+ R m = do
267+ unless (T.null txt') $
268+ spit False True txt'
269+ newlineRaw
270+ in local modRC m
271+ R . modify $ \sc -> sc
272+ { scPendingComments = []
273+ }
217274
218275-- | Low-level newline primitive. This one always just inserts a newline, no
219276-- hooks can be attached.
220277
221278newlineRaw :: R ()
222−newlineRaw = do
223− traceR "newline_before" (Just "\n")
224− R . modify $ \sc -> sc
225− { scBuilder = scBuilder sc <> "\n"
279+newlineRaw = R . modify $ \sc ->
280+ let requestedDel = scRequestedDelimiter sc
281+ builderSoFar = scBuilder sc
282+ in sc
283+ { scBuilder =
284+ case requestedDel of
285+ AfterNewline -> builderSoFar
286+ RequestedNewline -> builderSoFar
287+ VeryBeginning -> builderSoFar
288+ _ -> builderSoFar <> "\n"
226289 , scColumn = 0
227290 , scDirtyLine = False
228− , scSpace = False
229− }
230− traceR "newline_after" Nothing
231−
232−-- | The 'modNewline' function can be used to alter what will be inserted as
233−-- a newline. This is used to output comments following an element of AST
234−-- because we cannot output comments immediately, e.g. because we need to
235−-- close parentheses first, etc.
236−--
237−-- 'newline' auto-resets its modifications so the changes introduced with
238−-- 'modNewline' only have effect once.
239−--
240−-- The argument of the call-back is the version of 'newline' built so far.
241−
242−modNewline :: (R () -> R ()) -> R ()
243−modNewline f = R $ do
244− old <- gets scNewline
245− modify $ \sc -> sc
246− { scNewline = Just $ f (fromMaybe newlineRaw old)
291+ , scRequestedDelimiter =
292+ case scRequestedDelimiter sc of
293+ AfterNewline -> RequestedNewline
294+ RequestedNewline -> RequestedNewline
295+ VeryBeginning -> VeryBeginning
296+ _ -> AfterNewline
247297 }
248298
249−-- | Check if newline is in modified state.
250−
251−isNewlineModified :: R Bool
252−isNewlineModified = isJust <$> R (gets scNewline)
253−
254299-- | Check if the current line is “dirty”, that is, there is something on it
255300-- that can have comments attached to it.
256301
@@ -264,14 +309,11 @@ isLineDirty = R (gets scDirtyLine)
264309-- effect, but with multi-line layout correct indentation levels matter.
265310
266311inci :: R () -> R ()
267−inci m' = do
268− traceR "inci_before" Nothing
269− let R m = traceR "inci_inside" Nothing >> m'
270− modRC rc = rc
271− { rcIndent = rcIndent rc + indentStep
272− }
273− R (local modRC m)
274− traceR "inci_ended" Nothing
312+inci (R m) = R (local modRC m)
313+ where
314+ modRC rc = rc
315+ { rcIndent = rcIndent rc + indentStep
316+ }
275317
276318-- | Set indentation level for the inner computation equal to current
277319-- column. This makes sure that the entire inner block is uniformly
@@ -279,35 +321,30 @@ inci m' = do
279321-- layout is multi-line.
280322
281323sitcc :: R () -> R ()
282−sitcc m' = do
283− traceR "sitcc_before" Nothing
324+sitcc (R m) = do
325+ requestedDel <- R (gets scRequestedDelimiter)
284326 i <- R (asks rcIndent)
285327 c <- R (gets scColumn)
286− needsSpace <- R (gets scSpace)
287− let R m = traceR "sitcc_inside" Nothing >> m'
288− modRC rc = rc
289− { rcIndent = max i c + bool 0 1 needsSpace
328+ let modRC rc = rc
329+ { rcIndent = max i c + bool 0 1 (requestedDel == RequestedSpace)
290330 }
291− vlayout m' . R $ do
292− modify $ \sc -> sc { scSpace = False }
331+ vlayout (R m) . R $ do
332+ modify $ \sc -> sc
333+ { scRequestedDelimiter =
334+ case requestedDel of
335+ RequestedSpace -> RequestedNothing
336+ other -> other
337+ }
293338 local modRC m
294− traceR "sitcc_ended" Nothing
295339
296340-- | Set 'Layout' for internal computation.
297341
298342enterLayout :: Layout -> R () -> R ()
299−enterLayout l (R m) = do
300− let label =
301− case l of
302− SingleLine -> "single_line"
303− MultiLine -> "multi_line"
304− traceR ("lstart_" ++ label) Nothing
305− let modRC rc = rc
306− { rcLayout = l
307− }
308− x <- R (local modRC m)
309− traceR ("lend_" ++ label) Nothing
310− return x
343+enterLayout l (R m) = R (local modRC m)
344+ where
345+ modRC rc = rc
346+ { rcLayout = l
347+ }
311348
312349-- | Do one or another thing depending on current 'Layout'.
313350
@@ -324,6 +361,21 @@ vlayout sline mline = do
324361----------------------------------------------------------------------------
325362-- Special helpers for comment placement
326363
364+-- | Register a comment line for outputting. It will be inserted right
365+-- before next newline. When the comment goes after something else on the
366+-- same line, a space will be inserted between preceding text and the
367+-- comment when necessary.
368+
369+registerPendingCommentLine
370+ :: CommentPosition -- ^ Comment position
371+ -> Text -- ^ 'Text' to output
372+ -> R ()
373+registerPendingCommentLine position txt' = R $ do
374+ i <- asks rcIndent
375+ modify $ \sc -> sc
376+ { scPendingComments = (position, i, txt') : scPendingComments sc
377+ }
378+
327379-- | Drop elements that begin before or at the same place as given
328380-- 'SrcSpan'.
329381
@@ -359,30 +411,6 @@ popComment f = R $ do
359411 })
360412 else return Nothing
361413
362−-- | Return 'True' if there are more comments in the 'CommentStream'.
363−
364−hasMoreComments :: R Bool
365−hasMoreComments = R $ do
366− CommentStream cstream <- gets scCommentStream
367− (return . not . null) cstream
368−
369−-- | Current indentation level.
370−
371−getIndent :: R Int
372−getIndent = R (asks rcIndent)
373−
374−-- | Set indentation level for the given computation.
375−
376−setIndent :: Int -> R () -> R ()
377−setIndent i m' = do
378− traceR "set_indent_before" Nothing
379− let R m = traceR "set_indent_inside" Nothing >> m'
380− modRC rc = rc
381− { rcIndent = i
382− }
383− R (local modRC m)
384− traceR "set_indent_after" Nothing
385−
386414-- | Get the first enclosing 'RealSrcSpan' that satisfies given predicate.
387415
388416getEnclosingSpan
@@ -394,11 +422,23 @@ getEnclosingSpan f =
394422-- | Set 'RealSrcSpan' of enclosing span for the given computation.
395423
396424withEnclosingSpan :: RealSrcSpan -> R () -> R ()
397−withEnclosingSpan spn (R m) = do
398− let modRC rc = rc
399− { rcEnclosingSpans = spn : rcEnclosingSpans rc
400− }
401− R (local modRC m)
425+withEnclosingSpan spn (R m) = R (local modRC m)
426+ where
427+ modRC rc = rc
428+ { rcEnclosingSpans = spn : rcEnclosingSpans rc
429+ }
430+
431+-- | Set span of last output comment.
432+
433+setLastCommentSpan :: RealSrcSpan -> R ()
434+setLastCommentSpan spn = R . modify $ \sc -> sc
435+ { scLastCommentSpan = Just spn
436+ }
437+
438+-- | Get span of last output comment.
439+
440+getLastCommentSpan :: R (Maybe RealSrcSpan)
441+getLastCommentSpan = R (gets scLastCommentSpan)
402442
403443----------------------------------------------------------------------------
404444-- Annotations
@@ -428,29 +468,6 @@ dontUseBraces (R r) = R (local (\i -> i {rcCanUseBraces = False}) r)
428468canUseBraces :: R Bool
429469canUseBraces = R $ asks rcCanUseBraces
430470
431−----------------------------------------------------------------------------
432−-- Debug helpers
433−
434−-- | Tracing helper.
435−
436−traceR
437− :: String -- ^ Label
438− -> Maybe Text -- ^ Output, if any
439− -> R ()
440−traceR label moutput = R $ do
441− debug <- asks rcDebug
442− i <- asks rcIndent
443− c <- gets scColumn
444− when debug . traceM . concat $
445− [ replicate i ' '
446− , unwords [ label ++ ":"
447− , "i=" ++ show i
448− , "c=" ++ show c
449− ]
450− ] ++ case moutput of
451− Nothing -> []
452− Just output -> [" out=" ++ show output]
453−
454471----------------------------------------------------------------------------
455472-- Constants
456473