{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Ormolu.Printer.Comments
( spitPrecedingComments,
spitFollowingComments,
spitRemainingComments,
spitCommentNow,
spitCommentPending,
)
where
import Control.Monad
import qualified Data.List.NonEmpty as NE
import Data.Maybe (listToMaybe)
import qualified Data.Text as T
import Ormolu.Parser.CommentStream
import Ormolu.Printer.Internal
import SrcLoc
spitPrecedingComments ::
RealSrcSpan ->
R ()
RealSrcSpan
ref = do
Bool
gotSome <- R Bool -> R Bool
handleCommentSeries (RealSrcSpan -> R Bool
spitPrecedingComment RealSrcSpan
ref)
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
gotSome (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Maybe SpanMark
lastMark <- R (Maybe SpanMark)
getSpanMark
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RealSrcSpan -> Maybe SpanMark -> Bool
needsNewlineBefore RealSrcSpan
ref Maybe SpanMark
lastMark) R ()
newline
spitFollowingComments ::
RealSrcSpan ->
R ()
RealSrcSpan
ref = do
RealSrcSpan -> R ()
trimSpanStream RealSrcSpan
ref
R Bool -> R ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (R Bool -> R ()) -> R Bool -> R ()
forall a b. (a -> b) -> a -> b
$ R Bool -> R Bool
handleCommentSeries (RealSrcSpan -> R Bool
spitFollowingComment RealSrcSpan
ref)
spitRemainingComments :: R ()
spitRemainingComments :: R ()
spitRemainingComments = do
R ()
newline
R Bool -> R ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (R Bool -> R ()) -> R Bool -> R ()
forall a b. (a -> b) -> a -> b
$ R Bool -> R Bool
handleCommentSeries R Bool
spitRemainingComment
spitPrecedingComment ::
RealSrcSpan ->
R Bool
RealSrcSpan
ref = do
Maybe SpanMark
mlastMark <- R (Maybe SpanMark)
getSpanMark
let p :: GenLocated RealSrcSpan e -> Bool
p (L RealSrcSpan
l e
_) = RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
l RealSrcLoc -> RealSrcLoc -> Bool
forall a. Ord a => a -> a -> Bool
<= RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
ref
(RealLocated Comment -> Bool)
-> (RealSrcSpan -> Comment -> R ()) -> R Bool
withPoppedComment RealLocated Comment -> Bool
forall e. GenLocated RealSrcSpan e -> Bool
p ((RealSrcSpan -> Comment -> R ()) -> R Bool)
-> (RealSrcSpan -> Comment -> R ()) -> R Bool
forall a b. (a -> b) -> a -> b
$ \RealSrcSpan
l Comment
comment -> do
[RealSrcSpan]
lineSpans <- R [RealSrcSpan]
thisLineSpans
let thisCommentLine :: Int
thisCommentLine = RealSrcLoc -> Int
srcLocLine (RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
l)
needsNewline :: Bool
needsNewline =
case [RealSrcSpan] -> Maybe RealSrcSpan
forall a. [a] -> Maybe a
listToMaybe [RealSrcSpan]
lineSpans of
Maybe RealSrcSpan
Nothing -> Bool
False
Just RealSrcSpan
spn -> RealSrcLoc -> Int
srcLocLine (RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
spn) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
thisCommentLine
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
needsNewline Bool -> Bool -> Bool
|| RealSrcSpan -> Maybe SpanMark -> Bool
needsNewlineBefore RealSrcSpan
l Maybe SpanMark
mlastMark) R ()
newline
RealSrcSpan -> Comment -> R ()
spitCommentNow RealSrcSpan
l Comment
comment
if RealSrcSpan -> RealSrcSpan -> Bool
theSameLinePre RealSrcSpan
l RealSrcSpan
ref
then R ()
space
else R ()
newline
spitFollowingComment ::
RealSrcSpan ->
R Bool
RealSrcSpan
ref = do
Maybe SpanMark
mlastMark <- R (Maybe SpanMark)
getSpanMark
Maybe RealSrcSpan
mnSpn <- R (Maybe RealSrcSpan)
nextEltSpan
Maybe RealSrcSpan
meSpn <- (RealSrcSpan -> Bool) -> R (Maybe RealSrcSpan)
getEnclosingSpan (RealSrcSpan -> RealSrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
/= RealSrcSpan
ref)
(RealLocated Comment -> Bool)
-> (RealSrcSpan -> Comment -> R ()) -> R Bool
withPoppedComment (RealSrcSpan
-> Maybe RealSrcSpan
-> Maybe RealSrcSpan
-> Maybe SpanMark
-> RealLocated Comment
-> Bool
commentFollowsElt RealSrcSpan
ref Maybe RealSrcSpan
mnSpn Maybe RealSrcSpan
meSpn Maybe SpanMark
mlastMark) ((RealSrcSpan -> Comment -> R ()) -> R Bool)
-> (RealSrcSpan -> Comment -> R ()) -> R Bool
forall a b. (a -> b) -> a -> b
$ \RealSrcSpan
l Comment
comment ->
if RealSrcSpan -> RealSrcSpan -> Bool
theSameLinePost RealSrcSpan
l RealSrcSpan
ref
then
if Comment -> Bool
isMultilineComment Comment
comment
then R ()
space R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RealSrcSpan -> Comment -> R ()
spitCommentNow RealSrcSpan
l Comment
comment
else CommentPosition -> RealSrcSpan -> Comment -> R ()
spitCommentPending CommentPosition
OnTheSameLine RealSrcSpan
l Comment
comment
else do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RealSrcSpan -> Maybe SpanMark -> Bool
needsNewlineBefore RealSrcSpan
l Maybe SpanMark
mlastMark) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
CommentPosition -> Text -> R ()
registerPendingCommentLine CommentPosition
OnNextLine Text
""
CommentPosition -> RealSrcSpan -> Comment -> R ()
spitCommentPending CommentPosition
OnNextLine RealSrcSpan
l Comment
comment
spitRemainingComment ::
R Bool
spitRemainingComment :: R Bool
spitRemainingComment = do
Maybe SpanMark
mlastMark <- R (Maybe SpanMark)
getSpanMark
(RealLocated Comment -> Bool)
-> (RealSrcSpan -> Comment -> R ()) -> R Bool
withPoppedComment (Bool -> RealLocated Comment -> Bool
forall a b. a -> b -> a
const Bool
True) ((RealSrcSpan -> Comment -> R ()) -> R Bool)
-> (RealSrcSpan -> Comment -> R ()) -> R Bool
forall a b. (a -> b) -> a -> b
$ \RealSrcSpan
l Comment
comment -> do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RealSrcSpan -> Maybe SpanMark -> Bool
needsNewlineBefore RealSrcSpan
l Maybe SpanMark
mlastMark) R ()
newline
RealSrcSpan -> Comment -> R ()
spitCommentNow RealSrcSpan
l Comment
comment
R ()
newline
handleCommentSeries ::
R Bool ->
R Bool
handleCommentSeries :: R Bool -> R Bool
handleCommentSeries R Bool
f = Bool -> R Bool
go Bool
False
where
go :: Bool -> R Bool
go Bool
gotSome = do
Bool
done <- R Bool
f
if Bool
done
then Bool -> R Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
gotSome
else Bool -> R Bool
go Bool
True
withPoppedComment ::
(RealLocated Comment -> Bool) ->
(RealSrcSpan -> Comment -> R ()) ->
R Bool
RealLocated Comment -> Bool
p RealSrcSpan -> Comment -> R ()
f = do
Maybe (RealLocated Comment)
r <- (RealLocated Comment -> Bool) -> R (Maybe (RealLocated Comment))
popComment RealLocated Comment -> Bool
p
case Maybe (RealLocated Comment)
r of
Maybe (RealLocated Comment)
Nothing -> Bool -> R Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Just (L RealSrcSpan
l Comment
comment) -> Bool
False Bool -> R () -> R Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ RealSrcSpan -> Comment -> R ()
f RealSrcSpan
l Comment
comment
needsNewlineBefore ::
RealSrcSpan ->
Maybe SpanMark ->
Bool
needsNewlineBefore :: RealSrcSpan -> Maybe SpanMark -> Bool
needsNewlineBefore RealSrcSpan
l Maybe SpanMark
mlastMark =
case SpanMark -> RealSrcSpan
spanMarkSpan (SpanMark -> RealSrcSpan) -> Maybe SpanMark -> Maybe RealSrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SpanMark
mlastMark of
Maybe RealSrcSpan
Nothing -> Bool
False
Just RealSrcSpan
lastMark ->
RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
lastMark Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
theSameLinePre ::
RealSrcSpan ->
RealSrcSpan ->
Bool
theSameLinePre :: RealSrcSpan -> RealSrcSpan -> Bool
theSameLinePre RealSrcSpan
l RealSrcSpan
ref =
RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
ref
theSameLinePost ::
RealSrcSpan ->
RealSrcSpan ->
Bool
theSameLinePost :: RealSrcSpan -> RealSrcSpan -> Bool
theSameLinePost RealSrcSpan
l RealSrcSpan
ref =
RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
ref
commentFollowsElt ::
RealSrcSpan ->
Maybe RealSrcSpan ->
Maybe RealSrcSpan ->
Maybe SpanMark ->
RealLocated Comment ->
Bool
RealSrcSpan
ref Maybe RealSrcSpan
mnSpn Maybe RealSrcSpan
meSpn Maybe SpanMark
mlastMark (L RealSrcSpan
l Comment
comment) =
Bool
goesAfter
Bool -> Bool -> Bool
&& Bool
logicallyFollows
Bool -> Bool -> Bool
&& Bool
noEltBetween
Bool -> Bool -> Bool
&& (Bool
continuation Bool -> Bool -> Bool
|| Bool
lastInEnclosing Bool -> Bool -> Bool
|| Bool
supersedesParentElt)
where
goesAfter :: Bool
goesAfter =
RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
l RealSrcLoc -> RealSrcLoc -> Bool
forall a. Ord a => a -> a -> Bool
>= RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
ref
logicallyFollows :: Bool
logicallyFollows =
RealSrcSpan -> RealSrcSpan -> Bool
theSameLinePost RealSrcSpan
l RealSrcSpan
ref
Bool -> Bool -> Bool
|| Bool
continuation
Bool -> Bool -> Bool
|| Bool
lastInEnclosing
noEltBetween :: Bool
noEltBetween =
case Maybe RealSrcSpan
mnSpn of
Maybe RealSrcSpan
Nothing -> Bool
True
Just RealSrcSpan
nspn ->
RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
nspn RealSrcLoc -> RealSrcLoc -> Bool
forall a. Ord a => a -> a -> Bool
>= RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
l
supersedesParentElt :: Bool
supersedesParentElt =
case Maybe RealSrcSpan
meSpn of
Maybe RealSrcSpan
Nothing -> Bool
True
Just RealSrcSpan
espn ->
let startColumn :: RealSrcSpan -> Int
startColumn = RealSrcLoc -> Int
srcLocCol (RealSrcLoc -> Int)
-> (RealSrcSpan -> RealSrcLoc) -> RealSrcSpan -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealSrcSpan -> RealSrcLoc
realSrcSpanStart
in RealSrcSpan -> Int
startColumn RealSrcSpan
espn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> RealSrcSpan -> Int
startColumn RealSrcSpan
ref
Bool -> Bool -> Bool
|| ( Int -> Int
forall a. Num a => a -> a
abs (RealSrcSpan -> Int
startColumn RealSrcSpan
espn Int -> Int -> Int
forall a. Num a => a -> a -> a
- RealSrcSpan -> Int
startColumn RealSrcSpan
l)
Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Int
forall a. Num a => a -> a
abs (RealSrcSpan -> Int
startColumn RealSrcSpan
ref Int -> Int -> Int
forall a. Num a => a -> a -> a
- RealSrcSpan -> Int
startColumn RealSrcSpan
l)
)
continuation :: Bool
continuation =
Bool -> Bool
not (Comment -> Bool
hasAtomsBefore Comment
comment)
Bool -> Bool -> Bool
&& ( case Maybe SpanMark
mlastMark of
Just (HaddockSpan HaddockStyle
_ RealSrcSpan
spn) ->
RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
spn Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
l
Just (CommentSpan RealSrcSpan
spn) ->
RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
spn Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
l
Maybe SpanMark
_ -> Bool
False
)
lastInEnclosing :: Bool
lastInEnclosing =
case Maybe RealSrcSpan
meSpn of
Maybe RealSrcSpan
Nothing -> Bool
False
Just RealSrcSpan
espn ->
let
insideParent :: Bool
insideParent = RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
l RealSrcLoc -> RealSrcLoc -> Bool
forall a. Ord a => a -> a -> Bool
<= RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
espn
nextOutsideParent :: Bool
nextOutsideParent = case Maybe RealSrcSpan
mnSpn of
Maybe RealSrcSpan
Nothing -> Bool
True
Just RealSrcSpan
nspn -> RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
espn RealSrcLoc -> RealSrcLoc -> Bool
forall a. Ord a => a -> a -> Bool
< RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
nspn
in Bool
insideParent Bool -> Bool -> Bool
&& Bool
nextOutsideParent
spitCommentNow :: RealSrcSpan -> Comment -> R ()
RealSrcSpan
spn Comment
comment = do
R () -> R ()
sitcc
(R () -> R ()) -> (Comment -> R ()) -> Comment -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (R ()) -> R ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
(NonEmpty (R ()) -> R ())
-> (Comment -> NonEmpty (R ())) -> Comment -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> NonEmpty (R ()) -> NonEmpty (R ())
forall a. a -> NonEmpty a -> NonEmpty a
NE.intersperse R ()
newline
(NonEmpty (R ()) -> NonEmpty (R ()))
-> (Comment -> NonEmpty (R ())) -> Comment -> NonEmpty (R ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> R ()) -> NonEmpty String -> NonEmpty (R ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> R ()
txt (Text -> R ()) -> (String -> Text) -> String -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)
(NonEmpty String -> NonEmpty (R ()))
-> (Comment -> NonEmpty String) -> Comment -> NonEmpty (R ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comment -> NonEmpty String
unComment
(Comment -> R ()) -> Comment -> R ()
forall a b. (a -> b) -> a -> b
$ Comment
comment
SpanMark -> R ()
setSpanMark (RealSrcSpan -> SpanMark
CommentSpan RealSrcSpan
spn)
spitCommentPending :: CommentPosition -> RealSrcSpan -> Comment -> R ()
CommentPosition
position RealSrcSpan
spn Comment
comment = do
let wrapper :: R () -> R ()
wrapper = case CommentPosition
position of
CommentPosition
OnTheSameLine -> R () -> R ()
sitcc
CommentPosition
OnNextLine -> R () -> R ()
forall a. a -> a
id
R () -> R ()
wrapper
(R () -> R ()) -> (Comment -> R ()) -> Comment -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [R ()] -> R ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
([R ()] -> R ()) -> (Comment -> [R ()]) -> Comment -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (R ()) -> [R ()]
forall a. NonEmpty a -> [a]
NE.toList
(NonEmpty (R ()) -> [R ()])
-> (Comment -> NonEmpty (R ())) -> Comment -> [R ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> R ()) -> NonEmpty String -> NonEmpty (R ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CommentPosition -> Text -> R ()
registerPendingCommentLine CommentPosition
position (Text -> R ()) -> (String -> Text) -> String -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)
(NonEmpty String -> NonEmpty (R ()))
-> (Comment -> NonEmpty String) -> Comment -> NonEmpty (R ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comment -> NonEmpty String
unComment
(Comment -> R ()) -> Comment -> R ()
forall a b. (a -> b) -> a -> b
$ Comment
comment
SpanMark -> R ()
setSpanMark (RealSrcSpan -> SpanMark
CommentSpan RealSrcSpan
spn)