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

-- | Module preprocessing before pretty-printing.
module HIndent.ModulePreprocessing
  ( modifyASTForPrettyPrinting
  ) where

import Control.Applicative
import Data.Function
import Data.List
import Data.Maybe
import GHC.Hs
import GHC.Types.SrcLoc
import Generics.SYB hiding (GT, typeOf, typeRep)
import HIndent.Fixity
import HIndent.GhcLibParserWrapper.GHC.Hs
import HIndent.ModulePreprocessing.CommentRelocation
import Language.Haskell.GhclibParserEx.Fixity
import Type.Reflection

-- | This function modifies the given module AST for pretty-printing.
--
-- Pretty-printing a module without calling this function for it before may
-- raise an error or not print it correctly.
modifyASTForPrettyPrinting :: HsModule' -> HsModule'
modifyASTForPrettyPrinting :: HsModule' -> HsModule'
modifyASTForPrettyPrinting HsModule'
m = HsModule' -> [GenLocated Anchor EpaComment] -> HsModule'
relocateComments (HsModule' -> HsModule'
beforeRelocation HsModule'
m) [GenLocated Anchor EpaComment]
allComments
  where
    beforeRelocation :: HsModule' -> HsModule'
beforeRelocation =
      HsModule' -> HsModule'
resetLGRHSEndPositionInModule
        (HsModule' -> HsModule')
-> (HsModule' -> HsModule') -> HsModule' -> HsModule'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> HsModule'
removeAllDocDs
        (HsModule' -> HsModule')
-> (HsModule' -> HsModule') -> HsModule' -> HsModule'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> HsModule'
closeEpAnnOfHsFunTy
        (HsModule' -> HsModule')
-> (HsModule' -> HsModule') -> HsModule' -> HsModule'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> HsModule'
closeEpAnnOfMatchMExt
        (HsModule' -> HsModule')
-> (HsModule' -> HsModule') -> HsModule' -> HsModule'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> HsModule'
closePlaceHolderEpAnns
        (HsModule' -> HsModule')
-> (HsModule' -> HsModule') -> HsModule' -> HsModule'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> HsModule'
closeEpAnnOfFunBindFunId
        (HsModule' -> HsModule')
-> (HsModule' -> HsModule') -> HsModule' -> HsModule'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> HsModule'
resetModuleNameColumn
        (HsModule' -> HsModule')
-> (HsModule' -> HsModule') -> HsModule' -> HsModule'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> HsModule'
replaceAllNotUsedAnns
        (HsModule' -> HsModule')
-> (HsModule' -> HsModule') -> HsModule' -> HsModule'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> HsModule'
removeComments
        (HsModule' -> HsModule')
-> (HsModule' -> HsModule') -> HsModule' -> HsModule'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> HsModule'
sortExprLStmt
        (HsModule' -> HsModule')
-> (HsModule' -> HsModule') -> HsModule' -> HsModule'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> HsModule'
fixFixities
    allComments :: [GenLocated Anchor EpaComment]
allComments = (GenLocated Anchor EpaComment -> Bool)
-> GenericQ [GenLocated Anchor EpaComment]
forall r. Typeable r => (r -> Bool) -> GenericQ [r]
listify (Bool -> Bool
not (Bool -> Bool)
-> (GenLocated Anchor EpaComment -> Bool)
-> GenLocated Anchor EpaComment
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpaCommentTok -> Bool
isEofComment (EpaCommentTok -> Bool)
-> (GenLocated Anchor EpaComment -> EpaCommentTok)
-> GenLocated Anchor EpaComment
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpaComment -> EpaCommentTok
ac_tok (EpaComment -> EpaCommentTok)
-> (GenLocated Anchor EpaComment -> EpaComment)
-> GenLocated Anchor EpaComment
-> EpaCommentTok
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated Anchor EpaComment -> EpaComment
forall l e. GenLocated l e -> e
unLoc) HsModule'
m
    isEofComment :: EpaCommentTok -> Bool
isEofComment EpaCommentTok
EpaEofComment = Bool
True
    isEofComment EpaCommentTok
_ = Bool
False

-- | This function modifies the given module AST to apply fixities of infix
-- operators defined in the 'base' package.
fixFixities :: HsModule' -> HsModule'
fixFixities :: HsModule' -> HsModule'
fixFixities = [(String, Fixity)] -> HsModule' -> HsModule'
forall a. Data a => [(String, Fixity)] -> a -> a
applyFixities [(String, Fixity)]
fixities

