{-# 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 :: 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)
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
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) []
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
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
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
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 :: 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
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