{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Helpers for formatting of comments. This is low-level code, use
-- "Ormolu.Printer.Combinators" unless you know what you are doing.
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

----------------------------------------------------------------------------
-- Top-level

-- | Output all preceding comments for an element at given location.
spitPrecedingComments ::
  -- | Span of the element to attach comments to
  RealSrcSpan ->
  R ()
spitPrecedingComments :: RealSrcSpan -> R ()
spitPrecedingComments 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
    -- Insert a blank line between the preceding comments and the thing
    -- after them if there was a blank line in the input.
    Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RealSrcSpan -> Maybe SpanMark -> Bool
needsNewlineBefore RealSrcSpan
ref Maybe SpanMark
lastMark) R ()
newline

-- | Output all comments following an element at given location.
spitFollowingComments ::
  -- | Span of the element to attach comments to
  RealSrcSpan ->
  R ()
spitFollowingComments :: RealSrcSpan -> R ()
spitFollowingComments 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)

-- | Output all remaining comments in the comment stream.
spitRemainingComments :: R ()
spitRemainingComments :: R ()
spitRemainingComments = do
  -- Make sure we have a blank a line between the last definition and the
  -- trailing comments.
  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

----------------------------------------------------------------------------
-- Single-comment functions

-- | Output a single preceding comment for an element at given location.
spitPrecedingComment ::
  -- | Span of the element to attach comments to
  RealSrcSpan ->
  -- | Are we done?
  R Bool
spitPrecedingComment :: RealSrcSpan -> R Bool
spitPrecedingComment 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

-- | Output a comment that follows element at given location immediately on
-- the same line, if there is any.
spitFollowingComment ::
  -- | AST element to attach comments to
  RealSrcSpan ->
  -- | Are we done?
  R Bool
spitFollowingComment :: RealSrcSpan -> R Bool
spitFollowingComment RealSrcSpan
ref = do
  Maybe SpanMark
mlastMark <- R (Maybe SpanMark)
getSpanMark
  Maybe RealSrcSpan
mnSpn <- R (Maybe RealSrcSpan)
nextEltSpan
  -- Get first enclosing span that is not equal to reference span, i.e. it's
  -- truly something enclosing the AST element.
  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

-- | Output a single remaining comment from the comment stream.
spitRemainingComment ::
  -- | Are we done?
  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

----------------------------------------------------------------------------
-- Helpers

-- | Output series of comments.
handleCommentSeries ::
  -- | Given location of previous comment, output the next comment
  -- returning 'True' if we're done
  R Bool ->
  -- | Whether we printed any comments
  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

-- | Try to pop a comment using given predicate and if there is a comment
-- matching the predicate, print it out.
withPoppedComment ::
  -- | Comment predicate
  (RealLocated Comment -> Bool) ->
  -- | Printing function
  (RealSrcSpan -> Comment -> R ()) ->
  -- | Are we done?
  R Bool
withPoppedComment :: (RealLocated Comment -> Bool)
-> (RealSrcSpan -> Comment -> R ()) -> R Bool
withPoppedComment 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

-- | Determine if we need to insert a newline between current comment and
-- last printed comment.
needsNewlineBefore ::
  -- | Current comment span
  RealSrcSpan ->
  -- | Last printed comment span
  Maybe SpanMark ->
  Bool
needsNewlineBefore :: RealSrcSpan -> Maybe SpanMark -> Bool
needsNewlineBefore RealSrcSpan
_ (Just (HaddockSpan HaddockStyle
_ RealSrcSpan
_)) = Bool
True
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

-- | Is the preceding comment and AST element are on the same line?
theSameLinePre ::
  -- | Current comment span
  RealSrcSpan ->
  -- | AST element location
  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

-- | Is the following comment and AST element are on the same line?
theSameLinePost ::
  -- | Current comment span
  RealSrcSpan ->
  -- | AST element location
  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

-- | Determine if given comment follows AST element.
commentFollowsElt ::
  -- | Location of AST element
  RealSrcSpan ->
  -- | Location of next AST element
  Maybe RealSrcSpan ->
  -- | Location of enclosing AST element
  Maybe RealSrcSpan ->
  -- | Location of last comment in the series
  Maybe SpanMark ->
  -- | Comment to test
  RealLocated Comment ->
  Bool
commentFollowsElt :: RealSrcSpan
-> Maybe RealSrcSpan
-> Maybe RealSrcSpan
-> Maybe SpanMark
-> RealLocated Comment
-> Bool
commentFollowsElt RealSrcSpan
ref Maybe RealSrcSpan
mnSpn Maybe RealSrcSpan
meSpn Maybe SpanMark
mlastMark (L RealSrcSpan
l Comment
comment) =
  -- A comment follows a AST element if all 4 conditions are satisfied:
  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
    -- 1) The comment starts after end of the AST element:
    goesAfter :: Bool
goesAfter =
      RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
l RealSrcLoc -> RealSrcLoc -> Bool
forall a. Ord a => a -> a -> Bool
>= RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
ref
    -- 2) The comment logically belongs to the element, four cases:
    logicallyFollows :: Bool
logicallyFollows =
      RealSrcSpan -> RealSrcSpan -> Bool
theSameLinePost RealSrcSpan
l RealSrcSpan
ref -- a) it's on the same line
        Bool -> Bool -> Bool
|| Bool
continuation -- b) it's a continuation of a comment block
        Bool -> Bool -> Bool
|| Bool
lastInEnclosing -- c) it's the last element in the enclosing construct

    -- 3) There is no other AST element between this element and the comment:
    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
    -- 4) Less obvious: if column of comment is closer to the start of
    -- enclosing element, it probably related to that parent element, not to
    -- the current child element. This rule is important because otherwise
    -- all comments would end up assigned to closest inner elements, and
    -- parent elements won't have a chance to get any comments assigned to
    -- them. This is not OK because comments will get indented according to
    -- the AST elements they are attached to.
    --
    -- Skip this rule if the comment is a continuation of a comment block.
    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 =
      -- A comment is a continuation when it doesn't have non-whitespace
      -- lexemes in front of it and goes right after the previous comment.
      Bool -> Bool
not (Comment -> Bool
hasAtomsBefore Comment
comment)
        Bool -> Bool -> Bool
&& ( case Maybe SpanMark
mlastMark of
               Just (HaddockSpan HaddockStyle
_ RealSrcSpan
_) -> Bool
False
               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
        -- When there is no enclosing element, return false
        Maybe RealSrcSpan
Nothing -> Bool
False
        -- When there is an enclosing element,
        Just RealSrcSpan
espn ->
          let -- Make sure that the comment is inside the enclosing element
              insideParent :: Bool
insideParent = RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
l RealSrcLoc -> RealSrcLoc -> Bool
forall a. Ord a => a -> a -> Bool
<= RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
espn
              -- And check if the next element is outside of the parent
              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

-- | Output a 'Comment' immediately. This is a low-level printing function.
spitCommentNow :: RealSrcSpan -> Comment -> R ()
spitCommentNow :: RealSrcSpan -> Comment -> R ()
spitCommentNow 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)

-- | Output a 'Comment' at the end of correct line or after it depending on
-- 'CommentPosition'. Used for comments that may potentially follow on the
-- same line as something we just rendered, but not immediately after it.
spitCommentPending :: CommentPosition -> RealSrcSpan -> Comment -> R ()
spitCommentPending :: CommentPosition -> RealSrcSpan -> Comment -> R ()
spitCommentPending 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)