{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GADTs        #-}
module Development.IDE.Plugin.CodeAction.ExactPrint (
  Rewrite (..),
  rewriteToEdit,
  rewriteToWEdit,
#if !MIN_VERSION_ghc(9,2,0)
  transferAnn,
#endif

  -- * Utilities
  appendConstraint,
  removeConstraint,
  extendImport,
  hideSymbol,
  liftParseAST,

  wildCardSymbol
) where

import           Control.Monad
import           Control.Monad.Trans
import           Data.Char                       (isAlphaNum)
import           Data.Data                       (Data)
import           Data.Generics                   (listify)
import qualified Data.Text                       as T
import           Development.IDE.GHC.Compat      hiding (Annotation)
import           Development.IDE.GHC.Error
import           Development.IDE.GHC.ExactPrint
import           Development.IDE.GHC.Util
import           Development.IDE.Spans.Common
import           GHC.Exts                        (IsList (fromList))
import           GHC.Stack                       (HasCallStack)
import           Language.Haskell.GHC.ExactPrint
import           Language.LSP.Types

import           Development.IDE.Plugin.CodeAction.Util

-- GHC version specific imports. For any supported GHC version, make sure there is no warning in imports.
#if MIN_VERSION_ghc(9,2,0)
import           Control.Lens   (_head, _last, over)
import           Data.Bifunctor (first)
import           Data.Default   (Default (..))
import           Data.Maybe     (fromJust, fromMaybe, mapMaybe)
import           GHC            (AddEpAnn (..), AnnContext (..), AnnList (..),
                                 AnnParen (..), DeltaPos (SameLine), EpAnn (..),
                                 EpaLocation (EpaDelta),
                                 IsUnicodeSyntax (NormalSyntax),
                                 NameAdornment (NameParens),
                                 TrailingAnn (AddCommaAnn), addAnns, ann,
                                 emptyComments, reAnnL)
#else
import           Control.Applicative                   (Alternative ((<|>)))
import           Control.Monad.Extra                   (whenJust)
import           Data.Foldable                         (find)
import           Data.Functor                          (($>))
import qualified Data.Map.Strict                       as Map
import           Data.Maybe                            (fromJust, isJust,
                                                        isNothing, mapMaybe)
import qualified Development.IDE.GHC.Compat.Util       as Util
import           Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP),
                                                        KeywordId (G), mkAnnKey)
#endif

------------------------------------------------------------------------------

-- | Construct a 'Rewrite', replacing the node at the given 'SrcSpan' with the
--   given 'ast'.
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
    -- | The 'SrcSpan' that we want to rewrite
    SrcSpan ->
    -- | The ast that we want to graft
#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 = flip setEntryDP (SameLine 0)
    resetEntryDP :: forall ast.
