{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}

module Development.IDE.Plugin.CodeAction.ExactPrint
  ( Rewrite (..),
    rewriteToEdit,
    rewriteToWEdit,
    transferAnn,

    -- * Utilities
    appendConstraint,
    extendImport,
    hideImplicitPreludeSymbol,
    hideSymbol,
    liftParseAST,
  )
where

import Control.Applicative
import Control.Monad
import Control.Monad.Trans
import Data.Char (isAlphaNum)
import Data.Data (Data)
import Data.Functor
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust, isNothing, mapMaybe)
import qualified Data.Text as T
import Development.IDE.GHC.Compat hiding (parseExpr)
import Development.IDE.GHC.ExactPrint
    ( Annotate, ASTElement(parseAST) )
import FieldLabel (flLabel)
import GhcPlugins (sigPrec, mkRealSrcLoc)
import Language.Haskell.GHC.ExactPrint
import Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP), KeywordId (G), mkAnnKey)
import Language.LSP.Types
import OccName
import Outputable (ppr, showSDocUnsafe, showSDoc)
import Retrie.GHC (rdrNameOcc, unpackFS, mkRealSrcSpan, realSrcSpanEnd)
import Development.IDE.Spans.Common
import Development.IDE.GHC.Error
import Data.Generics (listify)
import GHC.Exts (IsList (fromList))
import Control.Monad.Extra (whenJust)

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

-- | Construct a 'Rewrite', replacing the node at the given 'SrcSpan' with the
--   given 'ast'.
data Rewrite where
  Rewrite ::
    Annotate ast =>
    -- | The 'SrcSpan' that we want to rewrite
    SrcSpan ->
    -- | The ast that we want to graft
    (DynFlags -> TransformT (Either String) (Located ast)) ->
    Rewrite

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

-- | Convert a 'Rewrite' into a list of '[TextEdit]'.
rewriteToEdit ::
  DynFlags ->
  Anns ->
  Rewrite ->
  Either String [TextEdit]
rewriteToEdit :: DynFlags -> Anns -> Rewrite -> Either String [TextEdit]
rewriteToEdit DynFlags
dflags Anns
anns (Rewrite SrcSpan
dst DynFlags -> TransformT (Either String) (Located ast)
f) = do
  (Located ast
ast, (Anns
anns, Int
_), [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 Anns
anns (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
      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))
  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 Anns
anns
                ]
  [TextEdit] -> Either String [TextEdit]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TextEdit]
editMap

-- | Convert a 'Rewrite' into a 'WorkspaceEdit'
rewriteToWEdit :: DynFlags -> Uri -> Anns -> Rewrite -> Either String WorkspaceEdit
rewriteToWEdit :: DynFlags -> Uri -> Anns -> Rewrite -> Either String WorkspaceEdit
rewriteToWEdit DynFlags
dflags Uri
uri Anns
anns Rewrite
r = do
    [TextEdit]
edits <- DynFlags -> Anns -> Rewrite -> Either String [TextEdit]
rewriteToEdit DynFlags
dflags Anns
anns 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) -> 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
            }

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

-- | Fix the parentheses around a type context
fixParens ::
  (Monad m, Data (HsType pass)) =>
  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
  -- Paren annotation for type contexts are usually quite screwed up
  -- we remove duplicates and fix negative DPs
  (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 pass] -> TransformT m [LHsType pass]
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsType pass] -> TransformT m [LHsType pass])
-> [LHsType pass] -> TransformT m [LHsType pass]
forall a b. (a -> b) -> a -> b
$ (LHsType pass -> LHsType pass) -> [LHsType pass] -> [LHsType pass]
forall a b. (a -> b) -> [a] -> [b]
map LHsType pass -> LHsType pass
forall pass. LHsType pass -> LHsType pass
dropHsParTy [LHsType pass]
elems
  where
    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)]

    dropHsParTy :: LHsType pass -> LHsType pass
    dropHsParTy :: LHsType pass -> LHsType pass
dropHsParTy (L SrcSpan
_ (HsParTy XParTy pass
_ LHsType pass
ty)) = LHsType pass
ty
    dropHsParTy LHsType pass
other = LHsType pass
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 = LHsType GhcPs -> Rewrite
go
  where
    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
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.
ASTElement ast =>
DynFlags -> String -> TransformT (Either String) (Located ast)
liftParseAST DynFlags
df String
constraintT
      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))

      -- 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
      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.
