{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | Comment relocation for pretty-printing comments correctly.
--
-- HIndent gathers all comments above a function, an import, a module
-- declaration, etc. For example, HIndent formats the following code
--
-- > f :: Int
-- > f = 1
-- >
-- > -- A comment between f and g
-- >
-- > -- Another comment between f and g
-- >
-- > g :: Int
-- > g = 2
--
-- to
--
-- > f :: Int
-- > f = 1
-- >
-- > -- A comment between f and g
-- > -- Another comment between f and g
-- > g :: Int
-- > g = 2
--
-- AST nodes must have the information of which comments are above, on the
-- same line, and below. However, AST nodes generated by a parser of
-- 'ghc-lib-parser' only contain comments after them. 'relocateComments' is
-- defined to solve the problem.
module HIndent.ModulePreprocessing.CommentRelocation
  ( relocateComments
  ) where

import Control.Exception
import Control.Monad.State
import Data.Foldable
import Data.Function
import Data.List
import Data.Traversable
import GHC.Data.Bag
import GHC.Types.SrcLoc
import Generics.SYB hiding (GT, typeOf, typeRep)
import HIndent.GhcLibParserWrapper.GHC.Hs
import HIndent.Pragma
import HIndent.Pretty.SigBindFamily
import Type.Reflection
#if MIN_VERSION_GLASGOW_HASKELL(9, 6, 0, 0)
import Control.Monad
#endif
-- | A wrapper type used in everywhereMEpAnnsBackwards' to collect all
-- 'EpAnn's to apply a function with them in order their positions.
data Wrapper =
  forall a. Typeable (EpAnn a) =>
            Wrapper (EpAnn a)

-- | 'State' with comments.
type WithComments = State [LEpaComment]

-- | This function collects all comments from the passed 'HsModule', and
-- modifies all 'EpAnn's so that all 'EpAnn's have 'EpaCommentsBalanced's.
relocateComments :: HsModule' -> [LEpaComment] -> HsModule'
relocateComments :: HsModule' -> [LEpaComment] -> HsModule'
relocateComments = State [LEpaComment] HsModule' -> [LEpaComment] -> HsModule'
forall s a. State s a -> s -> a
evalState (State [LEpaComment] HsModule' -> [LEpaComment] -> HsModule')
-> (HsModule' -> State [LEpaComment] HsModule')
-> HsModule'
-> [LEpaComment]
-> HsModule'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> State [LEpaComment] HsModule'
relocate
  where
    relocate :: HsModule' -> State [LEpaComment] HsModule'
relocate =
      HsModule' -> State [LEpaComment] HsModule'
relocatePragmas
        (HsModule' -> State [LEpaComment] HsModule')
-> (HsModule' -> State [LEpaComment] HsModule')
-> HsModule'
-> State [LEpaComment] HsModule'
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> HsModule' -> State [LEpaComment] HsModule'
relocateCommentsBeforePragmas
        (HsModule' -> State [LEpaComment] HsModule')
-> (HsModule' -> State [LEpaComment] HsModule')
-> HsModule'
-> State [LEpaComment] HsModule'
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> HsModule' -> State [LEpaComment] HsModule'
relocateCommentsInExportList
        (HsModule' -> State [LEpaComment] HsModule')
-> (HsModule' -> State [LEpaComment] HsModule')
-> HsModule'
-> State [LEpaComment] HsModule'
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> HsModule' -> State [LEpaComment] HsModule'
relocateCommentsInClass
        (HsModule' -> State [LEpaComment] HsModule')
-> (HsModule' -> State [LEpaComment] HsModule')
-> HsModule'
-> State [LEpaComment] HsModule'
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> HsModule' -> State [LEpaComment] HsModule'
relocateCommentsBeforeTopLevelDecls
        (HsModule' -> State [LEpaComment] HsModule')
-> (HsModule' -> State [LEpaComment] HsModule')
-> HsModule'
-> State [LEpaComment] HsModule'
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> HsModule' -> State [LEpaComment] HsModule'
relocateCommentsSameLine
        (HsModule' -> State [LEpaComment] HsModule')
-> (HsModule' -> State [LEpaComment] HsModule')
-> HsModule'
-> State [LEpaComment] HsModule'
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> HsModule' -> State [LEpaComment] HsModule'
relocateCommentsInDoExpr
        (HsModule' -> State [LEpaComment] HsModule')
-> (HsModule' -> State [LEpaComment] HsModule')
-> HsModule'
-> State [LEpaComment] HsModule'
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> HsModule' -> State [LEpaComment] HsModule'
relocateCommentsInCase
        (HsModule' -> State [LEpaComment] HsModule')
-> (HsModule' -> State [LEpaComment] HsModule')
-> HsModule'
-> State [LEpaComment] HsModule'
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> HsModule' -> State [LEpaComment] HsModule'
relocateCommentsTopLevelWhereClause
        (HsModule' -> State [LEpaComment] HsModule')
-> (HsModule' -> State [LEpaComment] HsModule')
-> HsModule'
-> State [LEpaComment] HsModule'
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> HsModule' -> State [LEpaComment] HsModule'
relocateCommentsAfter
        (HsModule' -> State [LEpaComment] HsModule')
-> (HsModule' -> State [LEpaComment] HsModule')
-> HsModule'
-> State [LEpaComment] HsModule'
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> HsModule' -> State [LEpaComment] HsModule'
forall {m :: * -> *} {t :: * -> *} {a} {b}.
(MonadState (t a) m, Foldable t) =>
b -> m b
assertAllCommentsAreConsumed
        (HsModule' -> State [LEpaComment] HsModule')
-> (HsModule' -> State [LEpaComment] HsModule')
-> HsModule'
-> State [LEpaComment] HsModule'
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> HsModule' -> State [LEpaComment] HsModule'
moveCommentsFromFunIdToMcFun
    assertAllCommentsAreConsumed :: b -> m b
assertAllCommentsAreConsumed b
x = do
      t a
cs <- m (t a)
forall s (m :: * -> *). MonadState s m => m s
get
      Bool -> m b -> m b
forall a. HasCallStack => Bool -> a -> a
assert (t a -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
cs) (b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
x)
-- | This function locates pragmas to the module's EPA.
#if MIN_VERSION_ghc_lib_parser(9,6,1)
relocatePragmas :: HsModule GhcPs -> WithComments (HsModule GhcPs)
relocatePragmas :: HsModule' -> State [LEpaComment] HsModule'
relocatePragmas m :: HsModule'
m@HsModule {hsmodExt :: forall p. HsModule p -> XCModule p
hsmodExt = xmod :: XCModule GhcPs
xmod@XModulePs {hsmodAnn :: XModulePs -> EpAnn AnnsModule
hsmodAnn = epa :: EpAnn AnnsModule
epa@EpAnn {}}} = do
  EpAnn AnnsModule
newAnn <- (LEpaComment -> Bool)
-> (EpAnnComments -> [LEpaComment] -> EpAnnComments)
-> EpAnn AnnsModule
-> WithComments (EpAnn AnnsModule)
forall a.
(LEpaComment -> Bool)
-> (EpAnnComments -> [LEpaComment] -> EpAnnComments)
-> EpAnn a
-> WithComments (EpAnn a)
insertComments (EpaCommentTok -> Bool
isPragma (EpaCommentTok -> Bool)
-> (LEpaComment -> EpaCommentTok) -> LEpaComment -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpaComment -> EpaCommentTok
ac_tok (EpaComment -> EpaCommentTok)
-> (LEpaComment -> EpaComment) -> LEpaComment -> EpaCommentTok
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LEpaComment -> EpaComment
forall l e. GenLocated l e -> e
unLoc) EpAnnComments -> [LEpaComment] -> EpAnnComments
insertPriorComments EpAnn AnnsModule
epa
  HsModule' -> State [LEpaComment] HsModule'
forall a. a -> StateT [LEpaComment] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return HsModule'
m {hsmodExt = xmod {hsmodAnn = newAnn}}
#else
relocatePragmas :: HsModule -> WithComments HsModule
relocatePragmas m@HsModule {hsmodAnn = epa@EpAnn {}} = do
  newAnn <- insertComments (isPragma . ac_tok . unLoc) insertPriorComments epa
  return m {hsmodAnn = newAnn}
#endif
relocatePragmas HsModule'
m = HsModule' -> State [LEpaComment] HsModule'
forall a. a -> StateT [LEpaComment] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsModule'
m
-- | This function locates comments that are located before pragmas to the
-- module's EPA.
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
relocateCommentsBeforePragmas :: HsModule GhcPs -> WithComments (HsModule GhcPs)
relocateCommentsBeforePragmas :: HsModule' -> State [LEpaComment] HsModule'
relocateCommentsBeforePragmas m :: HsModule'
m@HsModule {hsmodExt :: forall p. HsModule p -> XCModule p
hsmodExt = xmod :: XCModule GhcPs
xmod@XModulePs {hsmodAnn :: XModulePs -> EpAnn AnnsModule
hsmodAnn = EpAnn AnnsModule
ann}}
  | HsModule' -> Bool
pragmaExists HsModule'
m = do
    EpAnn AnnsModule
newAnn <- (RealSrcSpan -> Bool)
-> (EpAnnComments -> [LEpaComment] -> EpAnnComments)
-> EpAnn AnnsModule
-> WithComments (EpAnn AnnsModule)
forall a.
(RealSrcSpan -> Bool)
-> (EpAnnComments -> [LEpaComment] -> EpAnnComments)
-> EpAnn a
-> WithComments (EpAnn a)
insertCommentsByPos (RealSrcSpan -> RealSrcSpan -> Bool
forall a. Ord a => a -> a -> Bool
< RealSrcSpan
startPosOfPragmas) EpAnnComments -> [LEpaComment] -> EpAnnComments
insertPriorComments EpAnn AnnsModule
ann
    HsModule' -> State [LEpaComment] HsModule'
forall a. a -> StateT [LEpaComment] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsModule'
m {hsmodExt = xmod {hsmodAnn = newAnn}}
  | Bool
otherwise = HsModule' -> State [LEpaComment] HsModule'
forall a. a -> StateT [LEpaComment] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsModule'
m
  where
    startPosOfPragmas :: RealSrcSpan
startPosOfPragmas =
      let loc :: NoCommentsLocation
loc = LEpaComment -> NoCommentsLocation
forall l e. GenLocated l e -> l
getLoc (LEpaComment -> NoCommentsLocation)
-> LEpaComment -> NoCommentsLocation
forall a b. (a -> b) -> a -> b
$ [LEpaComment] -> LEpaComment
forall a. HasCallStack => [a] -> a
head ([LEpaComment] -> LEpaComment) -> [LEpaComment] -> LEpaComment
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [LEpaComment]
priorComments (EpAnnComments -> [LEpaComment]) -> EpAnnComments -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ EpAnn AnnsModule -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
comments EpAnn AnnsModule
ann
       in case NoCommentsLocation
loc of
            EpaSpan (RealSrcSpan RealSrcSpan
sp Maybe BufSpan
_) -> RealSrcSpan
sp
            NoCommentsLocation
_ -> RealSrcSpan
forall a. HasCallStack => a
undefined
#elif MIN_VERSION_ghc_lib_parser(9, 6, 1)
relocateCommentsBeforePragmas :: HsModule GhcPs -> WithComments (HsModule GhcPs)
relocateCommentsBeforePragmas m@HsModule {hsmodExt = xmod@XModulePs {hsmodAnn = ann}}
  | pragmaExists m = do
    newAnn <- insertCommentsByPos (< startPosOfPragmas) insertPriorComments ann
    pure m {hsmodExt = xmod {hsmodAnn = newAnn}}
  | otherwise = pure m
  where
    startPosOfPragmas = anchor $ getLoc $ head $ priorComments $ comments ann
#else
relocateCommentsBeforePragmas :: HsModule -> WithComments HsModule
relocateCommentsBeforePragmas m@HsModule {hsmodAnn = ann}
  | pragmaExists m = do
    newAnn <- insertCommentsByPos (< startPosOfPragmas) insertPriorComments ann
    pure m {hsmodAnn = newAnn}
  | otherwise = pure m
  where
    startPosOfPragmas = anchor $ getLoc $ head $ priorComments $ comments ann
#endif
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
-- | This function locates comments that are located before each element of
-- an export list.
relocateCommentsInExportList :: HsModule' -> WithComments HsModule'
relocateCommentsInExportList :: HsModule' -> State [LEpaComment] HsModule'
relocateCommentsInExportList =
  (HsModule' -> [GenLocated SrcSpanAnnA (IE GhcPs)])
-> ([GenLocated SrcSpanAnnA (IE GhcPs)] -> HsModule' -> HsModule')
-> (GenLocated SrcSpanAnnA (IE GhcPs) -> SrcSpanAnnA)
-> (SrcSpanAnnA
    -> GenLocated SrcSpanAnnA (IE GhcPs)
    -> GenLocated SrcSpanAnnA (IE GhcPs))
-> (HsModule'
    -> GenLocated SrcSpanAnnA (IE GhcPs) -> RealSrcSpan -> Bool)
-> HsModule'
-> State [LEpaComment] HsModule'
forall a b c.
Typeable a =>
(a -> [b])
-> ([b] -> a -> a)
-> (b -> EpAnn c)
-> (EpAnn c -> b -> b)
-> (a -> b -> RealSrcSpan -> Bool)
-> HsModule'
-> State [LEpaComment] HsModule'
relocateCommentsBeforeEachElement
    HsModule' -> [XRec GhcPs (IE GhcPs)]
HsModule' -> [GenLocated SrcSpanAnnA (IE GhcPs)]
elemGetter
    [XRec GhcPs (IE GhcPs)] -> HsModule' -> HsModule'
[GenLocated SrcSpanAnnA (IE GhcPs)] -> HsModule' -> HsModule'
forall {p} {l}.
(XRec p [XRec p (IE p)] ~ GenLocated l [XRec p (IE p)]) =>
[XRec p (IE p)] -> HsModule p -> HsModule p
elemSetter
    GenLocated SrcSpanAnnA (IE GhcPs) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
annGetter
    SrcSpanAnnA
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs)
forall {l} {l} {e}. l -> GenLocated l e -> GenLocated l e
annSetter
    HsModule'
-> GenLocated SrcSpanAnnA (IE GhcPs) -> RealSrcSpan -> Bool
forall {p} {ann} {ann} {e}.
(XRec p [XRec p (IE p)]
 ~ GenLocated (EpAnn ann) [XRec p (IE p)]) =>
HsModule p -> GenLocated (EpAnn ann) e -> RealSrcSpan -> Bool
cond
  where
    elemGetter :: HsModule' -> [LIE GhcPs]
    elemGetter :: HsModule' -> [XRec GhcPs (IE GhcPs)]
elemGetter HsModule {hsmodExports :: forall p. HsModule p -> Maybe (XRec p [LIE p])
hsmodExports = Just (L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (IE GhcPs)]
xs)} = [XRec GhcPs (IE GhcPs)]
[GenLocated SrcSpanAnnA (IE GhcPs)]
xs
    elemGetter HsModule'