GenLocated (SrcAnn an) ast -> GenLocated (SrcAnn an) ast
resetEntryDP (L SrcAnn an
srcAnn ast
x) = forall t a. Default t => LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP (forall l e. l -> e -> GenLocated l e
L SrcAnn an
srcAnn{ann :: EpAnn an
ann=forall ann. EpAnn ann
EpAnnNotUsed} ast
x) (Int -> DeltaPos
SameLine Int
0)
instance {-# OVERLAPPABLE #-} ResetEntryDP fallback where
    resetEntryDP :: forall ast. GenLocated fallback ast -> GenLocated fallback ast
resetEntryDP = forall a. a -> a
id
#endif

-- | Convert a 'Rewrite' into a list of '[TextEdit]'.
rewriteToEdit :: HasCallStack =>
  DynFlags ->
#if !MIN_VERSION_ghc(9,2,0)
  Anns ->
#endif
  Rewrite ->
  Either String [TextEdit]
rewriteToEdit :: HasCallStack => DynFlags -> Rewrite -> Either String [TextEdit]
rewriteToEdit DynFlags
dflags
#if !MIN_VERSION_ghc(9,2,0)
              anns
#endif
              (Rewrite SrcSpan
dst DynFlags -> TransformT (Either String) (GenLocated (Anno ast) ast)
f) = do
  (GenLocated (Anno ast) ast
ast, Int
anns , [String]
_) <- forall (m :: * -> *) a. TransformT m a -> m (a, Int, [String])
runTransformT
#if !MIN_VERSION_ghc(9,2,0)
                            anns
#endif
                          forall a b. (a -> b) -> a -> b
$ do
    GenLocated (Anno ast) ast
ast <- DynFlags -> TransformT (Either String) (GenLocated (Anno ast) ast)
f DynFlags
dflags
#if !MIN_VERSION_ghc(9,2,0)
    ast <$ setEntryDPT ast (DP (0, 0))
#else
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
(Data a, ExactPrint a, Outputable a, HasCallStack) =>
String -> a -> a
traceAst String
"REWRITE_result" forall a b. (a -> b) -> a -> b
$ forall ann ast.
ResetEntryDP ann =>
GenLocated ann ast -> GenLocated ann ast
resetEntryDP GenLocated (Anno ast) ast
ast
#endif
  let editMap :: [TextEdit]
editMap =
        [ Range -> Text -> TextEdit
TextEdit (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ SrcSpan -> Maybe Range
srcSpanToRange SrcSpan
dst) forall a b. (a -> b) -> a -> b
$
            String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall ast. ExactPrint ast => ast -> String
exactPrint GenLocated (Anno ast) ast
ast
#if !MIN_VERSION_ghc(9,2,0)
                       (fst anns)
#endif
        ]
  forall (f :: * -> *) a. Applicative f => a -> f a
pure [TextEdit]
editMap

-- | Convert a 'Rewrite' into a 'WorkspaceEdit'
rewriteToWEdit :: DynFlags
               -> Uri
#if !MIN_VERSION_ghc(9,2,0)
               -> Anns
#endif
               -> Rewrite
               -> Either String WorkspaceEdit
rewriteToWEdit :: DynFlags -> Uri -> Rewrite -> Either String WorkspaceEdit
rewriteToWEdit DynFlags
dflags Uri
uri
#if !MIN_VERSION_ghc(9,2,0)
               anns
#endif
               Rewrite
r = do
  [TextEdit]
edits <- HasCallStack => DynFlags -> Rewrite -> Either String [TextEdit]
rewriteToEdit DynFlags
dflags
#if !MIN_VERSION_ghc(9,2,0)
                         anns
#endif
                         Rewrite
r
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    WorkspaceEdit
      { $sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
_changes = forall a. a -> Maybe a
Just (forall l. IsList l => [Item l] -> l
fromList [(Uri
uri, forall a. [a] -> List a
List [TextEdit]
edits)])
      , $sel:_documentChanges:WorkspaceEdit :: Maybe (List DocumentChange)
_documentChanges = forall a. Maybe a
Nothing
      , $sel:_changeAnnotations:WorkspaceEdit :: Maybe ChangeAnnotationMap
_changeAnnotations = forall a. Maybe a
Nothing
      }

------------------------------------------------------------------------------

#if !MIN_VERSION_ghc(9,2,0)
-- | Fix the parentheses around a type context
fixParens ::
  (Monad m, Data (HsType pass), pass ~ GhcPass p0) =>
  Maybe DeltaPos ->
  Maybe DeltaPos ->
  LHsContext pass ->
  TransformT m [LHsType pass]
fixParens
          openDP closeDP
          ctxt@(L _ elems) = do
  -- Paren annotation for type contexts are usually quite screwed up
  -- we remove duplicates and fix negative DPs
  let parens = Map.fromList [(G AnnOpenP, dp00), (G AnnCloseP, dp00)]
  modifyAnnsT $
    Map.adjust
      ( \x ->
          let annsMap = Map.fromList (annsDP x)
           in x
                { annsDP =
                    Map.toList $
                      Map.alter (\_ -> openDP <|> Just dp00) (G AnnOpenP) $
                        Map.alter (\_ -> closeDP <|> Just dp00) (G AnnCloseP) $
                          annsMap <> parens
                }
      )
      (mkAnnKey ctxt)
  return $ map dropHsParTy elems
#endif

dropHsParTy :: LHsType (GhcPass pass) -> LHsType (GhcPass pass)
dropHsParTy :: forall (pass :: Pass).
LHsType (GhcPass pass) -> LHsType (GhcPass pass)
dropHsParTy (L SrcSpanAnnA
_ (HsParTy XParTy (GhcPass pass)
_ LHsType (GhcPass pass)
ty)) = LHsType (GhcPass pass)
ty
dropHsParTy LHsType (GhcPass pass)
other                = LHsType (GhcPass pass)
other

removeConstraint ::
  -- | Predicate: Which context to drop.
  (LHsType GhcPs -> Bool) ->
  LHsType GhcPs ->
  Rewrite
removeConstraint :: (LHsType GhcPs -> Bool) -> LHsType GhcPs -> Rewrite
removeConstraint LHsType GhcPs -> Bool
toRemove = LHsType GhcPs -> Rewrite
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (L l it@HsQualTy{hst_ctxt = L l' ctxt, hst_body}) = Rewrite (locA l) $ \_ -> do
#else
    go :: LHsType GhcPs -> Rewrite
go (L SrcSpanAnnA
l it :: HsType GhcPs
it@HsQualTy{hst_ctxt :: forall pass. HsType pass -> Maybe (LHsContext pass)
hst_ctxt = Just (L SrcSpanAnnC
l' [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt), LHsType GhcPs
hst_body :: forall pass. HsType pass -> LHsType pass
hst_body :: LHsType GhcPs
hst_body}) = forall ast.
(ExactPrint (GenLocated (Anno ast) ast), ResetEntryDP (Anno ast),
 Outputable (GenLocated (Anno ast) ast),
 Data (GenLocated (Anno ast) ast)) =>
SrcSpan
-> (DynFlags
    -> TransformT (Either String) (GenLocated (Anno ast) ast))
-> Rewrite
Rewrite (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) forall a b. (a -> b) -> a -> b
$ \DynFlags
_ -> do
#endif
      let ctxt' :: [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt' = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsType GhcPs -> Bool
toRemove) [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt
          removeStuff :: Bool
removeStuff = (LHsType GhcPs -> Bool
toRemove forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe a
headMaybe [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True
#if !MIN_VERSION_ghc(9,2,0)
      when removeStuff  $
        setEntryDPT hst_body (DP (0, 0))
      return $ L l $ it{hst_ctxt =  L l' ctxt'}
#else
      let hst_body' :: GenLocated SrcSpanAnnA (HsType GhcPs)
hst_body' = if Bool
removeStuff then forall ann ast.
ResetEntryDP ann =>
GenLocated ann ast -> GenLocated ann ast
resetEntryDP LHsType GhcPs
hst_body else LHsType GhcPs
hst_body
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt' of
          [] -> GenLocated SrcSpanAnnA (HsType GhcPs)
hst_body'
          [GenLocated SrcSpanAnnA (HsType GhcPs)]
_ -> do
            let ctxt'' :: [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt'' = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s a. Snoc s s a a => Traversal' s a
_last (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first SrcSpanAnnA -> SrcSpanAnnA
removeComma) [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt'
            forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l forall a b. (a -> b) -> a -> b
$ HsType GhcPs
it{ hst_ctxt :: Maybe (LHsContext GhcPs)
hst_ctxt = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnC
l' [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt''
                    , hst_body :: LHsType GhcPs
hst_body = GenLocated SrcSpanAnnA (HsType GhcPs)
hst_body'
                    }
#endif
    go (L SrcSpanAnnA
_ (HsParTy XParTy GhcPs
_ LHsType GhcPs
ty)) = LHsType GhcPs -> Rewrite
go LHsType GhcPs
ty
    go (L SrcSpanAnnA
_ 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 SrcSpanAnnA
l HsType GhcPs
other) = forall ast.
(ExactPrint (GenLocated (Anno ast) ast), ResetEntryDP (Anno ast),
 Outputable (GenLocated (Anno ast) ast),
 Data (GenLocated (Anno ast) ast)) =>
SrcSpan
-> (DynFlags
    -> TransformT (Either String) (GenLocated (Anno ast) ast))
-> Rewrite
Rewrite (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) forall a b. (a -> b) -> a -> b
$ \DynFlags
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l HsType GhcPs
other

-- | Append a constraint at the end of a type context.
--   If no context is present, a new one will be created.
appendConstraint ::
  -- | The new constraint to append
  String ->
  -- | The type signature where the constraint is to be inserted, also assuming annotated
  LHsType GhcPs ->
  Rewrite
appendConstraint :: String -> LHsType GhcPs -> Rewrite
appendConstraint String
constraintT = GenLocated SrcSpanAnnA (HsType GhcPs) -> Rewrite
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(Data a, ExactPrint a, Outputable a, HasCallStack) =>
String -> a -> a
traceAst String
"appendConstraint"
 where
#if !MIN_VERSION_ghc(9,2,0)
  go (L l it@HsQualTy{hst_ctxt = L l' ctxt}) = Rewrite (locA l) $ \df -> do
#else
  go :: GenLocated SrcSpanAnnA (HsType GhcPs) -> Rewrite
go (L SrcSpanAnnA
l it :: HsType GhcPs
it@HsQualTy{hst_ctxt :: forall pass. HsType pass -> Maybe (LHsContext pass)
hst_ctxt = Just (L SrcSpanAnnC
l' [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt)}) = forall ast.
(ExactPrint (GenLocated (Anno ast) ast), ResetEntryDP (Anno ast),
 Outputable (GenLocated (Anno ast) ast),
 Data (GenLocated (Anno ast) ast)) =>
SrcSpan
-> (DynFlags
    -> TransformT (Either String) (GenLocated (Anno ast) ast))
-> Rewrite
Rewrite (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) forall a b. (a -> b) -> a -> b
$ \DynFlags
df -> do
#endif
    GenLocated SrcSpanAnnA (HsType GhcPs)
constraint <- 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)
    setEntryDPT constraint (DP (0, 1))

    -- Paren annotations are usually attached to the first and last constraints,
    -- rather than to the constraint list itself, so to preserve them we need to reposition them
    closeParenDP <- lookupAnn (G AnnCloseP) `mapM` lastMaybe ctxt
    openParenDP <- lookupAnn (G AnnOpenP) `mapM` headMaybe ctxt
    ctxt' <- fixParens
                (join openParenDP) (join closeParenDP)
                (L l' ctxt)
    addTrailingCommaT (last ctxt')
    return $ L l $ it{hst_ctxt = L l' $ ctxt' ++ [constraint]}
#else
    GenLocated SrcSpanAnnA (HsType GhcPs)
constraint <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall t a. Default t => LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP GenLocated SrcSpanAnnA (HsType GhcPs)
constraint (Int -> DeltaPos
SameLine Int
1)
    let l'' :: SrcSpanAnnC
l'' = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Maybe EpaLocation -> AnnContext -> AnnContext
addParensToCtxt Maybe EpaLocation
close_dp) SrcSpanAnnC
l'
    -- For singleton constraints, the close Paren DP is attached to an HsPar wrapping the constraint
    -- we have to reposition it manually into the AnnContext
        close_dp :: Maybe EpaLocation
close_dp = case [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt of
            [L SrcSpanAnnA
_ (HsParTy EpAnn{anns :: forall ann. EpAnn ann -> ann
anns=AnnParen{EpaLocation
ap_close :: AnnParen -> EpaLocation
ap_close :: EpaLocation
ap_close}} LHsType GhcPs
_)] -> forall a. a -> Maybe a
Just EpaLocation
ap_close
            [GenLocated SrcSpanAnnA (HsType GhcPs)]
_ -> forall a. Maybe a
Nothing
        ctxt' :: [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt' = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s a. Snoc s s a a => Traversal' s a
_last (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first SrcSpanAnnA -> SrcSpanAnnA
addComma) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (pass :: Pass).
LHsType (GhcPass pass) -> LHsType (GhcPass pass)
dropHsParTy [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l forall a b. (a -> b) -> a -> b
$ HsType GhcPs
it{hst_ctxt :: Maybe (LHsContext GhcPs)
hst_ctxt = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnC
l'' forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt' forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (HsType GhcPs)
constraint]}
#endif
  go (L SrcSpanAnnA
_ HsForAllTy{LHsType GhcPs
hst_body :: LHsType GhcPs
hst_body :: forall pass. HsType pass -> LHsType pass
hst_body}) = GenLocated SrcSpanAnnA (HsType GhcPs) -> Rewrite
go LHsType GhcPs
hst_body
  go (L SrcSpanAnnA
_ (HsParTy XParTy GhcPs
_ LHsType GhcPs
ty)) = GenLocated SrcSpanAnnA (HsType GhcPs) -> Rewrite
go LHsType GhcPs
ty
  go ast :: GenLocated SrcSpanAnnA (HsType GhcPs)
ast@(L SrcSpanAnnA
l HsType GhcPs
_) = forall ast.
(ExactPrint (GenLocated (Anno ast) ast), ResetEntryDP (Anno ast),
 Outputable (GenLocated (Anno ast) ast),
 Data (GenLocated (Anno ast) ast)) =>
SrcSpan
-> (DynFlags
    -> TransformT (Either String) (GenLocated (Anno ast) ast))
-> Rewrite
Rewrite (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) forall a b. (a -> b) -> a -> b
$ \DynFlags
df -> do
    -- there isn't a context, so we must create one
    GenLocated SrcSpanAnnA (HsType GhcPs)
constraint <- 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 <- forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
    SrcSpan
lTop <- forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
#if !MIN_VERSION_ghc(9,2,0)
    let context = L lContext [constraint]
    addSimpleAnnT context dp00 $
      (G AnnDarrow, DP (0, 1)) :
      concat
        [ [ (G AnnOpenP, dp00)
          , (G AnnCloseP, dp00)
          ]
        | hsTypeNeedsParens sigPrec $ unLoc constraint
        ]
#else
    let context :: Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
context = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall ann e.
ann -> EpAnnComments -> Located e -> GenLocated (SrcAnn ann) e
reAnnL AnnContext
annCtxt EpAnnComments
emptyComments forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpan
lContext [forall ann ast.
ResetEntryDP ann =>
GenLocated ann ast -> GenLocated ann ast
resetEntryDP GenLocated SrcSpanAnnA (HsType GhcPs)
constraint]
        annCtxt :: AnnContext
annCtxt = Maybe (IsUnicodeSyntax, EpaLocation)
-> [EpaLocation] -> [EpaLocation] -> AnnContext
AnnContext (forall a. a -> Maybe a
Just (IsUnicodeSyntax
NormalSyntax, Int -> EpaLocation
epl Int
1)) [Int -> EpaLocation
epl Int
0 | Bool
needsParens] [Int -> EpaLocation
epl Int
0 | Bool
needsParens]
        needsParens :: Bool
needsParens = forall (p :: Pass). PprPrec -> HsType (GhcPass p) -> Bool
hsTypeNeedsParens PprPrec
sigPrec forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsType GhcPs)
constraint
    GenLocated SrcSpanAnnA (HsType GhcPs)
ast <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall t a. Default t => LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP GenLocated SrcSpanAnnA (HsType GhcPs)
ast (Int -> DeltaPos
SameLine Int
1)
#endif

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall e ann. Located e -> LocatedAn ann e
reLocA forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpan
lTop forall a b. (a -> b) -> a -> b
$ forall pass.
XQualTy pass
-> Maybe (LHsContext pass) -> LHsType pass -> HsType pass
HsQualTy NoExtField
noExtField Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
context GenLocated SrcSpanAnnA (HsType GhcPs)
ast

liftParseAST
    :: forall ast l.  (ASTElement l ast, ExactPrint (LocatedAn l ast))
    => DynFlags -> String -> TransformT (Either String) (LocatedAn l ast)
liftParseAST :: forall ast l.
(ASTElement l ast, ExactPrint (LocatedAn l ast)) =>
DynFlags -> String -> TransformT (Either String) (LocatedAn l ast)
liftParseAST DynFlags
df String
s = case 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, x) -> modifyAnnsT (anns <>) $> x
#else
  Right LocatedAn l ast
x ->  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall ast. ExactPrint ast => ast -> ast
makeDeltaAst LocatedAn l ast
x)
#endif
  Left ErrorMessages
_          -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"No parse: " 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 comment la = do
  anns <- getAnnsT
  return $ Map.lookup (mkAnnKey la) anns >>= lookup comment . annsDP

dp00 :: DeltaPos
dp00 = DP (0, 0)

-- | Copy anns attached to a into b with modification, then delete anns of a
transferAnn :: (Data a, Data b) => Located a -> Located b -> (Annotation -> Annotation) -> TransformT (Either String) ()
transferAnn la lb f = do
  anns <- getAnnsT
  let oldKey = mkAnnKey la
      newKey = mkAnnKey lb
  oldValue <- liftMaybe "Unable to find ann" $ Map.lookup oldKey anns
  putAnnsT $ Map.delete oldKey $ Map.insert newKey (f oldValue) anns

#endif

headMaybe :: [a] -> Maybe a
headMaybe :: forall a. [a] -> Maybe a
headMaybe []      = forall a. Maybe a
Nothing
headMaybe (a
a : [a]
_) = forall a. a -> Maybe a
Just a
a

lastMaybe :: [a] -> Maybe a
lastMaybe :: forall a. [a] -> Maybe a
lastMaybe []    = forall a. Maybe a
Nothing
lastMaybe [a]
other = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [a]
other

liftMaybe :: String -> Maybe a -> TransformT (Either String) a
liftMaybe :: forall a. String -> Maybe a -> TransformT (Either String) a
liftMaybe String
_ (Just a
x) = forall (m :: * -> *) a. Monad m => a -> m a
return a
x
liftMaybe String
s Maybe a
_        = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ 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 SrcSpanAnnA
l ImportDecl GhcPs
_) =
  forall ast.
(ExactPrint (GenLocated (Anno ast) ast), ResetEntryDP (Anno ast),
 Outputable (GenLocated (Anno ast) ast),
 Data (GenLocated (Anno ast) ast)) =>
SrcSpan
-> (DynFlags
    -> TransformT (Either String) (GenLocated (Anno ast) ast))
-> Rewrite
Rewrite (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) forall a b. (a -> b) -> a -> b
$ \DynFlags
df -> do
    case Maybe String
mparent of
      -- This will also work for `ImportAllConstructors`
      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

-- | Add an identifier or a data type to import list. Expects a Delta AST
--
-- extendImportTopLevel "foo" AST:
--
-- import A --> Error
-- import A (foo) --> Error
-- import A (bar) --> import A (bar, foo)
extendImportTopLevel ::
  -- | rendered
  String ->
  LImportDecl GhcPs ->
  TransformT (Either String) (LImportDecl GhcPs)
extendImportTopLevel :: String
-> LImportDecl GhcPs
-> TransformT (Either String) (LImportDecl GhcPs)
extendImportTopLevel String
thing (L SrcSpanAnnA
l it :: ImportDecl GhcPs
it@ImportDecl{Bool
Maybe (Bool, XRec GhcPs [LIE GhcPs])
Maybe (XRec GhcPs ModuleName)
Maybe StringLiteral
ImportDeclQualifiedStyle
XRec GhcPs ModuleName
XCImportDecl GhcPs
SourceText
IsBootInterface
ideclAs :: forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclImplicit :: forall pass. ImportDecl pass -> Bool
ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclPkgQual :: forall pass. ImportDecl pass -> Maybe StringLiteral
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
ideclSourceSrc :: forall pass. ImportDecl pass -> SourceText
ideclHiding :: Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclAs :: Maybe (XRec GhcPs ModuleName)
ideclImplicit :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: IsBootInterface
ideclPkgQual :: Maybe StringLiteral
ideclName :: XRec GhcPs ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
..})
  | Just (Bool
hide, L SrcSpanAnnL
l' [GenLocated SrcSpanAnnA (IE GhcPs)]
lies) <- Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding
    , Bool
hasSibling <- Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (IE GhcPs)]
lies = do
    SrcSpan
src <- forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
    SrcSpan
top <- forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
    let rdr :: LocatedAn NameAnn RdrName
rdr = forall e ann. Located e -> LocatedAn ann e
reLocA forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpan
src forall a b. (a -> b) -> a -> b
$ OccName -> RdrName
mkRdrUnqual forall a b. (a -> b) -> a -> b
$ String -> OccName
mkVarOcc String
thing
    let alreadyImported :: Bool
alreadyImported =
          forall a. Outputable a => a -> Text
printOutputable (forall name. HasOccName name => name -> OccName
occName (forall l e. GenLocated l e -> e
unLoc LocatedAn NameAnn RdrName
rdr))
            forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map (forall a. Outputable a => a -> Text
printOutputable @OccName) (forall r. Typeable r => (r -> Bool) -> GenericQ [r]
listify (forall a b. a -> b -> a
const Bool
True) [GenLocated SrcSpanAnnA (IE GhcPs)]
lies)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alreadyImported forall a b. (a -> b) -> a -> b
$
      forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
thing forall a. Semigroup a => a -> a -> a
<> String
" already imported")

    let lie :: LIEWrappedName RdrName
lie = forall e ann. Located e -> LocatedAn ann e
reLocA forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpan
src forall a b. (a -> b) -> a -> b
$ forall name. LocatedN name -> IEWrappedName name
IEName LocatedAn NameAnn RdrName
rdr
        x :: GenLocated SrcSpanAnnA (IE GhcPs)
x = forall e ann. Located e -> LocatedAn ann e
reLocA forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpan
top forall a b. (a -> b) -> a -> b
$ forall pass. XIEVar pass -> LIEWrappedName (IdP pass) -> IE pass
IEVar NoExtField
noExtField LIEWrappedName RdrName
lie

    if GenLocated SrcSpanAnnA (IE GhcPs)
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GenLocated SrcSpanAnnA (IE GhcPs)]
lies
      then forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
thing forall a. Semigroup a => a -> a -> a
<> String
" already imported")
      else do
#if !MIN_VERSION_ghc(9,2,0)
        anns <- getAnnsT
        maybe (pure ()) addTrailingCommaT (lastMaybe lies)
        addSimpleAnnT x (DP (0, if hasSibling then 1 else 0)) []
        addSimpleAnnT rdr dp00 [(G AnnVal, dp00)]

        -- When the last item already has a trailing comma, we append a trailing comma to the new item.
        let isAnnComma (G AnnComma, _) = True
            isAnnComma _               = False
            shouldAddTrailingComma = maybe False nodeHasComma (lastMaybe lies)
                && not (nodeHasComma (L l' lies))

            nodeHasComma :: Data a => Located a -> Bool
            nodeHasComma x = isJust $ Map.lookup (mkAnnKey x) anns >>= find isAnnComma . annsDP
        when shouldAddTrailingComma (addTrailingCommaT x)

        -- Parens are attachted to `lies`, so if `lies` was empty previously,
        -- we need change the ann key from `[]` to `:` to keep parens and other anns.
        unless hasSibling $
          transferAnn (L l' lies) (L l' [x]) id
        return $ L l it{ideclHiding = Just (hide, L l' $ lies ++ [x])}
#else
        let lies' :: [GenLocated SrcSpanAnnA (IE GhcPs)]
lies' = forall a.
[LocatedAn AnnListItem a]
-> LocatedAn AnnListItem a -> [LocatedAn AnnListItem a]
addCommaInImportList [GenLocated SrcSpanAnnA (IE GhcPs)]
lies GenLocated SrcSpanAnnA (IE GhcPs)
x
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l ImportDecl GhcPs
it{ideclHiding :: Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding = forall a. a -> Maybe a
Just (Bool
hide, forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l' [GenLocated SrcSpanAnnA (IE GhcPs)]
lies')}
#endif
extendImportTopLevel String
_ LImportDecl GhcPs
_ = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
"Unable to extend the import list"

wildCardSymbol :: String
wildCardSymbol :: String
wildCardSymbol = String
".."

-- | Add an identifier with its parent to import list
--
-- extendImportViaParent "Bar" "Cons" AST:
--
-- import A --> Error
-- import A (Bar(..)) --> Error
-- import A (Bar(Cons)) --> Error
-- import A () --> import A (Bar(Cons))
-- import A (Foo, Bar) --> import A (Foo, Bar(Cons))
-- import A (Foo, Bar()) --> import A (Foo, Bar(Cons))
--
-- extendImportViaParent "Bar" ".." AST:
-- import A () --> import A (Bar(..))
-- import A (Foo, Bar) -> import A (Foo, Bar(..))
-- import A (Foo, Bar()) -> import A (Foo, Bar(..))
extendImportViaParent ::
  DynFlags ->
  -- | parent (already parenthesized if needs)
  String ->
  -- | rendered child
  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 SrcSpanAnnA
l it :: ImportDecl GhcPs
it@ImportDecl{Bool
Maybe (Bool, XRec GhcPs [LIE GhcPs])
Maybe (XRec GhcPs ModuleName)
Maybe StringLiteral
ImportDeclQualifiedStyle
XRec GhcPs ModuleName
XCImportDecl GhcPs
SourceText
IsBootInterface
ideclHiding :: Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclAs :: Maybe (XRec GhcPs ModuleName)
ideclImplicit :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: IsBootInterface
ideclPkgQual :: Maybe StringLiteral
ideclName :: XRec GhcPs ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
ideclAs :: forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclImplicit :: forall pass. ImportDecl pass -> Bool
ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclPkgQual :: forall pass. ImportDecl pass -> Maybe StringLiteral
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
ideclSourceSrc :: forall pass. ImportDecl pass -> SourceText
..})
  | Just (Bool
hide, L SrcSpanAnnL
l' [GenLocated SrcSpanAnnA (IE GhcPs)]
lies) <- Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding = Bool
-> SrcSpanAnnL
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> TransformT
     (Either String) (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
go Bool
hide SrcSpanAnnL
l' [] [GenLocated SrcSpanAnnA (IE GhcPs)]
lies
 where
  go :: Bool
-> SrcSpanAnnL
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> TransformT
     (Either String) (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
go Bool
_hide SrcSpanAnnL
_l' [GenLocated SrcSpanAnnA (IE GhcPs)]
_pre ((L SrcSpanAnnA
_ll' (IEThingAll XIEThingAll GhcPs
_ (L SrcSpanAnnA
_ IEWrappedName (IdP GhcPs)
ie))) : [GenLocated SrcSpanAnnA (IE GhcPs)]
_xs)
    | String
parent forall a. Eq a => a -> a -> Bool
== IEWrappedName (IdP GhcPs) -> String
unIEWrappedName IEWrappedName (IdP GhcPs)
ie = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
child forall a. Semigroup a => a -> a -> a
<> String
" already included in " forall a. Semigroup a => a -> a -> a
<> String
parent forall a. Semigroup a => a -> a -> a
<> String
" imports"
  go Bool
hide SrcSpanAnnL
l' [GenLocated SrcSpanAnnA (IE GhcPs)]
pre (lAbs :: GenLocated SrcSpanAnnA (IE GhcPs)
lAbs@(L SrcSpanAnnA
ll' (IEThingAbs XIEThingAbs GhcPs
_ absIE :: GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))
absIE@(L SrcSpanAnnA
_ IEWrappedName (IdP GhcPs)
ie))) : [GenLocated SrcSpanAnnA (IE GhcPs)]
xs)
    -- ThingAbs ie => ThingWith ie child
    | String
parent forall a. Eq a => a -> a -> Bool
== IEWrappedName (IdP GhcPs) -> String
unIEWrappedName IEWrappedName (IdP GhcPs)
ie = do
      SrcSpan
srcChild <- forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
      let childRdr :: LocatedAn NameAnn RdrName
childRdr = forall e ann. Located e -> LocatedAn ann e
reLocA forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpan
srcChild forall a b. (a -> b) -> a -> b
$ OccName -> RdrName
mkRdrUnqual forall a b. (a -> b) -> a -> b
$ String -> OccName
mkVarOcc String
child
          childLIE :: LIEWrappedName RdrName
childLIE = forall e ann. Located e -> LocatedAn ann e
reLocA forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpan
srcChild forall a b. (a -> b) -> a -> b
$ forall name. LocatedN name -> IEWrappedName name
IEName LocatedAn NameAnn RdrName
childRdr
#if !MIN_VERSION_ghc(9,2,0)
          x :: LIE GhcPs = L ll' $ IEThingWith noExtField absIE NoIEWildcard [childLIE] []
      -- take anns from ThingAbs, and attatch parens to it
      transferAnn lAbs x $ \old -> old{annsDP = annsDP old ++ [(G AnnOpenP, DP (0, 1)), (G AnnCloseP, dp00)]}
      addSimpleAnnT childRdr dp00 [(G AnnVal, dp00)]
#else
          LIE GhcPs
x :: LIE GhcPs = forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
ll' forall a b. (a -> b) -> a -> b
$ forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> IE pass
IEThingWith (EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
addAnns forall a. Monoid a => a
mempty [AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnOpenP (DeltaPos -> [LEpaComment] -> EpaLocation
EpaDelta (Int -> DeltaPos
SameLine Int
1) []), AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnCloseP forall a. Default a => a
def] EpAnnComments
emptyComments) GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))
absIE IEWildcard
NoIEWildcard [LIEWrappedName RdrName
childLIE]
#endif
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l ImportDecl GhcPs
it{ideclHiding :: Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding = forall a. a -> Maybe a
Just (Bool
hide, forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l' forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [GenLocated SrcSpanAnnA (IE GhcPs)]
pre forall a. [a] -> [a] -> [a]
++ [LIE GhcPs
x] forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (IE GhcPs)]
xs)}
#if !MIN_VERSION_ghc(9,2,0)
  go hide l' pre ((L l'' (IEThingWith _ twIE@(L _ ie) _ lies' _)) : xs)
#else
  go Bool
hide SrcSpanAnnL
l' [GenLocated SrcSpanAnnA (IE GhcPs)]
pre ((L SrcSpanAnnA
l'' (IEThingWith XIEThingWith GhcPs
l''' twIE :: GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))
twIE@(L SrcSpanAnnA
_ IEWrappedName (IdP GhcPs)
ie) IEWildcard
_ [GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))]
lies')) : [GenLocated SrcSpanAnnA (IE GhcPs)]
xs)
#endif
    -- ThingWith ie lies' => ThingWith ie (lies' ++ [child])
    | String
parent forall a. Eq a => a -> a -> Bool
== IEWrappedName (IdP GhcPs) -> String
unIEWrappedName IEWrappedName (IdP GhcPs)
ie
    , String
child forall a. Eq a => a -> a -> Bool
== String
wildCardSymbol = do
#if MIN_VERSION_ghc(9,2,0)
        let it' :: ImportDecl GhcPs
it' = ImportDecl GhcPs
it{ideclHiding :: Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding = forall a. a -> Maybe a
Just (Bool
hide, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
lies)}
            thing :: IE GhcPs
thing = forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> IE pass
IEThingWith EpAnn [AddEpAnn]
newl GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))
twIE (Int -> IEWildcard
IEWildcard Int
2) []
            newl :: EpAnn [AddEpAnn]
newl = (\[AddEpAnn]
ann -> [AddEpAnn]
ann forall a. [a] -> [a] -> [a]
++ [(AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnDotdot EpaLocation
d0)]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XIEThingWith GhcPs
l'''
            lies :: GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
lies = forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l' forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [GenLocated SrcSpanAnnA (IE GhcPs)]
pre forall a. [a] -> [a] -> [a]
++ [forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l'' IE GhcPs
thing] forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (IE GhcPs)]
xs
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l ImportDecl GhcPs
it'
#else
        let thing = L l'' (IEThingWith noExtField twIE (IEWildcard 2)  [] [])
        modifyAnnsT (Map.map (\ann -> ann{annsDP = (G AnnDotdot, dp00) : annsDP ann}))
        return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [thing] ++ xs)}
#endif
    | String
parent forall a. Eq a => a -> a -> Bool
== IEWrappedName (IdP GhcPs) -> String
unIEWrappedName IEWrappedName (IdP GhcPs)
ie
    , Bool
hasSibling <- Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))]
lies' =
      do
        SrcSpan