(Monad m, Data (HsType pass)) =>
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]}
    go (L SrcSpan
_ HsForAllTy {LHsType GhcPs
hst_body :: forall pass. HsType pass -> LHsType pass
hst_body :: LHsType GhcPs
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 (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
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
      -- there isn't a context, so we must create one
      LHsType GhcPs
constraint <- DynFlags -> String -> TransformT (Either String) (LHsType GhcPs)
forall ast.
ASTElement ast =>
DynFlags -> String -> TransformT (Either String) (Located 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
      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 ((Int, Int) -> DeltaPos
DP (Int
0, Int
0)) ([(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
            ]
      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
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 (SrcSpan -> HsType GhcPs -> LHsType GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l HsType GhcPs
other)

liftParseAST :: ASTElement ast => DynFlags -> String -> TransformT (Either String) (Located ast)
liftParseAST :: DynFlags -> String -> TransformT (Either String) (Located ast)
liftParseAST DynFlags
df String
s = case Parser (Located ast)
forall ast. ASTElement ast => Parser (Located ast)
parseAST DynFlags
df String
"" String
s of
  Right (Anns
anns, Located 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) ()
-> Located ast -> TransformT (Either String) (Located ast)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Located ast
x
  Left ErrorMessages
_ -> Either String (Located ast)
-> TransformT (Either String) (Located ast)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String (Located ast)
 -> TransformT (Either String) (Located ast))
-> Either String (Located ast)
-> TransformT (Either String) (Located ast)
forall a b. (a -> b) -> a -> b
$ String -> Either String (Located ast)
forall a b. a -> Either a b
Left (String -> Either String (Located ast))
-> String -> Either String (Located ast)
forall a b. (a -> b) -> a -> b
$ String
"No parse: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s

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)

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

-- | 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 :: 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

------------------------------------------------------------------------------
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
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
_ -> DynFlags
-> String
-> LImportDecl GhcPs
-> TransformT (Either String) (LImportDecl GhcPs)
extendImportTopLevel DynFlags
df String
identifier LImportDecl GhcPs
lDecl

-- | Add an identifier to import list
--
-- extendImportTopLevel "foo" AST:
--
-- import A --> Error
-- import A (foo) --> Error
-- import A (bar) --> import A (bar, foo)
extendImportTopLevel :: DynFlags -> String -> LImportDecl GhcPs -> TransformT (Either String) (LImportDecl GhcPs)
extendImportTopLevel :: DynFlags
-> String
-> LImportDecl GhcPs
-> TransformT (Either String) (LImportDecl GhcPs)
extendImportTopLevel DynFlags
df String
idnetifier (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
    Located RdrName
rdr <- DynFlags -> String -> TransformT (Either String) (Located RdrName)
forall ast.
ASTElement ast =>
DynFlags -> String -> TransformT (Either String) (Located ast)
liftParseAST DynFlags
df String
idnetifier

    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
idnetifier String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" already imported")

    let lie :: GenLocated SrcSpan (IEWrappedName RdrName)
lie = SrcSpan
-> IEWrappedName RdrName
-> GenLocated SrcSpan (IEWrappedName RdrName)
forall l e. l -> e -> GenLocated l e
L SrcSpan
src (IEWrappedName RdrName
 -> GenLocated SrcSpan (IEWrappedName RdrName))
-> IEWrappedName RdrName
-> GenLocated SrcSpan (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 = 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)
GenLocated SrcSpan (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
idnetifier String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" already imported") else do
        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 ([(KeywordId, DeltaPos)] -> TransformT (Either String) ())
-> [(KeywordId, DeltaPos)] -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$ Bool -> [(KeywordId, DeltaPos)]
unqalDP (Bool -> [(KeywordId, DeltaPos)])
-> Bool -> [(KeywordId, DeltaPos)]
forall a b. (a -> b) -> a -> b
$ String -> Bool
hasParen String
idnetifier
        -- 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.
        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])}
extendImportTopLevel DynFlags
_ 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"

-- | 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 :: 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
-> 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)
      -- ThingAbs ie => ThingWith ie child
      | 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
        Located RdrName
childRdr <- DynFlags -> String -> TransformT (Either String) (Located RdrName)
forall ast.
ASTElement ast =>
DynFlags -> String -> TransformT (Either String) (Located ast)
liftParseAST DynFlags
df String
child
        let childLIE :: GenLocated SrcSpan (IEWrappedName RdrName)