-- | This function sets an 'LGRHS's end position to the end position of the
-- last RHS in the 'grhssGRHSs'.
--
-- The source span of an 'L?GRHS' contains the 'where' keyword, which
-- locates comments in the wrong position in the process of comment
-- relocation. This function prevents it by fixing the 'L?GRHS''s source
-- span.
resetLGRHSEndPositionInModule :: HsModule' -> HsModule'
resetLGRHSEndPositionInModule :: HsModule' -> HsModule'
resetLGRHSEndPositionInModule = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((LGRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs))
-> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT LGRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs)
resetLGRHSEndPosition)

-- | This function sorts lists of statements in order their positions.
--
-- For example, the last element of 'HsDo' of 'HsExpr' is the element
-- before a bar, and the elements are not sorted by their locations. This
-- function fixes the orderings.
sortExprLStmt :: HsModule' -> HsModule'
sortExprLStmt :: HsModule' -> HsModule'
sortExprLStmt m :: HsModule'
m@HsModule {hsmodDecls :: forall p. HsModule p -> [LHsDecl p]
hsmodDecls = [LHsDecl GhcPs]
xs} = HsModule'
m {hsmodDecls = sorted}
  where
    sorted :: [LHsDecl GhcPs]
sorted = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere (([ExprLStmt GhcPs] -> [ExprLStmt GhcPs]) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT [ExprLStmt GhcPs] -> [ExprLStmt GhcPs]
sortByLoc) [LHsDecl GhcPs]
xs
    sortByLoc :: [ExprLStmt GhcPs] -> [ExprLStmt GhcPs]
    sortByLoc :: [ExprLStmt GhcPs] -> [ExprLStmt GhcPs]