srcChild <- forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
        let childRdr :: LocatedAn NameAnn RdrName
childRdr = forall e ann. Located e -> LocatedAn ann e
reLocA forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpan
srcChild forall a b. (a -> b) -> a -> b
$ OccName -> RdrName
mkRdrUnqual forall a b. (a -> b) -> a -> b
$ String -> OccName
mkVarOcc String
child
#if MIN_VERSION_ghc(9,2,0)
        LocatedAn NameAnn RdrName
childRdr <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall t a. Default t => LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP LocatedAn NameAnn RdrName
childRdr forall a b. (a -> b) -> a -> b
$ Int -> DeltaPos
SameLine forall a b. (a -> b) -> a -> b
$ if Bool
hasSibling then Int
1 else Int
0
#endif
        let alreadyImported :: Bool
alreadyImported =
              forall a. Outputable a => a -> Text
printOutputable (forall name. HasOccName name => name -> OccName
occName (forall l e. GenLocated l e -> e
unLoc LocatedAn NameAnn RdrName
childRdr))
                forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map (forall a. Outputable a => a -> Text
printOutputable @OccName) (forall r. Typeable r => (r -> Bool) -> GenericQ [r]
listify (forall a b. a -> b -> a
const Bool
True) [GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))]
lies')
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alreadyImported forall a b. (a -> b) -> a -> b
$
          forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