childLIE = SrcSpan
-> IEWrappedName RdrName
-> GenLocated SrcSpan (IEWrappedName RdrName)
forall l e. l -> e -> GenLocated l e
L SrcSpan
srcChild (IEWrappedName RdrName
 -> GenLocated SrcSpan (IEWrappedName RdrName))
-> IEWrappedName RdrName
-> GenLocated SrcSpan (IEWrappedName RdrName)
forall a b. (a -> b) -> a -> b
$ Located RdrName -> IEWrappedName RdrName
forall name. Located name -> IEWrappedName name
IEName Located RdrName
childRdr
            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)
GenLocated SrcSpan (IEWrappedName RdrName)
childLIE] []
        -- take anns from ThingAbs, and attatch parens to it
        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)]
        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)}
    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)
      -- ThingWith ie lies' => ThingWith ie (lies' ++ [child])
      | 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
$ [GenLocated SrcSpan (IEWrappedName RdrName)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LIEWrappedName (IdP GhcPs)]
[GenLocated SrcSpan (IEWrappedName RdrName)]
lies' =
        do
          SrcSpan
srcChild <- TransformT (Either String) SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
          Located RdrName
childRdr <- DynFlags -> String -> TransformT (Either String) (Located RdrName)
forall ast.
ASTElement ast =>
DynFlags -> String -> TransformT (Either String) (Located ast)
liftParseAST DynFlags
df String
child

          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)
-> [GenLocated SrcSpan (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)]
[GenLocated SrcSpan (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")

          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
$
            GenLocated SrcSpan (IEWrappedName RdrName)
-> TransformT (Either String) ()
forall a (m :: * -> *).
(Data a, Monad m) =>
Located a -> TransformT m ()
addTrailingCommaT ([GenLocated SrcSpan (IEWrappedName RdrName)]
-> GenLocated SrcSpan (IEWrappedName RdrName)
forall a. [a] -> a
last [LIEWrappedName (IdP GhcPs)]
[GenLocated SrcSpan (IEWrappedName RdrName)]
lies')
          let childLIE :: GenLocated SrcSpan (IEWrappedName RdrName)
childLIE = SrcSpan
-> IEWrappedName RdrName
-> GenLocated SrcSpan (IEWrappedName RdrName)
forall l e. l -> e -> GenLocated l e
L SrcSpan
srcChild (IEWrappedName RdrName
 -> GenLocated SrcSpan (IEWrappedName RdrName))
-> IEWrappedName RdrName
-> GenLocated SrcSpan (IEWrappedName RdrName)
forall a b. (a -> b) -> a -> b
$ Located RdrName -> IEWrappedName RdrName
forall name. Located name -> IEWrappedName name
IEName Located RdrName
childRdr
          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)) ([(KeywordId, DeltaPos)] -> TransformT (Either String) ())
-> [(KeywordId, DeltaPos)] -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$ Bool -> [(KeywordId, DeltaPos)]
unqalDP (Bool -> [(KeywordId, DeltaPos)])
-> Bool -> [(KeywordId, DeltaPos)]
forall a b. (a -> b) -> a -> b
$ String -> Bool
hasParen String
child
          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)]
[GenLocated SrcSpan (IEWrappedName RdrName)]
lies' [GenLocated SrcSpan (IEWrappedName RdrName)]
-> [GenLocated SrcSpan (IEWrappedName RdrName)]
-> [GenLocated SrcSpan (IEWrappedName RdrName)]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpan (IEWrappedName RdrName)
childLIE]) [])] [LIE GhcPs] -> [LIE GhcPs] -> [LIE GhcPs]
forall a. [a] -> [a] -> [a]
++ [LIE GhcPs]
xs)}
    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
        -- [] => ThingWith parent [child]
        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.
ASTElement ast =>
DynFlags -> String -> TransformT (Either String) (Located ast)
liftParseAST DynFlags
df String
parent
        Located RdrName
childRdr <- DynFlags -> String -> TransformT (Either String) (Located RdrName)
forall ast.
ASTElement ast =>
DynFlags -> String -> TransformT (Either String) (Located ast)
liftParseAST DynFlags
df String
child
        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 :: GenLocated SrcSpan (IEWrappedName RdrName)
parentLIE = SrcSpan
-> IEWrappedName RdrName
-> GenLocated SrcSpan (IEWrappedName RdrName)
forall l e. l -> e -> GenLocated l e
L SrcSpan
srcParent (IEWrappedName RdrName
 -> GenLocated SrcSpan (IEWrappedName RdrName))
