@@ -17,8 +17,6 @@ module Ormolu.Printer.Internal
22 , isLineDirty
20 , isLineDirty
@@ -30,14 +28,15 @@ module Ormolu.Printer.Internal
30 , dontUseBraces
28 , dontUseBraces
31 , canUseBraces
29 , canUseBraces
32 -- * Special helpers for comment placement
30 -- * Special helpers for comment placement
31+ , CommentPosition (..)
32+ , registerPendingCommentLine
33 , trimSpanStream
33 , trimSpanStream
34 , nextEltSpan
34 , nextEltSpan
35 , popComment
35 , popComment
39 , getEnclosingSpan
36 , getEnclosingSpan
40 , withEnclosingSpan
37 , withEnclosingSpan
41 -- * Annotations
40 -- * Annotations
@@ -47,10 +46,9 @@ import Control.Monad.Reader
47import Control.Monad.State.Strict
46import Control.Monad.State.Strict
48import Data.Bool (bool)
47import Data.Bool (bool)
49import Data.Coerce
48import Data.Coerce
50−import Data.Maybe (fromMaybe, isJust, listToMaybe)
49+import Data.Maybe (listToMaybe)
51import Data.Text (Text)
50import Data.Text (Text)
52import Data.Text.Lazy.Builder
51import Data.Text.Lazy.Builder
55import Ormolu.Parser.Anns
53import Ormolu.Parser.Anns
56import Ormolu.Parser.CommentStream
54import Ormolu.Parser.CommentStream
@@ -70,16 +68,15 @@ import qualified Data.Text.Lazy as TL
70newtype R a = R (ReaderT RC (State SC) a)
68newtype R a = R (ReaderT RC (State SC) a)
71 deriving (Functor, Applicative, Monad)
69 deriving (Functor, Applicative, Monad)
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.
75data RC = RC
74data RC = RC
76 { rcIndent :: !Int
75 { rcIndent :: !Int
77− -- ^ Indentation level, as the column index we need to start from after a
76+ -- ^ Indentation level, as the column index we need to start from after
78− -- newline if we break lines
77+ -- a newline if we break lines
79 , rcLayout :: Layout
78 , rcLayout :: Layout
80 -- ^ Current layout
79 -- ^ Current layout
82− -- ^ Whether to print debugging info as we go
83 , rcEnclosingSpans :: [RealSrcSpan]
80 , rcEnclosingSpans :: [RealSrcSpan]
84 -- ^ Spans of enclosing elements of AST
81 -- ^ Spans of enclosing elements of AST
85 , rcAnns :: Anns
82 , rcAnns :: Anns
@@ -99,14 +96,28 @@ data SC = SC
99 -- ^ Span stream
96 -- ^ Span stream
100 , scCommentStream :: CommentStream
97 , scCommentStream :: CommentStream
101 -- ^ Comment stream
98 -- ^ Comment stream
102− , scNewline :: Maybe (R ())
99+ , scPendingComments :: ![(CommentPosition, Int, Text)]
103− -- ^ What to render as newline, or 'Nothing' ('newlineRaw' will be used)
100+ -- ^ Pending comment lines (in reverse order) to be inserted before next
101+ -- newline, 'Int' is the indentation level
104 , scDirtyLine :: !Bool
102 , scDirtyLine :: !Bool
105− -- ^ Whether the current line is “dirty”
103+ -- ^ Whether the current line is “dirty”, that is, already contains
106− , scSpace :: !Bool
104+ -- atoms that can have comments attached to them
105+ , scRequestedDelimiter :: !RequestedDelimiter
107 -- ^ Whether to output a space before the next output
106 -- ^ Whether to output a space before the next output
107+ , scLastCommentSpan :: !(Maybe RealSrcSpan)
108+ -- ^ Span of last output comment
111+-- | Make sure next output is delimited by one of the following.
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
110-- | 'Layout' options.
121-- | 'Layout' options.
112data Layout
123data Layout
@@ -114,22 +125,27 @@ data Layout
114 | MultiLine -- ^ Use multiple lines
125 | MultiLine -- ^ Use multiple lines
115 deriving (Eq, Show)
126 deriving (Eq, Show)
128+-- | Modes for rendering of pending comments.
131+ = OnTheSameLine -- ^ Put the comment on the same line
132+ | OnNextLine -- ^ Put the comment on next line
117-- | Run an 'R' monad.
135-- | Run an 'R' monad.
120− :: Bool -- ^ Whether to print debugging info
121− -> R () -- ^ Monad to run
138+ :: R () -- ^ Monad to run
122 -> SpanStream -- ^ Span stream
139 -> SpanStream -- ^ Span stream
123 -> CommentStream -- ^ Comment stream
140 -> CommentStream -- ^ Comment stream
124 -> Anns -- ^ Annotations
141 -> Anns -- ^ Annotations
125 -> Text -- ^ Resulting rendition
142 -> Text -- ^ Resulting rendition
126−runR debug (R m) sstream cstream anns =
143+runR (R m) sstream cstream anns =
127 TL.toStrict . toLazyText . scBuilder $ execState (runReaderT m rc) sc
144 TL.toStrict . toLazyText . scBuilder $ execState (runReaderT m rc) sc
130 { rcIndent = 0
147 { rcIndent = 0
131 , rcLayout = MultiLine
148 , rcLayout = MultiLine
133 , rcEnclosingSpans = []
149 , rcEnclosingSpans = []
134 , rcAnns = anns
150 , rcAnns = anns
135 , rcCanUseBraces = False
151 , rcCanUseBraces = False
@@ -139,9 +155,10 @@ runR debug (R m) sstream cstream anns =
139 , scBuilder = mempty
155 , scBuilder = mempty
140 , scSpanStream = sstream
156 , scSpanStream = sstream
141 , scCommentStream = cstream
157 , scCommentStream = cstream
142− , scNewline = Nothing
158+ , scPendingComments = []
143 , scDirtyLine = False
159 , scDirtyLine = False
144− , scSpace = False
160+ , scRequestedDelimiter = VeryBeginning
161+ , scLastCommentSpan = Nothing
147----------------------------------------------------------------------------
164----------------------------------------------------------------------------
@@ -156,9 +173,9 @@ runR debug (R m) sstream cstream anns =
156-- 'atom'.
173-- 'atom'.
159− :: Text -- ^ 'Text' to output
176+ :: Text -- ^ 'Text' to output
161−txt = spit False
178+txt = spit False False
163-- | Output 'Outputable' fragment of AST. This can be used to output numeric
180-- | Output 'Outputable' fragment of AST. This can be used to output numeric
164-- literals and similar. Everything that doesn't have inner structure but
181-- literals and similar. Everything that doesn't have inner structure but
@@ -168,28 +185,43 @@ atom
168 :: Outputable a
185 :: Outputable a
171−atom = spit True . T.pack . showOutputable
188+atom = spit True False . T.pack . showOutputable
173-- | Low-level non-public helper to define 'txt' and 'atom'.
190-- | Low-level non-public helper to define 'txt' and 'atom'.
175−spit :: Bool -> Text -> R ()
192+spit
193+ :: Bool -- ^ Should we mark the line as dirty?
194+ -> Bool -- ^ Used during outputting of pending comments?
195+ -> Text -- ^ 'Text' to output
176−spit dirty x' = do
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 }
177− i <- R (asks rcIndent)
208+ i <- asks rcIndent
178− c <- R (gets scColumn)
209+ c <- gets scColumn
179− needsSpace <- R (gets scSpace)
180− let spaces =
210+ let spaces =
181− if (c < i)
211+ if c < i
182− then T.replicate (i - c) " "
212+ then T.replicate (i - c) " "
183− else bool mempty " " needsSpace
213+ else bool mempty " " (requestedDel == RequestedSpace)
184− x = spaces <> x'
214+ indentedTxt = spaces <> txt'
185− traceR "spit_before" (Just x)
186− R . modify $ \sc -> sc
215+ modify $ \sc -> sc
187− { scBuilder = scBuilder sc <> fromText x
216+ { scBuilder = scBuilder sc <> fromText indentedTxt
188− , scColumn = scColumn sc + T.length x
217+ , scColumn = scColumn sc + T.length indentedTxt
189− , scDirtyLine = scDirtyLine sc || dirty
218+ , scDirtyLine = scDirtyLine sc || dirty
190− , scSpace = False
219+ , scRequestedDelimiter = RequestedNothing
191− }
220+ , scLastCommentSpan =
222+ then scLastCommentSpan sc
192− traceR "spit_after" Nothing
223+ else Nothing
194-- | This primitive /does not/ necessarily output a space. It just ensures
226-- | This primitive /does not/ necessarily output a space. It just ensures
195-- that the next thing that will be printed on the same line will be
227-- that the next thing that will be printed on the same line will be
@@ -202,55 +234,68 @@ spit dirty x' = do
203space :: R ()
235space :: R ()
204space = R . modify $ \sc -> sc
236space = R . modify $ \sc -> sc
205− { scSpace = True
237+ { scRequestedDelimiter =
238+ case scRequestedDelimiter sc of
239+ RequestedNothing -> RequestedSpace
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.
250+-- Similarly to 'space', this design prevents trailing newlines and makes it
251+-- hard to output more than one blank newline in a row.
210newline :: R ()
253newline :: R ()
211newline = do
254newline = do
212− n <- R (gets scNewline)
255+ cs <- reverse <$> R (gets scPendingComments)
258+ ((position, _, _):_) -> do
260+ OnTheSameLine -> space
261+ OnNextLine -> newlineRaw
262+ R . forM_ cs $ \(_, indent, txt') ->
267+ unless (T.null txt') $
268+ spit False True txt'
213− R . modify $ \sc -> sc
271+ R . modify $ \sc -> sc
214− { scNewline = Nothing
272+ { scPendingComments = []
216− fromMaybe newlineRaw n
218-- | Low-level newline primitive. This one always just inserts a newline, no
275-- | Low-level newline primitive. This one always just inserts a newline, no
219-- hooks can be attached.
276-- hooks can be attached.
221newlineRaw :: R ()
278newlineRaw :: R ()
222−newlineRaw = do
279+newlineRaw = R . modify $ \sc ->
223− traceR "newline_before" (Just "\n")
280+ let requestedDel = scRequestedDelimiter sc
224− R . modify $ \sc -> sc
281+ builderSoFar = scBuilder sc
225− { scBuilder = scBuilder sc <> "\n"
283+ { scBuilder =
284+ case requestedDel of
285+ AfterNewline -> builderSoFar
286+ RequestedNewline -> builderSoFar
287+ VeryBeginning -> builderSoFar
288+ _ -> builderSoFar <> "\n"
226 , scColumn = 0
289 , scColumn = 0
227 , scDirtyLine = False
290 , scDirtyLine = False
228− , scSpace = False
291+ , scRequestedDelimiter =
229− }
292+ case scRequestedDelimiter sc of
230− traceR "newline_after" Nothing
293+ AfterNewline -> RequestedNewline
231−
294+ RequestedNewline -> RequestedNewline
232−-- | The 'modNewline' function can be used to alter what will be inserted as
295+ VeryBeginning -> VeryBeginning
233−-- a newline. This is used to output comments following an element of AST
296+ _ -> AfterNewline
234−-- because we cannot output comments immediately, e.g. because we need to
235−-- close parentheses first, etc.
237−-- 'newline' auto-resets its modifications so the changes introduced with
238−-- 'modNewline' only have effect once.
240−-- The argument of the call-back is the version of 'newline' built so far.
242−modNewline :: (R () -> R ()) -> R ()
243−modNewline f = R $ do
244− old <- gets scNewline
246− { scNewline = Just $ f (fromMaybe newlineRaw old)
249−-- | Check if newline is in modified state.
251−isNewlineModified :: R Bool
252−isNewlineModified = isJust <$> R (gets scNewline)
254-- | Check if the current line is “dirty”, that is, there is something on it
299-- | Check if the current line is “dirty”, that is, there is something on it
255-- that can have comments attached to it.
300-- that can have comments attached to it.
@@ -264,14 +309,11 @@ isLineDirty = R (gets scDirtyLine)
264-- effect, but with multi-line layout correct indentation levels matter.
309-- effect, but with multi-line layout correct indentation levels matter.
266inci :: R () -> R ()
311inci :: R () -> R ()
267−inci m' = do
312+inci (R m) = R (local modRC m)
268− traceR "inci_before" Nothing
313+ where
269− let R m = traceR "inci_inside" Nothing >> m'
270− modRC rc = rc
314+ modRC rc = rc
271− { rcIndent = rcIndent rc + indentStep
315+ { rcIndent = rcIndent rc + indentStep
274− traceR "inci_ended" Nothing
276-- | Set indentation level for the inner computation equal to current
318-- | Set indentation level for the inner computation equal to current
277-- column. This makes sure that the entire inner block is uniformly
319-- column. This makes sure that the entire inner block is uniformly
@@ -279,35 +321,30 @@ inci m' = do
279-- layout is multi-line.
321-- layout is multi-line.
281sitcc :: R () -> R ()
323sitcc :: R () -> R ()
282−sitcc m' = do
324+sitcc (R m) = do
283− traceR "sitcc_before" Nothing
325+ requestedDel <- R (gets scRequestedDelimiter)
284 i <- R (asks rcIndent)
326 i <- R (asks rcIndent)
285 c <- R (gets scColumn)
327 c <- R (gets scColumn)
286− needsSpace <- R (gets scSpace)
287− let R m = traceR "sitcc_inside" Nothing >> m'
288− modRC rc = rc
328+ let modRC rc = rc
289− { rcIndent = max i c + bool 0 1 needsSpace
329+ { rcIndent = max i c + bool 0 1 (requestedDel == RequestedSpace)
291− vlayout m' . R $ do
331+ vlayout (R m) . R $ do
292− modify $ \sc -> sc { scSpace = False }
332+ modify $ \sc -> sc
333+ { scRequestedDelimiter =
334+ case requestedDel of
335+ RequestedSpace -> RequestedNothing
293 local modRC m
338 local modRC m
294− traceR "sitcc_ended" Nothing
296-- | Set 'Layout' for internal computation.
340-- | Set 'Layout' for internal computation.
298enterLayout :: Layout -> R () -> R ()
342enterLayout :: Layout -> R () -> R ()
299−enterLayout l (R m) = do
343+enterLayout l (R m) = R (local modRC m)
300− let label =
344+ where
302− SingleLine -> "single_line"
303− MultiLine -> "multi_line"
304− traceR ("lstart_" ++ label) Nothing
305− let modRC rc = rc
345+ modRC rc = rc
306− { rcLayout = l
346+ { rcLayout = l
308− x <- R (local modRC m)
309− traceR ("lend_" ++ label) Nothing
312-- | Do one or another thing depending on current 'Layout'.
349-- | Do one or another thing depending on current 'Layout'.
@@ -324,6 +361,21 @@ vlayout sline mline = do
324----------------------------------------------------------------------------
361----------------------------------------------------------------------------
325-- Special helpers for comment placement
362-- Special helpers for comment placement
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.
369+registerPendingCommentLine
370+ :: CommentPosition -- ^ Comment position
371+ -> Text -- ^ 'Text' to output
373+registerPendingCommentLine position txt' = R $ do
376+ { scPendingComments = (position, i, txt') : scPendingComments sc
327-- | Drop elements that begin before or at the same place as given
379-- | Drop elements that begin before or at the same place as given
328-- 'SrcSpan'.
380-- 'SrcSpan'.
@@ -359,30 +411,6 @@ popComment f = R $ do
360 else return Nothing
412 else return Nothing
362−-- | Return 'True' if there are more comments in the 'CommentStream'.
364−hasMoreComments :: R Bool
365−hasMoreComments = R $ do
366− CommentStream cstream <- gets scCommentStream
367− (return . not . null) cstream
369−-- | Current indentation level.
372−getIndent = R (asks rcIndent)
374−-- | Set indentation level for the given computation.
376−setIndent :: Int -> R () -> R ()
378− traceR "set_indent_before" Nothing
379− let R m = traceR "set_indent_inside" Nothing >> m'
384− traceR "set_indent_after" Nothing
386-- | Get the first enclosing 'RealSrcSpan' that satisfies given predicate.
414-- | Get the first enclosing 'RealSrcSpan' that satisfies given predicate.
388getEnclosingSpan
416getEnclosingSpan
@@ -394,11 +422,23 @@ getEnclosingSpan f =
394-- | Set 'RealSrcSpan' of enclosing span for the given computation.
422-- | Set 'RealSrcSpan' of enclosing span for the given computation.
396withEnclosingSpan :: RealSrcSpan -> R () -> R ()
424withEnclosingSpan :: RealSrcSpan -> R () -> R ()
397−withEnclosingSpan spn (R m) = do
425+withEnclosingSpan spn (R m) = R (local modRC m)
398− let modRC rc = rc
427+ modRC rc = rc
399− { rcEnclosingSpans = spn : rcEnclosingSpans rc
428+ { rcEnclosingSpans = spn : rcEnclosingSpans rc
401− R (local modRC m)
430+
431+-- | Set span of last output comment.
433+setLastCommentSpan :: RealSrcSpan -> R ()
434+setLastCommentSpan spn = R . modify $ \sc -> sc
435+ { scLastCommentSpan = Just spn
438+-- | Get span of last output comment.
440+getLastCommentSpan :: R (Maybe RealSrcSpan)
441+getLastCommentSpan = R (gets scLastCommentSpan)
403----------------------------------------------------------------------------
443----------------------------------------------------------------------------
404-- Annotations
444-- Annotations
@@ -428,29 +468,6 @@ dontUseBraces (R r) = R (local (\i -> i {rcCanUseBraces = False}) r)
428canUseBraces :: R Bool
468canUseBraces :: R Bool
429canUseBraces = R $ asks rcCanUseBraces
469canUseBraces = R $ asks rcCanUseBraces
431−----------------------------------------------------------------------------
437− :: String -- ^ Label
438− -> Maybe Text -- ^ Output, if any
440−traceR label moutput = R $ do
441− debug <- asks rcDebug
444− when debug . traceM . concat $
446− , unwords [ label ++ ":"
450− ] ++ case moutput of
452− Just output -> [" out=" ++ show output]
454----------------------------------------------------------------------------
471----------------------------------------------------------------------------
455-- Constants
472-- Constants