_ = []
    elemSetter :: [XRec p (IE p)] -> HsModule p -> HsModule p
elemSetter [XRec p (IE p)]
xs HsModule {hsmodExports :: forall p. HsModule p -> Maybe (XRec p [LIE p])
hsmodExports = Just (L l
sp [XRec p (IE p)]
_), [LImportDecl p]
[LHsDecl p]
Maybe (XRec p ModuleName)
XCModule p
hsmodExt :: forall p. HsModule p -> XCModule p
hsmodExt :: XCModule p
hsmodName :: Maybe (XRec p ModuleName)
hsmodImports :: [LImportDecl p]
hsmodDecls :: [LHsDecl p]
hsmodDecls :: forall p. HsModule p -> [LHsDecl p]
hsmodImports :: forall p. HsModule p -> [LImportDecl p]
hsmodName :: forall p. HsModule p -> Maybe (XRec p ModuleName)
..} =
      HsModule {hsmodExports :: Maybe (XRec p [XRec p (IE p)])
hsmodExports = GenLocated l [XRec p (IE p)]
-> Maybe (GenLocated l [XRec p (IE p)])
forall a. a -> Maybe a
Just (l -> [XRec p (IE p)] -> GenLocated l [XRec p (IE p)]
forall l e. l -> e -> GenLocated l e
L l
sp [XRec p (IE p)]
xs), [LImportDecl p]
[LHsDecl p]
Maybe (XRec p ModuleName)
XCModule p
hsmodExt :: XCModule p
hsmodExt :: XCModule p
hsmodName :: Maybe (XRec p ModuleName)
hsmodImports :: [LImportDecl p]
hsmodDecls :: [LHsDecl p]
hsmodDecls :: [LHsDecl p]
hsmodImports :: [LImportDecl p]
hsmodName :: Maybe (XRec p ModuleName)
..}
    elemSetter [XRec p (IE p)]
_ HsModule p
x = HsModule p
x
    annGetter :: GenLocated l e -> l
annGetter (L l
ann e
_) = l
ann
    annSetter :: l -> GenLocated l e -> GenLocated l e
annSetter l
newAnn (L l
_ e
x) = l -> e -> GenLocated l e
forall l e. l -> e -> GenLocated l e
L l
newAnn e
x
    cond :: HsModule p -> GenLocated (EpAnn ann) e -> RealSrcSpan -> Bool
cond HsModule {hsmodExports :: forall p. HsModule p -> Maybe (XRec p [LIE p])
hsmodExports = Just (L EpAnn {entry :: forall ann. EpAnn ann -> Anchor
entry = EpaSpan (RealSrcSpan RealSrcSpan
listAnc Maybe BufSpan
_)} [XRec p (IE p)]
_)} (L EpAnn {entry :: forall ann. EpAnn ann -> Anchor
entry = EpaSpan (RealSrcSpan RealSrcSpan
elemAnc Maybe BufSpan
_)} e
_) RealSrcSpan
comAnc =
      RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
comAnc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
elemAnc
        Bool -> Bool -> Bool
&& RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
listAnc RealSrcLoc -> RealSrcLoc -> Bool
forall a. Ord a => a -> a -> Bool
< RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
comAnc
    cond HsModule p
_ GenLocated (EpAnn ann) e
_ RealSrcSpan
_ = Bool
False