-> IEWrappedName RdrName
-> GenLocated SrcSpan (IEWrappedName RdrName)
forall a b. (a -> b) -> a -> b
$ Located RdrName -> IEWrappedName RdrName
forall name. Located name -> IEWrappedName name
IEName Located RdrName
parentRdr
            childLIE :: GenLocated SrcSpan (IEWrappedName RdrName)
childLIE = SrcSpan
-> IEWrappedName RdrName
-> GenLocated SrcSpan (IEWrappedName RdrName)
forall l e. l -> e -> GenLocated l e
L SrcSpan
srcChild (IEWrappedName RdrName
 -> GenLocated SrcSpan (IEWrappedName RdrName))
-> IEWrappedName RdrName
-> GenLocated SrcSpan (IEWrappedName RdrName)
forall a b. (a -> b) -> a -> b
$ Located RdrName -> IEWrappedName RdrName
forall name. Located name -> IEWrappedName name
IEName Located RdrName
childRdr
            LIE GhcPs
x :: LIE GhcPs = 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)
GenLocated SrcSpan (IEWrappedName RdrName)
parentLIE IEWildcard
NoIEWildcard [LIEWrappedName (IdP GhcPs)
GenLocated SrcSpan (IEWrappedName RdrName)
childLIE] []
        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
$ Bool -> [(KeywordId, DeltaPos)]
unqalDP (Bool -> [(KeywordId, DeltaPos)])
-> Bool -> [(KeywordId, DeltaPos)]
forall a b. (a -> b) -> a -> b
$ String -> Bool
hasParen String
parent
        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)) ([(KeywordId, DeltaPos)] -> TransformT (Either String) ())
-> [(KeywordId, DeltaPos)] -> TransformT (Either String) ()
forall a b. (a -> b) -> a -> b
$ Bool -> [(KeywordId, DeltaPos)]
unqalDP (Bool -> [(KeywordId, DeltaPos)])
-> Bool -> [(KeywordId, DeltaPos)]
forall a b. (a -> b) -> a -> b
$ String -> Bool
hasParen String
child
        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))]
        -- 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.
        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
        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

