{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs, CPP #-}
{-# 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 GHC.Data.Bag
import GHC.Types.SrcLoc
import Generics.SYB hiding (GT, typeOf, typeRep)
import HIndent.GhcLibParserWrapper.GHC.Hs
import HIndent.Pretty.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
    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,6,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 = Anchor -> RealSrcSpan
anchor (Anchor -> RealSrcSpan) -> Anchor -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ LEpaComment -> Anchor
forall l e. GenLocated l e -> l
getLoc (LEpaComment -> Anchor) -> LEpaComment -> Anchor
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
#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
-- | 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) -> EpAnn AnnListItem)
-> (EpAnn AnnListItem
    -> 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) -> EpAnn AnnListItem
forall {a} {e}. GenLocated (SrcSpanAnn' a) e -> a
annGetter
    EpAnn AnnListItem
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs)
forall {a} {a} {e}.
a -> GenLocated (SrcSpanAnn' a) e -> GenLocated (SrcSpanAnn' a) e
annSetter
    HsModule'
-> GenLocated SrcSpanAnnA (IE GhcPs) -> RealSrcSpan -> Bool
forall {p} {ann} {ann} {e}.
(XRec p [XRec p (IE p)]
 ~ GenLocated (SrcSpanAnn' (EpAnn ann)) [XRec p (IE p)]) =>
HsModule p
-> GenLocated (SrcSpanAnn' (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]
hsmodName :: forall p. HsModule p -> Maybe (XRec p ModuleName)
hsmodImports :: forall p. HsModule p -> [LImportDecl p]
hsmodDecls :: forall p. HsModule p -> [LHsDecl p]
..} =
      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]
hsmodName :: Maybe (XRec p ModuleName)
hsmodImports :: [LImportDecl p]
hsmodDecls :: [LHsDecl p]
..}
    elemSetter [XRec p (IE p)]
_ HsModule p
x = HsModule p
x
    annGetter :: GenLocated (SrcSpanAnn' a) e -> a
annGetter (L SrcSpanAnn {a
SrcSpan
ann :: a
locA :: SrcSpan
ann :: forall a. SrcSpanAnn' a -> a
locA :: forall a. SrcSpanAnn' a -> SrcSpan
..} e
_) = a
ann
    annSetter :: a -> GenLocated (SrcSpanAnn' a) e -> GenLocated (SrcSpanAnn' a) e
annSetter a
newAnn (L SrcSpanAnn {a
SrcSpan
ann :: forall a. SrcSpanAnn' a -> a
locA :: forall a. SrcSpanAnn' a -> SrcSpan
ann :: a
locA :: SrcSpan
..} e
x) = SrcSpanAnn' a -> e -> GenLocated (SrcSpanAnn' a) e
forall l e. l -> e -> GenLocated l e
L SrcSpanAnn {ann :: a
ann = a
newAnn, SrcSpan
locA :: SrcSpan
locA :: SrcSpan
..} e
x
    cond :: HsModule p
-> GenLocated (SrcSpanAnn' (EpAnn ann)) e -> RealSrcSpan -> Bool
cond HsModule {hsmodExports :: forall p. HsModule p -> Maybe (XRec p [LIE p])
hsmodExports = Just (L SrcSpanAnn {ann :: forall a. SrcSpanAnn' a -> a
ann = EpAnn {entry :: forall ann. EpAnn ann -> Anchor
entry = Anchor {anchor :: Anchor -> RealSrcSpan
anchor = RealSrcSpan
listAnc}}} [XRec p (IE p)]
_)} (L SrcSpanAnn {ann :: forall a. SrcSpanAnn' a -> a
ann = EpAnn {entry :: forall ann. EpAnn ann -> Anchor
entry = Anchor {anchor :: Anchor -> RealSrcSpan
anchor = RealSrcSpan
elemAnc}}} 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 (SrcSpanAnn' (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)))
    -> EpAnn AnnListItem)
-> (EpAnn AnnListItem
    -> 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)))