-- | Locates comments before each case branch.
relocateCommentsInCase :: HsModule' -> WithComments HsModule'
relocateCommentsInCase :: HsModule' -> State [LEpaComment] HsModule'
relocateCommentsInCase =
  (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> [GenLocated
       SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> ([GenLocated
       SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    -> SrcSpanAnnA)
-> (SrcSpanAnnA
    -> GenLocated
         SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    -> GenLocated
         SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated
         SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    -> RealSrcSpan
    -> Bool)
-> HsModule'
-> State [LEpaComment] HsModule'
forall a b c.
Typeable a =>
(a -> [b])
-> ([b] -> a -> a)
-> (b -> EpAnn c)
-> (EpAnn c -> b -> b)
-> (a -> b -> RealSrcSpan -> Bool)
-> HsModule'
-> State [LEpaComment] HsModule'
relocateCommentsBeforeEachElement
    XRec GhcPs (HsExpr GhcPs)
-> [XRec GhcPs (Match GhcPs (XRec GhcPs (HsExpr GhcPs)))]
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
elemGetter
    [XRec GhcPs (Match GhcPs (XRec GhcPs (HsExpr GhcPs)))]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
[GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall {p} {l} {l}.
(XRec p [XRec p (Match p (XRec p (HsExpr p)))]
 ~ GenLocated l [XRec p (Match p (XRec p (HsExpr p)))]) =>
[XRec p (Match p (XRec p (HsExpr p)))]
-> GenLocated l (HsExpr p) -> GenLocated l (HsExpr p)
elemSetter
    GenLocated
  SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpanAnnA
forall l e. GenLocated l e -> l
annGetter
    SrcSpanAnnA
-> GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall {l} {l} {e}. l -> GenLocated l e -> GenLocated l e
annSetter
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> RealSrcSpan
-> Bool
forall {ann} {e} {ann} {e}.
GenLocated (EpAnn ann) e
-> GenLocated (EpAnn ann) e -> RealSrcSpan -> Bool
cond
  where
    elemGetter :: LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)]
    elemGetter :: XRec GhcPs (HsExpr GhcPs)
-> [XRec GhcPs (Match GhcPs (XRec GhcPs (HsExpr GhcPs)))]
elemGetter (L SrcSpanAnnA
_ (HsCase XCase GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_ (MG {mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = L SrcSpanAnnL
_ [GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs}))) = [XRec GhcPs (Match GhcPs (XRec GhcPs (HsExpr GhcPs)))]
[GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs
    elemGetter XRec GhcPs (HsExpr GhcPs)
_ = []
    elemSetter :: [XRec p (Match p (XRec p (HsExpr p)))]
-> GenLocated l (HsExpr p) -> GenLocated l (HsExpr p)
elemSetter [XRec p (Match p (XRec p (HsExpr p)))]
xs (L l
sp (HsCase XCase p
ext XRec p (HsExpr p)
expr (MG {mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = L l
sp' [XRec p (Match p (XRec p (HsExpr p)))]
_, XMG p (XRec p (HsExpr p))
mg_ext :: XMG p (XRec p (HsExpr p))
mg_ext :: forall p body. MatchGroup p body -> XMG p body
..}))) =
      l -> HsExpr p -> GenLocated l (HsExpr p)
forall l e. l -> e -> GenLocated l e
L l
sp (XCase p
-> XRec p (HsExpr p)
-> MatchGroup p (XRec p (HsExpr p))
-> HsExpr p
forall p.
XCase p -> LHsExpr p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsCase XCase p
ext XRec p (HsExpr p)
expr (MG {mg_alts :: XRec p [XRec p (Match p (XRec p (HsExpr p)))]
mg_alts = l
-> [XRec p (Match p (XRec p (HsExpr p)))]
-> GenLocated l [XRec p (Match p (XRec p (HsExpr p)))]
forall l e. l -> e -> GenLocated l e
L l
sp' [XRec p (Match p (XRec p (HsExpr p)))]
xs, XMG p (XRec p (HsExpr p))
mg_ext :: XMG p (XRec p (HsExpr p))
mg_ext :: XMG p (XRec p (HsExpr p))
..}))
    elemSetter [XRec p (Match p (XRec p (HsExpr p)))]
_ GenLocated l (HsExpr p)
x = GenLocated l (HsExpr p)
x
    annGetter :: GenLocated l e -> l
annGetter (L l
ann e
_) = l
ann
    annSetter :: l -> GenLocated l e -> GenLocated l e
annSetter l
newAnn (L l
_ e
x) = l -> e -> GenLocated l e
forall l e. l -> e -> GenLocated l e
L l
newAnn e
x
    cond :: GenLocated (EpAnn ann) e
-> GenLocated (EpAnn ann) e -> RealSrcSpan -> Bool
cond (L EpAnn {entry :: forall ann. EpAnn ann -> Anchor
entry = EpaSpan (RealSrcSpan RealSrcSpan
caseAnchor Maybe BufSpan
_)} e
_) (L EpAnn {entry :: forall ann. EpAnn ann -> Anchor
entry = EpaSpan (RealSrcSpan RealSrcSpan
branchAnchor Maybe BufSpan
_)} e
_) RealSrcSpan
comAnc =
      RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
comAnc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
branchAnchor
        Bool -> Bool -> Bool
&& RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
caseAnchor RealSrcLoc -> RealSrcLoc -> Bool
forall a. Ord a => a -> a -> Bool
< RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
comAnc
    cond GenLocated (EpAnn ann) e
_ GenLocated (EpAnn ann) e
_ RealSrcSpan
_ = Bool
False

-- | Locates comments before each class element.
relocateCommentsInClass :: HsModule' -> WithComments HsModule'
relocateCommentsInClass :: HsModule' -> State [LEpaComment] HsModule'
relocateCommentsInClass =
  (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> [LSigBindFamily])
-> ([LSigBindFamily]
    -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
    -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> (LSigBindFamily -> SrcSpanAnnA)
-> (SrcSpanAnnA -> LSigBindFamily -> LSigBindFamily)
-> (GenLocated SrcSpanAnnA (HsDecl GhcPs)
    -> LSigBindFamily -> RealSrcSpan -> Bool)
-> HsModule'
-> State [LEpaComment] HsModule'
forall a b c.
Typeable a =>
(a -> [b])
-> ([b] -> a -> a)
-> (b -> EpAnn c)
-> (EpAnn c -> b -> b)
-> (a -> b -> RealSrcSpan -> Bool)
-> HsModule'
-> State [LEpaComment] HsModule'
relocateCommentsBeforeEachElement
    LHsDecl GhcPs -> [LSigBindFamily]
GenLocated SrcSpanAnnA (HsDecl GhcPs) -> [LSigBindFamily]
elemGetter
    [LSigBindFamily]
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall {l}.
[LSigBindFamily]
-> GenLocated l (HsDecl GhcPs) -> GenLocated l (HsDecl GhcPs)
elemSetter
    LSigBindFamily -> SrcSpanAnnA
forall l e. GenLocated l e -> l
annGetter
    SrcSpanAnnA -> LSigBindFamily -> LSigBindFamily
forall {l} {l} {e}. l -> GenLocated l e -> GenLocated l e
annSetter
    GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> LSigBindFamily -> RealSrcSpan -> Bool
forall {ann} {e} {ann} {e}.
GenLocated (EpAnn ann) e
-> GenLocated (EpAnn ann) e -> RealSrcSpan -> Bool
cond
  where
    elemGetter :: LHsDecl GhcPs -> [LSigBindFamily]
    elemGetter :: LHsDecl GhcPs -> [LSigBindFamily]
elemGetter (L SrcSpanAnnA
_ (TyClD XTyClD GhcPs
_ ClassDecl {[LSig GhcPs]
[LDocDecl GhcPs]
[LTyFamDefltDecl GhcPs]
[LFamilyDecl GhcPs]
[LHsFunDep GhcPs]
Maybe (LHsContext GhcPs)
XClassDecl GhcPs
LIdP GhcPs
LHsBinds GhcPs
LexicalFixity
LHsQTyVars GhcPs
tcdCExt :: XClassDecl GhcPs
tcdCtxt :: Maybe (LHsContext GhcPs)
tcdLName :: LIdP GhcPs
tcdTyVars :: LHsQTyVars GhcPs
tcdFixity :: LexicalFixity
tcdFDs :: [LHsFunDep GhcPs]
tcdSigs :: [LSig GhcPs]
tcdMeths :: LHsBinds GhcPs
tcdATs :: [LFamilyDecl GhcPs]
tcdATDefs :: [LTyFamDefltDecl GhcPs]
tcdDocs :: [LDocDecl GhcPs]
tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdDocs :: forall pass. TyClDecl pass -> [LDocDecl pass]
tcdATDefs :: forall pass. TyClDecl pass -> [LTyFamDefltDecl pass]
tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdMeths :: forall pass. TyClDecl pass -> LHsBinds pass
tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdFDs :: forall pass. TyClDecl pass -> [LHsFunDep pass]
tcdCtxt :: forall pass. TyClDecl pass -> Maybe (LHsContext pass)
tcdCExt :: forall pass. TyClDecl pass -> XClassDecl pass
..})) =
      [LSig GhcPs]
-> [LHsBindLR GhcPs GhcPs]
-> [LFamilyDecl GhcPs]
-> [LTyFamDefltDecl GhcPs]
-> [LDataFamInstDecl GhcPs]
-> [LSigBindFamily]
mkSortedLSigBindFamilyList
        [LSig GhcPs]
tcdSigs
        (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
-> [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
forall a. Bag a -> [a]
bagToList LHsBinds GhcPs
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
tcdMeths)
        [LFamilyDecl GhcPs]
tcdATs
        [LTyFamDefltDecl GhcPs]
tcdATDefs
        []
    elemGetter LHsDecl GhcPs
_ = []
    elemSetter :: [LSigBindFamily]
-> GenLocated l (HsDecl GhcPs) -> GenLocated l (HsDecl GhcPs)
elemSetter [LSigBindFamily]
xs (L l
sp (TyClD XTyClD GhcPs
ext ClassDecl {[LSig GhcPs]
[LDocDecl GhcPs]
[LTyFamDefltDecl GhcPs]
[LFamilyDecl GhcPs]
[LHsFunDep GhcPs]
Maybe (LHsContext GhcPs)
XClassDecl GhcPs
LIdP GhcPs
LHsBinds GhcPs
LexicalFixity
LHsQTyVars GhcPs
tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdDocs :: forall pass. TyClDecl pass -> [LDocDecl pass]
tcdATDefs :: forall pass. TyClDecl pass -> [LTyFamDefltDecl pass]
tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdMeths :: forall pass. TyClDecl pass -> LHsBinds pass
tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdFDs :: forall pass. TyClDecl pass -> [LHsFunDep pass]
tcdCtxt :: forall pass. TyClDecl pass -> Maybe (LHsContext pass)
tcdCExt :: forall pass. TyClDecl pass -> XClassDecl pass
tcdCExt :: XClassDecl GhcPs
tcdCtxt :: Maybe (LHsContext GhcPs)
tcdLName :: LIdP GhcPs
tcdTyVars :: LHsQTyVars GhcPs
tcdFixity :: LexicalFixity
tcdFDs :: [LHsFunDep GhcPs]
tcdSigs :: [LSig GhcPs]
tcdMeths :: LHsBinds GhcPs
tcdATs :: [LFamilyDecl GhcPs]
tcdATDefs :: [LTyFamDefltDecl GhcPs]
tcdDocs :: [LDocDecl GhcPs]
..})) = l -> HsDecl GhcPs -> GenLocated l (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L l
sp (XTyClD GhcPs -> TyClDecl GhcPs -> HsDecl GhcPs
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD GhcPs
ext TyClDecl GhcPs
newDecl)
      where
        newDecl :: TyClDecl GhcPs
newDecl =
          ClassDecl
            { tcdSigs :: [LSig GhcPs]
tcdSigs = [LSig GhcPs]
sigs
            , tcdMeths :: LHsBinds GhcPs
tcdMeths = [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
forall a. [a] -> Bag a
listToBag [LHsBindLR GhcPs GhcPs]
[GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
binds
            , tcdATs :: [LFamilyDecl GhcPs]
tcdATs = [LFamilyDecl GhcPs]
typeFamilies
            , tcdATDefs :: [LTyFamDefltDecl GhcPs]
tcdATDefs = [LTyFamDefltDecl GhcPs]
tyFamInsts
            , [LDocDecl GhcPs]
[LHsFunDep GhcPs]
Maybe (LHsContext GhcPs)
XClassDecl GhcPs
LIdP GhcPs
LexicalFixity
LHsQTyVars GhcPs
tcdFixity :: LexicalFixity
tcdTyVars :: LHsQTyVars GhcPs
tcdLName :: LIdP GhcPs
tcdDocs :: [LDocDecl GhcPs]
tcdFDs :: [LHsFunDep GhcPs]
tcdCtxt :: Maybe (LHsContext GhcPs)
tcdCExt :: XClassDecl GhcPs
tcdCExt :: XClassDecl GhcPs
tcdCtxt :: Maybe (LHsContext GhcPs)
tcdLName :: LIdP GhcPs
tcdTyVars :: LHsQTyVars GhcPs
tcdFixity :: LexicalFixity
tcdFDs :: [LHsFunDep GhcPs]
tcdDocs :: [LDocDecl GhcPs]
..
            }
        ([LSig GhcPs]
sigs, [LHsBindLR GhcPs GhcPs]
binds, [LFamilyDecl GhcPs]
typeFamilies, [LTyFamDefltDecl GhcPs]
tyFamInsts, [LDataFamInstDecl GhcPs]
_) =
          [LSigBindFamily]
-> ([LSig GhcPs], [LHsBindLR GhcPs GhcPs], [LFamilyDecl GhcPs],
    [LTyFamDefltDecl GhcPs], [LDataFamInstDecl GhcPs])
destructLSigBindFamilyList [LSigBindFamily]
xs
    elemSetter [LSigBindFamily]
_ GenLocated l (HsDecl GhcPs)
x = GenLocated l (HsDecl GhcPs)
x
    annGetter :: GenLocated l e -> l
annGetter (L l
ann e
_) = l
ann
    annSetter :: l -> GenLocated l e -> GenLocated l e
annSetter l
newAnn (L l
_ e
x) = l -> e -> GenLocated l e
forall l e. l -> e -> GenLocated l e
L l
newAnn e
x
    cond :: GenLocated (EpAnn ann) e
-> GenLocated (EpAnn ann) e -> RealSrcSpan -> Bool
cond (L EpAnn {entry :: forall ann. EpAnn ann -> Anchor
entry = EpaSpan (RealSrcSpan RealSrcSpan
classAnchor Maybe BufSpan
_)} e
_) (L EpAnn {entry :: forall ann. EpAnn ann -> Anchor
entry = EpaSpan (RealSrcSpan RealSrcSpan
elemAnchor Maybe BufSpan
_)} e
_) RealSrcSpan
comAnc =
      RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
comAnc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
elemAnchor
        Bool -> Bool -> Bool
&& RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
classAnchor RealSrcLoc -> RealSrcLoc -> Bool
forall a. Ord a => a -> a -> Bool
< RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
comAnc
    cond GenLocated (EpAnn ann) e
_ GenLocated (EpAnn ann) e
_ RealSrcSpan
_ = Bool
False

-- | Locates comments before each statement in a do expression.
relocateCommentsInDoExpr :: HsModule' -> WithComments HsModule'
relocateCommentsInDoExpr :: HsModule' -> State [LEpaComment] HsModule'
relocateCommentsInDoExpr =
  (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> [GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    -> SrcSpanAnnA)
-> (SrcSpanAnnA
    -> GenLocated
         SrcSpanAnnA
         (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    -> GenLocated
         SrcSpanAnnA
         (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated
         SrcSpanAnnA
         (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    -> RealSrcSpan
    -> Bool)
-> HsModule'
-> State [LEpaComment] HsModule'
forall a b c.
Typeable a =>
(a -> [b])
-> ([b] -> a -> a)
-> (b -> EpAnn c)
-> (EpAnn c -> b -> b)
-> (a -> b -> RealSrcSpan -> Bool)
-> HsModule'
-> State [LEpaComment] HsModule'
relocateCommentsBeforeEachElement
    XRec GhcPs (HsExpr GhcPs)
-> [XRec GhcPs (StmtLR GhcPs GhcPs (XRec GhcPs (HsExpr GhcPs)))]
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
elemGetter
    [XRec GhcPs (StmtLR GhcPs GhcPs (XRec GhcPs (HsExpr GhcPs)))]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall {p} {l} {l}.
(XRec p [XRec p (StmtLR p p (XRec p (HsExpr p)))]
 ~ GenLocated l [XRec p (StmtLR p p (XRec p (HsExpr p)))]) =>
[XRec p (StmtLR p p (XRec p (HsExpr p)))]
-> GenLocated l (HsExpr p) -> GenLocated l (HsExpr p)
elemSetter
    GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpanAnnA
forall l e. GenLocated l e -> l
annGetter
    SrcSpanAnnA
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall {l} {l} {e}. l -> GenLocated l e -> GenLocated l e
annSetter
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> RealSrcSpan
-> Bool
forall {ann} {e} {ann} {e}.
GenLocated (EpAnn ann) e
-> GenLocated (EpAnn ann) e -> RealSrcSpan -> Bool
cond
  where
    elemGetter :: LHsExpr GhcPs -> [ExprLStmt GhcPs]
    elemGetter :: XRec GhcPs (HsExpr GhcPs)
-> [XRec GhcPs (StmtLR GhcPs GhcPs (XRec GhcPs (HsExpr GhcPs)))]
elemGetter (L SrcSpanAnnA
_ (HsDo XDo GhcPs
_ DoExpr {} (L SrcSpanAnnL
_ [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs))) = [XRec GhcPs (StmtLR GhcPs GhcPs (XRec GhcPs (HsExpr GhcPs)))]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs
    elemGetter (L SrcSpanAnnA
_ (HsDo XDo GhcPs
_ MDoExpr {} (L SrcSpanAnnL
_ [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs))) = [XRec GhcPs (StmtLR GhcPs GhcPs (XRec GhcPs (HsExpr GhcPs)))]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs
    elemGetter XRec GhcPs (HsExpr GhcPs)
_ = []
    elemSetter :: [XRec p (StmtLR p p (XRec p (HsExpr p)))]
-> GenLocated l (HsExpr p) -> GenLocated l (HsExpr p)
elemSetter [XRec p (StmtLR p p (XRec p (HsExpr p)))]
xs (L l
sp (HsDo XDo p
ext flavor :: HsDoFlavour
flavor@DoExpr {} (L l
sp' [XRec p (StmtLR p p (XRec p (HsExpr p)))]
_))) =
      l -> HsExpr p -> GenLocated l (HsExpr p)
forall l e. l -> e -> GenLocated l e
L l
sp (XDo p
-> HsDoFlavour
-> XRec p [XRec p (StmtLR p p (XRec p (HsExpr p)))]
-> HsExpr p
forall p. XDo p -> HsDoFlavour -> XRec p [ExprLStmt p] -> HsExpr p
HsDo XDo p
ext HsDoFlavour
flavor (l
-> [XRec p (StmtLR p p (XRec p (HsExpr p)))]
-> GenLocated l [XRec p (StmtLR p p (XRec p (HsExpr p)))]
forall l e. l -> e -> GenLocated l e
L l
sp' [XRec p (StmtLR p p (XRec p (HsExpr p)))]
xs))
    elemSetter [XRec p (StmtLR p p (XRec p (HsExpr p)))]
xs (L l
sp (HsDo XDo p
ext flavor :: HsDoFlavour
flavor@MDoExpr {} (L l
sp' [XRec p (StmtLR p p (XRec p (HsExpr p)))]
_))) =
      l -> HsExpr p -> GenLocated l (HsExpr p)
forall l e. l -> e -> GenLocated l e
L l
sp (XDo p
-> HsDoFlavour
-> XRec p [XRec p (StmtLR p p (XRec p (HsExpr p)))]
-> HsExpr p
forall p. XDo p -> HsDoFlavour -> XRec p [ExprLStmt p] -> HsExpr p
HsDo XDo p
ext HsDoFlavour
flavor (l
-> [XRec p (StmtLR p p (XRec p (HsExpr p)))]
-> GenLocated l [XRec p (StmtLR p p (XRec p (HsExpr p)))]
forall l e. l -> e -> GenLocated l e
L l
sp' [XRec p (StmtLR p p (XRec p (HsExpr p)))]
xs))
    elemSetter [XRec p (StmtLR p p (XRec p (HsExpr p)))]
_ GenLocated l (HsExpr p)
x = GenLocated l (HsExpr p)
x
    annGetter :: GenLocated l e -> l
annGetter (L l
ann e
_) = l
ann
    annSetter :: l -> GenLocated l e -> GenLocated l e
annSetter l
newAnn (L l
_ e
x) = l -> e -> GenLocated l e
forall l e. l -> e -> GenLocated l e
L l
newAnn e
x
    cond :: GenLocated (EpAnn ann) e
-> GenLocated (EpAnn ann) e -> RealSrcSpan -> Bool
cond (L EpAnn {entry :: forall ann. EpAnn ann -> Anchor
entry = EpaSpan (RealSrcSpan RealSrcSpan
doAnchor Maybe BufSpan
_)} e
_) (L EpAnn {entry :: forall ann. EpAnn ann -> Anchor
entry = EpaSpan (RealSrcSpan RealSrcSpan
elemAnchor Maybe BufSpan
_)} e
_) RealSrcSpan
comAnc =
      RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
comAnc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
elemAnchor
        Bool -> Bool -> Bool
&& RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
doAnchor RealSrcLoc -> RealSrcLoc -> Bool
forall a. Ord a => a -> a -> Bool
< RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
comAnc
    cond GenLocated (EpAnn ann) e
_ GenLocated (EpAnn ann) e
_ RealSrcSpan
_ = Bool
False

-- | This function locates comments located before top-level declarations.
relocateCommentsBeforeTopLevelDecls :: HsModule' -> WithComments HsModule'
relocateCommentsBeforeTopLevelDecls :: HsModule' -> State [LEpaComment] HsModule'
relocateCommentsBeforeTopLevelDecls = GenericM (StateT [LEpaComment] Identity)
-> GenericM (StateT [LEpaComment] Identity)
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
everywhereM ((forall b. EpAnn b -> WithComments (EpAnn b))
-> a -> WithComments a
forall a.
Typeable a =>
(forall b. EpAnn b -> WithComments (EpAnn b))
-> a -> WithComments a
applyM EpAnn b -> WithComments (EpAnn b)
forall b. EpAnn b -> WithComments (EpAnn b)
f)
  where
    f :: EpAnn a -> WithComments (EpAnn a)
f epa :: EpAnn a
epa@EpAnn {a
Anchor
EpAnnComments
comments :: forall ann. EpAnn ann -> EpAnnComments
entry :: forall ann. EpAnn ann -> Anchor
entry :: Anchor
anns :: a
comments :: EpAnnComments
anns :: forall ann. EpAnn ann -> ann
..}
      | EpaSpan (RealSrcSpan RealSrcSpan
anc Maybe BufSpan
_) <- Anchor
entry =
        (RealSrcSpan -> Bool)
-> (EpAnnComments -> [LEpaComment] -> EpAnnComments)
-> EpAnn a
-> WithComments (EpAnn a)
forall a.
(RealSrcSpan -> Bool)
-> (EpAnnComments -> [LEpaComment] -> EpAnnComments)
-> EpAnn a
-> WithComments (EpAnn a)
insertCommentsByPos (RealSrcSpan -> RealSrcSpan -> Bool
isBefore RealSrcSpan
anc) EpAnnComments -> [LEpaComment] -> EpAnnComments
insertPriorComments EpAnn a
epa
      | Bool
otherwise = EpAnn a -> WithComments (EpAnn a)
forall a. a -> StateT [LEpaComment] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EpAnn a
epa
    isBefore :: RealSrcSpan -> RealSrcSpan -> Bool
isBefore RealSrcSpan
anc RealSrcSpan
comAnc =
      RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
anc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
        Bool -> Bool -> Bool
&& RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
comAnc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
        Bool -> Bool -> Bool
&& RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
comAnc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
anc

-- | This function scans the given AST from bottom to top and locates
-- comments that are on the same line as the node.  Comments are stored in
-- the 'followingComments' of 'EpaCommentsBalanced'.
relocateCommentsSameLine :: HsModule' -> WithComments HsModule'
relocateCommentsSameLine :: HsModule' -> State [LEpaComment] HsModule'
relocateCommentsSameLine = (forall b. EpAnn b -> WithComments (EpAnn b))
-> HsModule' -> State [LEpaComment] HsModule'
forall a.
Data a =>
(forall b. EpAnn b -> WithComments (EpAnn b))
-> a -> WithComments a
everywhereMEpAnnsBackwards EpAnn b -> WithComments (EpAnn b)
forall b. EpAnn b -> WithComments (EpAnn b)
f
  where
    f :: EpAnn a -> WithComments (EpAnn a)
f epa :: EpAnn a
epa@EpAnn {a
Anchor
EpAnnComments
comments :: forall ann. EpAnn ann -> EpAnnComments
entry :: forall ann. EpAnn ann -> Anchor
anns :: forall ann. EpAnn ann -> ann
entry :: Anchor
anns :: a
comments :: EpAnnComments
..}
      | EpaSpan (RealSrcSpan RealSrcSpan
anc Maybe BufSpan
_) <- Anchor
entry =
        (RealSrcSpan -> Bool)
-> (EpAnnComments -> [LEpaComment] -> EpAnnComments)
-> EpAnn a
-> WithComments (EpAnn a)
forall a.
(RealSrcSpan -> Bool)
-> (EpAnnComments -> [LEpaComment] -> EpAnnComments)
-> EpAnn a
-> WithComments (EpAnn a)
insertCommentsByPos (RealSrcSpan -> RealSrcSpan -> Bool
isOnSameLine RealSrcSpan
anc) EpAnnComments -> [LEpaComment] -> EpAnnComments
insertFollowingComments EpAnn a
epa
      | Bool
otherwise = EpAnn a -> WithComments (EpAnn a)
forall a. a -> StateT [LEpaComment] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EpAnn a
epa
    isOnSameLine :: RealSrcSpan -> RealSrcSpan -> Bool
isOnSameLine RealSrcSpan
anc RealSrcSpan
comAnc =
      RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
comAnc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
anc
        Bool -> Bool -> Bool
&& RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
comAnc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
anc

-- | This function locates comments above the top-level declarations in
-- a 'where' clause in the topmost declaration.
relocateCommentsTopLevelWhereClause :: HsModule' -> WithComments HsModule'
relocateCommentsTopLevelWhereClause :: HsModule' -> State [LEpaComment] HsModule'
relocateCommentsTopLevelWhereClause m :: HsModule'
m@HsModule {[LImportDecl GhcPs]
[LHsDecl GhcPs]
Maybe (XRec GhcPs [XRec GhcPs (IE GhcPs)])
Maybe (XRec GhcPs ModuleName)
XCModule GhcPs
hsmodExt :: forall p. HsModule p -> XCModule p
hsmodExports :: forall p. HsModule p -> Maybe (XRec p [LIE p])
hsmodDecls :: forall p. HsModule p -> [LHsDecl p]
hsmodImports :: forall p. HsModule p -> [LImportDecl p]
hsmodName :: forall p. HsModule p -> Maybe (XRec p ModuleName)
hsmodExt :: XCModule GhcPs
hsmodName :: Maybe (XRec GhcPs ModuleName)
hsmodExports :: Maybe (XRec GhcPs [XRec GhcPs (IE GhcPs)])
hsmodImports :: [LImportDecl GhcPs]
hsmodDecls :: [LHsDecl GhcPs]
..} = do
  [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
hsmodDecls' <- (GenLocated SrcSpanAnnA (HsDecl GhcPs)
 -> StateT
      [LEpaComment] Identity (GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> StateT
     [LEpaComment] Identity [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> StateT
     [LEpaComment] Identity (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall {p} {t :: * -> *} {t :: * -> *} {l} {body} {l}.
(XRec p [XRec p (Match p (XRec p (HsExpr p)))]
 ~ t (t (GenLocated l (Match GhcPs body))),
 Traversable t, Traversable t) =>
GenLocated l (HsDecl p)
-> StateT [LEpaComment] Identity (GenLocated l (HsDecl p))
relocateCommentsDeclWhereClause [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
hsmodDecls
  HsModule' -> State [LEpaComment] HsModule'
forall a. a -> StateT [LEpaComment] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsModule'
m {hsmodDecls = hsmodDecls'}
  where
    relocateCommentsDeclWhereClause :: GenLocated l (HsDecl p)
-> StateT [LEpaComment] Identity (GenLocated l (HsDecl p))
relocateCommentsDeclWhereClause (L l
l (ValD XValD p
ext fb :: HsBind p
fb@(FunBind {fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = MG {XMG p (XRec p (HsExpr p))
XRec p [XRec p (Match p (XRec p (HsExpr p)))]
mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_ext :: XMG p (XRec p (HsExpr p))
mg_alts :: XRec p [XRec p (Match p (XRec p (HsExpr p)))]
..}}))) = do
      t (t (GenLocated l (Match GhcPs body)))
mg_alts' <- (t (GenLocated l (Match GhcPs body))
 -> StateT
      [LEpaComment] Identity (t (GenLocated l (Match GhcPs body))))
-> t (t (GenLocated l (Match GhcPs body)))
-> StateT
     [LEpaComment] Identity (t (t (GenLocated l (Match GhcPs body))))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
mapM ((GenLocated l (Match GhcPs body)
 -> StateT [LEpaComment] Identity (GenLocated l (Match GhcPs body)))
-> t (GenLocated l (Match GhcPs body))
-> StateT
     [LEpaComment] Identity (t (GenLocated l (Match GhcPs body)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
mapM GenLocated l (Match GhcPs body)
-> StateT [LEpaComment] Identity (GenLocated l (Match GhcPs body))
forall {l} {body}.
GenLocated l (Match GhcPs body)
-> StateT [LEpaComment] Identity (GenLocated l (Match GhcPs body))
relocateCommentsMatch) t (t (GenLocated l (Match GhcPs body)))
XRec p [XRec p (Match p (XRec p (HsExpr p)))]
mg_alts
      GenLocated l (HsDecl p)
-> StateT [LEpaComment] Identity (GenLocated l (HsDecl p))
forall a. a -> StateT [LEpaComment] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated l (HsDecl p)
 -> StateT [LEpaComment] Identity (GenLocated l (HsDecl p)))
-> GenLocated l (HsDecl p)
-> StateT [LEpaComment] Identity (GenLocated l (HsDecl p))
forall a b. (a -> b) -> a -> b
$ l -> HsDecl p -> GenLocated l (HsDecl p)
forall l e. l -> e -> GenLocated l e
L l
l (XValD p -> HsBind p -> HsDecl p
forall p. XValD p -> HsBind p -> HsDecl p
ValD XValD p
ext HsBind p
fb {fun_matches = MG {mg_alts = mg_alts', ..}})
    relocateCommentsDeclWhereClause GenLocated l (HsDecl p)
x = GenLocated l (HsDecl p)
-> StateT [LEpaComment] Identity (GenLocated l (HsDecl p))
forall a. a -> StateT [LEpaComment] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenLocated l (HsDecl p)
x
    relocateCommentsMatch :: GenLocated l (Match GhcPs body)
-> StateT [LEpaComment] Identity (GenLocated l (Match GhcPs body))
relocateCommentsMatch (L l
l match :: Match GhcPs body
match@Match {m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = gs :: GRHSs GhcPs body
gs@GRHSs {grhssLocalBinds :: forall p body. GRHSs p body -> HsLocalBinds p
grhssLocalBinds = (HsValBinds XHsValBinds GhcPs GhcPs
ext (ValBinds XValBinds GhcPs GhcPs
ext' LHsBinds GhcPs
binds [LSig GhcPs]
sigs))}}) = do
      (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
binds', [GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs') <- LHsBinds GhcPs
-> [LSig GhcPs] -> WithComments (LHsBinds GhcPs, [LSig GhcPs])
relocateCommentsBindsSigs LHsBinds GhcPs
binds [LSig GhcPs]
sigs
      let localBinds :: HsLocalBindsLR GhcPs GhcPs
localBinds = XHsValBinds GhcPs GhcPs
-> HsValBindsLR GhcPs GhcPs -> HsLocalBindsLR GhcPs GhcPs
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds XHsValBinds GhcPs GhcPs
ext (XValBinds GhcPs GhcPs
-> LHsBinds GhcPs -> [LSig GhcPs] -> HsValBindsLR GhcPs GhcPs
forall idL idR.
XValBinds idL idR
-> LHsBindsLR idL idR -> [LSig idR] -> HsValBindsLR idL idR
ValBinds XValBinds GhcPs GhcPs
ext' LHsBinds GhcPs
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
binds' [LSig GhcPs]
[GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs')
      GenLocated l (Match GhcPs body)
-> StateT [LEpaComment] Identity (GenLocated l (Match GhcPs body))
forall a. a -> StateT [LEpaComment] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated l (Match GhcPs body)
 -> StateT [LEpaComment] Identity (GenLocated l (Match GhcPs body)))
-> GenLocated l (Match GhcPs body)
-> StateT [LEpaComment] Identity (GenLocated l (Match GhcPs body))
forall a b. (a -> b) -> a -> b
$ l -> Match GhcPs body -> GenLocated l (Match GhcPs body)
forall l e. l -> e -> GenLocated l e
L l
l Match GhcPs body
match {m_grhss = gs {grhssLocalBinds = localBinds}}
    relocateCommentsMatch GenLocated l (Match GhcPs body)
x = GenLocated l (Match GhcPs body)
-> StateT [LEpaComment] Identity (GenLocated l (Match GhcPs body))
forall a. a -> StateT [LEpaComment] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenLocated l (Match GhcPs body)
x
    relocateCommentsBindsSigs ::
         LHsBindsLR GhcPs GhcPs
      -> [LSig GhcPs]
      -> WithComments (LHsBindsLR GhcPs GhcPs, [LSig GhcPs])
    relocateCommentsBindsSigs :: LHsBinds GhcPs
-> [LSig GhcPs] -> WithComments (LHsBinds GhcPs, [LSig GhcPs])
relocateCommentsBindsSigs LHsBinds GhcPs
binds [LSig GhcPs]
sigs = do
      [LSigBindFamily]
bindsSigs' <- (LSigBindFamily -> StateT [LEpaComment] Identity LSigBindFamily)
-> [LSigBindFamily]
-> StateT [LEpaComment] Identity [LSigBindFamily]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LSigBindFamily -> StateT [LEpaComment] Identity LSigBindFamily
forall {m :: * -> *} {ann} {e}.
MonadState [LEpaComment] m =>
GenLocated (EpAnn ann) e -> m (GenLocated (EpAnn ann) e)
addCommentsBeforeEpAnn [LSigBindFamily]
bindsSigs
      (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
 [GenLocated SrcSpanAnnA (Sig GhcPs)])
-> StateT
     [LEpaComment]
     Identity
     (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
      [GenLocated SrcSpanAnnA (Sig GhcPs)])
forall a. a -> StateT [LEpaComment] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([LHsBindLR GhcPs GhcPs] -> LHsBinds GhcPs
forall a. [a] -> Bag a
listToBag ([LHsBindLR GhcPs GhcPs] -> LHsBinds GhcPs)
-> [LHsBindLR GhcPs GhcPs] -> LHsBinds GhcPs
forall a b. (a -> b) -> a -> b
$ [LSigBindFamily] -> [LHsBindLR GhcPs GhcPs]
filterLBind [LSigBindFamily]
bindsSigs', [LSigBindFamily] -> [LSig GhcPs]
filterLSig [LSigBindFamily]
bindsSigs')
      where
        bindsSigs :: [LSigBindFamily]
bindsSigs = [LSig GhcPs]
-> [LHsBindLR GhcPs GhcPs]
-> [LFamilyDecl GhcPs]
-> [LTyFamDefltDecl GhcPs]
-> [LDataFamInstDecl GhcPs]
-> [LSigBindFamily]
mkSortedLSigBindFamilyList [LSig GhcPs]
sigs (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
-> [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
forall a. Bag a -> [a]
bagToList LHsBinds GhcPs
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
binds) [] [] []
    addCommentsBeforeEpAnn :: GenLocated (EpAnn ann) e -> m (GenLocated (EpAnn ann) e)
addCommentsBeforeEpAnn (L epa :: EpAnn ann
epa@EpAnn {ann
Anchor
EpAnnComments
comments :: forall ann. EpAnn ann -> EpAnnComments
entry :: forall ann. EpAnn ann -> Anchor
anns :: forall ann. EpAnn ann -> ann
entry :: Anchor
anns :: ann
comments :: EpAnnComments
..} e
x)
      | EpaSpan (RealSrcSpan RealSrcSpan
anc Maybe BufSpan
_) <- Anchor
entry = do
        [LEpaComment]
cs <- m [LEpaComment]
forall s (m :: * -> *). MonadState s m => m s
get
        let ([LEpaComment]
notAbove, [LEpaComment]
above) =
              [LEpaComment] -> RealSrcSpan -> ([LEpaComment], [LEpaComment])
forall {t :: * -> *} {a} {e}.
Foldable t =>
t (GenLocated (EpaLocation' a) e)
-> RealSrcSpan
-> ([GenLocated (EpaLocation' a) e],
    [GenLocated (EpaLocation' a) e])
partitionAboveNotAbove ([LEpaComment] -> [LEpaComment]
sortCommentsByLocation [LEpaComment]
cs) RealSrcSpan
anc
            epa' :: EpAnn ann
epa' = EpAnn ann
epa {comments = insertPriorComments comments above}
        [LEpaComment] -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [LEpaComment]
notAbove
        GenLocated (EpAnn ann) e -> m (GenLocated (EpAnn ann) e)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated (EpAnn ann) e -> m (GenLocated (EpAnn ann) e))
-> GenLocated (EpAnn ann) e -> m (GenLocated (EpAnn ann) e)
forall a b. (a -> b) -> a -> b
$ EpAnn ann -> e -> GenLocated (EpAnn ann) e
forall l e. l -> e -> GenLocated l e
L EpAnn ann
epa' e
x
      | Bool
otherwise = m (GenLocated (EpAnn ann) e)
forall a. HasCallStack => a
undefined
    addCommentsBeforeEpAnn GenLocated (EpAnn ann) e
x = GenLocated (EpAnn ann) e -> m (GenLocated (EpAnn ann) e)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenLocated (EpAnn ann) e
x
    partitionAboveNotAbove :: t (GenLocated (EpaLocation' a) e)
-> RealSrcSpan
-> ([GenLocated (EpaLocation' a) e],
    [GenLocated (EpaLocation' a) e])
partitionAboveNotAbove t (GenLocated (EpaLocation' a) e)
cs RealSrcSpan
sp =
      (([GenLocated (EpaLocation' a) e],
  [GenLocated (EpaLocation' a) e]),
 RealSrcSpan)
-> ([GenLocated (EpaLocation' a) e],
    [GenLocated (EpaLocation' a) e])
forall a b. (a, b) -> a
fst
        ((([GenLocated (EpaLocation' a) e],
   [GenLocated (EpaLocation' a) e]),
  RealSrcSpan)
 -> ([GenLocated (EpaLocation' a) e],
     [GenLocated (EpaLocation' a) e]))
-> (([GenLocated (EpaLocation' a) e],
     [GenLocated (EpaLocation' a) e]),
    RealSrcSpan)
-> ([GenLocated (EpaLocation' a) e],
    [GenLocated (EpaLocation' a) e])
forall a b. (a -> b) -> a -> b
$ (GenLocated (EpaLocation' a) e
 -> (([GenLocated (EpaLocation' a) e],
      [GenLocated (EpaLocation' a) e]),
     RealSrcSpan)
 -> (([GenLocated (EpaLocation' a) e],
      [GenLocated (EpaLocation' a) e]),
     RealSrcSpan))
-> (([GenLocated (EpaLocation' a) e],
     [GenLocated (EpaLocation' a) e]),
    RealSrcSpan)
-> t (GenLocated (EpaLocation' a) e)
-> (([GenLocated (EpaLocation' a) e],
     [GenLocated (EpaLocation' a) e]),
    RealSrcSpan)
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr'
            (\c :: GenLocated (EpaLocation' a) e
c@(L EpaLocation' a
l e
_) (([GenLocated (EpaLocation' a) e]
ls, [GenLocated (EpaLocation' a) e]
rs), RealSrcSpan
lastSpan) ->
               case EpaLocation' a
l of
                 EpaSpan (RealSrcSpan RealSrcSpan
anc Maybe BufSpan
_) ->
                   if RealSrcSpan
anc RealSrcSpan -> RealSrcSpan -> Bool
`isAbove` RealSrcSpan
lastSpan
                     then (([GenLocated (EpaLocation' a) e]
ls, GenLocated (EpaLocation' a) e
c GenLocated (EpaLocation' a) e
-> [GenLocated (EpaLocation' a) e]
-> [GenLocated (EpaLocation' a) e]
forall a. a -> [a] -> [a]
: [GenLocated (EpaLocation' a) e]
rs), RealSrcSpan
anc)
                     else ((GenLocated (EpaLocation' a) e
c GenLocated (EpaLocation' a) e
-> [GenLocated (EpaLocation' a) e]
-> [GenLocated (EpaLocation' a) e]
forall a. a -> [a] -> [a]
: [GenLocated (EpaLocation' a) e]
ls, [GenLocated (EpaLocation' a) e]
rs), RealSrcSpan
lastSpan)
                 EpaLocation' a
_ -> (([GenLocated (EpaLocation' a) e],
  [GenLocated (EpaLocation' a) e]),
 RealSrcSpan)
forall a. HasCallStack => a
undefined)
            (([], []), RealSrcSpan
sp)
            t (GenLocated (EpaLocation' a) e)
cs
    isAbove :: RealSrcSpan -> RealSrcSpan -> Bool
isAbove RealSrcSpan
comAnc RealSrcSpan
anc =
      RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
comAnc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
anc
        Bool -> Bool -> Bool
&& RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
comAnc 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
anc
#else
-- | This function locates comments that are located before each element of
-- an export list.
relocateCommentsInExportList :: HsModule' -> WithComments HsModule'
relocateCommentsInExportList =
  relocateCommentsBeforeEachElement
    elemGetter
    elemSetter
    annGetter
    annSetter
    cond
  where
    elemGetter :: HsModule' -> [LIE GhcPs]
    elemGetter HsModule {hsmodExports = Just (L _ xs)} = xs
    elemGetter _ = []
    elemSetter xs HsModule {hsmodExports = Just (L sp _), ..} =
      HsModule {hsmodExports = Just (L sp xs), ..}
    elemSetter _ x = x
    annGetter (L SrcSpanAnn {..} _) = ann
    annSetter newAnn (L SrcSpanAnn {..} x) = L SrcSpanAnn {ann = newAnn, ..} x
    cond HsModule {hsmodExports = Just (L SrcSpanAnn {ann = EpAnn {entry = Anchor {anchor = listAnc}}} _)} (L SrcSpanAnn {ann = EpAnn {entry = Anchor {anchor = elemAnc}}} _) comAnc =
      srcSpanStartLine comAnc < srcSpanStartLine elemAnc
        && realSrcSpanStart listAnc < realSrcSpanStart comAnc
    cond _ _ _ = False

-- | Locates comments before each case branch.
relocateCommentsInCase :: HsModule' -> WithComments HsModule'
relocateCommentsInCase =
  relocateCommentsBeforeEachElement
    elemGetter
    elemSetter
    annGetter
    annSetter
    cond
  where
    elemGetter :: LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)]
    elemGetter (L _ (HsCase _ _ (MG {mg_alts = L _ xs}))) = xs
    elemGetter _ = []
    elemSetter xs (L sp (HsCase ext expr (MG {mg_alts = L sp' _, ..}))) =
      L sp (HsCase ext expr (MG {mg_alts = L sp' xs, ..}))
    elemSetter _ x = x
    annGetter (L SrcSpanAnn {..} _) = ann
    annSetter newAnn (L SrcSpanAnn {..} x) = L SrcSpanAnn {ann = newAnn, ..} x
    cond (L SrcSpanAnn {ann = EpAnn {entry = Anchor {anchor = caseAnchor}}} _) (L SrcSpanAnn {ann = EpAnn {entry = Anchor {anchor = branchAnchor}}} _) comAnc =
      srcSpanStartLine comAnc < srcSpanStartLine branchAnchor
        && realSrcSpanStart caseAnchor < realSrcSpanStart comAnc
    cond _ _ _ = False

-- | Locates comments before each class element.
relocateCommentsInClass :: HsModule' -> WithComments HsModule'
relocateCommentsInClass =
  relocateCommentsBeforeEachElement
    elemGetter
    elemSetter
    annGetter
    annSetter
    cond
  where
    elemGetter :: LHsDecl GhcPs -> [LSigBindFamily]
    elemGetter (L _ (TyClD _ ClassDecl {..})) =
      mkSortedLSigBindFamilyList
        tcdSigs
        (bagToList tcdMeths)
        tcdATs
        tcdATDefs
        []
    elemGetter _ = []
    elemSetter xs (L sp (TyClD ext ClassDecl {..})) = L sp (TyClD ext newDecl)
      where
        newDecl =
          ClassDecl
            { tcdSigs = sigs
            , tcdMeths = listToBag binds
            , tcdATs = typeFamilies
            , tcdATDefs = tyFamInsts
            , ..
            }
        (sigs, binds, typeFamilies, tyFamInsts, _) =
          destructLSigBindFamilyList xs
    elemSetter _ x = x
    annGetter (L SrcSpanAnn {..} _) = ann
    annSetter newAnn (L SrcSpanAnn {..} x) = L SrcSpanAnn {ann = newAnn, ..} x
    cond (L SrcSpanAnn {ann = EpAnn {entry = Anchor {anchor = classAnchor}}} _) (L SrcSpanAnn {ann = EpAnn {entry = Anchor {anchor = elemAnchor}}} _) comAnc =
      srcSpanStartLine comAnc < srcSpanStartLine elemAnchor
        && realSrcSpanStart classAnchor < realSrcSpanStart comAnc
    cond _ _ _ = False

-- | Locates comments before each statement in a do expression.
relocateCommentsInDoExpr :: HsModule' -> WithComments HsModule'
relocateCommentsInDoExpr =
  relocateCommentsBeforeEachElement
    elemGetter
    elemSetter
    annGetter
    annSetter
    cond
  where
    elemGetter :: LHsExpr GhcPs -> [ExprLStmt GhcPs]
    elemGetter (L _ (HsDo _ DoExpr {} (L _ xs))) = xs
    elemGetter (L _ (HsDo _ MDoExpr {} (L _ xs))) = xs
    elemGetter _ = []
    elemSetter xs (L sp (HsDo ext flavor@DoExpr {} (L sp' _))) =
      L sp (HsDo ext flavor (L sp' xs))
    elemSetter xs (L sp (HsDo ext flavor@MDoExpr {} (L sp' _))) =
      L sp (HsDo ext flavor (L sp' xs))
    elemSetter _ x = x
    annGetter (L SrcSpanAnn {..} _) = ann
    annSetter newAnn (L SrcSpanAnn {..} x) = L SrcSpanAnn {ann = newAnn, ..} x
    cond (L SrcSpanAnn {ann = EpAnn {entry = Anchor {anchor = doAnchor}}} _) (L SrcSpanAnn {ann = EpAnn {entry = Anchor {anchor = elemAnchor}}} _) comAnc =
      srcSpanStartLine comAnc < srcSpanStartLine elemAnchor
        && realSrcSpanStart doAnchor < realSrcSpanStart comAnc
    cond _ _ _ = False

-- | This function locates comments located before top-level declarations.
relocateCommentsBeforeTopLevelDecls :: HsModule' -> WithComments HsModule'
relocateCommentsBeforeTopLevelDecls = everywhereM (applyM f)
  where
    f epa@EpAnn {..} =
      insertCommentsByPos (isBefore $ anchor entry) insertPriorComments epa
    f EpAnnNotUsed = pure EpAnnNotUsed
    isBefore anc comAnc =
      srcSpanStartCol anc == 1
        && srcSpanStartCol comAnc == 1
        && srcSpanStartLine comAnc < srcSpanStartLine anc

-- | This function scans the given AST from bottom to top and locates
-- comments that are on the same line as the node.  Comments are stored in
-- the 'followingComments' of 'EpaCommentsBalanced'.
relocateCommentsSameLine :: HsModule' -> WithComments HsModule'
relocateCommentsSameLine = everywhereMEpAnnsBackwards f
  where
    f epa@EpAnn {..} =
      insertCommentsByPos
        (isOnSameLine $ anchor entry)
        insertFollowingComments
        epa
    f EpAnnNotUsed = pure EpAnnNotUsed
    isOnSameLine anc comAnc =
      srcSpanStartLine comAnc == srcSpanStartLine anc
        && srcSpanStartLine comAnc == srcSpanEndLine anc

-- | This function locates comments above the top-level declarations in
-- a 'where' clause in the topmost declaration.
relocateCommentsTopLevelWhereClause :: HsModule' -> WithComments HsModule'
relocateCommentsTopLevelWhereClause m@HsModule {..} = do
  hsmodDecls' <- mapM relocateCommentsDeclWhereClause hsmodDecls
  pure m {hsmodDecls = hsmodDecls'}
  where
    relocateCommentsDeclWhereClause (L l (ValD ext fb@(FunBind {fun_matches = MG {..}}))) = do
      mg_alts' <- mapM (mapM relocateCommentsMatch) mg_alts
      pure $ L l (ValD ext fb {fun_matches = MG {mg_alts = mg_alts', ..}})
    relocateCommentsDeclWhereClause x = pure x
    relocateCommentsMatch (L l match@Match {m_grhss = gs@GRHSs {grhssLocalBinds = (HsValBinds ext (ValBinds ext' binds sigs))}}) = do
      (binds', sigs') <- relocateCommentsBindsSigs binds sigs
      let localBinds = HsValBinds ext (ValBinds ext' binds' sigs')
      pure $ L l match {m_grhss = gs {grhssLocalBinds = localBinds}}
    relocateCommentsMatch x = pure x
    relocateCommentsBindsSigs ::
         LHsBindsLR GhcPs GhcPs
      -> [LSig GhcPs]
      -> WithComments (LHsBindsLR GhcPs GhcPs, [LSig GhcPs])
    relocateCommentsBindsSigs binds sigs = do
      bindsSigs' <- mapM addCommentsBeforeEpAnn bindsSigs
      pure (listToBag $ filterLBind bindsSigs', filterLSig bindsSigs')
      where
        bindsSigs = mkSortedLSigBindFamilyList sigs (bagToList binds) [] [] []
    addCommentsBeforeEpAnn (L (SrcSpanAnn epa@EpAnn {..} sp) x) = do
      cs <- get
      let (notAbove, above) =
            partitionAboveNotAbove (sortCommentsByLocation cs) entry
          epa' = epa {comments = insertPriorComments comments above}
      put notAbove
      pure $ L (SrcSpanAnn epa' sp) x
    addCommentsBeforeEpAnn x = pure x
    partitionAboveNotAbove cs sp =
      fst
        $ foldr'
            (\c@(L l _) ((ls, rs), lastSpan) ->
               if anchor l `isAbove` anchor lastSpan
                 then ((ls, c : rs), l)
                 else ((c : ls, rs), lastSpan))
            (([], []), sp)
            cs
    isAbove comAnc anc =
      srcSpanStartCol comAnc == srcSpanStartCol anc
        && srcSpanEndLine comAnc + 1 == srcSpanStartLine anc
#endif
-- | This function scans the given AST from bottom to top and locates
-- comments in the comment pool after each node on it.
relocateCommentsAfter :: HsModule' -> WithComments HsModule'
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
relocateCommentsAfter :: HsModule' -> State [LEpaComment] HsModule'
relocateCommentsAfter = (forall b. EpAnn b -> WithComments (EpAnn b))
-> HsModule' -> State [LEpaComment] HsModule'
forall a.
Data a =>
(forall b. EpAnn b -> WithComments (EpAnn b))
-> a -> WithComments a
everywhereMEpAnnsBackwards EpAnn b -> WithComments (EpAnn b)
forall b. EpAnn b -> WithComments (EpAnn b)
f
  where
    f :: EpAnn a -> WithComments (EpAnn a)
f epa :: EpAnn a
epa@EpAnn {a
Anchor
EpAnnComments
comments :: forall ann. EpAnn ann -> EpAnnComments
entry :: forall ann. EpAnn ann -> Anchor
anns :: forall ann. EpAnn ann -> ann
entry :: Anchor
anns :: a
comments :: EpAnnComments
..} =
      (RealSrcSpan -> Bool)
-> (EpAnnComments -> [LEpaComment] -> EpAnnComments)
-> EpAnn a
-> WithComments (EpAnn a)
forall a.
(RealSrcSpan -> Bool)
-> (EpAnnComments -> [LEpaComment] -> EpAnnComments)
-> EpAnn a
-> WithComments (EpAnn a)
insertCommentsByPos (RealSrcSpan -> RealSrcSpan -> Bool
isAfter (RealSrcSpan -> RealSrcSpan -> Bool)
-> RealSrcSpan -> RealSrcSpan -> Bool
forall a b. (a -> b) -> a -> b
$ Anchor -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
anchor Anchor
entry) EpAnnComments -> [LEpaComment] -> EpAnnComments
insertFollowingComments EpAnn a
epa
    isAfter :: RealSrcSpan -> RealSrcSpan -> Bool
isAfter RealSrcSpan
anc RealSrcSpan
comAnc = RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
anc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
comAnc
#else
relocateCommentsAfter = everywhereMEpAnnsBackwards f
  where
    f epa@EpAnn {..} =
      insertCommentsByPos (isAfter $ anchor entry) insertFollowingComments epa
    f EpAnnNotUsed = pure EpAnnNotUsed
    isAfter anc comAnc = srcSpanEndLine anc <= srcSpanStartLine comAnc
#endif
-- | Locates comments before each element in a parent.
relocateCommentsBeforeEachElement ::
     forall a b c. Typeable a
  => (a -> [b]) -- ^ Element getter
  -> ([b] -> a -> a) -- ^ Element setter
  -> (b -> EpAnn c) -- ^ Annotation getter
  -> (EpAnn c -> b -> b) -- ^ Annotation setter
  -> (a -> b -> RealSrcSpan -> Bool) -- ^ The function to decide whether to locate comments
  -> HsModule'
  -> WithComments HsModule'
relocateCommentsBeforeEachElement :: forall a b c.
Typeable a =>
(a -> [b])
-> ([b] -> a -> a)
-> (b -> EpAnn c)
-> (EpAnn c -> b -> b)
-> (a -> b -> RealSrcSpan -> Bool)
-> HsModule'
-> State [LEpaComment] HsModule'
relocateCommentsBeforeEachElement a -> [b]
elemGetter [b] -> a -> a
elemSetter b -> EpAnn c
annGetter EpAnn c -> b -> b
annSetter a -> b -> RealSrcSpan -> Bool
cond =
  GenericM (StateT [LEpaComment] Identity)
-> GenericM (StateT [LEpaComment] Identity)
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
everywhereM ((a -> StateT [LEpaComment] Identity a)
-> a -> StateT [LEpaComment] Identity a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
mkM a -> StateT [LEpaComment] Identity a
f)
  where
    f :: a -> WithComments a
    f :: a -> StateT [LEpaComment] Identity a
f a
x = do
      [b]
newElems <- (b -> StateT [LEpaComment] Identity b)
-> [b] -> StateT [LEpaComment] Identity [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM b -> StateT [LEpaComment] Identity b
insertCommentsBeforeElement (a -> [b]
elemGetter a
x)
      a -> StateT [LEpaComment] Identity a
forall a. a -> StateT [LEpaComment] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> StateT [LEpaComment] Identity a)
-> a -> StateT [LEpaComment] Identity a
forall a b. (a -> b) -> a -> b
$ [b] -> a -> a
elemSetter [b]
newElems a
x
      where
        insertCommentsBeforeElement :: b -> StateT [LEpaComment] Identity b
insertCommentsBeforeElement b
element
          | elemAnn :: EpAnn c
elemAnn@EpAnn {} <- b -> EpAnn c
annGetter b
element = do
            EpAnn c
newEpa <-
              (RealSrcSpan -> Bool)
-> (EpAnnComments -> [LEpaComment] -> EpAnnComments)
-> EpAnn c
-> WithComments (EpAnn c)
forall a.
(RealSrcSpan -> Bool)
-> (EpAnnComments -> [LEpaComment] -> EpAnnComments)
-> EpAnn a
-> WithComments (EpAnn a)
insertCommentsByPos (a -> b -> RealSrcSpan -> Bool
cond a
x b
element) EpAnnComments -> [LEpaComment] -> EpAnnComments
insertPriorComments EpAnn c
elemAnn
            b -> StateT [LEpaComment] Identity b
forall a. a -> StateT [LEpaComment] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> StateT [LEpaComment] Identity b)
-> b -> StateT [LEpaComment] Identity b
forall a b. (a -> b) -> a -> b
$ EpAnn c -> b -> b
annSetter EpAnn c
newEpa b
element
          | Bool
otherwise = b -> StateT [LEpaComment] Identity b
forall a. a -> StateT [LEpaComment] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
element

-- | This function applies the given function to all 'EpAnn's.
applyM ::
     forall a. Typeable a
  => (forall b. EpAnn b -> WithComments (EpAnn b))
  -> (a -> WithComments a)
applyM :: forall a.
Typeable a =>
(forall b. EpAnn b -> WithComments (EpAnn b))
-> a -> WithComments a
applyM forall b. EpAnn b -> WithComments (EpAnn b)
f
  | App TypeRep a
g TypeRep b
_ <- forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a
  , Just a :~~: EpAnn
HRefl <- TypeRep a -> TypeRep EpAnn -> Maybe (a :~~: EpAnn)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
eqTypeRep TypeRep a
g (forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: * -> *). Typeable a => TypeRep a
typeRep @EpAnn) = a -> StateT [LEpaComment] Identity a
EpAnn b -> WithComments (EpAnn b)
forall b. EpAnn b -> WithComments (EpAnn b)
f
  | Bool
otherwise = a -> StateT [LEpaComment] Identity a
forall a. a -> StateT [LEpaComment] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | This function drains comments whose positions satisfy the given
-- predicate and inserts them to the given node using the given inserter.
insertCommentsByPos ::
     (RealSrcSpan -> Bool)
  -> (EpAnnComments -> [LEpaComment] -> EpAnnComments)
  -> EpAnn a
  -> WithComments (EpAnn a)
insertCommentsByPos :: forall a.
(RealSrcSpan -> Bool)
-> (EpAnnComments -> [LEpaComment] -> EpAnnComments)
-> EpAnn a
-> WithComments (EpAnn a)
insertCommentsByPos RealSrcSpan -> Bool
cond = (LEpaComment -> Bool)
-> (EpAnnComments -> [LEpaComment] -> EpAnnComments)
-> EpAnn a
-> WithComments (EpAnn a)
forall a.
(LEpaComment -> Bool)
-> (EpAnnComments -> [LEpaComment] -> EpAnnComments)
-> EpAnn a
-> WithComments (EpAnn a)
insertComments (RealSrcSpan -> Bool
cond (RealSrcSpan -> Bool)
-> (LEpaComment -> RealSrcSpan) -> LEpaComment -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoCommentsLocation -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
anchor (NoCommentsLocation -> RealSrcSpan)
-> (LEpaComment -> NoCommentsLocation)
-> LEpaComment
-> RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LEpaComment -> NoCommentsLocation
forall l e. GenLocated l e -> l
getLoc)

-- | This function drains comments that satisfy the given predicate and
-- inserts them to the given node using the given inserter.
insertComments ::
     (LEpaComment -> Bool)
  -> (EpAnnComments -> [LEpaComment] -> EpAnnComments)
  -> EpAnn a
  -> WithComments (EpAnn a)
insertComments :: forall a.
(LEpaComment -> Bool)
-> (EpAnnComments -> [LEpaComment] -> EpAnnComments)
-> EpAnn a
-> WithComments (EpAnn a)
insertComments LEpaComment -> Bool
cond EpAnnComments -> [LEpaComment] -> EpAnnComments
inserter epa :: EpAnn a
epa@EpAnn {a
Anchor
EpAnnComments
comments :: forall ann. EpAnn ann -> EpAnnComments
entry :: forall ann. EpAnn ann -> Anchor
anns :: forall ann. EpAnn ann -> ann
entry :: Anchor
anns :: a
comments :: EpAnnComments
..} = do
  [LEpaComment]
coms <- (LEpaComment -> Bool) -> WithComments [LEpaComment]
drainComments LEpaComment -> Bool
cond
  EpAnn a -> WithComments (EpAnn a)
forall a. a -> StateT [LEpaComment] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EpAnn a -> WithComments (EpAnn a))
-> EpAnn a -> WithComments (EpAnn a)
forall a b. (a -> b) -> a -> b
$ EpAnn a
epa {comments = inserter comments coms}
#if !MIN_VERSION_ghc_lib_parser(9, 10, 1)
insertComments _ _ EpAnnNotUsed = pure EpAnnNotUsed
#endif
-- | This function inserts comments to `priorComments`.
insertPriorComments :: EpAnnComments -> [LEpaComment] -> EpAnnComments
insertPriorComments :: EpAnnComments -> [LEpaComment] -> EpAnnComments
insertPriorComments (EpaComments [LEpaComment]
prior) [LEpaComment]
cs =
  [LEpaComment] -> EpAnnComments
EpaComments ([LEpaComment] -> [LEpaComment]
sortCommentsByLocation ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ [LEpaComment]
prior [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a] -> [a]
++ [LEpaComment]
cs)
insertPriorComments (EpaCommentsBalanced [LEpaComment]
prior [LEpaComment]
following) [LEpaComment]
cs =
  [LEpaComment] -> [LEpaComment] -> EpAnnComments
EpaCommentsBalanced ([LEpaComment] -> [LEpaComment]
sortCommentsByLocation ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ [LEpaComment]
prior [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a] -> [a]
++ [LEpaComment]
cs) [LEpaComment]
following

-- | This function inserts comments to `followingComments`.
insertFollowingComments :: EpAnnComments -> [LEpaComment] -> EpAnnComments
insertFollowingComments :: EpAnnComments -> [LEpaComment] -> EpAnnComments
insertFollowingComments (EpaComments [LEpaComment]
prior) [LEpaComment]
cs = [LEpaComment] -> [LEpaComment] -> EpAnnComments
EpaCommentsBalanced [LEpaComment]
prior [LEpaComment]
cs
insertFollowingComments (EpaCommentsBalanced [LEpaComment]
prior [LEpaComment]
following) [LEpaComment]
cs =
  [LEpaComment] -> [LEpaComment] -> EpAnnComments
EpaCommentsBalanced [LEpaComment]
prior ([LEpaComment] -> [LEpaComment]
sortCommentsByLocation ([LEpaComment] -> [LEpaComment]) -> [LEpaComment] -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ [LEpaComment]
following [LEpaComment] -> [LEpaComment] -> [LEpaComment]
forall a. [a] -> [a] -> [a]
++ [LEpaComment]
cs)

-- | This function drains comments that satisfy the given predicate.
drainComments :: (LEpaComment -> Bool) -> WithComments [LEpaComment]
drainComments :: (LEpaComment -> Bool) -> WithComments [LEpaComment]
drainComments LEpaComment -> Bool
cond = do
  [LEpaComment]
coms <- WithComments [LEpaComment]
forall s (m :: * -> *). MonadState s m => m s
get
  let ([LEpaComment]
xs, [LEpaComment]
others) = (LEpaComment -> Bool)
-> [LEpaComment] -> ([LEpaComment], [LEpaComment])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition LEpaComment -> Bool
cond [LEpaComment]
coms
  [LEpaComment] -> StateT [LEpaComment] Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [LEpaComment]
others
  [LEpaComment] -> WithComments [LEpaComment]
forall a. a -> StateT [LEpaComment] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [LEpaComment]
xs

-- | 'everywhereM' but applies the given function to EPAs in order their
-- positions from backwards.
everywhereMEpAnnsBackwards ::
     Data a
  => (forall b. EpAnn b -> WithComments (EpAnn b))
  -> a
  -> WithComments a
everywhereMEpAnnsBackwards :: forall a.
Data a =>
(forall b. EpAnn b -> WithComments (EpAnn b))
-> a -> WithComments a
everywhereMEpAnnsBackwards =
  (forall b c. EpAnn b -> EpAnn c -> Ordering)
-> (forall b. EpAnn b -> WithComments (EpAnn b))
-> a
-> WithComments a
forall a.
Data a =>
(forall b c. EpAnn b -> EpAnn c -> Ordering)
-> (forall b. EpAnn b -> WithComments (EpAnn b))
-> a
-> WithComments a
everywhereMEpAnnsInOrder ((EpAnn c -> EpAnn b -> Ordering) -> EpAnn b -> EpAnn c -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip EpAnn c -> EpAnn b -> Ordering
forall b c. EpAnn b -> EpAnn c -> Ordering
compareEpaByEndPosition)

-- | 'everywhereM' but applies the given function to EPAs in order
-- specified by the given ordering function.
everywhereMEpAnnsInOrder ::
     Data a
  => (forall b c. EpAnn b -> EpAnn c -> Ordering)
  -> (forall b. EpAnn b -> WithComments (EpAnn b))
  -> a
  -> WithComments a
everywhereMEpAnnsInOrder :: forall a.
Data a =>
(forall b c. EpAnn b -> EpAnn c -> Ordering)
-> (forall b. EpAnn b -> WithComments (EpAnn b))
-> a
-> WithComments a
everywhereMEpAnnsInOrder forall b c. EpAnn b -> EpAnn c -> Ordering
cmp forall b. EpAnn b -> WithComments (EpAnn b)
f a
hm =
  StateT [LEpaComment] Identity [Wrapper]
collectEpAnnsInOrderEverywhereMTraverses
    StateT [LEpaComment] Identity [Wrapper]
-> ([Wrapper] -> StateT [LEpaComment] Identity [(Int, Wrapper)])
-> StateT [LEpaComment] Identity [(Int, Wrapper)]
forall a b.
StateT [LEpaComment] Identity a
-> (a -> StateT [LEpaComment] Identity b)
-> StateT [LEpaComment] Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Wrapper] -> StateT [LEpaComment] Identity [(Int, Wrapper)]
applyFunctionInOrderEpAnnEndPositions
    StateT [LEpaComment] Identity [(Int, Wrapper)]
-> ([(Int, Wrapper)] -> StateT [LEpaComment] Identity a)
-> StateT [LEpaComment] Identity a
forall a b.
StateT [LEpaComment] Identity a
-> (a -> StateT [LEpaComment] Identity b)
-> StateT [LEpaComment] Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(Int, Wrapper)] -> StateT [LEpaComment] Identity a
putModifiedEpAnnsToModule
  where
    collectEpAnnsInOrderEverywhereMTraverses :: StateT [LEpaComment] Identity [Wrapper]
collectEpAnnsInOrderEverywhereMTraverses
      -- This function uses 'everywhereM' to collect 'EpAnn's because they
      -- should be collected in the same order as 'putModifiedEpAnnsToModule'
      -- puts them to the AST.
     = [Wrapper] -> [Wrapper]
forall a. [a] -> [a]
reverse ([Wrapper] -> [Wrapper])
-> StateT [LEpaComment] Identity [Wrapper]
-> StateT [LEpaComment] Identity [Wrapper]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT [Wrapper] (StateT [LEpaComment] Identity) a
-> [Wrapper] -> StateT [LEpaComment] Identity [Wrapper]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (GenericM (StateT [Wrapper] (StateT [LEpaComment] Identity))
-> GenericM (StateT [Wrapper] (StateT [LEpaComment] Identity))
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
everywhereM a -> StateT [Wrapper] (StateT [LEpaComment] Identity) a
GenericM (StateT [Wrapper] (StateT [LEpaComment] Identity))
forall {m :: * -> *} {b}.
(MonadState [Wrapper] m, Typeable b) =>
b -> m b
collectEpAnnsST a
hm) []
      where
        collectEpAnnsST :: b -> m b
collectEpAnnsST b
x = do
          ([Wrapper] -> [Wrapper]) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (([Wrapper] -> [Wrapper]) -> m ())
-> ([Wrapper] -> [Wrapper]) -> m ()
forall a b. (a -> b) -> a -> b
$ b -> [Wrapper] -> [Wrapper]
forall a. Typeable a => a -> [Wrapper] -> [Wrapper]
collectEpAnns b
x
          b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
x
        collectEpAnns ::
             forall a. Typeable a
          => a
          -> ([Wrapper] -> [Wrapper])
        collectEpAnns :: forall a. Typeable a => a -> [Wrapper] -> [Wrapper]
collectEpAnns a
x
          -- If 'a' is 'EpAnn b' ('b' can be any type), wrap 'x' with a 'Wrapper'.
          | App TypeRep a
g TypeRep b
_ <- forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a
          , Just a :~~: EpAnn
HRefl <- TypeRep a -> TypeRep EpAnn -> Maybe (a :~~: EpAnn)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
eqTypeRep TypeRep a
g (forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: * -> *). Typeable a => TypeRep a
typeRep @EpAnn) = (EpAnn b -> Wrapper
forall a. Typeable (EpAnn a) => EpAnn a -> Wrapper
Wrapper a
EpAnn b
x Wrapper -> [Wrapper] -> [Wrapper]
forall a. a -> [a] -> [a]
:)
          | Bool
otherwise = [Wrapper] -> [Wrapper]
forall a. a -> a
id
    applyFunctionInOrderEpAnnEndPositions ::
         [Wrapper]
      -> WithComments [(Int, Wrapper)] -- ^ The first element of the tuple
                                       -- indicates how many 'Wrapper's were there before 'everywhereM'
                                       -- accessed the second element.
    applyFunctionInOrderEpAnnEndPositions :: [Wrapper] -> StateT [LEpaComment] Identity [(Int, Wrapper)]
applyFunctionInOrderEpAnnEndPositions [Wrapper]
anns =
      [(Int, Wrapper)]
-> ((Int, Wrapper) -> StateT [LEpaComment] Identity (Int, Wrapper))
-> StateT [LEpaComment] Identity [(Int, Wrapper)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Int, Wrapper)]
sorted (((Int, Wrapper) -> StateT [LEpaComment] Identity (Int, Wrapper))
 -> StateT [LEpaComment] Identity [(Int, Wrapper)])
-> ((Int, Wrapper) -> StateT [LEpaComment] Identity (Int, Wrapper))
-> StateT [LEpaComment] Identity [(Int, Wrapper)]
forall a b. (a -> b) -> a -> b
$ \(Int
i, Wrapper EpAnn a
x) -> do
        EpAnn a
x' <- EpAnn a -> WithComments (EpAnn a)
forall b. EpAnn b -> WithComments (EpAnn b)
f EpAnn a
x
        (Int, Wrapper) -> StateT [LEpaComment] Identity (Int, Wrapper)
forall a. a -> StateT [LEpaComment] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
i, EpAnn a -> Wrapper
forall a. Typeable (EpAnn a) => EpAnn a -> Wrapper
Wrapper EpAnn a
x')
      where
        indexed :: [(Int, Wrapper)]
indexed = [Int] -> [Wrapper] -> [(Int, Wrapper)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [Wrapper]
anns
        sorted :: [(Int, Wrapper)]
sorted = ((Int, Wrapper) -> (Int, Wrapper) -> Ordering)
-> [(Int, Wrapper)] -> [(Int, Wrapper)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Int
_, Wrapper EpAnn a
a) (Int
_, Wrapper EpAnn a
b) -> EpAnn a -> EpAnn a -> Ordering
forall b c. EpAnn b -> EpAnn c -> Ordering
cmp EpAnn a
a EpAnn a
b) [(Int, Wrapper)]
indexed
    putModifiedEpAnnsToModule :: [(Int, Wrapper)] -> StateT [LEpaComment] Identity a
putModifiedEpAnnsToModule [(Int, Wrapper)]
anns = StateT [Int] (StateT [LEpaComment] Identity) a
-> [Int] -> StateT [LEpaComment] Identity a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (GenericM (StateT [Int] (StateT [LEpaComment] Identity))
-> GenericM (StateT [Int] (StateT [LEpaComment] Identity))
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
everywhereM a -> StateT [Int] (StateT [LEpaComment] Identity) a
GenericM (StateT [Int] (StateT [LEpaComment] Identity))
forall a.
Typeable a =>
a -> StateT [Int] (StateT [LEpaComment] Identity) a
setEpAnn a
hm) [Int
0 ..]
      where
        setEpAnn ::
             forall a. Typeable a
          => a
          -> StateT [Int] WithComments a
        setEpAnn :: forall a.
Typeable a =>
a -> StateT [Int] (StateT [LEpaComment] Identity) a
setEpAnn a
x
          -- This guard arm checks if 'a' is 'EpAnn b' ('b' can be any type).
          | App TypeRep a
g TypeRep b
g' <- forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a
          , Just a :~~: EpAnn
HRefl <- TypeRep a -> TypeRep EpAnn -> Maybe (a :~~: EpAnn)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
eqTypeRep TypeRep a
g (forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: * -> *). Typeable a => TypeRep a
typeRep @EpAnn) = do
            Int
i <- ([Int] -> Int) -> StateT [Int] (StateT [LEpaComment] Identity) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets [Int] -> Int
forall a. HasCallStack => [a] -> a
head
            ([Int] -> [Int]) -> StateT [Int] (StateT [LEpaComment] Identity) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify [Int] -> [Int]
forall a. HasCallStack => [a] -> [a]
tail
            case Int -> [(Int, Wrapper)] -> Maybe Wrapper
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
i [(Int, Wrapper)]
anns of
              Just (Wrapper EpAnn a
y)
                | App TypeRep a
_ TypeRep b
h <- EpAnn a -> TypeRep (EpAnn a)
forall a. Typeable a => a -> TypeRep a
typeOf EpAnn a
y
                , Just b :~~: b
HRefl <- TypeRep b -> TypeRep b -> Maybe (b :~~: b)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
eqTypeRep TypeRep b
g' TypeRep b
h -> a -> StateT [Int] (StateT [LEpaComment] Identity) a
forall a. a -> StateT [Int] (StateT [LEpaComment] Identity) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
EpAnn a
y
              Maybe Wrapper
_ -> [Char] -> StateT [Int] (StateT [LEpaComment] Identity) a
forall a. HasCallStack => [Char] -> a
error [Char]
"Unmatches"
          | Bool
otherwise = a -> StateT [Int] (StateT [LEpaComment] Identity) a
forall a. a -> StateT [Int] (StateT [LEpaComment] Identity) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

-- | This function moves comments in `fun_id` of `FunBind` to
-- `mc_fun` of `HsMatchContext`.
--
-- This is a workaround for the issue that `EpAnn`s in `mc_fun` cannot be
-- closed since 9.10.1.
moveCommentsFromFunIdToMcFun :: HsModule' -> WithComments HsModule'
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
moveCommentsFromFunIdToMcFun :: HsModule' -> State [LEpaComment] HsModule'
moveCommentsFromFunIdToMcFun = HsModule' -> State [LEpaComment] HsModule'
forall a. a -> StateT [LEpaComment] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsModule' -> State [LEpaComment] HsModule')
-> (HsModule' -> HsModule')
-> HsModule'
-> State [LEpaComment] HsModule'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((HsBindLR GhcPs GhcPs -> HsBindLR GhcPs GhcPs) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT HsBindLR GhcPs GhcPs -> HsBindLR GhcPs GhcPs
f)
  where
    f :: HsBind GhcPs -> HsBind GhcPs
    f :: HsBindLR GhcPs GhcPs -> HsBindLR GhcPs GhcPs
f fb :: HsBindLR GhcPs GhcPs
fb@FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = L EpAnn {comments :: forall ann. EpAnn ann -> EpAnnComments
comments = EpAnnComments
from, Anchor
NameAnn
entry :: forall ann. EpAnn ann -> Anchor
anns :: forall ann. EpAnn ann -> ann
entry :: Anchor
anns :: NameAnn
..} RdrName
fid
                 , fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = MG {mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = L SrcSpanAnnL
l [GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
alts, XMG GhcPs (XRec GhcPs (HsExpr GhcPs))
mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_ext :: XMG GhcPs (XRec GhcPs (HsExpr GhcPs))
..}
                 } =
      HsBindLR GhcPs GhcPs
fb
        { fun_id = L EpAnn {comments = EpaCommentsBalanced [] [], ..} fid
        , fun_matches = MG {mg_alts = L l alts', ..}
        }
      where
        alts' :: [GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
alts' =
          (GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            (\(L SrcSpanAnnA
l' Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x) ->
               case Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x of
                 Match {m_ctxt :: forall p body. Match p body -> HsMatchContext (LIdP (NoGhcTc p))
m_ctxt = FunRhs {mc_fun :: forall fn. HsMatchContext fn -> fn
mc_fun = L EpAnn {Anchor
NameAnn
EpAnnComments
comments :: forall ann. EpAnn ann -> EpAnnComments
entry :: forall ann. EpAnn ann -> Anchor
anns :: forall ann. EpAnn ann -> ann
entry :: Anchor
anns :: NameAnn
comments :: EpAnnComments
..} RdrName
fun, SrcStrictness
LexicalFixity
mc_fixity :: LexicalFixity
mc_strictness :: SrcStrictness
mc_strictness :: forall fn. HsMatchContext fn -> SrcStrictness
mc_fixity :: forall fn. HsMatchContext fn -> LexicalFixity
..}, [LPat GhcPs]
XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_grhss :: forall p body. Match p body -> GRHSs p body
m_ext :: XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_pats :: [LPat GhcPs]
m_grhss :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_pats :: forall p body. Match p body -> [LPat p]
m_ext :: forall p body. Match p body -> XCMatch p body
..} ->
                   SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L
                     SrcSpanAnnA
l'
                     Match
                       { m_ctxt :: HsMatchContext (LIdP (NoGhcTc GhcPs))
m_ctxt =
                           FunRhs
                             {mc_fun :: GenLocated (EpAnn NameAnn) RdrName
mc_fun = EpAnn NameAnn -> RdrName -> GenLocated (EpAnn NameAnn) RdrName
forall l e. l -> e -> GenLocated l e
L EpAnn {comments :: EpAnnComments
comments = EpAnnComments
from, Anchor
NameAnn
entry :: Anchor
anns :: NameAnn
entry :: Anchor
anns :: NameAnn
..} RdrName
fun, SrcStrictness
LexicalFixity
mc_fixity :: LexicalFixity
mc_strictness :: SrcStrictness
mc_strictness :: SrcStrictness
mc_fixity :: LexicalFixity
..}
                       , [LPat GhcPs]
XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_grhss :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_ext :: XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_pats :: [LPat GhcPs]
m_grhss :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_pats :: [LPat GhcPs]
m_ext :: XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
..
                       }
                 Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x'' -> SrcSpanAnnA
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l' Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x'')
            [GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
alts
    f HsBindLR GhcPs GhcPs
x = HsBindLR GhcPs GhcPs
x
#else
moveCommentsFromFunIdToMcFun = pure
#endif
-- | This function sorts comments by its location.
sortCommentsByLocation :: [LEpaComment] -> [LEpaComment]
sortCommentsByLocation :: [LEpaComment] -> [LEpaComment]
sortCommentsByLocation = (LEpaComment -> LEpaComment -> Ordering)
-> [LEpaComment] -> [LEpaComment]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (RealSrcSpan -> RealSrcSpan -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RealSrcSpan -> RealSrcSpan -> Ordering)
-> (LEpaComment -> RealSrcSpan)
-> LEpaComment
-> LEpaComment
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NoCommentsLocation -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
anchor (NoCommentsLocation -> RealSrcSpan)
-> (LEpaComment -> NoCommentsLocation)
-> LEpaComment
-> RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LEpaComment -> NoCommentsLocation
forall l e. GenLocated l e -> l
getLoc)

-- | This function compares given EPAs by their end positions.
compareEpaByEndPosition :: EpAnn a -> EpAnn b -> Ordering
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
compareEpaByEndPosition :: forall b c. EpAnn b -> EpAnn c -> Ordering
compareEpaByEndPosition (EpAnn (EpaSpan SrcSpan
a) a
_ EpAnnComments
_) (EpAnn (EpaSpan SrcSpan
b) b
_ EpAnnComments
_) =
  case (SrcSpan
a, SrcSpan
b) of
    (RealSrcSpan RealSrcSpan
a' Maybe BufSpan
_, RealSrcSpan RealSrcSpan
b' Maybe BufSpan
_) ->
      RealSrcLoc -> RealSrcLoc -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
a') (RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
b')
    (UnhelpfulSpan UnhelpfulSpanReason
_, UnhelpfulSpan UnhelpfulSpanReason
_) -> Ordering
EQ
    (SrcSpan
_, UnhelpfulSpan UnhelpfulSpanReason
_) -> Ordering
GT
    (UnhelpfulSpan UnhelpfulSpanReason
_, SrcSpan
_) -> Ordering
LT
compareEpaByEndPosition (EpAnn Anchor
a a
_ EpAnnComments
_) (EpAnn Anchor
b b
_ EpAnnComments
_) =
  case (Anchor
a, Anchor
b) of
    (EpaDelta {}, EpaDelta {}) -> Ordering
EQ
    (Anchor
_, EpaDelta {}) -> Ordering
GT
    (EpaDelta {}, Anchor
_) -> Ordering
LT
#else
compareEpaByEndPosition (EpAnn a _ _) (EpAnn b _ _) =
  on compare (realSrcSpanEnd . anchor) a b
compareEpaByEndPosition EpAnnNotUsed EpAnnNotUsed = EQ
compareEpaByEndPosition _ EpAnnNotUsed = GT
compareEpaByEndPosition EpAnnNotUsed _ = LT
#endif