unqalDP :: Bool -> [(KeywordId, DeltaPos)]
unqalDP :: Bool -> [(KeywordId, DeltaPos)]
unqalDP Bool
paren =
  ( if Bool
paren
      then \(KeywordId, DeltaPos)
x -> (AnnKeywordId -> KeywordId
G AnnKeywordId
AnnOpenP, DeltaPos
dp00) (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)

------------------------------------------------------------------------------
-- | Hide a symbol from import declaration
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
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
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
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 ->
    Maybe (Located [LIE GhcPs]) ->
    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
        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
        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.
ASTElement ast =>
DynFlags -> String -> TransformT (Either String) (Located ast)
liftParseAST DynFlags
df String
symbol
    let lie :: GenLocated SrcSpan (IEWrappedName RdrName)
lie = SrcSpan
-> IEWrappedName RdrName
-> GenLocated SrcSpan (IEWrappedName RdrName)
forall l e. l -> e -> GenLocated l e
L SrcSpan
src (IEWrappedName RdrName
 -> GenLocated SrcSpan (IEWrappedName RdrName))
-> IEWrappedName RdrName
-> GenLocated SrcSpan (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 = 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)
GenLocated SrcSpan (IEWrappedName RdrName)
lie
        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
$ Bool -> [(KeywordId, DeltaPos)]
unqalDP (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 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
$ 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) -- Why we need this?
        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
    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 ->
    Located [LIE GhcPs] ->
    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)
            }
    -- avoid import A (foo,)
    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))
            ]
    LImportDecl GhcPs -> TransformT (Either String) (LImportDecl GhcPs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure LImportDecl GhcPs
lidecl'
    where
        deletedLies :: [LIE GhcPs]
deletedLies =
            (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

        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))
            | 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
                  ((GenLocated SrcSpan (IEWrappedName RdrName) -> Bool)
-> [GenLocated SrcSpan (IEWrappedName RdrName)]
-> [GenLocated SrcSpan (IEWrappedName RdrName)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
symbol) (Text -> Bool)
-> (GenLocated SrcSpan (IEWrappedName RdrName) -> Text)
-> GenLocated SrcSpan (IEWrappedName RdrName)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IEWrappedName RdrName -> Text
unqualIEWrapName (IEWrappedName RdrName -> Text)
-> (GenLocated SrcSpan (IEWrappedName RdrName)
    -> IEWrappedName RdrName)
-> GenLocated SrcSpan (IEWrappedName RdrName)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (IEWrappedName RdrName) -> IEWrappedName RdrName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LIEWrappedName (IdP GhcPs)]
[GenLocated SrcSpan (IEWrappedName RdrName)]
cons)
                  ((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
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)
        killLie LIE GhcPs
v = LIE GhcPs -> Maybe (LIE GhcPs)
forall a. a -> Maybe a
Just LIE GhcPs
v

-- | Insert a import declaration hiding a symbole from Prelude
hideImplicitPreludeSymbol
    :: String -> ParsedSource -> Maybe Rewrite
hideImplicitPreludeSymbol :: String -> ParsedSource -> Maybe Rewrite
hideImplicitPreludeSymbol String
symbol (L SrcSpan
_ HsModule{[LHsDecl GhcPs]
[LImportDecl GhcPs]
Maybe (Located [LIE GhcPs])
Maybe LHsDocString
Maybe (Located WarningTxt)
Maybe (Located ModuleName)
hsmodName :: forall pass. HsModule pass -> Maybe (Located ModuleName)
hsmodExports :: forall pass. HsModule pass -> Maybe (Located [LIE pass])
hsmodImports :: forall pass. HsModule pass -> [LImportDecl pass]
hsmodDecls :: forall pass. HsModule pass -> [LHsDecl pass]
hsmodDeprecMessage :: forall pass. HsModule pass -> Maybe (Located WarningTxt)
hsmodHaddockModHeader :: forall pass. HsModule pass -> Maybe LHsDocString
hsmodHaddockModHeader :: Maybe LHsDocString
hsmodDeprecMessage :: Maybe (Located WarningTxt)
hsmodDecls :: [LHsDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodExports :: Maybe (Located [LIE GhcPs])
hsmodName :: Maybe (Located ModuleName)
..}) = do
    let predLine :: RealSrcLoc -> RealSrcLoc
predLine RealSrcLoc
old = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (RealSrcLoc -> FastString
srcLocFile RealSrcLoc
old) (RealSrcLoc -> Int
srcLocLine RealSrcLoc
old Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (RealSrcLoc -> Int
srcLocCol RealSrcLoc
old)
        existingImpSpan :: Maybe (RealSrcLoc -> RealSrcLoc, RealSrcSpan)
existingImpSpan =  ((RealSrcSpan -> (RealSrcLoc -> RealSrcLoc, RealSrcSpan))
-> Maybe RealSrcSpan
-> Maybe (RealSrcLoc -> RealSrcLoc, RealSrcSpan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RealSrcLoc -> RealSrcLoc
forall a. a -> a
id,) (Maybe RealSrcSpan
 -> Maybe (RealSrcLoc -> RealSrcLoc, RealSrcSpan))
-> (LImportDecl GhcPs -> Maybe RealSrcSpan)
-> LImportDecl GhcPs
-> Maybe (RealSrcLoc -> RealSrcLoc, RealSrcSpan)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> Maybe RealSrcSpan
realSpan (SrcSpan -> Maybe RealSrcSpan)
-> (LImportDecl GhcPs -> SrcSpan)
-> LImportDecl GhcPs
-> Maybe RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LImportDecl GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc) (LImportDecl GhcPs
 -> Maybe (RealSrcLoc -> RealSrcLoc, RealSrcSpan))
-> Maybe (LImportDecl GhcPs)
-> Maybe (RealSrcLoc -> RealSrcLoc, RealSrcSpan)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [LImportDecl GhcPs] -> Maybe (LImportDecl GhcPs)
forall a. [a] -> Maybe a
lastMaybe [LImportDecl GhcPs]
hsmodImports
        existingDeclSpan :: Maybe (RealSrcLoc -> RealSrcLoc, RealSrcSpan)
existingDeclSpan = ((RealSrcSpan -> (RealSrcLoc -> RealSrcLoc, RealSrcSpan))
-> Maybe RealSrcSpan
-> Maybe (RealSrcLoc -> RealSrcLoc, RealSrcSpan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RealSrcLoc -> RealSrcLoc
predLine, ) (Maybe RealSrcSpan
 -> Maybe (RealSrcLoc -> RealSrcLoc, RealSrcSpan))
-> (LHsDecl GhcPs -> Maybe RealSrcSpan)
-> LHsDecl GhcPs
-> Maybe (RealSrcLoc -> RealSrcLoc, RealSrcSpan)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> Maybe RealSrcSpan
realSpan (SrcSpan -> Maybe RealSrcSpan)
-> (LHsDecl GhcPs -> SrcSpan) -> LHsDecl GhcPs -> Maybe RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsDecl GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc) (LHsDecl GhcPs -> Maybe (RealSrcLoc -> RealSrcLoc, RealSrcSpan))
-> Maybe (LHsDecl GhcPs)
-> Maybe (RealSrcLoc -> RealSrcLoc, RealSrcSpan)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [LHsDecl GhcPs] -> Maybe (LHsDecl GhcPs)
forall a. [a] -> Maybe a
headMaybe [LHsDecl GhcPs]
hsmodDecls
    (RealSrcLoc -> RealSrcLoc
f, RealSrcSpan
s) <- Maybe (RealSrcLoc -> RealSrcLoc, RealSrcSpan)
existingImpSpan Maybe (RealSrcLoc -> RealSrcLoc, RealSrcSpan)
-> Maybe (RealSrcLoc -> RealSrcLoc, RealSrcSpan)
-> Maybe (RealSrcLoc -> RealSrcLoc, RealSrcSpan)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (RealSrcLoc -> RealSrcLoc, RealSrcSpan)
existingDeclSpan
    let beg :: RealSrcLoc
beg = RealSrcLoc -> RealSrcLoc
f (RealSrcLoc -> RealSrcLoc) -> RealSrcLoc -> RealSrcLoc
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
s
        indentation :: Int
indentation = RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
s
        ran :: SrcSpan
ran = RealSrcSpan -> SrcSpan
RealSrcSpan (RealSrcSpan -> SrcSpan) -> RealSrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$ RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan RealSrcLoc
beg RealSrcLoc
beg
    Rewrite -> Maybe Rewrite
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rewrite -> Maybe Rewrite) -> Rewrite -> Maybe Rewrite
forall a b. (a -> b) -> a -> b
$ SrcSpan
-> (DynFlags -> TransformT (Either String) (LImportDecl GhcPs))
-> Rewrite
forall ast.
Annotate ast =>
SrcSpan
-> (DynFlags -> TransformT (Either String) (Located ast))
-> Rewrite
Rewrite SrcSpan
ran ((DynFlags -> TransformT (Either String) (LImportDecl GhcPs))
 -> Rewrite)
-> (DynFlags -> TransformT (Either String) (LImportDecl GhcPs))
-> Rewrite
forall a b. (a -> b) -> a -> b
$ \DynFlags
df -> do
        let symOcc :: OccName
symOcc = String -> OccName
mkVarOcc String
symbol
            symImp :: Text
symImp = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> String
showSDoc DynFlags
df (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ OccName -> SDoc -> SDoc
parenSymOcc OccName
symOcc (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
symOcc
            impStmt :: Text
impStmt = Text
"import Prelude hiding (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
symImp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

        -- Re-labeling is needed to reflect annotations correctly
        L SrcSpan
_ ImportDecl GhcPs
idecl0 <- DynFlags
-> String -> TransformT (Either String) (LImportDecl GhcPs)
forall ast.
ASTElement ast =>
DynFlags -> String -> TransformT (Either String) (Located ast)
liftParseAST @(ImportDecl GhcPs) DynFlags
df (String -> TransformT (Either String) (LImportDecl GhcPs))
-> String -> TransformT (Either String) (LImportDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
impStmt
        let idecl :: LImportDecl GhcPs
idecl = SrcSpan -> ImportDecl GhcPs -> LImportDecl GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
ran ImportDecl GhcPs
idecl0
        LImportDecl GhcPs
-> DeltaPos
-> [(KeywordId, DeltaPos)]
-> TransformT (Either String) ()
forall a (m :: * -> *).
(Constraints a, Monad m) =>
a -> DeltaPos -> [(KeywordId, DeltaPos)] -> TransformT m ()
addSimpleAnnT LImportDecl GhcPs
idecl ((Int, Int) -> DeltaPos
DP (Int
1, Int
indentation Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
            [(AnnKeywordId -> KeywordId
G AnnKeywordId
AnnImport, (Int, Int) -> DeltaPos
DP (Int
1, Int
indentation Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))]
        LImportDecl GhcPs -> TransformT (Either String) (LImportDecl GhcPs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure LImportDecl GhcPs
idecl