sortByLoc = (GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> Ordering)
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Maybe RealSrcSpan -> Maybe RealSrcSpan -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Maybe RealSrcSpan -> Maybe RealSrcSpan -> Ordering)
-> (GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    -> Maybe RealSrcSpan)
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` SrcSpan -> Maybe RealSrcSpan
srcSpanToRealSrcSpan (SrcSpan -> Maybe RealSrcSpan)
-> (GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    -> SrcSpan)
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Maybe RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA (SrcSpanAnnA -> SrcSpan)
-> (GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    -> SrcSpanAnnA)
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc)

-- | This function removes all comments from the given module not to
-- duplicate them on comment relocation.
removeComments :: HsModule' -> HsModule'
removeComments :: HsModule' -> HsModule'
removeComments = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((EpAnnComments -> EpAnnComments) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT ((EpAnnComments -> EpAnnComments) -> a -> a)
-> (EpAnnComments -> EpAnnComments) -> a -> a
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> EpAnnComments -> EpAnnComments
forall a b. a -> b -> a
const EpAnnComments
emptyComments)

-- | This function replaces all 'EpAnnNotUsed's in 'SrcSpanAnn''s with
-- 'EpAnn's to make it possible to locate comments on them.
replaceAllNotUsedAnns :: HsModule' -> HsModule'
replaceAllNotUsedAnns :: HsModule' -> HsModule'
replaceAllNotUsedAnns = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere a -> a
forall a. Data a => a -> a
app
  where
    app ::
         forall a. Data a
      => (a -> a)
    app :: forall a. Data a => a -> a
app a
sp
      | App TypeRep a
g (App TypeRep a
y TypeRep b
z) <- forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a
      , Just a :~~: SrcSpanAnn'
HRefl <- TypeRep a -> TypeRep SrcSpanAnn' -> Maybe (a :~~: SrcSpanAnn')
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 @SrcSpanAnn')
      , 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
y (forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: * -> *). Typeable a => TypeRep a
typeRep @EpAnn) =
        a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
sp (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ do
          let try :: Typeable b => b -> Maybe a
              try :: forall b. Typeable b => b -> Maybe a
try b
ann = do
                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 (b -> TypeRep b
forall a. Typeable a => a -> TypeRep a
typeOf b
ann) TypeRep b
z
                a -> Maybe a
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
sp {ann = EpAnn (spanAsAnchor $ locA sp) ann emptyComments}
          AnnListItem -> Maybe a
forall b. Typeable b => b -> Maybe a
try AnnListItem
emptyListItem
            Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AnnList -> Maybe a
forall b. Typeable b => b -> Maybe a
try AnnList
emptyList
            Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AnnPragma -> Maybe a
forall b. Typeable b => b -> Maybe a
try AnnPragma
emptyPragma
            Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AnnContext -> Maybe a
forall b. Typeable b => b -> Maybe a
try AnnContext
emptyContext
            Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NameAnn -> Maybe a
forall b. Typeable b => b -> Maybe a
try NameAnn
emptyNameAnn
            Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NoEpAnns -> Maybe a
forall b. Typeable b => b -> Maybe a
try NoEpAnns
NoEpAnns
    app a
x = a
x
    emptyListItem :: AnnListItem
emptyListItem = [TrailingAnn] -> AnnListItem
AnnListItem []
    emptyList :: AnnList
emptyList = Maybe Anchor
-> Maybe AddEpAnn
-> Maybe AddEpAnn
-> [AddEpAnn]
-> [TrailingAnn]
-> AnnList
AnnList Maybe Anchor
forall a. Maybe a
Nothing Maybe AddEpAnn
forall a. Maybe a
Nothing Maybe AddEpAnn
forall a. Maybe a
Nothing [] []
    emptyPragma :: AnnPragma
emptyPragma = AddEpAnn -> AddEpAnn -> [AddEpAnn] -> AnnPragma
AnnPragma AddEpAnn
emptyAddEpAnn AddEpAnn
emptyAddEpAnn []
    emptyContext :: AnnContext
emptyContext = Maybe (IsUnicodeSyntax, EpaLocation)
-> [EpaLocation] -> [EpaLocation] -> AnnContext
AnnContext Maybe (IsUnicodeSyntax, EpaLocation)
forall a. Maybe a
Nothing [] []
    emptyNameAnn :: NameAnn
emptyNameAnn = [TrailingAnn] -> NameAnn
NameAnnTrailing []
    emptyAddEpAnn :: AddEpAnn
emptyAddEpAnn = AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnAnyclass EpaLocation
emptyEpaLocation
    emptyEpaLocation :: EpaLocation
emptyEpaLocation = DeltaPos -> [GenLocated Anchor EpaComment] -> EpaLocation
EpaDelta (Int -> DeltaPos
SameLine Int
0) []

-- | This function sets the start column of 'hsmodName' of the given
-- 'HsModule' to 1 to correctly locate comments above the module name.
resetModuleNameColumn :: HsModule' -> HsModule'
resetModuleNameColumn :: HsModule' -> HsModule'
resetModuleNameColumn m :: HsModule'
m@HsModule {hsmodName :: forall p. HsModule p -> Maybe (XRec p ModuleName)
hsmodName = Just (L (SrcSpanAnn epa :: EpAnn AnnListItem
epa@EpAnn {AnnListItem
EpAnnComments
Anchor
entry :: Anchor
anns :: AnnListItem
comments :: EpAnnComments
entry :: forall ann. EpAnn ann -> Anchor
anns :: forall ann. EpAnn ann -> ann
comments :: forall ann. EpAnn ann -> EpAnnComments
..} SrcSpan
sp) ModuleName
name)} =
  HsModule'
m {hsmodName = Just (L (SrcSpanAnn newAnn sp) name)}
  where
    newAnn :: EpAnn AnnListItem
newAnn = EpAnn AnnListItem
epa {entry = realSpanAsAnchor newSpan}
    newSpan :: RealSrcSpan
newSpan =
      RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan
        (FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
anc) (RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
anc) Int
1)
        (RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
anc)
    anc :: RealSrcSpan
anc = Anchor -> RealSrcSpan
anchor Anchor
entry
resetModuleNameColumn HsModule'
m = HsModule'
m

-- | This function replaces the 'EpAnn' of 'fun_id' in 'FunBind' with
-- 'EpAnnNotUsed'.
--
-- The 'fun_id' contains the function's name. However, 'FunRhs' of 'Match'
-- also contains the name, and we use the latter one. This function
-- prevents comments from being located in 'fun_id'.
closeEpAnnOfFunBindFunId :: HsModule' -> HsModule'
closeEpAnnOfFunBindFunId :: HsModule' -> HsModule'
closeEpAnnOfFunBindFunId = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((HsBind GhcPs -> HsBind GhcPs) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT HsBind GhcPs -> HsBind GhcPs
closeEpAnn)
  where
    closeEpAnn :: HsBind GhcPs -> HsBind GhcPs
    closeEpAnn :: HsBind GhcPs -> HsBind GhcPs
closeEpAnn bind :: HsBind GhcPs
bind@FunBind {fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = (L (SrcSpanAnn EpAnn NameAnn
_ SrcSpan
l) RdrName
name)} =
      HsBind GhcPs
bind {fun_id = L (SrcSpanAnn EpAnnNotUsed l) name}
    closeEpAnn HsBind GhcPs
x = HsBind GhcPs
x

-- | This function replaces the 'EpAnn' of 'm_ext' in 'Match' with
-- 'EpAnnNotUsed.
--
-- The field contains the annotation of the match LHS. However, the same
-- information is also stored inside the 'Match'. This function removes the
-- duplication not to locate comments on a wrong point.
closeEpAnnOfMatchMExt :: HsModule' -> HsModule'
closeEpAnnOfMatchMExt :: HsModule' -> HsModule'
closeEpAnnOfMatchMExt = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere a -> a
forall a. Data a => a -> a
forall a. Typeable a => a -> a
closeEpAnn
  where
    closeEpAnn ::
         forall a. Typeable a
      => a
      -> a
    closeEpAnn :: forall a. Typeable a => a -> a
closeEpAnn a
x
      | App (App TypeRep a
g TypeRep b
h) TypeRep b
_ <- forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a
      , Just a :~~: Match
HRefl <- TypeRep a -> TypeRep Match -> Maybe (a :~~: Match)
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 @Match)
      , Just b :~~: GhcPs
HRefl <- TypeRep b -> TypeRep GhcPs -> Maybe (b :~~: GhcPs)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
eqTypeRep TypeRep b
h (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @GhcPs) = a
x {m_ext = EpAnnNotUsed}
      | Bool
otherwise = a
x

-- | This function replaces the 'EpAnn' of the first argument of 'HsFunTy'
-- of 'HsType'.
--
-- 'HsFunTy' should not have any comments. Instead, its LHS and RHS should
-- have them.
closeEpAnnOfHsFunTy :: HsModule' -> HsModule'
closeEpAnnOfHsFunTy :: HsModule' -> HsModule'
closeEpAnnOfHsFunTy = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((HsType GhcPs -> HsType GhcPs) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT HsType GhcPs -> HsType GhcPs
closeEpAnn)
  where
    closeEpAnn :: HsType GhcPs -> HsType GhcPs
    closeEpAnn :: HsType GhcPs -> HsType GhcPs
closeEpAnn (HsFunTy XFunTy GhcPs
_ HsArrow GhcPs
p LHsType GhcPs
l LHsType GhcPs
r) = XFunTy GhcPs
-> HsArrow GhcPs -> LHsType GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass.
XFunTy pass
-> HsArrow pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy XFunTy GhcPs
EpAnn NoEpAnns
forall ann. EpAnn ann
EpAnnNotUsed HsArrow GhcPs
p LHsType GhcPs
l LHsType GhcPs
r
    closeEpAnn HsType GhcPs
x = HsType GhcPs
x

-- | This function replaces all 'EpAnn's that contain placeholder anchors
-- to locate comments correctly. A placeholder anchor is an anchor pointing
-- on (-1, -1).
closePlaceHolderEpAnns :: HsModule' -> HsModule'
closePlaceHolderEpAnns :: HsModule' -> HsModule'
closePlaceHolderEpAnns = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere a -> a
forall a. Data a => a -> a
forall a. Typeable a => a -> a
closeEpAnn
  where
    closeEpAnn ::
         forall a. Typeable a
      => a
      -> a
    closeEpAnn :: forall a. Typeable a => a -> a
closeEpAnn a
x
      | 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 (Anchor RealSrcSpan
sp AnchorOperation
_) b
_ EpAnnComments
_) <- a
x
      , RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
sp Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1 Bool -> Bool -> Bool
&& RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
sp Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1 = a
EpAnn b
forall ann. EpAnn ann
EpAnnNotUsed
      | Bool
otherwise = a
x

-- | This function removes all 'DocD's from the given module. They have
-- haddocks, but the same information is stored in 'EpaCommentTok's. Thus,
-- we need to remove the duplication.
removeAllDocDs :: HsModule' -> HsModule'
removeAllDocDs :: HsModule' -> HsModule'
removeAllDocDs x :: HsModule'
x@HsModule {hsmodDecls :: forall p. HsModule p -> [LHsDecl p]
hsmodDecls = [LHsDecl GhcPs]
decls} =
  HsModule'
x {hsmodDecls = filter (not . isDocD . unLoc) decls}
  where
    isDocD :: HsDecl p -> Bool
isDocD DocD {} = Bool
True
    isDocD HsDecl p
_ = Bool
False

-- | This function sets the position of the given 'LGRHS' to the end
-- position of the last RHS in it.
--
-- See the documentation of 'resetLGRHSEndPositionInModule' for the reason.
resetLGRHSEndPosition ::
     LGRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs)
#if MIN_VERSION_ghc_lib_parser(9,4,1)
resetLGRHSEndPosition :: LGRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs)
resetLGRHSEndPosition (L (SrcSpanAnn locAnn :: EpAnn NoEpAnns
locAnn@EpAnn {} SrcSpan
sp) (GRHS ext :: XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ext@EpAnn {EpAnnComments
Anchor
GrhsAnn
entry :: forall ann. EpAnn ann -> Anchor
anns :: forall ann. EpAnn ann -> ann
comments :: forall ann. EpAnn ann -> EpAnnComments
entry :: Anchor
anns :: GrhsAnn
comments :: EpAnnComments
..} [ExprLStmt GhcPs]
stmt GenLocated SrcSpanAnnA (HsExpr GhcPs)
body)) =
  let lastPosition :: RealSrcLoc
lastPosition =
        [RealSrcLoc] -> RealSrcLoc
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([RealSrcLoc] -> RealSrcLoc) -> [RealSrcLoc] -> RealSrcLoc
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> RealSrcLoc
realSrcSpanEnd (RealSrcSpan -> RealSrcLoc)
-> (Anchor -> RealSrcSpan) -> Anchor -> RealSrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Anchor -> RealSrcSpan
anchor (Anchor -> RealSrcLoc) -> [Anchor] -> [RealSrcLoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Anchor -> Bool) -> GenericQ [Anchor]
forall r. Typeable r => (r -> Bool) -> GenericQ [r]
listify Anchor -> Bool
collectAnchor GenLocated SrcSpanAnnA (HsExpr GhcPs)
body
      newSpan :: RealSrcSpan
newSpan = RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan (RealSrcSpan -> RealSrcLoc
realSrcSpanStart (RealSrcSpan -> RealSrcLoc) -> RealSrcSpan -> RealSrcLoc
forall a b. (a -> b) -> a -> b
$ Anchor -> RealSrcSpan
anchor Anchor
entry) RealSrcLoc
lastPosition
      newLocAnn :: EpAnn NoEpAnns
newLocAnn = EpAnn NoEpAnns
locAnn {entry = realSpanAsAnchor newSpan}
      newAnn :: EpAnn GrhsAnn
newAnn = XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
ext {entry = realSpanAsAnchor newSpan}
   in SrcAnn NoEpAnns
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     (SrcAnn NoEpAnns)
     (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L (EpAnn NoEpAnns -> SrcSpan -> SrcAnn NoEpAnns
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn EpAnn NoEpAnns
newLocAnn SrcSpan
sp) (XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [ExprLStmt GhcPs]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
newAnn [ExprLStmt GhcPs]
stmt GenLocated SrcSpanAnnA (HsExpr GhcPs)
body)
  where
    collectAnchor :: Anchor -> Bool
    collectAnchor :: Anchor -> Bool
collectAnchor Anchor
_ = Bool
True
#else
resetLGRHSEndPosition (L _ (GRHS ext@EpAnn {..} stmt body)) =
  let lastPosition =
        maximum $ realSrcSpanEnd . anchor <$> listify collectAnchor body
      newSpan = mkRealSrcSpan (realSrcSpanStart $ anchor entry) lastPosition
      newLoc = RealSrcSpan newSpan Nothing
      newAnn = ext {entry = realSpanAsAnchor newSpan}
   in L newLoc (GRHS newAnn stmt body)
  where
    collectAnchor :: Anchor -> Bool
    collectAnchor _ = True
#endif
resetLGRHSEndPosition LGRHS GhcPs (LHsExpr GhcPs)
x = LGRHS GhcPs (LHsExpr GhcPs)
x