{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
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
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
fixFixities :: HsModule' -> HsModule'
fixFixities :: HsModule' -> HsModule'
fixFixities = [(String, Fixity)] -> HsModule' -> HsModule'
forall a. Data a => [(String, Fixity)] -> a -> a
applyFixities [(String, Fixity)]
fixities
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)
sortExprLStmt :: HsModule' -> HsModule'
sortExprLStmt :: HsModule' -> HsModule'
sortExprLStmt m :: HsModule'
m@HsModule {hsmodDecls :: HsModule' -> [LHsDecl GhcPs]
hsmodDecls = [LHsDecl GhcPs]
xs} = HsModule'
m {hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls = [LHsDecl GhcPs]
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)
removeComments :: HsModule' -> HsModule'
= (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)
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
SrcSpanAnn' (EpAnn b)
sp {ann :: EpAnn b
ann = Anchor -> b -> EpAnnComments -> EpAnn b
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> Anchor
spanAsAnchor (SrcSpan -> Anchor) -> SrcSpan -> Anchor
forall a b. (a -> b) -> a -> b
$ SrcSpanAnn' (EpAnn b) -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA a
SrcSpanAnn' (EpAnn b)
sp) b
ann EpAnnComments
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) []
resetModuleNameColumn :: HsModule' -> HsModule'
resetModuleNameColumn :: HsModule' -> HsModule'
resetModuleNameColumn m :: HsModule'
m@HsModule {hsmodName :: HsModule' -> Maybe (LocatedA 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 :: Maybe (LocatedA ModuleName)
hsmodName = LocatedA ModuleName -> Maybe (LocatedA ModuleName)
forall a. a -> Maybe a
Just (SrcSpanAnnA -> ModuleName -> LocatedA ModuleName
forall l e. l -> e -> GenLocated l e
L (EpAnn AnnListItem -> SrcSpan -> SrcSpanAnnA
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn EpAnn AnnListItem
newAnn SrcSpan
sp) ModuleName
name)}
where
newAnn :: EpAnn AnnListItem
newAnn = EpAnn AnnListItem
epa {entry :: Anchor
entry = RealSrcSpan -> Anchor
realSpanAsAnchor RealSrcSpan
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
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 :: LIdP GhcPs
fun_id = SrcSpanAnn' (EpAnn NameAnn)
-> RdrName -> GenLocated (SrcSpanAnn' (EpAnn NameAnn)) RdrName
forall l e. l -> e -> GenLocated l e
L (EpAnn NameAnn -> SrcSpan -> SrcSpanAnn' (EpAnn NameAnn)
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn EpAnn NameAnn
forall ann. EpAnn ann
EpAnnNotUsed SrcSpan
l) RdrName
name}
closeEpAnn HsBind GhcPs
x = HsBind GhcPs
x
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
Match GhcPs b
x {m_ext :: XCMatch GhcPs b
m_ext = XCMatch GhcPs b
EpAnn [AddEpAnn]
forall ann. EpAnn ann
EpAnnNotUsed}
| Bool
otherwise = a
x
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
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
removeAllDocDs :: HsModule' -> HsModule'
removeAllDocDs :: HsModule' -> HsModule'
removeAllDocDs x :: HsModule'
x@HsModule {hsmodDecls :: HsModule' -> [LHsDecl GhcPs]
hsmodDecls = [LHsDecl GhcPs]
decls} =
HsModule'
x {hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls = (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Bool)
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDecl GhcPs -> Bool
forall {p}. HsDecl p -> Bool
isDocD (HsDecl GhcPs -> Bool)
-> (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> HsDecl GhcPs)
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsDecl GhcPs) -> HsDecl GhcPs
forall l e. GenLocated l e -> e
unLoc) [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
[LHsDecl GhcPs]
decls}
where
isDocD :: HsDecl p -> Bool
isDocD DocD {} = Bool
True
isDocD HsDecl p
_ = Bool
False
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 :: Anchor
entry = RealSrcSpan -> Anchor
realSpanAsAnchor RealSrcSpan
newSpan}
newAnn :: EpAnn GrhsAnn
newAnn = XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
ext {entry :: Anchor
entry = RealSrcSpan -> Anchor
realSpanAsAnchor RealSrcSpan
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