{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
module Development.IDE.Plugin.CodeAction.ExactPrint (
Rewrite (..),
rewriteToEdit,
rewriteToWEdit,
#if !MIN_VERSION_ghc(9,2,0)
transferAnn,
#endif
appendConstraint,
removeConstraint,
extendImport,
hideSymbol,
liftParseAST,
) where
import Control.Applicative
import Control.Monad
import Control.Monad.Extra (whenJust)
import Control.Monad.Trans
import Data.Char (isAlphaNum)
import Data.Data (Data)
import Data.Functor
import Data.Generics (listify)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust, isNothing,
mapMaybe)
import qualified Data.Text as T
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Error
import Development.IDE.GHC.ExactPrint
import Development.IDE.Spans.Common
import GHC.Exts (IsList (fromList))
import Language.Haskell.GHC.ExactPrint
#if !MIN_VERSION_ghc(9,2,0)
import qualified Development.IDE.GHC.Compat.Util as Util
import Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP),
KeywordId (G), mkAnnKey)
#else
import Data.Default
import GHC (AddEpAnn (..), AnnContext (..), AnnParen (..),
DeltaPos (SameLine), EpAnn (..), EpaLocation (EpaDelta),
IsUnicodeSyntax (NormalSyntax),
NameAdornment (NameParens), NameAnn (..), addAnns, ann, emptyComments,
reAnnL, AnnList (..))
#endif
import Language.LSP.Types
import Development.IDE.GHC.Util
import Data.Bifunctor (first)
import Control.Lens (_head, _last, over)
import GHC.Stack (HasCallStack)
data Rewrite where
Rewrite ::
#if !MIN_VERSION_ghc(9,2,0)
Annotate ast =>
#else
(ExactPrint (GenLocated (Anno ast) ast), ResetEntryDP (Anno ast), Outputable (GenLocated (Anno ast) ast), Data (GenLocated (Anno ast) ast)) =>
#endif
SrcSpan ->
#if !MIN_VERSION_ghc(9,2,0)
(DynFlags -> TransformT (Either String) (Located ast)) ->
#else
(DynFlags -> TransformT (Either String) (GenLocated (Anno ast) ast)) ->
#endif
Rewrite
#if MIN_VERSION_ghc(9,2,0)
class ResetEntryDP ann where
resetEntryDP :: GenLocated ann ast -> GenLocated ann ast
instance {-# OVERLAPPING #-} Default an => ResetEntryDP (SrcAnn an) where
resetEntryDP (L srcAnn x) = setEntryDP (L srcAnn{ann=EpAnnNotUsed} x) (SameLine 0)
instance {-# OVERLAPPABLE #-} ResetEntryDP fallback where
resetEntryDP = id
#endif
rewriteToEdit :: HasCallStack =>
DynFlags ->
#if !MIN_VERSION_ghc(9,2,0)
Anns ->
#endif
Rewrite ->
Either String [TextEdit]
rewriteToEdit :: DynFlags -> Anns -> Rewrite -> Either String [TextEdit]
rewriteToEdit DynFlags
dflags
#if !MIN_VERSION_ghc(9,2,0)
Anns
anns
#endif
(Rewrite SrcSpan
dst DynFlags -> TransformT (Either String) (Located ast)
f) = do
(Located ast
ast, (Anns, Int)
anns , [String]
_) <- Anns
-> TransformT (Either String) (Located ast)
-> Either String (Located ast, (Anns, Int), [String])
forall (m :: * -> *) a.
Anns -> TransformT m a -> m (a, (Anns, Int), [String])
runTransformT
#if !MIN_VERSION_ghc(9,2,0)
Anns
anns
#endif
(TransformT (Either String) (Located ast)
-> Either String (Located ast, (Anns, Int), [String]))
-> TransformT (Either String) (Located ast)
-> Either String (Located ast, (Anns, Int), [String])
forall a b. (a -> b) -> a -> b
$ do
Located ast
ast <- DynFlags -> TransformT (Either String) (Located ast)
f DynFlags
dflags
#if !MIN_VERSION_ghc(9,2,0)
Located ast
ast Located ast
-> TransformT (Either String) ()
-> TransformT (Either String) (Located ast)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Located ast -> DeltaPos -> TransformT (Either String) ()
forall a (m :: * -> *).
(Constraints a, Monad m) =>
a -> DeltaPos -> TransformT m ()
setEntryDPT Located ast
ast ((Int, Int) -> DeltaPos
DP (Int
0, Int
0))
#else
pure $ traceAst "REWRITE_result" $ resetEntryDP ast
#endif
let editMap :: [TextEdit]
editMap =
[ Range -> Text -> TextEdit
TextEdit (Maybe Range -> Range
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Range -> Range) -> Maybe Range -> Range
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Maybe Range
srcSpanToRange SrcSpan
dst) (Text -> TextEdit) -> Text -> TextEdit
forall a b. (a -> b) -> a -> b
$
String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Located ast -> Anns -> String
forall ast. Annotate ast => Located ast -> Anns -> String
exactPrint Located ast
ast
#if !MIN_VERSION_ghc(9,2,0)
((Anns, Int) -> Anns
forall a b. (a, b) -> a
fst (Anns, Int)
anns)
#endif
]
[TextEdit] -> Either String [TextEdit]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TextEdit]
editMap
rewriteToWEdit :: DynFlags
-> Uri
#if !MIN_VERSION_ghc(9,2,0)
-> Anns
#endif
-> Rewrite
-> Either String WorkspaceEdit
rewriteToWEdit :: DynFlags -> Uri -> Anns -> Rewrite -> Either String WorkspaceEdit
rewriteToWEdit DynFlags
dflags Uri
uri
#if !MIN_VERSION_ghc(9,2,0)
Anns
anns
#endif
Rewrite
r = do
[TextEdit]
edits <- HasCallStack =>
DynFlags -> Anns -> Rewrite -> Either String [TextEdit]
DynFlags -> Anns -> Rewrite -> Either String [TextEdit]
rewriteToEdit DynFlags
dflags
#if !MIN_VERSION_ghc(9,2,0)
Anns
anns
#endif
Rewrite
r
WorkspaceEdit -> Either String WorkspaceEdit
forall (m :: * -> *) a. Monad m => a -> m a
return (WorkspaceEdit -> Either String WorkspaceEdit)
-> WorkspaceEdit -> Either String WorkspaceEdit
forall a b. (a -> b) -> a -> b
$
WorkspaceEdit :: Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit
{ $sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
_changes = WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just ([Item WorkspaceEditMap] -> WorkspaceEditMap
forall l. IsList l => [Item l] -> l
fromList [(Uri
uri, [TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit]
edits)])
, $sel:_documentChanges:WorkspaceEdit :: Maybe (List DocumentChange)
_documentChanges = Maybe (List DocumentChange)
forall a. Maybe a
Nothing
, $sel:_changeAnnotations:WorkspaceEdit :: Maybe ChangeAnnotationMap
_changeAnnotations = Maybe ChangeAnnotationMap
forall a. Maybe a
Nothing
}
#if !MIN_VERSION_ghc(9,2,0)
fixParens ::
(Monad m, Data (HsType pass), pass ~ GhcPass p0) =>
Maybe DeltaPos ->
Maybe DeltaPos ->
LHsContext pass ->
TransformT m [LHsType pass]
fixParens :: Maybe DeltaPos
-> Maybe DeltaPos -> LHsContext pass -> TransformT m [LHsType pass]
fixParens
Maybe DeltaPos
openDP Maybe DeltaPos
closeDP
ctxt :: LHsContext pass
ctxt@(L SrcSpan
_ [LHsType pass]
elems) = do
let parens :: Map KeywordId DeltaPos
parens = [(KeywordId, DeltaPos)] -> Map KeywordId DeltaPos
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(AnnKeywordId -> KeywordId
G AnnKeywordId
AnnOpenP, DeltaPos
dp00), (AnnKeywordId -> KeywordId
G AnnKeywordId
AnnCloseP, DeltaPos
dp00)]
(Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT ((Anns -> Anns) -> TransformT m ())
-> (Anns -> Anns) -> TransformT m ()
forall a b. (a -> b) -> a -> b
$
(Annotation -> Annotation) -> AnnKey -> Anns -> Anns
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust
( \Annotation
x ->
let annsMap :: Map KeywordId DeltaPos
annsMap = [(KeywordId, DeltaPos)] -> Map KeywordId DeltaPos
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (Annotation -> [(KeywordId, DeltaPos)]
annsDP Annotation
x)
in Annotation
x
{ annsDP :: [(KeywordId, DeltaPos)]
annsDP =
Map KeywordId DeltaPos -> [(KeywordId, DeltaPos)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map KeywordId DeltaPos -> [(KeywordId, DeltaPos)])
-> Map KeywordId DeltaPos -> [(KeywordId, DeltaPos)]
forall a b. (a -> b) -> a -> b
$
(Maybe DeltaPos -> Maybe DeltaPos)
-> KeywordId -> Map KeywordId DeltaPos -> Map KeywordId DeltaPos
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (\Maybe DeltaPos
_ -> Maybe DeltaPos
openDP Maybe DeltaPos -> Maybe DeltaPos -> Maybe DeltaPos
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DeltaPos -> Maybe DeltaPos
forall a. a -> Maybe a
Just DeltaPos
dp00) (AnnKeywordId -> KeywordId
G AnnKeywordId
AnnOpenP) (Map KeywordId DeltaPos -> Map KeywordId DeltaPos)
-> Map KeywordId DeltaPos -> Map KeywordId DeltaPos
forall a b. (a -> b) -> a -> b
$
(Maybe DeltaPos -> Maybe DeltaPos)
-> KeywordId -> Map KeywordId DeltaPos -> Map KeywordId DeltaPos
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (\Maybe DeltaPos
_ -> Maybe DeltaPos
closeDP Maybe DeltaPos -> Maybe DeltaPos -> Maybe DeltaPos
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DeltaPos -> Maybe DeltaPos
forall a. a -> Maybe a
Just DeltaPos
dp00) (AnnKeywordId -> KeywordId
G AnnKeywordId
AnnCloseP) (Map KeywordId DeltaPos -> Map KeywordId DeltaPos)
-> Map KeywordId DeltaPos -> Map KeywordId DeltaPos
forall a b. (a -> b) -> a -> b
$
Map KeywordId DeltaPos
annsMap Map KeywordId DeltaPos
-> Map KeywordId DeltaPos -> Map KeywordId DeltaPos
forall a. Semigroup a => a -> a -> a
<> Map KeywordId DeltaPos
parens
}
)
(LHsContext pass -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey LHsContext pass
ctxt)
[LHsType (GhcPass p0)] -> TransformT m [LHsType (GhcPass p0)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsType (GhcPass p0)] -> TransformT m [LHsType (GhcPass p0)])
-> [LHsType (GhcPass p0)] -> TransformT m [LHsType (GhcPass p0)]
forall a b. (a -> b) -> a -> b
$ (LHsType (GhcPass p0) -> LHsType (GhcPass p0))
-> [LHsType (GhcPass p0)] -> [LHsType (GhcPass p0)]
forall a b. (a -> b) -> [a] -> [b]
map LHsType (GhcPass p0) -> LHsType (GhcPass p0)
forall (pass :: Pass).
LHsType (GhcPass pass) -> LHsType (GhcPass pass)
dropHsParTy [LHsType pass]
[LHsType (GhcPass p0)]
elems
#endif
dropHsParTy :: LHsType (GhcPass pass) -> LHsType (GhcPass pass)
dropHsParTy :: LHsType (GhcPass pass) -> LHsType (GhcPass pass)
dropHsParTy (L SrcSpan
_ (HsParTy XParTy (GhcPass pass)
_ LHsType (GhcPass pass)
ty)) = LHsType (GhcPass pass)
ty
dropHsParTy LHsType (GhcPass pass)
other = LHsType (GhcPass pass)
other
removeConstraint ::
(LHsType GhcPs -> Bool) ->
LHsType GhcPs ->
Rewrite
removeConstraint :: (LHsType GhcPs -> Bool) -> LHsType GhcPs -> Rewrite
removeConstraint LHsType GhcPs -> Bool
toRemove = LHsType GhcPs -> Rewrite
go (LHsType GhcPs -> Rewrite)
-> (LHsType GhcPs -> LHsType GhcPs) -> LHsType GhcPs -> Rewrite
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LHsType GhcPs -> LHsType GhcPs
forall a.
(Data a, ExactPrint a, Outputable a, HasCallStack) =>
String -> a -> a
traceAst String
"REMOVE_CONSTRAINT_input"
where
go :: LHsType GhcPs -> Rewrite
#if !MIN_VERSION_ghc(9,2,0)
go :: LHsType GhcPs -> Rewrite
go (L SrcSpan
l it :: HsType GhcPs
it@HsQualTy{hst_ctxt :: forall pass. HsType pass -> LHsContext pass
hst_ctxt = L SrcSpan
l' HsContext GhcPs
ctxt, LHsType GhcPs
hst_body :: forall pass. HsType pass -> LHsType pass
hst_body :: LHsType GhcPs
hst_body}) = SrcSpan
-> (DynFlags -> TransformT (Either String) (LHsType GhcPs))
-> Rewrite
forall ast.
Annotate ast =>
SrcSpan
-> (DynFlags -> TransformT (Either String) (Located ast))
-> Rewrite
Rewrite (SrcSpan -> SrcSpan
forall a. a -> a
locA SrcSpan
l) ((DynFlags -> TransformT (Either String) (LHsType GhcPs))
-> Rewrite)
-> (DynFlags -> TransformT (Either String) (LHsType GhcPs))
-> Rewrite
forall a b. (a -> b) -> a -> b
$ \DynFlags
_ -> do
#else
go (L l it@HsQualTy{hst_ctxt = Just (L l' ctxt), hst_body}) = Rewrite (locA l) $ \_ -> do
#endif
let ctxt' :: HsContext GhcPs
ctxt' = (LHsType GhcPs -> Bool) -> HsContext GhcPs -> HsContext GhcPs
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (LHsType GhcPs -> Bool) -> LHsType GhcPs -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsType GhcPs -> Bool
toRemove) HsContext GhcPs
ctxt
removeStuff :: Bool
removeStuff = (LHsType GhcPs -> Bool
toRemove (LHsType GhcPs -> Bool) -> Maybe (LHsType GhcPs) -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsContext GhcPs -> Maybe (LHsType GhcPs)
forall a. [a] -> Maybe a
headMaybe HsContext GhcPs
ctxt) Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
#if !MIN_VERSION_ghc(9,2,0)
Bool
-> TransformT (Either String) () -> TransformT (Either String) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
removeStuff (TransformT (Either String) () -> TransformT (Either String) ())
-> TransformT (Either String) () -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$
LHsType GhcPs -> DeltaPos -> TransformT (Either String) ()
forall a (m :: * -> *).
(Constraints a, Monad m) =>
a -> DeltaPos -> TransformT m ()
setEntryDPT LHsType GhcPs
hst_body ((Int, Int) -> DeltaPos
DP (Int
0, Int
0))
LHsType GhcPs -> TransformT (Either String) (LHsType GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsType GhcPs -> TransformT (Either String) (LHsType GhcPs))
-> LHsType GhcPs -> TransformT (Either String) (LHsType GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsType GhcPs -> LHsType GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsType GhcPs -> LHsType GhcPs) -> HsType GhcPs -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ HsType GhcPs
it{hst_ctxt :: GenLocated SrcSpan (HsContext GhcPs)
hst_ctxt = SrcSpan -> HsContext GhcPs -> GenLocated SrcSpan (HsContext GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l' HsContext GhcPs
ctxt'}
#else
let hst_body' = if removeStuff then resetEntryDP hst_body else hst_body
return $ case ctxt' of
[] -> hst_body'
_ -> do
let ctxt'' = over _last (first removeComma) ctxt'
L l $ it{ hst_ctxt = Just $ L l' ctxt''
, hst_body = hst_body'
}
#endif
go (L SrcSpan
_ (HsParTy XParTy GhcPs
_ LHsType GhcPs
ty)) = LHsType GhcPs -> Rewrite
go LHsType GhcPs
ty
go (L SrcSpan
_ HsForAllTy{LHsType GhcPs
hst_body :: LHsType GhcPs
hst_body :: forall pass. HsType pass -> LHsType pass
hst_body}) = LHsType GhcPs -> Rewrite
go LHsType GhcPs
hst_body
go (L SrcSpan
l HsType GhcPs
other) = SrcSpan
-> (DynFlags -> TransformT (Either String) (LHsType GhcPs))
-> Rewrite
forall ast.
Annotate ast =>
SrcSpan
-> (DynFlags -> TransformT (Either String) (Located ast))
-> Rewrite
Rewrite (SrcSpan -> SrcSpan
forall a. a -> a
locA SrcSpan
l) ((DynFlags -> TransformT (Either String) (LHsType GhcPs))
-> Rewrite)
-> (DynFlags -> TransformT (Either String) (LHsType GhcPs))
-> Rewrite
forall a b. (a -> b) -> a -> b
$ \DynFlags
_ -> LHsType GhcPs -> TransformT (Either String) (LHsType GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsType GhcPs -> TransformT (Either String) (LHsType GhcPs))
-> LHsType GhcPs -> TransformT (Either String) (LHsType GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsType GhcPs -> LHsType GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l HsType GhcPs
other
appendConstraint ::
String ->
LHsType GhcPs ->
Rewrite
appendConstraint :: String -> LHsType GhcPs -> Rewrite
appendConstraint String
constraintT = LHsType GhcPs -> Rewrite
go (LHsType GhcPs -> Rewrite)
-> (LHsType GhcPs -> LHsType GhcPs) -> LHsType GhcPs -> Rewrite
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LHsType GhcPs -> LHsType GhcPs
forall a.
(Data a, ExactPrint a, Outputable a, HasCallStack) =>
String -> a -> a
traceAst String
"appendConstraint"
where
#if !MIN_VERSION_ghc(9,2,0)
go :: LHsType GhcPs -> Rewrite
go (L SrcSpan
l it :: HsType GhcPs
it@HsQualTy{hst_ctxt :: forall pass. HsType pass -> LHsContext pass
hst_ctxt = L SrcSpan
l' HsContext GhcPs
ctxt}) = SrcSpan
-> (DynFlags -> TransformT (Either String) (LHsType GhcPs))
-> Rewrite
forall ast.
Annotate ast =>
SrcSpan
-> (DynFlags -> TransformT (Either String) (Located ast))
-> Rewrite
Rewrite (SrcSpan -> SrcSpan
forall a. a -> a
locA SrcSpan
l) ((DynFlags -> TransformT (Either String) (LHsType GhcPs))
-> Rewrite)
-> (DynFlags -> TransformT (Either String) (LHsType GhcPs))
-> Rewrite
forall a b. (a -> b) -> a -> b
$ \DynFlags
df -> do
#else
go (L l it@HsQualTy{hst_ctxt = Just (L l' ctxt)}) = Rewrite (locA l) $ \df -> do
#endif
LHsType GhcPs
constraint <- DynFlags -> String -> TransformT (Either String) (LHsType GhcPs)
forall ast l.
(ASTElement l ast, ExactPrint (LocatedAn l ast)) =>
DynFlags -> String -> TransformT (Either String) (LocatedAn l ast)
liftParseAST DynFlags
df String
constraintT
#if !MIN_VERSION_ghc(9,2,0)
LHsType GhcPs -> DeltaPos -> TransformT (Either String) ()
forall a (m :: * -> *).
(Constraints a, Monad m) =>
a -> DeltaPos -> TransformT m ()
setEntryDPT LHsType GhcPs
constraint ((Int, Int) -> DeltaPos
DP (Int
0, Int
1))
Maybe (Maybe DeltaPos)
closeParenDP <- KeywordId
-> LHsType GhcPs -> TransformT (Either String) (Maybe DeltaPos)
forall a (m :: * -> *).
(Data a, Monad m) =>
KeywordId -> Located a -> TransformT m (Maybe DeltaPos)
lookupAnn (AnnKeywordId -> KeywordId
G AnnKeywordId
AnnCloseP) (LHsType GhcPs -> TransformT (Either String) (Maybe DeltaPos))
-> Maybe (LHsType GhcPs)
-> TransformT (Either String) (Maybe (Maybe DeltaPos))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
`mapM` HsContext GhcPs -> Maybe (LHsType GhcPs)
forall a. [a] -> Maybe a
lastMaybe HsContext GhcPs
ctxt
Maybe (Maybe DeltaPos)
openParenDP <- KeywordId
-> LHsType GhcPs -> TransformT (Either String) (Maybe DeltaPos)
forall a (m :: * -> *).
(Data a, Monad m) =>
KeywordId -> Located a -> TransformT m (Maybe DeltaPos)
lookupAnn (AnnKeywordId -> KeywordId
G AnnKeywordId
AnnOpenP) (LHsType GhcPs -> TransformT (Either String) (Maybe DeltaPos))
-> Maybe (LHsType GhcPs)
-> TransformT (Either String) (Maybe (Maybe DeltaPos))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
`mapM` HsContext GhcPs -> Maybe (LHsType GhcPs)
forall a. [a] -> Maybe a
headMaybe HsContext GhcPs
ctxt
HsContext GhcPs
ctxt' <- Maybe DeltaPos
-> Maybe DeltaPos
-> GenLocated SrcSpan (HsContext GhcPs)
-> TransformT (Either String) (HsContext GhcPs)
forall (m :: * -> *) pass (p0 :: Pass).
(Monad m, Data (HsType pass), pass ~ GhcPass p0) =>
Maybe DeltaPos
-> Maybe DeltaPos -> LHsContext pass -> TransformT m [LHsType pass]
fixParens
(Maybe (Maybe DeltaPos) -> Maybe DeltaPos
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe DeltaPos)
openParenDP) (Maybe (Maybe DeltaPos) -> Maybe DeltaPos
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe DeltaPos)
closeParenDP)
(SrcSpan -> HsContext GhcPs -> GenLocated SrcSpan (HsContext GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l' HsContext GhcPs
ctxt)
LHsType GhcPs -> TransformT (Either String) ()
forall a (m :: * -> *).
(Data a, Monad m) =>
Located a -> TransformT m ()
addTrailingCommaT (HsContext GhcPs -> LHsType GhcPs
forall a. [a] -> a
last HsContext GhcPs
ctxt')
LHsType GhcPs -> TransformT (Either String) (LHsType GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsType GhcPs -> TransformT (Either String) (LHsType GhcPs))
-> LHsType GhcPs -> TransformT (Either String) (LHsType GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsType GhcPs -> LHsType GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsType GhcPs -> LHsType GhcPs) -> HsType GhcPs -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ HsType GhcPs
it{hst_ctxt :: GenLocated SrcSpan (HsContext GhcPs)
hst_ctxt = SrcSpan -> HsContext GhcPs -> GenLocated SrcSpan (HsContext GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l' (HsContext GhcPs -> GenLocated SrcSpan (HsContext GhcPs))
-> HsContext GhcPs -> GenLocated SrcSpan (HsContext GhcPs)
forall a b. (a -> b) -> a -> b
$ HsContext GhcPs
ctxt' HsContext GhcPs -> HsContext GhcPs -> HsContext GhcPs
forall a. [a] -> [a] -> [a]
++ [LHsType GhcPs
constraint]}
#else
constraint <- pure $ setEntryDP constraint (SameLine 1)
let l'' = (fmap.fmap) (addParensToCtxt close_dp) l'
close_dp = case ctxt of
[L _ (HsParTy EpAnn{anns=AnnParen{ap_close}} _)] -> Just ap_close
_ -> Nothing
ctxt' = over _last (first addComma) $ map dropHsParTy ctxt
return $ L l $ it{hst_ctxt = Just $ L l'' $ ctxt' ++ [constraint]}
#endif
go (L SrcSpan
_ HsForAllTy{LHsType GhcPs
hst_body :: LHsType GhcPs
hst_body :: forall pass. HsType pass -> LHsType pass
hst_body}) = LHsType GhcPs -> Rewrite
go LHsType GhcPs
hst_body
go (L SrcSpan
_ (HsParTy XParTy GhcPs
_ LHsType GhcPs
ty)) = LHsType GhcPs -> Rewrite
go LHsType GhcPs
ty
go ast :: LHsType GhcPs
ast@(L SrcSpan
l HsType GhcPs
_) = SrcSpan
-> (DynFlags -> TransformT (Either String) (LHsType GhcPs))
-> Rewrite
forall ast.
Annotate ast =>
SrcSpan
-> (DynFlags -> TransformT (Either String) (Located ast))
-> Rewrite
Rewrite (SrcSpan -> SrcSpan
forall a. a -> a
locA SrcSpan
l) ((DynFlags -> TransformT (Either String) (LHsType GhcPs))
-> Rewrite)
-> (DynFlags -> TransformT (Either String) (LHsType GhcPs))
-> Rewrite
forall a b. (a -> b) -> a -> b
$ \DynFlags
df -> do
LHsType GhcPs
constraint <- DynFlags -> String -> TransformT (Either String) (LHsType GhcPs)
forall ast l.
(ASTElement l ast, ExactPrint (LocatedAn l ast)) =>
DynFlags -> String -> TransformT (Either String) (LocatedAn l ast)
liftParseAST DynFlags
df String
constraintT
SrcSpan
lContext <- TransformT (Either String) SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
SrcSpan
lTop <- TransformT (Either String) SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
#if !MIN_VERSION_ghc(9,2,0)
let context :: GenLocated SrcSpan (HsContext GhcPs)
context = SrcSpan -> HsContext GhcPs -> GenLocated SrcSpan (HsContext GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
lContext [LHsType GhcPs
constraint]
GenLocated SrcSpan (HsContext GhcPs)
-> DeltaPos
-> [(KeywordId, DeltaPos)]
-> TransformT (Either String) ()
forall a (m :: * -> *).
(Constraints a, Monad m) =>
a -> DeltaPos -> [(KeywordId, DeltaPos)] -> TransformT m ()
addSimpleAnnT GenLocated SrcSpan (HsContext GhcPs)
context DeltaPos
dp00 ([(KeywordId, DeltaPos)] -> TransformT (Either String) ())
-> [(KeywordId, DeltaPos)] -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$
(AnnKeywordId -> KeywordId
G AnnKeywordId
AnnDarrow, (Int, Int) -> DeltaPos
DP (Int
0, Int
1)) (KeywordId, DeltaPos)
-> [(KeywordId, DeltaPos)] -> [(KeywordId, DeltaPos)]
forall a. a -> [a] -> [a]
:
[[(KeywordId, DeltaPos)]] -> [(KeywordId, DeltaPos)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ (AnnKeywordId -> KeywordId
G AnnKeywordId
AnnOpenP, DeltaPos
dp00)
, (AnnKeywordId -> KeywordId
G AnnKeywordId
AnnCloseP, DeltaPos
dp00)
]
| PprPrec -> HsType GhcPs -> Bool
forall pass. PprPrec -> HsType pass -> Bool
hsTypeNeedsParens PprPrec
sigPrec (HsType GhcPs -> Bool) -> HsType GhcPs -> Bool
forall a b. (a -> b) -> a -> b
$ LHsType GhcPs -> SrcSpanLess (LHsType GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType GhcPs
constraint
]
#else
let context = Just $ reAnnL annCtxt emptyComments $ L lContext [resetEntryDP constraint]
annCtxt = AnnContext (Just (NormalSyntax, epl 1)) [epl 0 | needsParens] [epl 0 | needsParens]
needsParens = hsTypeNeedsParens sigPrec $ unLoc constraint
ast <- pure $ setEntryDP ast (SameLine 1)
#endif
LHsType GhcPs -> TransformT (Either String) (LHsType GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsType GhcPs -> TransformT (Either String) (LHsType GhcPs))
-> LHsType GhcPs -> TransformT (Either String) (LHsType GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsType GhcPs -> LHsType GhcPs
forall a. Located a -> Located a
reLocA (LHsType GhcPs -> LHsType GhcPs) -> LHsType GhcPs -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsType GhcPs -> LHsType GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
lTop (HsType GhcPs -> LHsType GhcPs) -> HsType GhcPs -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ XQualTy GhcPs
-> GenLocated SrcSpan (HsContext GhcPs)
-> LHsType GhcPs
-> HsType GhcPs
forall pass.
XQualTy pass -> LHsContext pass -> LHsType pass -> HsType pass
HsQualTy NoExtField
XQualTy GhcPs
noExtField GenLocated SrcSpan (HsContext GhcPs)
context LHsType GhcPs
ast
liftParseAST
:: forall ast l. (ASTElement l ast, ExactPrint (LocatedAn l ast))
=> DynFlags -> String -> TransformT (Either String) (LocatedAn l ast)
liftParseAST :: DynFlags -> String -> TransformT (Either String) (LocatedAn l ast)
liftParseAST DynFlags
df String
s = case Parser (LocatedAn l ast)
forall l ast. ASTElement l ast => Parser (LocatedAn l ast)
parseAST DynFlags
df String
"" String
s of
#if !MIN_VERSION_ghc(9,2,0)
Right (Anns
anns, LocatedAn l ast
x) -> (Anns -> Anns) -> TransformT (Either String) ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT (Anns
anns Anns -> Anns -> Anns
forall a. Semigroup a => a -> a -> a
<>) TransformT (Either String) ()
-> LocatedAn l ast -> TransformT (Either String) (LocatedAn l ast)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> LocatedAn l ast
x
#else
Right x -> pure (makeDeltaAst x)
#endif
Left ErrorMessages
_ -> Either String (LocatedAn l ast)
-> TransformT (Either String) (LocatedAn l ast)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String (LocatedAn l ast)
-> TransformT (Either String) (LocatedAn l ast))
-> Either String (LocatedAn l ast)
-> TransformT (Either String) (LocatedAn l ast)
forall a b. (a -> b) -> a -> b
$ String -> Either String (LocatedAn l ast)
forall a b. a -> Either a b
Left (String -> Either String (LocatedAn l ast))
-> String -> Either String (LocatedAn l ast)
forall a b. (a -> b) -> a -> b
$ String
"No parse: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s
#if !MIN_VERSION_ghc(9,2,0)
lookupAnn :: (Data a, Monad m)
=> KeywordId -> Located a -> TransformT m (Maybe DeltaPos)
lookupAnn :: KeywordId -> Located a -> TransformT m (Maybe DeltaPos)
lookupAnn KeywordId
comment Located a
la = do
Anns
anns <- TransformT m Anns
forall (m :: * -> *). Monad m => TransformT m Anns
getAnnsT
Maybe DeltaPos -> TransformT m (Maybe DeltaPos)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DeltaPos -> TransformT m (Maybe DeltaPos))
-> Maybe DeltaPos -> TransformT m (Maybe DeltaPos)
forall a b. (a -> b) -> a -> b
$ AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Located a -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey Located a
la) Anns
anns Maybe Annotation
-> (Annotation -> Maybe DeltaPos) -> Maybe DeltaPos
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= KeywordId -> [(KeywordId, DeltaPos)] -> Maybe DeltaPos
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup KeywordId
comment ([(KeywordId, DeltaPos)] -> Maybe DeltaPos)
-> (Annotation -> [(KeywordId, DeltaPos)])
-> Annotation
-> Maybe DeltaPos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotation -> [(KeywordId, DeltaPos)]
annsDP
dp00 :: DeltaPos
dp00 :: DeltaPos
dp00 = (Int, Int) -> DeltaPos
DP (Int
0, Int
0)
transferAnn :: (Data a, Data b) => Located a -> Located b -> (Annotation -> Annotation) -> TransformT (Either String) ()
transferAnn :: Located a
-> Located b
-> (Annotation -> Annotation)
-> TransformT (Either String) ()
transferAnn Located a
la Located b
lb Annotation -> Annotation
f = do
Anns
anns <- TransformT (Either String) Anns
forall (m :: * -> *). Monad m => TransformT m Anns
getAnnsT
let oldKey :: AnnKey
oldKey = Located a -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey Located a
la
newKey :: AnnKey
newKey = Located b -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey Located b
lb
Annotation
oldValue <- String -> Maybe Annotation -> TransformT (Either String) Annotation
forall a. String -> Maybe a -> TransformT (Either String) a
liftMaybe String
"Unable to find ann" (Maybe Annotation -> TransformT (Either String) Annotation)
-> Maybe Annotation -> TransformT (Either String) Annotation
forall a b. (a -> b) -> a -> b
$ AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AnnKey
oldKey Anns
anns
Anns -> TransformT (Either String) ()
forall (m :: * -> *). Monad m => Anns -> TransformT m ()
putAnnsT (Anns -> TransformT (Either String) ())
-> Anns -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$ AnnKey -> Anns -> Anns
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete AnnKey
oldKey (Anns -> Anns) -> Anns -> Anns
forall a b. (a -> b) -> a -> b
$ AnnKey -> Annotation -> Anns -> Anns
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AnnKey
newKey (Annotation -> Annotation
f Annotation
oldValue) Anns
anns
#endif
headMaybe :: [a] -> Maybe a
headMaybe :: [a] -> Maybe a
headMaybe [] = Maybe a
forall a. Maybe a
Nothing
headMaybe (a
a : [a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
lastMaybe :: [a] -> Maybe a
lastMaybe :: [a] -> Maybe a
lastMaybe [] = Maybe a
forall a. Maybe a
Nothing
lastMaybe [a]
other = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall a. [a] -> a
last [a]
other
liftMaybe :: String -> Maybe a -> TransformT (Either String) a
liftMaybe :: String -> Maybe a -> TransformT (Either String) a
liftMaybe String
_ (Just a
x) = a -> TransformT (Either String) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
liftMaybe String
s Maybe a
_ = Either String a -> TransformT (Either String) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String a -> TransformT (Either String) a)
-> Either String a -> TransformT (Either String) a
forall a b. (a -> b) -> a -> b
$ String -> Either String a
forall a b. a -> Either a b
Left String
s
extendImport :: Maybe String -> String -> LImportDecl GhcPs -> Rewrite
extendImport :: Maybe String -> String -> LImportDecl GhcPs -> Rewrite
extendImport Maybe String
mparent String
identifier lDecl :: LImportDecl GhcPs
lDecl@(L SrcSpan
l ImportDecl GhcPs
_) =
SrcSpan
-> (DynFlags -> TransformT (Either String) (LImportDecl GhcPs))
-> Rewrite
forall ast.
Annotate ast =>
SrcSpan
-> (DynFlags -> TransformT (Either String) (Located ast))
-> Rewrite
Rewrite (SrcSpan -> SrcSpan
forall a. a -> a
locA SrcSpan
l) ((DynFlags -> TransformT (Either String) (LImportDecl GhcPs))
-> Rewrite)
-> (DynFlags -> TransformT (Either String) (LImportDecl GhcPs))
-> Rewrite
forall a b. (a -> b) -> a -> b
$ \DynFlags
df -> do
case Maybe String
mparent of
Just String
parent -> DynFlags
-> String
-> String
-> LImportDecl GhcPs
-> TransformT (Either String) (LImportDecl GhcPs)
extendImportViaParent DynFlags
df String
parent String
identifier LImportDecl GhcPs
lDecl
Maybe String
_ -> String
-> LImportDecl GhcPs
-> TransformT (Either String) (LImportDecl GhcPs)
extendImportTopLevel String
identifier LImportDecl GhcPs
lDecl
extendImportTopLevel ::
String ->
LImportDecl GhcPs ->
TransformT (Either String) (LImportDecl GhcPs)
extendImportTopLevel :: String
-> LImportDecl GhcPs
-> TransformT (Either String) (LImportDecl GhcPs)
extendImportTopLevel String
thing (L SrcSpan
l it :: ImportDecl GhcPs
it@ImportDecl{Bool
Maybe (Bool, Located [LIE GhcPs])
Maybe StringLiteral
Maybe (Located ModuleName)
ImportDeclQualifiedStyle
XCImportDecl GhcPs
SourceText
Located ModuleName
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclSourceSrc :: forall pass. ImportDecl pass -> SourceText
ideclName :: forall pass. ImportDecl pass -> Located ModuleName
ideclPkgQual :: forall pass. ImportDecl pass -> Maybe StringLiteral
ideclSource :: forall pass. ImportDecl pass -> Bool
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclImplicit :: forall pass. ImportDecl pass -> Bool
ideclAs :: forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclAs :: Maybe (Located ModuleName)
ideclImplicit :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: Bool
ideclPkgQual :: Maybe StringLiteral
ideclName :: Located ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
..})
| Just (Bool
hide, L SrcSpan
l' [LIE GhcPs]
lies) <- Maybe (Bool, Located [LIE GhcPs])
ideclHiding
, Bool
hasSibling <- Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [LIE GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LIE GhcPs]
lies = do
SrcSpan
src <- TransformT (Either String) SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
SrcSpan
top <- TransformT (Either String) SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
let rdr :: Located RdrName
rdr = Located RdrName -> Located RdrName
forall a. Located a -> Located a
reLocA (Located RdrName -> Located RdrName)
-> Located RdrName -> Located RdrName
forall a b. (a -> b) -> a -> b
$ SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
src (RdrName -> Located RdrName) -> RdrName -> Located RdrName
forall a b. (a -> b) -> a -> b
$ OccName -> RdrName
mkRdrUnqual (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ String -> OccName
mkVarOcc String
thing
let alreadyImported :: Bool
alreadyImported =
OccName -> Text
forall a. Outputable a => a -> Text
showNameWithoutUniques (RdrName -> OccName
forall name. HasOccName name => name -> OccName
occName (Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located RdrName
rdr))
Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (OccName -> Text) -> [OccName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Outputable OccName => OccName -> Text
forall a. Outputable a => a -> Text
showNameWithoutUniques @OccName) ((OccName -> Bool) -> [LIE GhcPs] -> [OccName]
forall r. Typeable r => (r -> Bool) -> GenericQ [r]
listify (Bool -> OccName -> Bool
forall a b. a -> b -> a
const Bool
True) [LIE GhcPs]
lies)
Bool
-> TransformT (Either String) () -> TransformT (Either String) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alreadyImported (TransformT (Either String) () -> TransformT (Either String) ())
-> TransformT (Either String) () -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$
Either String () -> TransformT (Either String) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
thing String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" already imported")
let lie :: Located (IEWrappedName RdrName)
lie = Located (IEWrappedName RdrName) -> Located (IEWrappedName RdrName)
forall a. Located a -> Located a
reLocA (Located (IEWrappedName RdrName)
-> Located (IEWrappedName RdrName))
-> Located (IEWrappedName RdrName)
-> Located (IEWrappedName RdrName)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> IEWrappedName RdrName -> Located (IEWrappedName RdrName)
forall l e. l -> e -> GenLocated l e
L SrcSpan
src (IEWrappedName RdrName -> Located (IEWrappedName RdrName))
-> IEWrappedName RdrName -> Located (IEWrappedName RdrName)
forall a b. (a -> b) -> a -> b
$ Located RdrName -> IEWrappedName RdrName
forall name. Located name -> IEWrappedName name
IEName Located RdrName
rdr
x :: LIE GhcPs
x = LIE GhcPs -> LIE GhcPs
forall a. Located a -> Located a
reLocA (LIE GhcPs -> LIE GhcPs) -> LIE GhcPs -> LIE GhcPs
forall a b. (a -> b) -> a -> b
$ SrcSpan -> IE GhcPs -> LIE GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
top (IE GhcPs -> LIE GhcPs) -> IE GhcPs -> LIE GhcPs
forall a b. (a -> b) -> a -> b
$ XIEVar GhcPs -> LIEWrappedName (IdP GhcPs) -> IE GhcPs
forall pass. XIEVar pass -> LIEWrappedName (IdP pass) -> IE pass
IEVar NoExtField
XIEVar GhcPs
noExtField LIEWrappedName (IdP GhcPs)
Located (IEWrappedName RdrName)
lie
if LIE GhcPs
x LIE GhcPs -> [LIE GhcPs] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [LIE GhcPs]
lies
then Either String (LImportDecl GhcPs)
-> TransformT (Either String) (LImportDecl GhcPs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> Either String (LImportDecl GhcPs)
forall a b. a -> Either a b
Left (String -> Either String (LImportDecl GhcPs))
-> String -> Either String (LImportDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ String
thing String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" already imported")
else do
#if !MIN_VERSION_ghc(9,2,0)
Bool
-> TransformT (Either String) () -> TransformT (Either String) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasSibling (TransformT (Either String) () -> TransformT (Either String) ())
-> TransformT (Either String) () -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$
LIE GhcPs -> TransformT (Either String) ()
forall a (m :: * -> *).
(Data a, Monad m) =>
Located a -> TransformT m ()
addTrailingCommaT ([LIE GhcPs] -> LIE GhcPs
forall a. [a] -> a
last [LIE GhcPs]
lies)
LIE GhcPs
-> DeltaPos
-> [(KeywordId, DeltaPos)]
-> TransformT (Either String) ()
forall a (m :: * -> *).
(Constraints a, Monad m) =>
a -> DeltaPos -> [(KeywordId, DeltaPos)] -> TransformT m ()
addSimpleAnnT LIE GhcPs
x ((Int, Int) -> DeltaPos
DP (Int
0, if Bool
hasSibling then Int
1 else Int
0)) []
Located RdrName
-> DeltaPos
-> [(KeywordId, DeltaPos)]
-> TransformT (Either String) ()
forall a (m :: * -> *).
(Constraints a, Monad m) =>
a -> DeltaPos -> [(KeywordId, DeltaPos)] -> TransformT m ()
addSimpleAnnT Located RdrName
rdr DeltaPos
dp00 [(AnnKeywordId -> KeywordId
G AnnKeywordId
AnnVal, DeltaPos
dp00)]
Bool
-> TransformT (Either String) () -> TransformT (Either String) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hasSibling (TransformT (Either String) () -> TransformT (Either String) ())
-> TransformT (Either String) () -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$
Located [LIE GhcPs]
-> Located [LIE GhcPs]
-> (Annotation -> Annotation)
-> TransformT (Either String) ()
forall a b.
(Data a, Data b) =>
Located a
-> Located b
-> (Annotation -> Annotation)
-> TransformT (Either String) ()
transferAnn (SrcSpan -> [LIE GhcPs] -> Located [LIE GhcPs]
forall l e. l -> e -> GenLocated l e
L SrcSpan
l' [LIE GhcPs]
lies) (SrcSpan -> [LIE GhcPs] -> Located [LIE GhcPs]
forall l e. l -> e -> GenLocated l e
L SrcSpan
l' [LIE GhcPs
x]) Annotation -> Annotation
forall a. a -> a
id
LImportDecl GhcPs -> TransformT (Either String) (LImportDecl GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (LImportDecl GhcPs
-> TransformT (Either String) (LImportDecl GhcPs))
-> LImportDecl GhcPs
-> TransformT (Either String) (LImportDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> ImportDecl GhcPs -> LImportDecl GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l ImportDecl GhcPs
it{ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclHiding = (Bool, Located [LIE GhcPs]) -> Maybe (Bool, Located [LIE GhcPs])
forall a. a -> Maybe a
Just (Bool
hide, SrcSpan -> [LIE GhcPs] -> Located [LIE GhcPs]
forall l e. l -> e -> GenLocated l e
L SrcSpan
l' ([LIE GhcPs] -> Located [LIE GhcPs])
-> [LIE GhcPs] -> Located [LIE GhcPs]
forall a b. (a -> b) -> a -> b
$ [LIE GhcPs]
lies [LIE GhcPs] -> [LIE GhcPs] -> [LIE GhcPs]
forall a. [a] -> [a] -> [a]
++ [LIE GhcPs
x])}
#else
x <- pure $ setEntryDP x (SameLine $ if hasSibling then 1 else 0)
let fixLast = if hasSibling then first addComma else id
lies' = over _last fixLast lies ++ [x]
return $ L l it{ideclHiding = Just (hide, L l' lies')}
#endif
extendImportTopLevel String
_ LImportDecl GhcPs
_ = Either String (LImportDecl GhcPs)
-> TransformT (Either String) (LImportDecl GhcPs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String (LImportDecl GhcPs)
-> TransformT (Either String) (LImportDecl GhcPs))
-> Either String (LImportDecl GhcPs)
-> TransformT (Either String) (LImportDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ String -> Either String (LImportDecl GhcPs)
forall a b. a -> Either a b
Left String
"Unable to extend the import list"
extendImportViaParent ::
DynFlags ->
String ->
String ->
LImportDecl GhcPs ->
TransformT (Either String) (LImportDecl GhcPs)
extendImportViaParent :: DynFlags
-> String
-> String
-> LImportDecl GhcPs
-> TransformT (Either String) (LImportDecl GhcPs)
extendImportViaParent DynFlags
df String
parent String
child (L SrcSpan
l it :: ImportDecl GhcPs
it@ImportDecl{Bool
Maybe (Bool, Located [LIE GhcPs])
Maybe StringLiteral
Maybe (Located ModuleName)
ImportDeclQualifiedStyle
XCImportDecl GhcPs
SourceText
Located ModuleName
ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclAs :: Maybe (Located ModuleName)
ideclImplicit :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: Bool
ideclPkgQual :: Maybe StringLiteral
ideclName :: Located ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclSourceSrc :: forall pass. ImportDecl pass -> SourceText
ideclName :: forall pass. ImportDecl pass -> Located ModuleName
ideclPkgQual :: forall pass. ImportDecl pass -> Maybe StringLiteral
ideclSource :: forall pass. ImportDecl pass -> Bool
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclImplicit :: forall pass. ImportDecl pass -> Bool
ideclAs :: forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
..})
| Just (Bool
hide, L SrcSpan
l' [LIE GhcPs]
lies) <- Maybe (Bool, Located [LIE GhcPs])
ideclHiding = Bool
-> SrcSpan
-> [LIE GhcPs]
-> [LIE GhcPs]
-> TransformT (Either String) (LImportDecl GhcPs)
go Bool
hide SrcSpan
l' [] [LIE GhcPs]
lies
where
go :: Bool
-> SrcSpan
-> [LIE GhcPs]
-> [LIE GhcPs]
-> TransformT (Either String) (LImportDecl GhcPs)
go Bool
_hide SrcSpan
_l' [LIE GhcPs]
_pre ((L SrcSpan
_ll' (IEThingAll XIEThingAll GhcPs
_ (L SrcSpan
_ IEWrappedName (IdP GhcPs)
ie))) : [LIE GhcPs]
_xs)
| String
parent String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== IEWrappedName (IdP GhcPs) -> String
unIEWrappedName IEWrappedName (IdP GhcPs)
ie = Either String (LImportDecl GhcPs)
-> TransformT (Either String) (LImportDecl GhcPs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String (LImportDecl GhcPs)
-> TransformT (Either String) (LImportDecl GhcPs))
-> (String -> Either String (LImportDecl GhcPs))
-> String
-> TransformT (Either String) (LImportDecl GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String (LImportDecl GhcPs)
forall a b. a -> Either a b
Left (String -> TransformT (Either String) (LImportDecl GhcPs))
-> String -> TransformT (Either String) (LImportDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ String
child String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" already included in " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
parent String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" imports"
go Bool
hide SrcSpan
l' [LIE GhcPs]
pre (lAbs :: LIE GhcPs
lAbs@(L SrcSpan
ll' (IEThingAbs XIEThingAbs GhcPs
_ absIE :: LIEWrappedName (IdP GhcPs)
absIE@(L SrcSpan
_ IEWrappedName (IdP GhcPs)
ie))) : [LIE GhcPs]
xs)
| String
parent String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== IEWrappedName (IdP GhcPs) -> String
unIEWrappedName IEWrappedName (IdP GhcPs)
ie = do
SrcSpan
srcChild <- TransformT (Either String) SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
let childRdr :: Located RdrName
childRdr = Located RdrName -> Located RdrName
forall a. Located a -> Located a
reLocA (Located RdrName -> Located RdrName)
-> Located RdrName -> Located RdrName
forall a b. (a -> b) -> a -> b
$ SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
srcChild (RdrName -> Located RdrName) -> RdrName -> Located RdrName
forall a b. (a -> b) -> a -> b
$ OccName -> RdrName
mkRdrUnqual (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ String -> OccName
mkVarOcc String
child
childLIE :: Located (IEWrappedName RdrName)
childLIE = Located (IEWrappedName RdrName) -> Located (IEWrappedName RdrName)
forall a. Located a -> Located a
reLocA (Located (IEWrappedName RdrName)
-> Located (IEWrappedName RdrName))
-> Located (IEWrappedName RdrName)
-> Located (IEWrappedName RdrName)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> IEWrappedName RdrName -> Located (IEWrappedName RdrName)
forall l e. l -> e -> GenLocated l e
L SrcSpan
srcChild (IEWrappedName RdrName -> Located (IEWrappedName RdrName))
-> IEWrappedName RdrName -> Located (IEWrappedName RdrName)
forall a b. (a -> b) -> a -> b
$ Located RdrName -> IEWrappedName RdrName
forall name. Located name -> IEWrappedName name
IEName Located RdrName
childRdr
#if !MIN_VERSION_ghc(9,2,0)
LIE GhcPs
x :: LIE GhcPs = SrcSpan -> IE GhcPs -> LIE GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
ll' (IE GhcPs -> LIE GhcPs) -> IE GhcPs -> LIE GhcPs
forall a b. (a -> b) -> a -> b
$ XIEThingWith GhcPs
-> LIEWrappedName (IdP GhcPs)
-> IEWildcard
-> [LIEWrappedName (IdP GhcPs)]
-> [Located (FieldLbl (IdP GhcPs))]
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> [Located (FieldLbl (IdP pass))]
-> IE pass
IEThingWith NoExtField
XIEThingWith GhcPs
noExtField LIEWrappedName (IdP GhcPs)
absIE IEWildcard
NoIEWildcard [LIEWrappedName (IdP GhcPs)
Located (IEWrappedName RdrName)
childLIE] []
LIE GhcPs
-> LIE GhcPs
-> (Annotation -> Annotation)
-> TransformT (Either String) ()
forall a b.
(Data a, Data b) =>
Located a
-> Located b
-> (Annotation -> Annotation)
-> TransformT (Either String) ()
transferAnn LIE GhcPs
lAbs LIE GhcPs
x ((Annotation -> Annotation) -> TransformT (Either String) ())
-> (Annotation -> Annotation) -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$ \Annotation
old -> Annotation
old{annsDP :: [(KeywordId, DeltaPos)]
annsDP = Annotation -> [(KeywordId, DeltaPos)]
annsDP Annotation
old [(KeywordId, DeltaPos)]
-> [(KeywordId, DeltaPos)] -> [(KeywordId, DeltaPos)]
forall a. [a] -> [a] -> [a]
++ [(AnnKeywordId -> KeywordId
G AnnKeywordId
AnnOpenP, (Int, Int) -> DeltaPos
DP (Int
0, Int
1)), (AnnKeywordId -> KeywordId
G AnnKeywordId
AnnCloseP, DeltaPos
dp00)]}
Located RdrName
-> DeltaPos
-> [(KeywordId, DeltaPos)]
-> TransformT (Either String) ()
forall a (m :: * -> *).
(Constraints a, Monad m) =>
a -> DeltaPos -> [(KeywordId, DeltaPos)] -> TransformT m ()
addSimpleAnnT Located RdrName
childRdr DeltaPos
dp00 [(AnnKeywordId -> KeywordId
G AnnKeywordId
AnnVal, DeltaPos
dp00)]
#else
x :: LIE GhcPs = L ll' $ IEThingWith (addAnns mempty [AddEpAnn AnnOpenP (EpaDelta (SameLine 1) []), AddEpAnn AnnCloseP def] emptyComments) absIE NoIEWildcard [childLIE]
#endif
LImportDecl GhcPs -> TransformT (Either String) (LImportDecl GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (LImportDecl GhcPs
-> TransformT (Either String) (LImportDecl GhcPs))
-> LImportDecl GhcPs
-> TransformT (Either String) (LImportDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> ImportDecl GhcPs -> LImportDecl GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l ImportDecl GhcPs
it{ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclHiding = (Bool, Located [LIE GhcPs]) -> Maybe (Bool, Located [LIE GhcPs])
forall a. a -> Maybe a
Just (Bool
hide, SrcSpan -> [LIE GhcPs] -> Located [LIE GhcPs]
forall l e. l -> e -> GenLocated l e
L SrcSpan
l' ([LIE GhcPs] -> Located [LIE GhcPs])
-> [LIE GhcPs] -> Located [LIE GhcPs]
forall a b. (a -> b) -> a -> b
$ [LIE GhcPs] -> [LIE GhcPs]
forall a. [a] -> [a]
reverse [LIE GhcPs]
pre [LIE GhcPs] -> [LIE GhcPs] -> [LIE GhcPs]
forall a. [a] -> [a] -> [a]
++ [LIE GhcPs
x] [LIE GhcPs] -> [LIE GhcPs] -> [LIE GhcPs]
forall a. [a] -> [a] -> [a]
++ [LIE GhcPs]
xs)}
#if !MIN_VERSION_ghc(9,2,0)
go Bool
hide SrcSpan
l' [LIE GhcPs]
pre ((L SrcSpan
l'' (IEThingWith XIEThingWith GhcPs
_ twIE :: LIEWrappedName (IdP GhcPs)
twIE@(L SrcSpan
_ IEWrappedName (IdP GhcPs)
ie) IEWildcard
_ [LIEWrappedName (IdP GhcPs)]
lies' [Located (FieldLbl (IdP GhcPs))]
_)) : [LIE GhcPs]
xs)
#else
go hide l' pre ((L l'' (IEThingWith l''' twIE@(L _ ie) _ lies')) : xs)
#endif
| String
parent String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== IEWrappedName (IdP GhcPs) -> String
unIEWrappedName IEWrappedName (IdP GhcPs)
ie
, Bool
hasSibling <- Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Located (IEWrappedName RdrName)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LIEWrappedName (IdP GhcPs)]
[Located (IEWrappedName RdrName)]
lies' =
do
SrcSpan
srcChild <- TransformT (Either String) SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
let childRdr :: Located RdrName
childRdr = Located RdrName -> Located RdrName
forall a. Located a -> Located a
reLocA (Located RdrName -> Located RdrName)
-> Located RdrName -> Located RdrName
forall a b. (a -> b) -> a -> b
$ SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
srcChild (RdrName -> Located RdrName) -> RdrName -> Located RdrName
forall a b. (a -> b) -> a -> b
$ OccName -> RdrName
mkRdrUnqual (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ String -> OccName
mkVarOcc String
child
#if MIN_VERSION_ghc(9,2,0)
childRdr <- pure $ setEntryDP childRdr $ SameLine $ if hasSibling then 1 else 0
#endif
let alreadyImported :: Bool
alreadyImported =
OccName -> Text
forall a. Outputable a => a -> Text
showNameWithoutUniques (RdrName -> OccName
forall name. HasOccName name => name -> OccName
occName (Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located RdrName
childRdr))
Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (OccName -> Text) -> [OccName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Outputable OccName => OccName -> Text
forall a. Outputable a => a -> Text
showNameWithoutUniques @OccName) ((OccName -> Bool) -> [Located (IEWrappedName RdrName)] -> [OccName]
forall r. Typeable r => (r -> Bool) -> GenericQ [r]
listify (Bool -> OccName -> Bool
forall a b. a -> b -> a
const Bool
True) [LIEWrappedName (IdP GhcPs)]
[Located (IEWrappedName RdrName)]
lies')
Bool
-> TransformT (Either String) () -> TransformT (Either String) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alreadyImported (TransformT (Either String) () -> TransformT (Either String) ())
-> TransformT (Either String) () -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$
Either String () -> TransformT (Either String) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
child String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" already included in " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
parent String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" imports")
let childLIE :: Located (IEWrappedName RdrName)
childLIE = Located (IEWrappedName RdrName) -> Located (IEWrappedName RdrName)
forall a. Located a -> Located a
reLocA (Located (IEWrappedName RdrName)
-> Located (IEWrappedName RdrName))
-> Located (IEWrappedName RdrName)
-> Located (IEWrappedName RdrName)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> IEWrappedName RdrName -> Located (IEWrappedName RdrName)
forall l e. l -> e -> GenLocated l e
L SrcSpan
srcChild (IEWrappedName RdrName -> Located (IEWrappedName RdrName))
-> IEWrappedName RdrName -> Located (IEWrappedName RdrName)
forall a b. (a -> b) -> a -> b
$ Located RdrName -> IEWrappedName RdrName
forall name. Located name -> IEWrappedName name
IEName Located RdrName
childRdr
#if !MIN_VERSION_ghc(9,2,0)
Bool
-> TransformT (Either String) () -> TransformT (Either String) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasSibling (TransformT (Either String) () -> TransformT (Either String) ())
-> TransformT (Either String) () -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$
Located (IEWrappedName RdrName) -> TransformT (Either String) ()
forall a (m :: * -> *).
(Data a, Monad m) =>
Located a -> TransformT m ()
addTrailingCommaT ([Located (IEWrappedName RdrName)]
-> Located (IEWrappedName RdrName)
forall a. [a] -> a
last [LIEWrappedName (IdP GhcPs)]
[Located (IEWrappedName RdrName)]
lies')
Located RdrName
-> DeltaPos
-> [(KeywordId, DeltaPos)]
-> TransformT (Either String) ()
forall a (m :: * -> *).
(Constraints a, Monad m) =>
a -> DeltaPos -> [(KeywordId, DeltaPos)] -> TransformT m ()
addSimpleAnnT Located RdrName
childRdr ((Int, Int) -> DeltaPos
DP (Int
0, if Bool
hasSibling then Int
1 else Int
0)) [(AnnKeywordId -> KeywordId
G AnnKeywordId
AnnVal, DeltaPos
dp00)]
LImportDecl GhcPs -> TransformT (Either String) (LImportDecl GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (LImportDecl GhcPs
-> TransformT (Either String) (LImportDecl GhcPs))
-> LImportDecl GhcPs
-> TransformT (Either String) (LImportDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> ImportDecl GhcPs -> LImportDecl GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l ImportDecl GhcPs
it{ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclHiding = (Bool, Located [LIE GhcPs]) -> Maybe (Bool, Located [LIE GhcPs])
forall a. a -> Maybe a
Just (Bool
hide, SrcSpan -> [LIE GhcPs] -> Located [LIE GhcPs]
forall l e. l -> e -> GenLocated l e
L SrcSpan
l' ([LIE GhcPs] -> Located [LIE GhcPs])
-> [LIE GhcPs] -> Located [LIE GhcPs]
forall a b. (a -> b) -> a -> b
$ [LIE GhcPs] -> [LIE GhcPs]
forall a. [a] -> [a]
reverse [LIE GhcPs]
pre [LIE GhcPs] -> [LIE GhcPs] -> [LIE GhcPs]
forall a. [a] -> [a] -> [a]
++ [SrcSpan -> IE GhcPs -> LIE GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l'' (XIEThingWith GhcPs
-> LIEWrappedName (IdP GhcPs)
-> IEWildcard
-> [LIEWrappedName (IdP GhcPs)]
-> [Located (FieldLbl (IdP GhcPs))]
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> [Located (FieldLbl (IdP pass))]
-> IE pass
IEThingWith NoExtField
XIEThingWith GhcPs
noExtField LIEWrappedName (IdP GhcPs)
twIE IEWildcard
NoIEWildcard ([LIEWrappedName (IdP GhcPs)]
[Located (IEWrappedName RdrName)]
lies' [Located (IEWrappedName RdrName)]
-> [Located (IEWrappedName RdrName)]
-> [Located (IEWrappedName RdrName)]
forall a. [a] -> [a] -> [a]
++ [Located (IEWrappedName RdrName)
childLIE]) [])] [LIE GhcPs] -> [LIE GhcPs] -> [LIE GhcPs]
forall a. [a] -> [a] -> [a]
++ [LIE GhcPs]
xs)}
#else
let it' = it{ideclHiding = Just (hide, lies)}
lies = L l' $ reverse pre ++
[L l'' (IEThingWith l''' twIE NoIEWildcard (over _last fixLast lies' ++ [childLIE]))] ++ xs
fixLast = if hasSibling then first addComma else id
return $ if hasSibling
then L l it'
else L l it'
#endif
go Bool
hide SrcSpan
l' [LIE GhcPs]
pre (LIE GhcPs
x : [LIE GhcPs]
xs) = Bool
-> SrcSpan
-> [LIE GhcPs]
-> [LIE GhcPs]
-> TransformT (Either String) (LImportDecl GhcPs)
go Bool
hide SrcSpan
l' (LIE GhcPs
x LIE GhcPs -> [LIE GhcPs] -> [LIE GhcPs]
forall a. a -> [a] -> [a]
: [LIE GhcPs]
pre) [LIE GhcPs]
xs
go Bool
hide SrcSpan
l' [LIE GhcPs]
pre []
| Bool
hasSibling <- Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [LIE GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LIE GhcPs]
pre = do
SrcSpan
l'' <- TransformT (Either String) SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
SrcSpan
srcParent <- TransformT (Either String) SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
SrcSpan
srcChild <- TransformT (Either String) SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
Located RdrName
parentRdr <- DynFlags -> String -> TransformT (Either String) (Located RdrName)
forall ast l.
(ASTElement l ast, ExactPrint (LocatedAn l ast)) =>
DynFlags -> String -> TransformT (Either String) (LocatedAn l ast)
liftParseAST DynFlags
df String
parent
let childRdr :: Located RdrName
childRdr = Located RdrName -> Located RdrName
forall a. Located a -> Located a
reLocA (Located RdrName -> Located RdrName)
-> Located RdrName -> Located RdrName
forall a b. (a -> b) -> a -> b
$ SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
srcChild (RdrName -> Located RdrName) -> RdrName -> Located RdrName
forall a b. (a -> b) -> a -> b
$ OccName -> RdrName
mkRdrUnqual (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ String -> OccName
mkVarOcc String
child
isParentOperator :: Bool
isParentOperator = String -> Bool
hasParen String
parent
#if !MIN_VERSION_ghc(9,2,0)
Bool
-> TransformT (Either String) () -> TransformT (Either String) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasSibling (TransformT (Either String) () -> TransformT (Either String) ())
-> TransformT (Either String) () -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$
LIE GhcPs -> TransformT (Either String) ()
forall a (m :: * -> *).
(Data a, Monad m) =>
Located a -> TransformT m ()
addTrailingCommaT ([LIE GhcPs] -> LIE GhcPs
forall a. [a] -> a
head [LIE GhcPs]
pre)
let parentLIE :: Located (IEWrappedName RdrName)
parentLIE = SrcSpan -> IEWrappedName RdrName -> Located (IEWrappedName RdrName)
forall l e. l -> e -> GenLocated l e
L SrcSpan
srcParent (if Bool
isParentOperator then Located RdrName -> IEWrappedName RdrName
forall name. Located name -> IEWrappedName name
IEType Located RdrName
parentRdr else Located RdrName -> IEWrappedName RdrName
forall name. Located name -> IEWrappedName name
IEName Located RdrName
parentRdr)
childLIE :: Located (IEWrappedName RdrName)
childLIE = Located (IEWrappedName RdrName) -> Located (IEWrappedName RdrName)
forall a. Located a -> Located a
reLocA (Located (IEWrappedName RdrName)
-> Located (IEWrappedName RdrName))
-> Located (IEWrappedName RdrName)
-> Located (IEWrappedName RdrName)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> IEWrappedName RdrName -> Located (IEWrappedName RdrName)
forall l e. l -> e -> GenLocated l e
L SrcSpan
srcChild (IEWrappedName RdrName -> Located (IEWrappedName RdrName))
-> IEWrappedName RdrName -> Located (IEWrappedName RdrName)
forall a b. (a -> b) -> a -> b
$ Located RdrName -> IEWrappedName RdrName
forall name. Located name -> IEWrappedName name
IEName Located RdrName
childRdr
#else
let parentLIE = reLocA $ L srcParent $ (if isParentOperator then IEType (epl 0) parentRdr' else IEName parentRdr')
parentRdr' = modifyAnns parentRdr $ \case
it@NameAnn{nann_adornment = NameParens} -> it{nann_open = epl 1}
other -> other
childLIE = reLocA $ L srcChild $ IEName childRdr
#endif
#if !MIN_VERSION_ghc(9,2,0)
LIE GhcPs
x :: LIE GhcPs = LIE GhcPs -> LIE GhcPs
forall a. Located a -> Located a
reLocA (LIE GhcPs -> LIE GhcPs) -> LIE GhcPs -> LIE GhcPs
forall a b. (a -> b) -> a -> b
$ SrcSpan -> IE GhcPs -> LIE GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l'' (IE GhcPs -> LIE GhcPs) -> IE GhcPs -> LIE GhcPs
forall a b. (a -> b) -> a -> b
$ XIEThingWith GhcPs
-> LIEWrappedName (IdP GhcPs)
-> IEWildcard
-> [LIEWrappedName (IdP GhcPs)]
-> [Located (FieldLbl (IdP GhcPs))]
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> [Located (FieldLbl (IdP pass))]
-> IE pass
IEThingWith NoExtField
XIEThingWith GhcPs
noExtField LIEWrappedName (IdP GhcPs)
Located (IEWrappedName RdrName)
parentLIE IEWildcard
NoIEWildcard [LIEWrappedName (IdP GhcPs)
Located (IEWrappedName RdrName)
childLIE] []
Bool
-> TransformT (Either String) () -> TransformT (Either String) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isParentOperator (TransformT (Either String) () -> TransformT (Either String) ())
-> TransformT (Either String) () -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$
Located (IEWrappedName RdrName)
-> DeltaPos
-> [(KeywordId, DeltaPos)]
-> TransformT (Either String) ()
forall a (m :: * -> *).
(Constraints a, Monad m) =>
a -> DeltaPos -> [(KeywordId, DeltaPos)] -> TransformT m ()
addSimpleAnnT Located (IEWrappedName RdrName)
parentLIE ((Int, Int) -> DeltaPos
DP (Int
0, Int
0)) [(AnnKeywordId -> KeywordId
G AnnKeywordId
AnnType, (Int, Int) -> DeltaPos
DP (Int
0, Int
0))]
Located RdrName
-> DeltaPos
-> [(KeywordId, DeltaPos)]
-> TransformT (Either String) ()
forall a (m :: * -> *).
(Constraints a, Monad m) =>
a -> DeltaPos -> [(KeywordId, DeltaPos)] -> TransformT m ()
addSimpleAnnT Located RdrName
parentRdr ((Int, Int) -> DeltaPos
DP (Int
0, if Bool
hasSibling then Int
1 else Int
0)) ([(KeywordId, DeltaPos)] -> TransformT (Either String) ())
-> [(KeywordId, DeltaPos)] -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [(KeywordId, DeltaPos)]
unqalDP Int
1 Bool
isParentOperator
Located RdrName
-> DeltaPos
-> [(KeywordId, DeltaPos)]
-> TransformT (Either String) ()
forall a (m :: * -> *).
(Constraints a, Monad m) =>
a -> DeltaPos -> [(KeywordId, DeltaPos)] -> TransformT m ()
addSimpleAnnT Located RdrName
childRdr ((Int, Int) -> DeltaPos
DP (Int
0, Int
0)) [(AnnKeywordId -> KeywordId
G AnnKeywordId
AnnVal, DeltaPos
dp00)]
LIE GhcPs
-> DeltaPos
-> [(KeywordId, DeltaPos)]
-> TransformT (Either String) ()
forall a (m :: * -> *).
(Constraints a, Monad m) =>
a -> DeltaPos -> [(KeywordId, DeltaPos)] -> TransformT m ()
addSimpleAnnT LIE GhcPs
x ((Int, Int) -> DeltaPos
DP (Int
0, Int
0)) [(AnnKeywordId -> KeywordId
G AnnKeywordId
AnnOpenP, (Int, Int) -> DeltaPos
DP (Int
0, Int
1)), (AnnKeywordId -> KeywordId
G AnnKeywordId
AnnCloseP, (Int, Int) -> DeltaPos
DP (Int
0, Int
0))]
Bool
-> TransformT (Either String) () -> TransformT (Either String) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hasSibling (TransformT (Either String) () -> TransformT (Either String) ())
-> TransformT (Either String) () -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$
Located [LIE GhcPs]
-> Located [LIE GhcPs]
-> (Annotation -> Annotation)
-> TransformT (Either String) ()
forall a b.
(Data a, Data b) =>
Located a
-> Located b
-> (Annotation -> Annotation)
-> TransformT (Either String) ()
transferAnn (SrcSpan -> [LIE GhcPs] -> Located [LIE GhcPs]
forall l e. l -> e -> GenLocated l e
L SrcSpan
l' ([LIE GhcPs] -> Located [LIE GhcPs])
-> [LIE GhcPs] -> Located [LIE GhcPs]
forall a b. (a -> b) -> a -> b
$ [LIE GhcPs] -> [LIE GhcPs]
forall a. [a] -> [a]
reverse [LIE GhcPs]
pre) (SrcSpan -> [LIE GhcPs] -> Located [LIE GhcPs]
forall l e. l -> e -> GenLocated l e
L SrcSpan
l' [LIE GhcPs
x]) Annotation -> Annotation
forall a. a -> a
id
#else
x :: LIE GhcPs = reLocA $ L l'' $ IEThingWith listAnn parentLIE NoIEWildcard [childLIE]
listAnn = epAnn srcParent [AddEpAnn AnnOpenP (epl 1), AddEpAnn AnnCloseP (epl 0)]
#endif
LImportDecl GhcPs -> TransformT (Either String) (LImportDecl GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (LImportDecl GhcPs
-> TransformT (Either String) (LImportDecl GhcPs))
-> LImportDecl GhcPs
-> TransformT (Either String) (LImportDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> ImportDecl GhcPs -> LImportDecl GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l ImportDecl GhcPs
it{ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclHiding = (Bool, Located [LIE GhcPs]) -> Maybe (Bool, Located [LIE GhcPs])
forall a. a -> Maybe a
Just (Bool
hide, SrcSpan -> [LIE GhcPs] -> Located [LIE GhcPs]
forall l e. l -> e -> GenLocated l e
L SrcSpan
l' ([LIE GhcPs] -> Located [LIE GhcPs])
-> [LIE GhcPs] -> Located [LIE GhcPs]
forall a b. (a -> b) -> a -> b
$ [LIE GhcPs] -> [LIE GhcPs]
forall a. [a] -> [a]
reverse [LIE GhcPs]
pre [LIE GhcPs] -> [LIE GhcPs] -> [LIE GhcPs]
forall a. [a] -> [a] -> [a]
++ [LIE GhcPs
x])}
extendImportViaParent DynFlags
_ String
_ String
_ LImportDecl GhcPs
_ = Either String (LImportDecl GhcPs)
-> TransformT (Either String) (LImportDecl GhcPs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String (LImportDecl GhcPs)
-> TransformT (Either String) (LImportDecl GhcPs))
-> Either String (LImportDecl GhcPs)
-> TransformT (Either String) (LImportDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ String -> Either String (LImportDecl GhcPs)
forall a b. a -> Either a b
Left String
"Unable to extend the import list via parent"
unIEWrappedName :: IEWrappedName (IdP GhcPs) -> String
unIEWrappedName :: IEWrappedName (IdP GhcPs) -> String
unIEWrappedName (IEWrappedName (IdP GhcPs) -> OccName
forall name. HasOccName name => name -> OccName
occName -> OccName
occ) = SDoc -> String
showSDocUnsafe (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ OccName -> SDoc -> SDoc
parenSymOcc OccName
occ (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ)
hasParen :: String -> Bool
hasParen :: String -> Bool
hasParen (Char
'(' : String
_) = Bool
True
hasParen String
_ = Bool
False
#if !MIN_VERSION_ghc(9,2,0)
unqalDP :: Int -> Bool -> [(KeywordId, DeltaPos)]
unqalDP :: Int -> Bool -> [(KeywordId, DeltaPos)]
unqalDP Int
c Bool
paren =
( if Bool
paren
then \(KeywordId, DeltaPos)
x -> (AnnKeywordId -> KeywordId
G AnnKeywordId
AnnOpenP, (Int, Int) -> DeltaPos
DP (Int
0, Int
c)) (KeywordId, DeltaPos)
-> [(KeywordId, DeltaPos)] -> [(KeywordId, DeltaPos)]
forall a. a -> [a] -> [a]
: (KeywordId, DeltaPos)
x (KeywordId, DeltaPos)
-> [(KeywordId, DeltaPos)] -> [(KeywordId, DeltaPos)]
forall a. a -> [a] -> [a]
: [(AnnKeywordId -> KeywordId
G AnnKeywordId
AnnCloseP, DeltaPos
dp00)]
else (KeywordId, DeltaPos) -> [(KeywordId, DeltaPos)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
)
(AnnKeywordId -> KeywordId
G AnnKeywordId
AnnVal, DeltaPos
dp00)
#endif
hideSymbol ::
String -> LImportDecl GhcPs -> Rewrite
hideSymbol :: String -> LImportDecl GhcPs -> Rewrite
hideSymbol String
symbol lidecl :: LImportDecl GhcPs
lidecl@(L SrcSpan
loc ImportDecl{Bool
Maybe (Bool, Located [LIE GhcPs])
Maybe StringLiteral
Maybe (Located ModuleName)
ImportDeclQualifiedStyle
XCImportDecl GhcPs
SourceText
Located ModuleName
ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclAs :: Maybe (Located ModuleName)
ideclImplicit :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: Bool
ideclPkgQual :: Maybe StringLiteral
ideclName :: Located ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclSourceSrc :: forall pass. ImportDecl pass -> SourceText
ideclName :: forall pass. ImportDecl pass -> Located ModuleName
ideclPkgQual :: forall pass. ImportDecl pass -> Maybe StringLiteral
ideclSource :: forall pass. ImportDecl pass -> Bool
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclImplicit :: forall pass. ImportDecl pass -> Bool
ideclAs :: forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
..}) =
case Maybe (Bool, Located [LIE GhcPs])
ideclHiding of
Maybe (Bool, Located [LIE GhcPs])
Nothing -> SrcSpan
-> (DynFlags -> TransformT (Either String) (LImportDecl GhcPs))
-> Rewrite
forall ast.
Annotate ast =>
SrcSpan
-> (DynFlags -> TransformT (Either String) (Located ast))
-> Rewrite
Rewrite (SrcSpan -> SrcSpan
forall a. a -> a
locA SrcSpan
loc) ((DynFlags -> TransformT (Either String) (LImportDecl GhcPs))
-> Rewrite)
-> (DynFlags -> TransformT (Either String) (LImportDecl GhcPs))
-> Rewrite
forall a b. (a -> b) -> a -> b
$ String
-> LImportDecl GhcPs
-> Maybe (Located [LIE GhcPs])
-> DynFlags
-> TransformT (Either String) (LImportDecl GhcPs)
extendHiding String
symbol LImportDecl GhcPs
lidecl Maybe (Located [LIE GhcPs])
forall a. Maybe a
Nothing
Just (Bool
True, Located [LIE GhcPs]
hides) -> SrcSpan
-> (DynFlags -> TransformT (Either String) (LImportDecl GhcPs))
-> Rewrite
forall ast.
Annotate ast =>
SrcSpan
-> (DynFlags -> TransformT (Either String) (Located ast))
-> Rewrite
Rewrite (SrcSpan -> SrcSpan
forall a. a -> a
locA SrcSpan
loc) ((DynFlags -> TransformT (Either String) (LImportDecl GhcPs))
-> Rewrite)
-> (DynFlags -> TransformT (Either String) (LImportDecl GhcPs))
-> Rewrite
forall a b. (a -> b) -> a -> b
$ String
-> LImportDecl GhcPs
-> Maybe (Located [LIE GhcPs])
-> DynFlags
-> TransformT (Either String) (LImportDecl GhcPs)
extendHiding String
symbol LImportDecl GhcPs
lidecl (Located [LIE GhcPs] -> Maybe (Located [LIE GhcPs])
forall a. a -> Maybe a
Just Located [LIE GhcPs]
hides)
Just (Bool
False, Located [LIE GhcPs]
imports) -> SrcSpan
-> (DynFlags -> TransformT (Either String) (LImportDecl GhcPs))
-> Rewrite
forall ast.
Annotate ast =>
SrcSpan
-> (DynFlags -> TransformT (Either String) (Located ast))
-> Rewrite
Rewrite (SrcSpan -> SrcSpan
forall a. a -> a
locA SrcSpan
loc) ((DynFlags -> TransformT (Either String) (LImportDecl GhcPs))
-> Rewrite)
-> (DynFlags -> TransformT (Either String) (LImportDecl GhcPs))
-> Rewrite
forall a b. (a -> b) -> a -> b
$ String
-> LImportDecl GhcPs
-> Located [LIE GhcPs]
-> DynFlags
-> TransformT (Either String) (LImportDecl GhcPs)
deleteFromImport String
symbol LImportDecl GhcPs
lidecl Located [LIE GhcPs]
imports
hideSymbol String
_ (L SrcSpan
_ (XImportDecl XXImportDecl GhcPs
_)) =
String -> Rewrite
forall a. HasCallStack => String -> a
error String
"cannot happen"
extendHiding ::
String ->
LImportDecl GhcPs ->
#if !MIN_VERSION_ghc(9,2,0)
Maybe (Located [LIE GhcPs]) ->
#else
Maybe (XRec GhcPs [LIE GhcPs]) ->
#endif
DynFlags ->
TransformT (Either String) (LImportDecl GhcPs)
extendHiding :: String
-> LImportDecl GhcPs
-> Maybe (Located [LIE GhcPs])
-> DynFlags
-> TransformT (Either String) (LImportDecl GhcPs)
extendHiding String
symbol (L SrcSpan
l ImportDecl GhcPs
idecls) Maybe (Located [LIE GhcPs])
mlies DynFlags
df = do
L SrcSpan
l' [LIE GhcPs]
lies <- case Maybe (Located [LIE GhcPs])
mlies of
#if !MIN_VERSION_ghc(9,2,0)
Maybe (Located [LIE GhcPs])
Nothing -> (SrcSpan -> [LIE GhcPs] -> Located [LIE GhcPs])
-> [LIE GhcPs] -> SrcSpan -> Located [LIE GhcPs]
forall a b c. (a -> b -> c) -> b -> a -> c
flip SrcSpan -> [LIE GhcPs] -> Located [LIE GhcPs]
forall l e. l -> e -> GenLocated l e
L [] (SrcSpan -> Located [LIE GhcPs])
-> TransformT (Either String) SrcSpan
-> TransformT (Either String) (Located [LIE GhcPs])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TransformT (Either String) SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
#else
Nothing -> do
src <- uniqueSrcSpanT
let ann = noAnnSrcSpanDP0 src
ann' = flip (fmap.fmap) ann $ \x -> x
{al_rest = [AddEpAnn AnnHiding (epl 1)]
,al_open = Just $ AddEpAnn AnnOpenP (epl 1)
,al_close = Just $ AddEpAnn AnnCloseP (epl 0)
}
return $ L ann' []
#endif
Just Located [LIE GhcPs]
pr -> Located [LIE GhcPs]
-> TransformT (Either String) (Located [LIE GhcPs])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Located [LIE GhcPs]
pr
let hasSibling :: Bool
hasSibling = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [LIE GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LIE GhcPs]
lies
SrcSpan
src <- TransformT (Either String) SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
SrcSpan
top <- TransformT (Either String) SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
Located RdrName
rdr <- DynFlags -> String -> TransformT (Either String) (Located RdrName)
forall ast l.
(ASTElement l ast, ExactPrint (LocatedAn l ast)) =>
DynFlags -> String -> TransformT (Either String) (LocatedAn l ast)
liftParseAST DynFlags
df String
symbol
#if MIN_VERSION_ghc(9,2,0)
rdr <- pure $ modifyAnns rdr $ addParens (isOperator $ unLoc rdr)
#endif
let lie :: Located (IEWrappedName RdrName)
lie = Located (IEWrappedName RdrName) -> Located (IEWrappedName RdrName)
forall a. Located a -> Located a
reLocA (Located (IEWrappedName RdrName)
-> Located (IEWrappedName RdrName))
-> Located (IEWrappedName RdrName)
-> Located (IEWrappedName RdrName)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> IEWrappedName RdrName -> Located (IEWrappedName RdrName)
forall l e. l -> e -> GenLocated l e
L SrcSpan
src (IEWrappedName RdrName -> Located (IEWrappedName RdrName))
-> IEWrappedName RdrName -> Located (IEWrappedName RdrName)
forall a b. (a -> b) -> a -> b
$ Located RdrName -> IEWrappedName RdrName
forall name. Located name -> IEWrappedName name
IEName Located RdrName
rdr
x :: LIE GhcPs
x = LIE GhcPs -> LIE GhcPs
forall a. Located a -> Located a
reLocA (LIE GhcPs -> LIE GhcPs) -> LIE GhcPs -> LIE GhcPs
forall a b. (a -> b) -> a -> b
$ SrcSpan -> IE GhcPs -> LIE GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
top (IE GhcPs -> LIE GhcPs) -> IE GhcPs -> LIE GhcPs
forall a b. (a -> b) -> a -> b
$ XIEVar GhcPs -> LIEWrappedName (IdP GhcPs) -> IE GhcPs
forall pass. XIEVar pass -> LIEWrappedName (IdP pass) -> IE pass
IEVar NoExtField
XIEVar GhcPs
noExtField LIEWrappedName (IdP GhcPs)
Located (IEWrappedName RdrName)
lie
#if MIN_VERSION_ghc(9,2,0)
x <- pure $ if hasSibling then first addComma x else x
lies <- pure $ over _head (`setEntryDP` SameLine 1) lies
#endif
#if !MIN_VERSION_ghc(9,2,0)
singleHide :: Located [LIE GhcPs]
singleHide = SrcSpan -> [LIE GhcPs] -> Located [LIE GhcPs]
forall l e. l -> e -> GenLocated l e
L SrcSpan
l' [LIE GhcPs
x]
Bool
-> TransformT (Either String) () -> TransformT (Either String) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Located [LIE GhcPs]) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (Located [LIE GhcPs])
mlies) (TransformT (Either String) () -> TransformT (Either String) ())
-> TransformT (Either String) () -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$ do
Located [LIE GhcPs]
-> DeltaPos
-> [(KeywordId, DeltaPos)]
-> TransformT (Either String) ()
forall a (m :: * -> *).
(Constraints a, Monad m) =>
a -> DeltaPos -> [(KeywordId, DeltaPos)] -> TransformT m ()
addSimpleAnnT
Located [LIE GhcPs]
singleHide
DeltaPos
dp00
[ (AnnKeywordId -> KeywordId
G AnnKeywordId
AnnHiding, (Int, Int) -> DeltaPos
DP (Int
0, Int
1))
, (AnnKeywordId -> KeywordId
G AnnKeywordId
AnnOpenP, (Int, Int) -> DeltaPos
DP (Int
0, Int
1))
, (AnnKeywordId -> KeywordId
G AnnKeywordId
AnnCloseP, (Int, Int) -> DeltaPos
DP (Int
0, Int
0))
]
LIE GhcPs
-> DeltaPos
-> [(KeywordId, DeltaPos)]
-> TransformT (Either String) ()
forall a (m :: * -> *).
(Constraints a, Monad m) =>
a -> DeltaPos -> [(KeywordId, DeltaPos)] -> TransformT m ()
addSimpleAnnT LIE GhcPs
x ((Int, Int) -> DeltaPos
DP (Int
0, Int
0)) []
Located RdrName
-> DeltaPos
-> [(KeywordId, DeltaPos)]
-> TransformT (Either String) ()
forall a (m :: * -> *).
(Constraints a, Monad m) =>
a -> DeltaPos -> [(KeywordId, DeltaPos)] -> TransformT m ()
addSimpleAnnT Located RdrName
rdr DeltaPos
dp00 ([(KeywordId, DeltaPos)] -> TransformT (Either String) ())
-> [(KeywordId, DeltaPos)] -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [(KeywordId, DeltaPos)]
unqalDP Int
0 (Bool -> [(KeywordId, DeltaPos)])
-> Bool -> [(KeywordId, DeltaPos)]
forall a b. (a -> b) -> a -> b
$ RdrName -> Bool
isOperator (RdrName -> Bool) -> RdrName -> Bool
forall a b. (a -> b) -> a -> b
$ Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located RdrName
rdr
if Bool
hasSibling
then do
LIE GhcPs -> TransformT (Either String) ()
forall a (m :: * -> *).
(Data a, Monad m) =>
Located a -> TransformT m ()
addTrailingCommaT LIE GhcPs
x
LIE GhcPs
-> DeltaPos
-> [(KeywordId, DeltaPos)]
-> TransformT (Either String) ()
forall a (m :: * -> *).
(Constraints a, Monad m) =>
a -> DeltaPos -> [(KeywordId, DeltaPos)] -> TransformT m ()
addSimpleAnnT ([LIE GhcPs] -> LIE GhcPs
forall a. [a] -> a
head [LIE GhcPs]
lies) ((Int, Int) -> DeltaPos
DP (Int
0, Int
1)) []
Bool
-> TransformT (Either String) () -> TransformT (Either String) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LIE GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([LIE GhcPs] -> Bool) -> [LIE GhcPs] -> Bool
forall a b. (a -> b) -> a -> b
$ [LIE GhcPs] -> [LIE GhcPs]
forall a. [a] -> [a]
tail [LIE GhcPs]
lies) (TransformT (Either String) () -> TransformT (Either String) ())
-> TransformT (Either String) () -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$
LIE GhcPs -> TransformT (Either String) ()
forall a (m :: * -> *).
(Data a, Monad m) =>
Located a -> TransformT m ()
addTrailingCommaT ([LIE GhcPs] -> LIE GhcPs
forall a. [a] -> a
head [LIE GhcPs]
lies)
else Maybe (Located [LIE GhcPs])
-> (Located [LIE GhcPs] -> TransformT (Either String) ())
-> TransformT (Either String) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Located [LIE GhcPs])
mlies ((Located [LIE GhcPs] -> TransformT (Either String) ())
-> TransformT (Either String) ())
-> (Located [LIE GhcPs] -> TransformT (Either String) ())
-> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$ \Located [LIE GhcPs]
lies0 -> do
Located [LIE GhcPs]
-> Located [LIE GhcPs]
-> (Annotation -> Annotation)
-> TransformT (Either String) ()
forall a b.
(Data a, Data b) =>
Located a
-> Located b
-> (Annotation -> Annotation)
-> TransformT (Either String) ()
transferAnn Located [LIE GhcPs]
lies0 Located [LIE GhcPs]
singleHide Annotation -> Annotation
forall a. a -> a
id
#endif
LImportDecl GhcPs -> TransformT (Either String) (LImportDecl GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (LImportDecl GhcPs
-> TransformT (Either String) (LImportDecl GhcPs))
-> LImportDecl GhcPs
-> TransformT (Either String) (LImportDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> ImportDecl GhcPs -> LImportDecl GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l ImportDecl GhcPs
idecls{ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclHiding = (Bool, Located [LIE GhcPs]) -> Maybe (Bool, Located [LIE GhcPs])
forall a. a -> Maybe a
Just (Bool
True, SrcSpan -> [LIE GhcPs] -> Located [LIE GhcPs]
forall l e. l -> e -> GenLocated l e
L SrcSpan
l' ([LIE GhcPs] -> Located [LIE GhcPs])
-> [LIE GhcPs] -> Located [LIE GhcPs]
forall a b. (a -> b) -> a -> b
$ LIE GhcPs
x LIE GhcPs -> [LIE GhcPs] -> [LIE GhcPs]
forall a. a -> [a] -> [a]
: [LIE GhcPs]
lies)}
where
isOperator :: RdrName -> Bool
isOperator = Bool -> Bool
not (Bool -> Bool) -> (RdrName -> Bool) -> RdrName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAlphaNum (String -> Bool) -> (RdrName -> String) -> RdrName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> String
occNameString (OccName -> String) -> (RdrName -> OccName) -> RdrName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc
deleteFromImport ::
String ->
LImportDecl GhcPs ->
#if !MIN_VERSION_ghc(9,2,0)
Located [LIE GhcPs] ->
#else
XRec GhcPs [LIE GhcPs] ->
#endif
DynFlags ->
TransformT (Either String) (LImportDecl GhcPs)
deleteFromImport :: String
-> LImportDecl GhcPs
-> Located [LIE GhcPs]
-> DynFlags
-> TransformT (Either String) (LImportDecl GhcPs)
deleteFromImport (String -> Text
T.pack -> Text
symbol) (L SrcSpan
l ImportDecl GhcPs
idecl) llies :: Located [LIE GhcPs]
llies@(L SrcSpan
lieLoc [LIE GhcPs]
lies) DynFlags
_ = do
let edited :: Located [LIE GhcPs]
edited = SrcSpan -> [LIE GhcPs] -> Located [LIE GhcPs]
forall l e. l -> e -> GenLocated l e
L SrcSpan
lieLoc [LIE GhcPs]
deletedLies
lidecl' :: LImportDecl GhcPs
lidecl' =
SrcSpan -> ImportDecl GhcPs -> LImportDecl GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (ImportDecl GhcPs -> LImportDecl GhcPs)
-> ImportDecl GhcPs -> LImportDecl GhcPs
forall a b. (a -> b) -> a -> b
$
ImportDecl GhcPs
idecl
{ ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclHiding = (Bool, Located [LIE GhcPs]) -> Maybe (Bool, Located [LIE GhcPs])
forall a. a -> Maybe a
Just (Bool
False, Located [LIE GhcPs]
edited)
}
#if !MIN_VERSION_ghc(9,2,0)
Maybe (LIE GhcPs)
-> (LIE GhcPs -> TransformT (Either String) ())
-> TransformT (Either String) ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust ([LIE GhcPs] -> Maybe (LIE GhcPs)
forall a. [a] -> Maybe a
lastMaybe [LIE GhcPs]
deletedLies) LIE GhcPs -> TransformT (Either String) ()
forall a (m :: * -> *).
(Data a, Monad m) =>
Located a -> TransformT m ()
removeTrailingCommaT
Bool
-> TransformT (Either String) () -> TransformT (Either String) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([LIE GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LIE GhcPs]
lies) Bool -> Bool -> Bool
&& [LIE GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LIE GhcPs]
deletedLies) (TransformT (Either String) () -> TransformT (Either String) ())
-> TransformT (Either String) () -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$ do
Located [LIE GhcPs]
-> Located [LIE GhcPs]
-> (Annotation -> Annotation)
-> TransformT (Either String) ()
forall a b.
(Data a, Data b) =>
Located a
-> Located b
-> (Annotation -> Annotation)
-> TransformT (Either String) ()
transferAnn Located [LIE GhcPs]
llies Located [LIE GhcPs]
edited Annotation -> Annotation
forall a. a -> a
id
Located [LIE GhcPs]
-> DeltaPos
-> [(KeywordId, DeltaPos)]
-> TransformT (Either String) ()
forall a (m :: * -> *).
(Constraints a, Monad m) =>
a -> DeltaPos -> [(KeywordId, DeltaPos)] -> TransformT m ()
addSimpleAnnT
Located [LIE GhcPs]
edited
DeltaPos
dp00
[ (AnnKeywordId -> KeywordId
G AnnKeywordId
AnnOpenP, (Int, Int) -> DeltaPos
DP (Int
0, Int
1))
, (AnnKeywordId -> KeywordId
G AnnKeywordId
AnnCloseP, (Int, Int) -> DeltaPos
DP (Int
0, Int
0))
]
#endif
LImportDecl GhcPs -> TransformT (Either String) (LImportDecl GhcPs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure LImportDecl GhcPs
lidecl'
where
deletedLies :: [LIE GhcPs]
deletedLies =
#if MIN_VERSION_ghc(9,2,0)
over _last removeTrailingComma $
#endif
(LIE GhcPs -> Maybe (LIE GhcPs)) -> [LIE GhcPs] -> [LIE GhcPs]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LIE GhcPs -> Maybe (LIE GhcPs)
killLie [LIE GhcPs]
lies
killLie :: LIE GhcPs -> Maybe (LIE GhcPs)
killLie :: LIE GhcPs -> Maybe (LIE GhcPs)
killLie v :: LIE GhcPs
v@(L SrcSpan
_ (IEVar XIEVar GhcPs
_ (L SrcSpan
_ (IEWrappedName (IdP GhcPs) -> Text
IEWrappedName RdrName -> Text
unqualIEWrapName -> Text
nam))))
| Text
nam Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
symbol = Maybe (LIE GhcPs)
forall a. Maybe a
Nothing
| Bool
otherwise = LIE GhcPs -> Maybe (LIE GhcPs)
forall a. a -> Maybe a
Just LIE GhcPs
v
killLie v :: LIE GhcPs
v@(L SrcSpan
_ (IEThingAbs XIEThingAbs GhcPs
_ (L SrcSpan
_ (IEWrappedName (IdP GhcPs) -> Text
IEWrappedName RdrName -> Text
unqualIEWrapName -> Text
nam))))
| Text
nam Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
symbol = Maybe (LIE GhcPs)
forall a. Maybe a
Nothing
| Bool
otherwise = LIE GhcPs -> Maybe (LIE GhcPs)
forall a. a -> Maybe a
Just LIE GhcPs
v
#if !MIN_VERSION_ghc(9,2,0)
killLie (L SrcSpan
lieL (IEThingWith XIEThingWith GhcPs
xt ty :: LIEWrappedName (IdP GhcPs)
ty@(L SrcSpan
_ (IEWrappedName (IdP GhcPs) -> Text
IEWrappedName RdrName -> Text
unqualIEWrapName -> Text
nam)) IEWildcard
wild [LIEWrappedName (IdP GhcPs)]
cons [Located (FieldLbl (IdP GhcPs))]
flds))
#else
killLie (L lieL (IEThingWith xt ty@(L _ (unqualIEWrapName -> nam)) wild cons))
#endif
| Text
nam Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
symbol = Maybe (LIE GhcPs)
forall a. Maybe a
Nothing
| Bool
otherwise =
LIE GhcPs -> Maybe (LIE GhcPs)
forall a. a -> Maybe a
Just (LIE GhcPs -> Maybe (LIE GhcPs)) -> LIE GhcPs -> Maybe (LIE GhcPs)
forall a b. (a -> b) -> a -> b
$
SrcSpan -> IE GhcPs -> LIE GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
lieL (IE GhcPs -> LIE GhcPs) -> IE GhcPs -> LIE GhcPs
forall a b. (a -> b) -> a -> b
$
XIEThingWith GhcPs
-> LIEWrappedName (IdP GhcPs)
-> IEWildcard
-> [LIEWrappedName (IdP GhcPs)]
-> [Located (FieldLbl (IdP GhcPs))]
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> [Located (FieldLbl (IdP pass))]
-> IE pass
IEThingWith
XIEThingWith GhcPs
xt
LIEWrappedName (IdP GhcPs)
ty
IEWildcard
wild
((Located (IEWrappedName RdrName) -> Bool)
-> [Located (IEWrappedName RdrName)]
-> [Located (IEWrappedName RdrName)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
symbol) (Text -> Bool)
-> (Located (IEWrappedName RdrName) -> Text)
-> Located (IEWrappedName RdrName)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IEWrappedName RdrName -> Text
unqualIEWrapName (IEWrappedName RdrName -> Text)
-> (Located (IEWrappedName RdrName) -> IEWrappedName RdrName)
-> Located (IEWrappedName RdrName)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (IEWrappedName RdrName) -> IEWrappedName RdrName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LIEWrappedName (IdP GhcPs)]
[Located (IEWrappedName RdrName)]
cons)
#if !MIN_VERSION_ghc(9,2,0)
((Located (FieldLbl RdrName) -> Bool)
-> [Located (FieldLbl RdrName)] -> [Located (FieldLbl RdrName)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
symbol) (Text -> Bool)
-> (Located (FieldLbl RdrName) -> Text)
-> Located (FieldLbl RdrName)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text)
-> (Located (FieldLbl RdrName) -> String)
-> Located (FieldLbl RdrName)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> String
Util.unpackFS (FastString -> String)
-> (Located (FieldLbl RdrName) -> FastString)
-> Located (FieldLbl RdrName)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLbl RdrName -> FastString
forall a. FieldLbl a -> FastString
flLabel (FieldLbl RdrName -> FastString)
-> (Located (FieldLbl RdrName) -> FieldLbl RdrName)
-> Located (FieldLbl RdrName)
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (FieldLbl RdrName) -> FieldLbl RdrName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located (FieldLbl (IdP GhcPs))]
[Located (FieldLbl RdrName)]
flds)
#endif
killLie LIE GhcPs
v = LIE GhcPs -> Maybe (LIE GhcPs)
forall a. a -> Maybe a
Just LIE GhcPs
v