child forall a. Semigroup a => a -> a -> a
<> String
" already included in " forall a. Semigroup a => a -> a -> a
<> String
parent forall a. Semigroup a => a -> a -> a
<> String
" imports")

        let childLIE :: LIEWrappedName RdrName
childLIE = forall e ann. Located e -> LocatedAn ann e
reLocA forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpan
srcChild forall a b. (a -> b) -> a -> b
$ forall name. LocatedN name -> IEWrappedName name
IEName LocatedAn NameAnn RdrName
childRdr
#if !MIN_VERSION_ghc(9,2,0)
        when hasSibling $
          addTrailingCommaT (last lies')
        addSimpleAnnT childRdr (DP (0, if hasSibling then 1 else 0)) [(G AnnVal, dp00)]
        return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [L l'' (IEThingWith noExtField twIE NoIEWildcard (lies' ++ [childLIE]) [])] ++ xs)}
#else
        let it' :: ImportDecl GhcPs
it' = ImportDecl GhcPs
it{ideclHiding :: Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding = forall a. a -> Maybe a
Just (Bool
hide, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
lies)}
            lies :: GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
lies = forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l' forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [GenLocated SrcSpanAnnA (IE GhcPs)]
pre forall a. [a] -> [a] -> [a]
++
                [forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l'' (forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> IE pass
IEThingWith XIEThingWith GhcPs
l''' GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))
twIE IEWildcard
NoIEWildcard (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s a. Snoc s s a a => Traversal' s a
_last LIEWrappedName RdrName -> LIEWrappedName RdrName
fixLast [GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))]
lies' forall a. [a] -> [a] -> [a]
++ [LIEWrappedName RdrName
childLIE]))] forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (IE GhcPs)]
xs
            fixLast :: LIEWrappedName RdrName -> LIEWrappedName RdrName
fixLast = if Bool
hasSibling then forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first SrcSpanAnnA -> SrcSpanAnnA
addComma else forall a. a -> a
id
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l ImportDecl GhcPs
it'
#endif
  go Bool
hide SrcSpanAnnL
l' [GenLocated SrcSpanAnnA (IE GhcPs)]
pre (GenLocated SrcSpanAnnA (IE GhcPs)
x : [GenLocated SrcSpanAnnA (IE GhcPs)]
xs) = Bool
-> SrcSpanAnnL
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> TransformT
     (Either String) (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
go Bool
hide SrcSpanAnnL
l' (GenLocated SrcSpanAnnA (IE GhcPs)
x forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (IE GhcPs)]
pre) [GenLocated SrcSpanAnnA (IE GhcPs)]
xs
  go Bool
hide SrcSpanAnnL
l' [GenLocated SrcSpanAnnA (IE GhcPs)]
pre []
    | Bool
hasSibling <- Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (IE GhcPs)]
pre = do
      -- [] => ThingWith parent [child]
      SrcSpan
l'' <- forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
      SrcSpan
srcParent <- forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
      SrcSpan
srcChild <- forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
      LocatedAn NameAnn (IdP GhcPs)
parentRdr <- 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 :: LocatedAn NameAnn RdrName
childRdr = forall e ann. Located e -> LocatedAn ann e
reLocA forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpan
srcChild forall a b. (a -> b) -> a -> b
$ OccName -> RdrName
mkRdrUnqual 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)
      when hasSibling $
        addTrailingCommaT (head pre)
      let parentLIE = L srcParent (if isParentOperator then IEType parentRdr else IEName parentRdr)
          childLIE = reLocA $ L srcChild $ IEName childRdr
#else
      let parentLIE :: GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))
parentLIE = forall e ann. Located e -> LocatedAn ann e
reLocA forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpan
srcParent forall a b. (a -> b) -> a -> b
$ (if Bool
isParentOperator then forall name. EpaLocation -> LocatedN name -> IEWrappedName name
IEType (Int -> EpaLocation
epl Int
0) LocatedAn NameAnn (IdP GhcPs)
parentRdr' else forall name. LocatedN name -> IEWrappedName name
IEName LocatedAn NameAnn (IdP GhcPs)
parentRdr')
          parentRdr' :: LocatedAn NameAnn (IdP GhcPs)
parentRdr' = forall a ast. LocatedAn a ast -> (a -> a) -> LocatedAn a ast
modifyAnns LocatedAn NameAnn (IdP GhcPs)
parentRdr forall a b. (a -> b) -> a -> b
$ \case
              it :: NameAnn
it@NameAnn{nann_adornment :: NameAnn -> NameAdornment
nann_adornment = NameAdornment
NameParens} -> NameAnn
it{nann_open :: EpaLocation
nann_open = Int -> EpaLocation
epl Int
1}
              NameAnn
other -> NameAnn
other
          childLIE :: LIEWrappedName RdrName
childLIE = forall e ann. Located e -> LocatedAn ann e
reLocA forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpan
srcChild forall a b. (a -> b) -> a -> b
$ forall name. LocatedN name -> IEWrappedName name
IEName LocatedAn NameAnn RdrName
childRdr
#endif
#if !MIN_VERSION_ghc(9,2,0)
          x :: LIE GhcPs = reLocA $ L l'' $ IEThingWith noExtField parentLIE NoIEWildcard [childLIE] []
      -- Add AnnType for the parent if it's parenthesized (type operator)
      when isParentOperator $
        addSimpleAnnT parentLIE (DP (0, 0)) [(G AnnType, DP (0, 0))]
      addSimpleAnnT parentRdr (DP (0, if hasSibling then 1 else 0)) $ unqalDP 1 isParentOperator
      addSimpleAnnT childRdr (DP (0, 0)) [(G AnnVal, dp00)]
      addSimpleAnnT x (DP (0, 0)) [(G AnnOpenP, DP (0, 1)), (G AnnCloseP, DP (0, 0))]
      -- Parens are attachted to `pre`, so if `pre` was empty previously,
      -- we need change the ann key from `[]` to `:` to keep parens and other anns.
      unless hasSibling $
        transferAnn (L l' $ reverse pre) (L l' [x]) id

      let lies' = reverse pre ++ [x]
#else
          listAnn :: EpAnn [AddEpAnn]
listAnn = forall ann. SrcSpan -> ann -> EpAnn ann
epAnn SrcSpan
srcParent [AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnOpenP (Int -> EpaLocation
epl Int
1), AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnCloseP (Int -> EpaLocation
epl Int
0)]
          LIE GhcPs
x :: LIE GhcPs = forall e ann. Located e -> LocatedAn ann e
reLocA forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpan
l'' forall a b. (a -> b) -> a -> b
$ forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> IE pass
IEThingWith EpAnn [AddEpAnn]
listAnn GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))
parentLIE IEWildcard
NoIEWildcard [LIEWrappedName RdrName
childLIE]

          lies' :: [GenLocated SrcSpanAnnA (IE GhcPs)]
lies' = forall a.
[LocatedAn AnnListItem a]
-> LocatedAn AnnListItem a -> [LocatedAn AnnListItem a]
addCommaInImportList (forall a. [a] -> [a]
reverse [GenLocated SrcSpanAnnA (IE GhcPs)]
pre) LIE GhcPs
x
#endif
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l ImportDecl GhcPs
it{ideclHiding :: Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding = forall a. a -> Maybe a
Just (Bool
hide, forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l' [GenLocated SrcSpanAnnA (IE GhcPs)]
lies')}
extendImportViaParent DynFlags
_ String
_ String
_ LImportDecl GhcPs
_ = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
"Unable to extend the import list via parent"

#if MIN_VERSION_ghc(9,2,0)
-- Add an item in an import list, taking care of adding comma if needed.
addCommaInImportList ::
  -- | Initial list
  [LocatedAn AnnListItem a]
  -- | Additionnal item
  -> LocatedAn AnnListItem a
  -> [LocatedAn AnnListItem a]
addCommaInImportList :: forall a.
[LocatedAn AnnListItem a]
-> LocatedAn AnnListItem a -> [LocatedAn AnnListItem a]
addCommaInImportList [LocatedAn AnnListItem a]
lies LocatedAn AnnListItem a
x =
    forall a. [LocatedAn AnnListItem a] -> [LocatedAn AnnListItem a]
fixLast [LocatedAn AnnListItem a]
lies forall a. [a] -> [a] -> [a]
++ [LocatedAn AnnListItem a
newItem]
  where
    isTrailingAnnComma :: TrailingAnn -> Bool
    isTrailingAnnComma :: TrailingAnn -> Bool
isTrailingAnnComma (AddCommaAnn EpaLocation
_) = Bool
True
    isTrailingAnnComma TrailingAnn
_ = Bool
False

    -- check if there is an existing trailing comma
    existingTrailingComma :: Bool
existingTrailingComma = forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ do
        L SrcSpanAnnA
lastItemSrcAnn a
_ <- forall a. [a] -> Maybe a
lastMaybe [LocatedAn AnnListItem a]
lies
        AnnListItem
lastItemAnn <- case forall a. SrcSpanAnn' a -> a
ann SrcSpanAnnA
lastItemSrcAnn of
            EpAnn Anchor
_ AnnListItem
lastItemAnn EpAnnComments
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure AnnListItem
lastItemAnn
            EpAnn AnnListItem
_ -> forall a. Maybe a
Nothing
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TrailingAnn -> Bool
isTrailingAnnComma (AnnListItem -> [TrailingAnn]
lann_trailing AnnListItem
lastItemAnn)

    hasSibling :: Bool
hasSibling = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ [LocatedAn AnnListItem a]
lies

    -- Setup the new item. It should have a preceding whitespace if it has siblings, and a trailing comma if the
    -- preceding item already has one.
    newItem :: LocatedAn AnnListItem a
newItem = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (if Bool
existingTrailingComma then SrcSpanAnnA -> SrcSpanAnnA
addComma else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
        forall t a. Default t => LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP LocatedAn AnnListItem a
x (Int -> DeltaPos
SameLine forall a b. (a -> b) -> a -> b
$ if Bool
hasSibling then Int
1 else Int
0)

    -- Add the comma (if needed)
    fixLast :: [LocatedAn AnnListItem a] -> [LocatedAn AnnListItem a]
    fixLast :: forall a. [LocatedAn AnnListItem a] -> [LocatedAn AnnListItem a]
fixLast = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s a. Snoc s s a a => Traversal' s a
_last (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (if Bool
existingTrailingComma then forall a. a -> a
id else SrcSpanAnnA -> SrcSpanAnnA
addComma))
#endif

unIEWrappedName :: IEWrappedName (IdP GhcPs) -> String
unIEWrappedName :: IEWrappedName (IdP GhcPs) -> String
unIEWrappedName (forall name. HasOccName name => name -> OccName
occName -> OccName
occ) = Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> Text
printOutputable forall a b. (a -> b) -> a -> b
$ OccName -> SDoc -> SDoc
parenSymOcc OccName
occ (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 c paren =
  ( if paren
      then \x -> (G AnnOpenP, DP (0, c)) : x : [(G AnnCloseP, dp00)]
      else pure
  )
    (G AnnVal, dp00)
#endif

------------------------------------------------------------------------------

-- | Hide a symbol from import declaration
hideSymbol ::
  String -> LImportDecl GhcPs -> Rewrite
hideSymbol :: String -> LImportDecl GhcPs -> Rewrite
hideSymbol String
symbol lidecl :: LImportDecl GhcPs
lidecl@(L SrcSpanAnnA
loc ImportDecl{Bool
Maybe (Bool, XRec GhcPs [LIE GhcPs])
Maybe (XRec GhcPs ModuleName)
Maybe StringLiteral
ImportDeclQualifiedStyle
XRec GhcPs ModuleName
XCImportDecl GhcPs
SourceText
IsBootInterface
ideclHiding :: Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclAs :: Maybe (XRec GhcPs ModuleName)
ideclImplicit :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: IsBootInterface
ideclPkgQual :: Maybe StringLiteral
ideclName :: XRec GhcPs ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
ideclAs :: forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclImplicit :: forall pass. ImportDecl pass -> Bool
ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclPkgQual :: forall pass. ImportDecl pass -> Maybe StringLiteral
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
ideclSourceSrc :: forall pass. ImportDecl pass -> SourceText
..}) =
  case Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding of
    Maybe (Bool, XRec GhcPs [LIE GhcPs])
Nothing -> forall ast.
(ExactPrint (GenLocated (Anno ast) ast), ResetEntryDP (Anno ast),
 Outputable (GenLocated (Anno ast) ast),
 Data (GenLocated (Anno ast) ast)) =>
SrcSpan
-> (DynFlags
    -> TransformT (Either String) (GenLocated (Anno ast) ast))
-> Rewrite
Rewrite (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) forall a b. (a -> b) -> a -> b
$ String
-> LImportDecl GhcPs
-> Maybe (XRec GhcPs [LIE GhcPs])
-> DynFlags
-> TransformT (Either String) (LImportDecl GhcPs)
extendHiding String
symbol LImportDecl GhcPs
lidecl forall a. Maybe a
Nothing
    Just (Bool
True, XRec GhcPs [LIE GhcPs]
hides) -> forall ast.
(ExactPrint (GenLocated (Anno ast) ast), ResetEntryDP (Anno ast),
 Outputable (GenLocated (Anno ast) ast),
 Data (GenLocated (Anno ast) ast)) =>
SrcSpan
-> (DynFlags
    -> TransformT (Either String) (GenLocated (Anno ast) ast))
-> Rewrite
Rewrite (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) forall a b. (a -> b) -> a -> b
$ String
-> LImportDecl GhcPs
-> Maybe (XRec GhcPs [LIE GhcPs])
-> DynFlags
-> TransformT (Either String) (LImportDecl GhcPs)
extendHiding String
symbol LImportDecl GhcPs
lidecl (forall a. a -> Maybe a
Just XRec GhcPs [LIE GhcPs]
hides)
    Just (Bool
False, XRec GhcPs [LIE GhcPs]
imports) -> forall ast.
(ExactPrint (GenLocated (Anno ast) ast), ResetEntryDP (Anno ast),
 Outputable (GenLocated (Anno ast) ast),
 Data (GenLocated (Anno ast) ast)) =>
SrcSpan
-> (DynFlags
    -> TransformT (Either String) (GenLocated (Anno ast) ast))
-> Rewrite
Rewrite (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) forall a b. (a -> b) -> a -> b
$ String
-> LImportDecl GhcPs
-> XRec GhcPs [LIE GhcPs]
-> DynFlags
-> TransformT (Either String) (LImportDecl GhcPs)
deleteFromImport String
symbol LImportDecl GhcPs
lidecl XRec GhcPs [LIE GhcPs]
imports
hideSymbol String
_ (L SrcSpanAnnA
_ (XImportDecl XXImportDecl GhcPs
_)) =
  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 (XRec GhcPs [LIE GhcPs])
-> DynFlags
-> TransformT (Either String) (LImportDecl GhcPs)
extendHiding String
symbol (L SrcSpanAnnA
l ImportDecl GhcPs
idecls) Maybe (XRec GhcPs [LIE GhcPs])
mlies DynFlags
df = do
  L SrcSpanAnnL
l' [GenLocated SrcSpanAnnA (IE GhcPs)]
lies <- case Maybe (XRec GhcPs [LIE GhcPs])
mlies of
#if !MIN_VERSION_ghc(9,2,0)
    Nothing -> flip L [] <$> uniqueSrcSpanT
#else
    Maybe (XRec GhcPs [LIE GhcPs])
Nothing -> do
        SrcSpan
src <- forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
        let ann :: SrcSpanAnnL
ann = forall ann. Monoid ann => SrcSpan -> SrcSpanAnn' (EpAnn ann)
noAnnSrcSpanDP0 SrcSpan
src
            ann' :: SrcSpanAnnL
ann' = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) SrcSpanAnnL
ann forall a b. (a -> b) -> a -> b
$ \AnnList
x -> AnnList
x
                {al_rest :: [AddEpAnn]
al_rest = [AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnHiding (Int -> EpaLocation
epl Int
1)]
                ,al_open :: Maybe AddEpAnn
al_open = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnOpenP (Int -> EpaLocation
epl Int
1)
                ,al_close :: Maybe AddEpAnn
al_close = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnCloseP (Int -> EpaLocation
epl Int
0)
                }
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
ann' []
#endif
    Just XRec GhcPs [LIE GhcPs]
pr -> forall (f :: * -> *) a. Applicative f => a -> f a
pure XRec GhcPs [LIE GhcPs]
pr
  let hasSibling :: Bool
hasSibling = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (IE GhcPs)]
lies
  SrcSpan
src <- forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
  SrcSpan
top <- forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
  LocatedAn NameAnn RdrName
rdr <- 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)
  LocatedAn NameAnn RdrName
rdr <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a ast. LocatedAn a ast -> (a -> a) -> LocatedAn a ast
modifyAnns LocatedAn NameAnn RdrName
rdr forall a b. (a -> b) -> a -> b
$ Bool -> NameAnn -> NameAnn
addParens (RdrName -> Bool
isOperator forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc LocatedAn NameAnn RdrName
rdr)
#endif
  let lie :: LIEWrappedName RdrName
lie = forall e ann. Located e -> LocatedAn ann e
reLocA forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpan
src forall a b. (a -> b) -> a -> b
$ forall name. LocatedN name -> IEWrappedName name
IEName LocatedAn NameAnn RdrName
rdr
      x :: GenLocated SrcSpanAnnA (IE GhcPs)
x = forall e ann. Located e -> LocatedAn ann e
reLocA forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpan
top forall a b. (a -> b) -> a -> b
$ forall pass. XIEVar pass -> LIEWrappedName (IdP pass) -> IE pass
IEVar NoExtField
noExtField LIEWrappedName RdrName
lie
#if MIN_VERSION_ghc(9,2,0)
  GenLocated SrcSpanAnnA (IE GhcPs)
x <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if Bool
hasSibling then forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first SrcSpanAnnA -> SrcSpanAnnA
addComma GenLocated SrcSpanAnnA (IE GhcPs)
x else GenLocated SrcSpanAnnA (IE GhcPs)
x
  [GenLocated SrcSpanAnnA (IE GhcPs)]
lies <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s a. Cons s s a a => Traversal' s a
_head (forall t a. Default t => LocatedAn t a -> DeltaPos -> LocatedAn t a
`setEntryDP` Int -> DeltaPos
SameLine Int
1) [GenLocated SrcSpanAnnA (IE GhcPs)]
lies
#endif
#if !MIN_VERSION_ghc(9,2,0)
      singleHide = L l' [x]
  when (isNothing mlies) $ do
    addSimpleAnnT
      singleHide
      dp00
      [ (G AnnHiding, DP (0, 1))
      , (G AnnOpenP, DP (0, 1))
      , (G AnnCloseP, DP (0, 0))
      ]
  addSimpleAnnT x (DP (0, 0)) []
  addSimpleAnnT rdr dp00 $ unqalDP 0 $ isOperator $ unLoc rdr
  if hasSibling
    then do
      addTrailingCommaT x
      addSimpleAnnT (head lies) (DP (0, 1)) []
      unless (null $ tail lies) $
        addTrailingCommaT (head lies) -- Why we need this?
    else forM_ mlies $ \lies0 -> do
      transferAnn lies0 singleHide id
#endif
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l ImportDecl GhcPs
idecls{ideclHiding :: Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding = forall a. a -> Maybe a
Just (Bool
True, forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l' forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (IE GhcPs)
x forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (IE GhcPs)]
lies)}
 where
  isOperator :: RdrName -> Bool
isOperator = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAlphaNum forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> String
occNameString 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
-> XRec GhcPs [LIE GhcPs]
-> DynFlags
-> TransformT (Either String) (LImportDecl GhcPs)
deleteFromImport (String -> Text
T.pack -> Text
symbol) (L SrcSpanAnnA
l ImportDecl GhcPs
idecl) llies :: XRec GhcPs [LIE GhcPs]
llies@(L SrcSpanAnnL
lieLoc [GenLocated SrcSpanAnnA (IE GhcPs)]
lies) DynFlags
_ = do
  let edited :: GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
edited = forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
lieLoc [GenLocated SrcSpanAnnA (IE GhcPs)]
deletedLies
      lidecl' :: GenLocated SrcSpanAnnA (ImportDecl GhcPs)
lidecl' =
        forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l forall a b. (a -> b) -> a -> b
$
          ImportDecl GhcPs
idecl
            { ideclHiding :: Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding = forall a. a -> Maybe a
Just (Bool
False, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
edited)
            }
#if !MIN_VERSION_ghc(9,2,0)
  -- avoid import A (foo,)
  whenJust (lastMaybe deletedLies) removeTrailingCommaT
  when (not (null lies) && null deletedLies) $ do
    transferAnn llies edited id
    addSimpleAnnT
      edited
      dp00
      [ (G AnnOpenP, DP (0, 1))
      , (G AnnCloseP, DP (0, 0))
      ]
#endif
  forall (f :: * -> *) a. Applicative f => a -> f a
pure GenLocated SrcSpanAnnA (ImportDecl GhcPs)
lidecl'
 where
  deletedLies :: [GenLocated SrcSpanAnnA (IE GhcPs)]
deletedLies =
#if MIN_VERSION_ghc(9,2,0)
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s a. Snoc s s a a => Traversal' s a
_last forall ast.
GenLocated SrcSpanAnnA ast -> GenLocated SrcSpanAnnA ast
removeTrailingComma forall a b. (a -> b) -> a -> b
$
#endif
    forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LIE GhcPs -> Maybe (LIE GhcPs)
killLie [GenLocated SrcSpanAnnA (IE GhcPs)]
lies
  killLie :: LIE GhcPs -> Maybe (LIE GhcPs)
  killLie :: LIE GhcPs -> Maybe (LIE GhcPs)
killLie v :: LIE GhcPs
v@(L SrcSpanAnnA
_ (IEVar XIEVar GhcPs
_ (L SrcSpanAnnA
_ (IEWrappedName RdrName -> Text
unqualIEWrapName -> Text
nam))))
    | Text
nam forall a. Eq a => a -> a -> Bool
== Text
symbol = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just LIE GhcPs
v
  killLie v :: LIE GhcPs
v@(L SrcSpanAnnA
_ (IEThingAbs XIEThingAbs GhcPs
_ (L SrcSpanAnnA
_ (IEWrappedName RdrName -> Text
unqualIEWrapName -> Text
nam))))
    | Text
nam forall a. Eq a => a -> a -> Bool
== Text
symbol = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just LIE GhcPs
v
#if !MIN_VERSION_ghc(9,2,0)
  killLie (L lieL (IEThingWith xt ty@(L _ (unqualIEWrapName -> nam)) wild cons flds))
#else
  killLie (L SrcSpanAnnA
lieL (IEThingWith XIEThingWith GhcPs
xt ty :: GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))
ty@(L SrcSpanAnnA
_ (IEWrappedName RdrName -> Text
unqualIEWrapName -> Text
nam)) IEWildcard
wild [GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))]
cons))
#endif
    | Text
nam forall a. Eq a => a -> a -> Bool
== Text
symbol = forall a. Maybe a
Nothing
    | Bool
otherwise =
      forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
        forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
lieL forall a b. (a -> b) -> a -> b
$
          forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> IE pass
IEThingWith
            XIEThingWith GhcPs
xt
            GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))
ty
            IEWildcard
wild
            (forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= Text
symbol) forall b c a. (b -> c) -> (a -> b) -> a -> c
. IEWrappedName RdrName -> Text
unqualIEWrapName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) [GenLocated SrcSpanAnnA (IEWrappedName (IdP GhcPs))]
cons)
#if !MIN_VERSION_ghc(9,2,0)
            (filter ((/= symbol) . T.pack . Util.unpackFS . flLabel . unLoc) flds)
#endif
  killLie LIE GhcPs
v = forall a. a -> Maybe a
Just LIE GhcPs
v