-> EpAnn AnnListItem
forall {a} {e}. GenLocated (SrcSpanAnn' a) e -> a
annGetter
    EpAnn AnnListItem
-> GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall {a} {a} {e}.
a -> GenLocated (SrcSpanAnn' a) e -> GenLocated (SrcSpanAnn' a) e
annSetter
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> RealSrcSpan
-> Bool
forall {ann} {e} {ann} {e}.
GenLocated (SrcSpanAnn' (EpAnn ann)) e
-> GenLocated (SrcSpanAnn' (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 (SrcSpanAnn' a) e -> a
annGetter (L SrcSpanAnn {a
SrcSpan
ann :: forall a. SrcSpanAnn' a -> a
locA :: forall a. SrcSpanAnn' a -> SrcSpan
ann :: a
locA :: SrcSpan
..} e
_) = a
ann
    annSetter :: a -> GenLocated (SrcSpanAnn' a) e -> GenLocated (SrcSpanAnn' a) e
annSetter a
newAnn (L SrcSpanAnn {a
SrcSpan
ann :: forall a. SrcSpanAnn' a -> a
locA :: forall a. SrcSpanAnn' a -> SrcSpan
ann :: a
locA :: SrcSpan
..} e
x) = SrcSpanAnn' a -> e -> GenLocated (SrcSpanAnn' a) e
forall l e. l -> e -> GenLocated l e
L SrcSpanAnn {ann :: a
ann = a
newAnn, SrcSpan
locA :: SrcSpan
locA :: SrcSpan
..} e
x
    cond :: GenLocated (SrcSpanAnn' (EpAnn ann)) e
-> GenLocated (SrcSpanAnn' (EpAnn ann)) e -> RealSrcSpan -> Bool
cond (L SrcSpanAnn {ann :: forall a. SrcSpanAnn' a -> a
ann = EpAnn {entry :: forall ann. EpAnn ann -> Anchor
entry = Anchor {anchor :: Anchor -> RealSrcSpan
anchor = RealSrcSpan
caseAnchor}}} e
_) (L SrcSpanAnn {ann :: forall a. SrcSpanAnn' a -> a
ann = EpAnn {entry :: forall ann. EpAnn ann -> Anchor
entry = Anchor {anchor :: Anchor -> RealSrcSpan
anchor = RealSrcSpan
branchAnchor}}} 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 (SrcSpanAnn' (EpAnn ann)) e
_ GenLocated (SrcSpanAnn' (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 -> EpAnn AnnListItem)
-> (EpAnn AnnListItem -> 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 -> EpAnn AnnListItem
forall {a} {e}. GenLocated (SrcSpanAnn' a) e -> a
annGetter
    EpAnn AnnListItem -> LSigBindFamily -> LSigBindFamily
forall {a} {a} {e}.
a -> GenLocated (SrcSpanAnn' a) e -> GenLocated (SrcSpanAnn' a) e
annSetter
    GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> LSigBindFamily -> RealSrcSpan -> Bool
forall {ann} {e} {ann} {e}.
GenLocated (SrcSpanAnn' (EpAnn ann)) e
-> GenLocated (SrcSpanAnn' (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
LayoutInfo GhcPs
LHsBinds GhcPs
LexicalFixity
LHsQTyVars GhcPs
tcdCExt :: XClassDecl GhcPs
tcdLayout :: LayoutInfo 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]
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdCExt :: forall pass. TyClDecl pass -> XClassDecl pass
tcdLayout :: forall pass. TyClDecl pass -> LayoutInfo pass
tcdCtxt :: forall pass. TyClDecl pass -> Maybe (LHsContext pass)
tcdFDs :: forall pass. TyClDecl pass -> [LHsFunDep pass]
tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdMeths :: forall pass. TyClDecl pass -> LHsBinds pass
tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATDefs :: forall pass. TyClDecl pass -> [LTyFamDefltDecl pass]
tcdDocs :: forall pass. TyClDecl pass -> [LDocDecl 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
LayoutInfo GhcPs
LHsBinds GhcPs
LexicalFixity
LHsQTyVars GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdCExt :: forall pass. TyClDecl pass -> XClassDecl pass
tcdLayout :: forall pass. TyClDecl pass -> LayoutInfo pass
tcdCtxt :: forall pass. TyClDecl pass -> Maybe (LHsContext pass)
tcdFDs :: forall pass. TyClDecl pass -> [LHsFunDep pass]
tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdMeths :: forall pass. TyClDecl pass -> LHsBinds pass
tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATDefs :: forall pass. TyClDecl pass -> [LTyFamDefltDecl pass]
tcdDocs :: forall pass. TyClDecl pass -> [LDocDecl pass]
tcdCExt :: XClassDecl GhcPs
tcdLayout :: LayoutInfo 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
LayoutInfo GhcPs
LexicalFixity
LHsQTyVars GhcPs
tcdLName :: LIdP GhcPs
tcdTyVars :: LHsQTyVars GhcPs
tcdFixity :: LexicalFixity
tcdCExt :: XClassDecl GhcPs
tcdLayout :: LayoutInfo GhcPs
tcdCtxt :: Maybe (LHsContext GhcPs)
tcdFDs :: [LHsFunDep GhcPs]
tcdDocs :: [LDocDecl GhcPs]
tcdCExt :: XClassDecl GhcPs
tcdLayout :: LayoutInfo 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 (SrcSpanAnn' a) e -> a
annGetter (L SrcSpanAnn {a
SrcSpan
ann :: forall a. SrcSpanAnn' a -> a
locA :: forall a. SrcSpanAnn' a -> SrcSpan
ann :: a
locA :: SrcSpan
..} e
_) = a
ann
    annSetter :: a -> GenLocated (SrcSpanAnn' a) e -> GenLocated (SrcSpanAnn' a) e
annSetter a
newAnn (L SrcSpanAnn {a
SrcSpan
ann :: forall a. SrcSpanAnn' a -> a
locA :: forall a. SrcSpanAnn' a -> SrcSpan
ann :: a
locA :: SrcSpan
..} e
x) = SrcSpanAnn' a -> e -> GenLocated (SrcSpanAnn' a) e
forall l e. l -> e -> GenLocated l e
L SrcSpanAnn {ann :: a
ann = a
newAnn, SrcSpan
locA :: SrcSpan
locA :: SrcSpan
..} e
x
    cond :: GenLocated (SrcSpanAnn' (EpAnn ann)) e
-> GenLocated (SrcSpanAnn' (EpAnn ann)) e -> RealSrcSpan -> Bool
cond (L SrcSpanAnn {ann :: forall a. SrcSpanAnn' a -> a
ann = EpAnn {entry :: forall ann. EpAnn ann -> Anchor
entry = Anchor {anchor :: Anchor -> RealSrcSpan
anchor = RealSrcSpan
classAnchor}}} e
_) (L SrcSpanAnn {ann :: forall a. SrcSpanAnn' a -> a
ann = EpAnn {entry :: forall ann. EpAnn ann -> Anchor
entry = Anchor {anchor :: Anchor -> RealSrcSpan
anchor = RealSrcSpan
elemAnchor}}} 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 (SrcSpanAnn' (EpAnn ann)) e
_ GenLocated (SrcSpanAnn' (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)))
    -> EpAnn AnnListItem)
-> (EpAnn AnnListItem
    -> 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)))
-> EpAnn AnnListItem
forall {a} {e}. GenLocated (SrcSpanAnn' a) e -> a
annGetter
    EpAnn AnnListItem
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall {a} {a} {e}.
a -> GenLocated (SrcSpanAnn' a) e -> GenLocated (SrcSpanAnn' a) e
annSetter
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> RealSrcSpan
-> Bool
forall {ann} {e} {ann} {e}.
GenLocated (SrcSpanAnn' (EpAnn ann)) e
-> GenLocated (SrcSpanAnn' (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 (SrcSpanAnn' a) e -> a
annGetter (L SrcSpanAnn {a
SrcSpan
ann :: forall a. SrcSpanAnn' a -> a
locA :: forall a. SrcSpanAnn' a -> SrcSpan
ann :: a
locA :: SrcSpan
..} e
_) = a
ann
    annSetter :: a -> GenLocated (SrcSpanAnn' a) e -> GenLocated (SrcSpanAnn' a) e
annSetter a
newAnn (L SrcSpanAnn {a
SrcSpan
ann :: forall a. SrcSpanAnn' a -> a
locA :: forall a. SrcSpanAnn' a -> SrcSpan
ann :: a
locA :: SrcSpan
..} e
x) = SrcSpanAnn' a -> e -> GenLocated (SrcSpanAnn' a) e
forall l e. l -> e -> GenLocated l e
L SrcSpanAnn {ann :: a
ann = a
newAnn, SrcSpan
locA :: SrcSpan
locA :: SrcSpan
..} e
x
    cond :: GenLocated (SrcSpanAnn' (EpAnn ann)) e
-> GenLocated (SrcSpanAnn' (EpAnn ann)) e -> RealSrcSpan -> Bool
cond (L SrcSpanAnn {ann :: forall a. SrcSpanAnn' a -> a
ann = EpAnn {entry :: forall ann. EpAnn ann -> Anchor
entry = Anchor {anchor :: Anchor -> RealSrcSpan
anchor = RealSrcSpan
doAnchor}}} e
_) (L SrcSpanAnn {ann :: forall a. SrcSpanAnn' a -> a
ann = EpAnn {entry :: forall ann. EpAnn ann -> Anchor
entry = Anchor {anchor :: Anchor -> RealSrcSpan
anchor = RealSrcSpan
elemAnchor}}} 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 (SrcSpanAnn' (EpAnn ann)) e
_ GenLocated (SrcSpanAnn' (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
EpAnnComments
Anchor
comments :: forall ann. EpAnn ann -> EpAnnComments
entry :: forall ann. EpAnn ann -> Anchor
entry :: Anchor
anns :: a
comments :: EpAnnComments
anns :: forall ann. EpAnn ann -> ann
..} =
      (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 -> RealSrcSpan -> Bool)
-> RealSrcSpan -> RealSrcSpan -> Bool
forall a b. (a -> b) -> a -> b
$ Anchor -> RealSrcSpan
anchor Anchor
entry) EpAnnComments -> [LEpaComment] -> EpAnnComments
insertPriorComments EpAnn a
epa
    f EpAnn a
EpAnnNotUsed = EpAnn a -> WithComments (EpAnn a)
forall a. a -> StateT [LEpaComment] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EpAnn a
forall ann. EpAnn ann
EpAnnNotUsed
    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
EpAnnComments
Anchor
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
isOnSameLine (RealSrcSpan -> RealSrcSpan -> Bool)
-> RealSrcSpan -> RealSrcSpan -> Bool
forall a b. (a -> b) -> a -> b
$ Anchor -> RealSrcSpan
anchor Anchor
entry)
        EpAnnComments -> [LEpaComment] -> EpAnnComments
insertFollowingComments
        EpAnn a
epa
    f EpAnn a
EpAnnNotUsed = EpAnn a -> WithComments (EpAnn a)
forall a. a -> StateT [LEpaComment] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EpAnn a
forall ann. EpAnn ann
EpAnnNotUsed
    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])
hsmodName :: forall p. HsModule p -> Maybe (XRec p ModuleName)
hsmodImports :: forall p. HsModule p -> [LImportDecl p]
hsmodDecls :: forall p. HsModule p -> [LHsDecl p]
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 (SrcSpanAnn' (EpAnn ann)) e
-> m (GenLocated (SrcSpanAnn' (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 (SrcSpanAnn' (EpAnn ann)) e
-> m (GenLocated (SrcSpanAnn' (EpAnn ann)) e)
addCommentsBeforeEpAnn (L (SrcSpanAnn epa :: EpAnn ann
epa@EpAnn {ann
EpAnnComments
Anchor
comments :: forall ann. EpAnn ann -> EpAnnComments
entry :: forall ann. EpAnn ann -> Anchor
anns :: forall ann. EpAnn ann -> ann
entry :: Anchor
anns :: ann
comments :: EpAnnComments
..} SrcSpan
sp) e
x) = do
      [LEpaComment]
cs <- m [LEpaComment]
forall s (m :: * -> *). MonadState s m => m s
get
      let ([LEpaComment]
notAbove, [LEpaComment]
above) =
            [LEpaComment] -> Anchor -> ([LEpaComment], [LEpaComment])
forall {t :: * -> *} {e}.
Foldable t =>
t (GenLocated Anchor e)
-> Anchor -> ([GenLocated Anchor e], [GenLocated Anchor e])
partitionAboveNotAbove ([LEpaComment] -> [LEpaComment]
sortCommentsByLocation [LEpaComment]
cs) Anchor
entry
          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 (SrcSpanAnn' (EpAnn ann)) e
-> m (GenLocated (SrcSpanAnn' (EpAnn ann)) e)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated (SrcSpanAnn' (EpAnn ann)) e
 -> m (GenLocated (SrcSpanAnn' (EpAnn ann)) e))
-> GenLocated (SrcSpanAnn' (EpAnn ann)) e
-> m (GenLocated (SrcSpanAnn' (EpAnn ann)) e)
forall a b. (a -> b) -> a -> b
$ SrcSpanAnn' (EpAnn ann)
-> e -> GenLocated (SrcSpanAnn' (EpAnn ann)) e
forall l e. l -> e -> GenLocated l e
L (EpAnn ann -> SrcSpan -> SrcSpanAnn' (EpAnn ann)
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn EpAnn ann
epa' SrcSpan
sp) e
x
    addCommentsBeforeEpAnn GenLocated (SrcSpanAnn' (EpAnn ann)) e
x = GenLocated (SrcSpanAnn' (EpAnn ann)) e
-> m (GenLocated (SrcSpanAnn' (EpAnn ann)) e)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenLocated (SrcSpanAnn' (EpAnn ann)) e
x
    partitionAboveNotAbove :: t (GenLocated Anchor e)
-> Anchor -> ([GenLocated Anchor e], [GenLocated Anchor e])
partitionAboveNotAbove t (GenLocated Anchor e)
cs Anchor
sp =
      (([GenLocated Anchor e], [GenLocated Anchor e]), Anchor)
-> ([GenLocated Anchor e], [GenLocated Anchor e])
forall a b. (a, b) -> a
fst
        ((([GenLocated Anchor e], [GenLocated Anchor e]), Anchor)
 -> ([GenLocated Anchor e], [GenLocated Anchor e]))
-> (([GenLocated Anchor e], [GenLocated Anchor e]), Anchor)
-> ([GenLocated Anchor e], [GenLocated Anchor e])
forall a b. (a -> b) -> a -> b
$ (GenLocated Anchor e
 -> (([GenLocated Anchor e], [GenLocated Anchor e]), Anchor)
 -> (([GenLocated Anchor e], [GenLocated Anchor e]), Anchor))
-> (([GenLocated Anchor e], [GenLocated Anchor e]), Anchor)
-> t (GenLocated Anchor e)
-> (([GenLocated Anchor e], [GenLocated Anchor e]), Anchor)
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 Anchor e
c@(L Anchor
l e
_) (([GenLocated Anchor e]
ls, [GenLocated Anchor e]
rs), Anchor
lastSpan) ->
               if Anchor -> RealSrcSpan
anchor Anchor
l RealSrcSpan -> RealSrcSpan -> Bool
`isAbove` Anchor -> RealSrcSpan
anchor Anchor
lastSpan
                 then (([GenLocated Anchor e]
ls, GenLocated Anchor e
c GenLocated Anchor e
-> [GenLocated Anchor e] -> [GenLocated Anchor e]
forall a. a -> [a] -> [a]
: [GenLocated Anchor e]
rs), Anchor
l)
                 else ((GenLocated Anchor e
c GenLocated Anchor e
-> [GenLocated Anchor e] -> [GenLocated Anchor e]
forall a. a -> [a] -> [a]
: [GenLocated Anchor e]
ls, [GenLocated Anchor e]
rs), Anchor
lastSpan))
            (([], []), Anchor
sp)
            t (GenLocated Anchor 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

-- | 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'
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
EpAnnComments
Anchor
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
anchor Anchor
entry) EpAnnComments -> [LEpaComment] -> EpAnnComments
insertFollowingComments EpAnn a
epa
    f EpAnn a
EpAnnNotUsed = EpAnn a -> WithComments (EpAnn a)
forall a. a -> StateT [LEpaComment] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EpAnn a
forall ann. EpAnn ann
EpAnnNotUsed
    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

-- | 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
. Anchor -> RealSrcSpan
anchor (Anchor -> RealSrcSpan)
-> (LEpaComment -> Anchor) -> LEpaComment -> RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LEpaComment -> Anchor
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
EpAnnComments
Anchor
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}
insertComments LEpaComment -> Bool
_ EpAnnComments -> [LEpaComment] -> EpAnnComments
_ EpAnn a
EpAnnNotUsed = EpAnn a -> WithComments (EpAnn a)
forall a. a -> StateT [LEpaComment] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EpAnn a
forall ann. EpAnn ann
EpAnnNotUsed

-- | 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 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` Anchor -> RealSrcSpan
anchor (Anchor -> RealSrcSpan)
-> (LEpaComment -> Anchor) -> LEpaComment -> RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LEpaComment -> Anchor
forall l e. GenLocated l e -> l
getLoc)

-- | This function compares given EPAs by their end positions.
compareEpaByEndPosition :: EpAnn a -> EpAnn b -> Ordering
compareEpaByEndPosition :: forall b c. EpAnn b -> EpAnn c -> Ordering
compareEpaByEndPosition (EpAnn Anchor
a a
_ EpAnnComments
_) (EpAnn Anchor
b b
_ EpAnnComments
_) =
  (RealSrcLoc -> RealSrcLoc -> Ordering)
-> (Anchor -> RealSrcLoc) -> Anchor -> Anchor -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on RealSrcLoc -> RealSrcLoc -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RealSrcSpan -> RealSrcLoc
realSrcSpanEnd (RealSrcSpan -> RealSrcLoc)
-> (Anchor -> RealSrcSpan) -> Anchor -> RealSrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Anchor -> RealSrcSpan
anchor) Anchor
a Anchor
b
compareEpaByEndPosition EpAnn a
EpAnnNotUsed EpAnn b
EpAnnNotUsed = Ordering
EQ
compareEpaByEndPosition EpAnn a
_ EpAnn b
EpAnnNotUsed = Ordering
GT
compareEpaByEndPosition EpAnn a
EpAnnNotUsed EpAnn b
_ = Ordering
LT