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

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

    -- * Utilities

    appendConstraint,
    extendImport,
  )
where

import Control.Applicative
import Control.Monad
import Control.Monad.Trans
import Data.Data (Data)
import Data.Functor
import qualified Data.HashMap.Strict as HMap
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust)
import qualified Data.Text as T
import Development.IDE.GHC.Compat hiding (parseExpr)
import Development.IDE.GHC.ExactPrint
import Development.IDE.Types.Location
import GhcPlugins (realSrcSpanEnd, realSrcSpanStart, sigPrec)
import Language.Haskell.GHC.ExactPrint
import Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP), KeywordId (G), mkAnnKey)
import Language.Haskell.LSP.Types
import OccName
import Outputable (ppr, showSDocUnsafe)

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


-- | 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 'WorkspaceEdit'.

rewriteToEdit ::
  DynFlags ->
  Uri ->
  Anns ->
  Rewrite ->
  Either String WorkspaceEdit
rewriteToEdit :: DynFlags -> Uri -> Anns -> Rewrite -> Either String WorkspaceEdit
rewriteToEdit DynFlags
dflags Uri
uri 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
$ DynFlags -> TransformT (Either String) (Located ast)
f DynFlags
dflags
  let editMap :: HashMap Uri (List TextEdit)
editMap =
        [(Uri, List TextEdit)] -> HashMap Uri (List TextEdit)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMap.fromList
          [ ( Uri
uri,
              [TextEdit] -> List TextEdit
forall a. [a] -> List a
List
                [ 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
$ String -> String
forall a. [a] -> [a]
tail (String -> String) -> String -> String
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
                ]
            )
          ]
  WorkspaceEdit -> Either String WorkspaceEdit
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WorkspaceEdit -> Either String WorkspaceEdit)
-> WorkspaceEdit -> Either String WorkspaceEdit
forall a b. (a -> b) -> a -> b
$ Maybe (HashMap Uri (List TextEdit))
-> Maybe (List TextDocumentEdit) -> WorkspaceEdit
WorkspaceEdit (HashMap Uri (List TextEdit) -> Maybe (HashMap Uri (List TextEdit))
forall a. a -> Maybe a
Just HashMap Uri (List TextEdit)
editMap) Maybe (List TextDocumentEdit)
forall a. Maybe a
Nothing

srcSpanToRange :: SrcSpan -> Maybe Range
srcSpanToRange :: SrcSpan -> Maybe Range
srcSpanToRange (UnhelpfulSpan FastString
_) = Maybe Range
forall a. Maybe a
Nothing
srcSpanToRange (RealSrcSpan RealSrcSpan
real) = Range -> Maybe Range
forall a. a -> Maybe a
Just (Range -> Maybe Range) -> Range -> Maybe Range
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
real

realSrcSpanToRange :: RealSrcSpan -> Range
realSrcSpanToRange :: RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
real =
  Position -> Position -> Range
Range
    (RealSrcLoc -> Position
realSrcLocToPosition (RealSrcLoc -> Position) -> RealSrcLoc -> Position
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
real)
    (RealSrcLoc -> Position
realSrcLocToPosition (RealSrcLoc -> Position) -> RealSrcLoc -> Position
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
real)

realSrcLocToPosition :: RealSrcLoc -> Position
realSrcLocToPosition :: RealSrcLoc -> Position
realSrcLocToPosition RealSrcLoc
real =
  Int -> Int -> Position
Position (RealSrcLoc -> Int
srcLocLine RealSrcLoc
real Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (RealSrcLoc -> Int
srcLocCol RealSrcLoc
real Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

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


-- | 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
1)) ([(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 (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 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
    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 () --> 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 (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
          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)