{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Ormolu.Printer.Comments
( spitPrecedingComments,
spitFollowingComments,
spitRemainingComments,
spitCommentNow,
spitCommentPending,
)
where
import Control.Monad
import Data.Coerce (coerce)
import Data.Data (Data)
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import Ormolu.Parser.CommentStream
import Ormolu.Printer.Internal
import Ormolu.Utils (isModule)
import SrcLoc
spitPrecedingComments ::
Data a =>
RealLocated a ->
R ()
spitPrecedingComments ref = do
gotSome <- handleCommentSeries (spitPrecedingComment ref)
when gotSome $ do
lastMark <- getSpanMark
when (needsNewlineBefore (getRealSrcSpan ref) lastMark) newline
spitFollowingComments ::
Data a =>
RealLocated a ->
R ()
spitFollowingComments ref = do
trimSpanStream (getRealSrcSpan ref)
void $ handleCommentSeries (spitFollowingComment ref)
spitRemainingComments :: R ()
spitRemainingComments = do
newline
void $ handleCommentSeries spitRemainingComment
spitPrecedingComment ::
Data a =>
RealLocated a ->
Maybe SpanMark ->
R Bool
spitPrecedingComment (L ref a) mlastMark = do
let p (L l _) = realSrcSpanEnd l <= realSrcSpanStart ref
withPoppedComment p $ \l comment -> do
dirtyLine <-
case mlastMark of
Nothing -> isLineDirty
Just _ -> return False
when (dirtyLine || needsNewlineBefore l mlastMark) newline
spitCommentNow l comment
if theSameLinePre l ref && not (isModule a)
then space
else newline
spitFollowingComment ::
Data a =>
RealLocated a ->
Maybe SpanMark ->
R Bool
spitFollowingComment (L ref a) mlastMark = do
mnSpn <- nextEltSpan
meSpn <- getEnclosingSpan (/= ref)
withPoppedComment (commentFollowsElt ref mnSpn meSpn mlastMark) $ \l comment ->
if theSameLinePost l ref && not (isModule a)
then
if isMultilineComment comment
then space >> spitCommentNow l comment
else spitCommentPending OnTheSameLine l comment
else do
when (needsNewlineBefore l mlastMark) $
registerPendingCommentLine OnNextLine ""
spitCommentPending OnNextLine l comment
spitRemainingComment ::
Maybe SpanMark ->
R Bool
spitRemainingComment mlastMark =
withPoppedComment (const True) $ \l comment -> do
when (needsNewlineBefore l mlastMark) newline
spitCommentNow l comment
newline
handleCommentSeries ::
(Maybe SpanMark -> R Bool) ->
R Bool
handleCommentSeries f = go False
where
go gotSome = do
done <- getSpanMark >>= f
if done
then return gotSome
else go True
withPoppedComment ::
(RealLocated Comment -> Bool) ->
(RealSrcSpan -> Comment -> R ()) ->
R Bool
withPoppedComment p f = do
r <- popComment p
case r of
Nothing -> return True
Just (L l comment) -> False <$ f l comment
needsNewlineBefore ::
RealSrcSpan ->
Maybe SpanMark ->
Bool
needsNewlineBefore l mlastMark =
case spanMarkSpan <$> mlastMark of
Nothing -> False
Just lastMark ->
srcSpanStartLine l > srcSpanEndLine lastMark + 1
theSameLinePre ::
RealSrcSpan ->
RealSrcSpan ->
Bool
theSameLinePre l ref =
srcSpanEndLine l == srcSpanStartLine ref
theSameLinePost ::
RealSrcSpan ->
RealSrcSpan ->
Bool
theSameLinePost l ref =
srcSpanStartLine l == srcSpanEndLine ref
commentFollowsElt ::
RealSrcSpan ->
Maybe RealSrcSpan ->
Maybe RealSrcSpan ->
Maybe SpanMark ->
RealLocated Comment ->
Bool
commentFollowsElt ref mnSpn meSpn mlastMark (L l comment) =
goesAfter
&& logicallyFollows
&& noEltBetween
&& (continuation || lastInEnclosing || supersedesParentElt)
where
goesAfter =
realSrcSpanStart l >= realSrcSpanEnd ref
logicallyFollows =
theSameLinePost l ref
|| isPrevHaddock comment
|| continuation
|| lastInEnclosing
noEltBetween =
case mnSpn of
Nothing -> True
Just nspn ->
realSrcSpanStart nspn >= realSrcSpanEnd l
supersedesParentElt =
case meSpn of
Nothing -> True
Just espn ->
let startColumn = srcLocCol . realSrcSpanStart
in startColumn espn > startColumn ref
|| ( abs (startColumn espn - startColumn l)
>= abs (startColumn ref - startColumn l)
)
continuation =
case mlastMark of
Just (HaddockSpan _ spn) ->
srcSpanEndLine spn + 1 == srcSpanStartLine l
Just (CommentSpan spn) ->
srcSpanEndLine spn + 1 == srcSpanStartLine l
_ -> False
lastInEnclosing =
case meSpn of
Nothing -> False
Just espn ->
let
insideParent = realSrcSpanEnd l <= realSrcSpanEnd espn
nextOutsideParent = case mnSpn of
Nothing -> True
Just nspn -> realSrcSpanEnd espn < realSrcSpanStart nspn
in insideParent && nextOutsideParent
spitCommentNow :: RealSrcSpan -> Comment -> R ()
spitCommentNow spn comment = do
sitcc
. sequence_
. NE.intersperse newline
. fmap (txt . T.pack)
. coerce
$ comment
setSpanMark (CommentSpan spn)
spitCommentPending :: CommentPosition -> RealSrcSpan -> Comment -> R ()
spitCommentPending position spn comment = do
let wrapper = case position of
OnTheSameLine -> sitcc
OnNextLine -> id
wrapper
. sequence_
. NE.toList
. fmap (registerPendingCommentLine position . T.pack)
. coerce
$ comment
setSpanMark (CommentSpan spn)