{-# LANGUAGE CPP #-}
module Development.IDE.Plugin.Plugins.AddArgument (plugin) where
import Control.Monad (join)
import Control.Monad.Trans.Class (lift)
import Data.Bifunctor (Bifunctor (..))
import Data.Either.Extra (maybeToEither)
import qualified Data.Text as T
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Error (spanContainsRange)
import Development.IDE.GHC.ExactPrint (modifyMgMatchesT',
modifySigWithM,
modifySmallestDeclWithM)
import Development.IDE.Plugin.Plugins.Diagnostic
import GHC.Parser.Annotation (SrcSpanAnnA,
SrcSpanAnnN, noAnn)
import Ide.Plugin.Error (PluginError (PluginInternalError))
import Ide.PluginUtils (makeDiffTextEdit)
import Language.Haskell.GHC.ExactPrint (TransformT (..),
exactPrint,
noAnnSrcSpanDP1,
runTransformT)
import Language.LSP.Protocol.Types
#if !MIN_VERSION_ghc(9,4,0)
import GHC.Parser.Annotation (IsUnicodeSyntax (..),
TrailingAnn (..))
import Language.Haskell.GHC.ExactPrint (d1)
#endif
#if MIN_VERSION_ghc(9,4,0) && !MIN_VERSION_ghc(9,9,0)
import Development.IDE.GHC.ExactPrint (epl)
import GHC.Parser.Annotation (TokenLocation (..))
#endif
#if !MIN_VERSION_ghc(9,9,0)
import Development.IDE.GHC.Compat.ExactPrint (makeDeltaAst)
import Development.IDE.GHC.ExactPrint (genAnchor1)
import GHC.Parser.Annotation (EpAnn (..),
SrcSpanAnn' (..),
emptyComments)
import GHC.Types.SrcLoc (generatedSrcSpan)
#endif
#if MIN_VERSION_ghc(9,9,0)
import GHC (DeltaPos (..),
EpUniToken (..),
IsUnicodeSyntax (NormalSyntax))
import Language.Haskell.GHC.ExactPrint (d1, setEntryDP)
#endif
plugin :: ParsedModule -> Diagnostic -> Either PluginError [(T.Text, [TextEdit])]
plugin :: ParsedModule
-> Diagnostic -> Either PluginError [(Text, [TextEdit])]
plugin ParsedModule
parsedModule Diagnostic {Text
_message :: Text
$sel:_message:Diagnostic :: Diagnostic -> Text
_message, Range
_range :: Range
$sel:_range:Diagnostic :: Diagnostic -> Range
_range}
| Just (Text
name, Maybe Text
typ) <- Text -> Maybe (Text, Maybe Text)
matchVariableNotInScope Text
message = ParsedModule
-> Range
-> Text
-> Maybe Text
-> Either PluginError [(Text, [TextEdit])]
addArgumentAction ParsedModule
parsedModule Range
_range Text
name Maybe Text
typ
| Just (Text
name, Text
typ) <- Text -> Maybe (Text, Text)
matchFoundHoleIncludeUnderscore Text
message = ParsedModule
-> Range
-> Text
-> Maybe Text
-> Either PluginError [(Text, [TextEdit])]
addArgumentAction ParsedModule
parsedModule Range
_range Text
name (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
typ)
| Bool
otherwise = [(Text, [TextEdit])] -> Either PluginError [(Text, [TextEdit])]
forall a. a -> Either PluginError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
where
message :: Text
message = Text -> Text
unifySpaces Text
_message
addArgToMatch :: T.Text -> GenLocated l (Match GhcPs (LocatedA (HsExpr GhcPs))) -> (GenLocated l (Match GhcPs (LocatedA (HsExpr GhcPs))), Int)
addArgToMatch :: forall l.
Text
-> GenLocated l (Match GhcPs (LocatedA (HsExpr GhcPs)))
-> (GenLocated l (Match GhcPs (LocatedA (HsExpr GhcPs))), Int)
addArgToMatch Text
name (L l
locMatch (Match XCMatch GhcPs (LocatedA (HsExpr GhcPs))
xMatch HsMatchContext GhcPs
ctxMatch [LPat GhcPs]
pats GRHSs GhcPs (LocatedA (HsExpr GhcPs))
rhs)) =
let unqualName :: RdrName
unqualName = OccName -> RdrName
mkRdrUnqual (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ String -> OccName
mkVarOcc (String -> OccName) -> String -> OccName
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
name
#if MIN_VERSION_ghc(9,9,0)
newPat = L noAnnSrcSpanDP1 $ VarPat NoExtField $ L noAnn unqualName
indentRhs :: GRHSs GhcPs (LocatedA (HsExpr GhcPs)) -> GRHSs GhcPs (LocatedA (HsExpr GhcPs))
indentRhs rhs@GRHSs{grhssGRHSs} = rhs {grhssGRHSs = fmap (`setEntryDP` (SameLine 1)) grhssGRHSs }
#else
newPat :: GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (Pat GhcPs)
newPat = SrcSpanAnn' (EpAnn AnnListItem)
-> Pat GhcPs
-> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (Pat GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnn' (EpAnn AnnListItem)
forall ann. Monoid ann => SrcSpan -> SrcSpanAnn' (EpAnn ann)
noAnnSrcSpanDP1 SrcSpan
generatedSrcSpan) (Pat GhcPs
-> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (Pat GhcPs))
-> Pat GhcPs
-> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ XVarPat GhcPs -> LIdP GhcPs -> Pat GhcPs
forall p. XVarPat p -> LIdP p -> Pat p
VarPat XVarPat GhcPs
NoExtField
NoExtField (RdrName -> LocatedAn NameAnn RdrName
forall a an. a -> LocatedAn an a
noLocA RdrName
unqualName)
indentRhs :: a -> a
indentRhs = a -> a
forall a. a -> a
id
#endif
in (l
-> Match GhcPs (LocatedA (HsExpr GhcPs))
-> GenLocated l (Match GhcPs (LocatedA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L l
locMatch (XCMatch GhcPs (LocatedA (HsExpr GhcPs))
-> HsMatchContext GhcPs
-> [LPat GhcPs]
-> GRHSs GhcPs (LocatedA (HsExpr GhcPs))
-> Match GhcPs (LocatedA (HsExpr GhcPs))
forall p body.
XCMatch p body
-> HsMatchContext p -> [LPat p] -> GRHSs p body -> Match p body
Match XCMatch GhcPs (LocatedA (HsExpr GhcPs))
xMatch HsMatchContext GhcPs
ctxMatch ([LPat GhcPs]
[GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (Pat GhcPs)]
pats [GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (Pat GhcPs)]
-> [GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (Pat GhcPs)]
-> [GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (Pat GhcPs)]
forall a. Semigroup a => a -> a -> a
<> [GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (Pat GhcPs)
newPat]) (GRHSs GhcPs (LocatedA (HsExpr GhcPs))
-> GRHSs GhcPs (LocatedA (HsExpr GhcPs))
forall a. a -> a
indentRhs GRHSs GhcPs (LocatedA (HsExpr GhcPs))
rhs)), [GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (Pat GhcPs)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [LPat GhcPs]
[GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (Pat GhcPs)]
pats)
appendFinalPatToMatches :: T.Text -> LHsDecl GhcPs -> TransformT (Either PluginError) (LHsDecl GhcPs, Maybe (GenLocated SrcSpanAnnN RdrName, Int))
appendFinalPatToMatches :: Text
-> LHsDecl GhcPs
-> TransformT
(Either PluginError)
(LHsDecl GhcPs, Maybe (LocatedAn NameAnn RdrName, Int))
appendFinalPatToMatches Text
name = \case
(L SrcSpanAnn' (EpAnn AnnListItem)
locDecl (ValD XValD GhcPs
xVal fun :: HsBind GhcPs
fun@FunBind{fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches=MatchGroup GhcPs (LHsExpr GhcPs)
mg,fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = LIdP GhcPs
idFunBind})) -> do
(MatchGroup GhcPs (LHsExpr GhcPs)
mg', Maybe Int
numPatsMay) <- MatchGroup GhcPs (LHsExpr GhcPs)
-> (LMatch GhcPs (LHsExpr GhcPs)
-> TransformT
(Either PluginError) (LMatch GhcPs (LHsExpr GhcPs), Maybe Int))
-> Maybe Int
-> (Maybe Int -> Maybe Int -> Either PluginError (Maybe Int))
-> TransformT
(Either PluginError) (MatchGroup GhcPs (LHsExpr GhcPs), Maybe Int)
forall (m :: * -> *) r.
Monad m =>
MatchGroup GhcPs (LHsExpr GhcPs)
-> (LMatch GhcPs (LHsExpr GhcPs)
-> TransformT m (LMatch GhcPs (LHsExpr GhcPs), r))
-> r
-> (r -> r -> m r)
-> TransformT m (MatchGroup GhcPs (LHsExpr GhcPs), r)
modifyMgMatchesT' MatchGroup GhcPs (LHsExpr GhcPs)
mg ((GenLocated
(SrcSpanAnn' (EpAnn AnnListItem))
(Match GhcPs (LocatedA (HsExpr GhcPs))),
Maybe Int)
-> TransformT
(Either PluginError)
(GenLocated
(SrcSpanAnn' (EpAnn AnnListItem))
(Match GhcPs (LocatedA (HsExpr GhcPs))),
Maybe Int)
forall a. a -> TransformT (Either PluginError) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((GenLocated
(SrcSpanAnn' (EpAnn AnnListItem))
(Match GhcPs (LocatedA (HsExpr GhcPs))),
Maybe Int)
-> TransformT
(Either PluginError)
(GenLocated
(SrcSpanAnn' (EpAnn AnnListItem))
(Match GhcPs (LocatedA (HsExpr GhcPs))),
Maybe Int))
-> (GenLocated
(SrcSpanAnn' (EpAnn AnnListItem))
(Match GhcPs (LocatedA (HsExpr GhcPs)))
-> (GenLocated
(SrcSpanAnn' (EpAnn AnnListItem))
(Match GhcPs (LocatedA (HsExpr GhcPs))),
Maybe Int))
-> GenLocated
(SrcSpanAnn' (EpAnn AnnListItem))
(Match GhcPs (LocatedA (HsExpr GhcPs)))
-> TransformT
(Either PluginError)
(GenLocated
(SrcSpanAnn' (EpAnn AnnListItem))
(Match GhcPs (LocatedA (HsExpr GhcPs))),
Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Maybe Int)
-> (GenLocated
(SrcSpanAnn' (EpAnn AnnListItem))
(Match GhcPs (LocatedA (HsExpr GhcPs))),
Int)
-> (GenLocated
(SrcSpanAnn' (EpAnn AnnListItem))
(Match GhcPs (LocatedA (HsExpr GhcPs))),
Maybe Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Int -> Maybe Int
forall a. a -> Maybe a
Just ((GenLocated
(SrcSpanAnn' (EpAnn AnnListItem))
(Match GhcPs (LocatedA (HsExpr GhcPs))),
Int)
-> (GenLocated
(SrcSpanAnn' (EpAnn AnnListItem))
(Match GhcPs (LocatedA (HsExpr GhcPs))),
Maybe Int))
-> (GenLocated
(SrcSpanAnn' (EpAnn AnnListItem))
(Match GhcPs (LocatedA (HsExpr GhcPs)))
-> (GenLocated
(SrcSpanAnn' (EpAnn AnnListItem))
(Match GhcPs (LocatedA (HsExpr GhcPs))),
Int))
-> GenLocated
(SrcSpanAnn' (EpAnn AnnListItem))
(Match GhcPs (LocatedA (HsExpr GhcPs)))
-> (GenLocated
(SrcSpanAnn' (EpAnn AnnListItem))
(Match GhcPs (LocatedA (HsExpr GhcPs))),
Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> GenLocated
(SrcSpanAnn' (EpAnn AnnListItem))
(Match GhcPs (LocatedA (HsExpr GhcPs)))
-> (GenLocated
(SrcSpanAnn' (EpAnn AnnListItem))
(Match GhcPs (LocatedA (HsExpr GhcPs))),
Int)
forall l.
Text
-> GenLocated l (Match GhcPs (LocatedA (HsExpr GhcPs)))
-> (GenLocated l (Match GhcPs (LocatedA (HsExpr GhcPs))), Int)
addArgToMatch Text
name) Maybe Int
forall a. Maybe a
Nothing Maybe Int -> Maybe Int -> Either PluginError (Maybe Int)
forall {a}.
Eq a =>
Maybe a -> Maybe a -> Either PluginError (Maybe a)
combineMatchNumPats
Int
numPats <- RWST () [String] Int (Either PluginError) Int
-> TransformT (Either PluginError) Int
forall (m :: * -> *) a. RWST () [String] Int m a -> TransformT m a
TransformT (RWST () [String] Int (Either PluginError) Int
-> TransformT (Either PluginError) Int)
-> RWST () [String] Int (Either PluginError) Int
-> TransformT (Either PluginError) Int
forall a b. (a -> b) -> a -> b
$ Either PluginError Int
-> RWST () [String] Int (Either PluginError) Int
forall (m :: * -> *) a. Monad m => m a -> RWST () [String] Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either PluginError Int
-> RWST () [String] Int (Either PluginError) Int)
-> Either PluginError Int
-> RWST () [String] Int (Either PluginError) Int
forall a b. (a -> b) -> a -> b
$ PluginError -> Maybe Int -> Either PluginError Int
forall a b. a -> Maybe b -> Either a b
maybeToEither (Text -> PluginError
PluginInternalError Text
"Unexpected empty match group in HsDecl") Maybe Int
numPatsMay
let decl' :: GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
decl' = SrcSpanAnn' (EpAnn AnnListItem)
-> HsDecl GhcPs
-> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnn' (EpAnn AnnListItem)
locDecl (XValD GhcPs -> HsBind GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
ValD XValD GhcPs
xVal HsBind GhcPs
fun{fun_matches=mg'})
(GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs),
Maybe (LocatedAn NameAnn RdrName, Int))
-> TransformT
(Either PluginError)
(GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs),
Maybe (LocatedAn NameAnn RdrName, Int))
forall a. a -> TransformT (Either PluginError) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
decl', (LocatedAn NameAnn RdrName, Int)
-> Maybe (LocatedAn NameAnn RdrName, Int)
forall a. a -> Maybe a
Just (LIdP GhcPs
LocatedAn NameAnn RdrName
idFunBind, Int
numPats))
LHsDecl GhcPs
decl -> (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs),
Maybe (LocatedAn NameAnn RdrName, Int))
-> TransformT
(Either PluginError)
(GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs),
Maybe (LocatedAn NameAnn RdrName, Int))
forall a. a -> TransformT (Either PluginError) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LHsDecl GhcPs
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
decl, Maybe (LocatedAn NameAnn RdrName, Int)
forall a. Maybe a
Nothing)
where
combineMatchNumPats :: Maybe a -> Maybe a -> Either PluginError (Maybe a)
combineMatchNumPats Maybe a
Nothing Maybe a
other = Maybe a -> Either PluginError (Maybe a)
forall a. a -> Either PluginError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
other
combineMatchNumPats Maybe a
other Maybe a
Nothing = Maybe a -> Either PluginError (Maybe a)
forall a. a -> Either PluginError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
other
combineMatchNumPats (Just a
l) (Just a
r)
| a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
r = Maybe a -> Either PluginError (Maybe a)
forall a. a -> Either PluginError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
l)
| Bool
otherwise = PluginError -> Either PluginError (Maybe a)
forall a b. a -> Either a b
Left (PluginError -> Either PluginError (Maybe a))
-> PluginError -> Either PluginError (Maybe a)
forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInternalError Text
"Unexpected different numbers of patterns in HsDecl MatchGroup"
addArgumentAction :: ParsedModule -> Range -> T.Text -> Maybe T.Text -> Either PluginError [(T.Text, [TextEdit])]
addArgumentAction :: ParsedModule
-> Range
-> Text
-> Maybe Text
-> Either PluginError [(Text, [TextEdit])]
addArgumentAction (ParsedModule ModSummary
_ ParsedSource
moduleSrc [String]
_ ()
_) Range
range Text
name Maybe Text
_typ = do
(ParsedSource
newSource, Int
_, [String]
_) <- TransformT (Either PluginError) ParsedSource
-> Either PluginError (ParsedSource, Int, [String])
forall (m :: * -> *) a. TransformT m a -> m (a, Int, [String])
runTransformT (TransformT (Either PluginError) ParsedSource
-> Either PluginError (ParsedSource, Int, [String]))
-> TransformT (Either PluginError) ParsedSource
-> Either PluginError (ParsedSource, Int, [String])
forall a b. (a -> b) -> a -> b
$ do
(ParsedSource
moduleSrc', Maybe (Maybe (LocatedAn NameAnn RdrName, Int))
-> Maybe (LocatedAn NameAnn RdrName, Int)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join -> Maybe (LocatedAn NameAnn RdrName, Int)
matchedDeclNameMay) <- ParsedSource
-> TransformT
(Either PluginError)
(ParsedSource, Maybe (Maybe (LocatedAn NameAnn RdrName, Int)))
addNameAsLastArgOfMatchingDecl
#if MIN_VERSION_ghc(9,9,0)
moduleSrc
#else
(ParsedSource -> ParsedSource
forall ast. ExactPrint ast => ast -> ast
makeDeltaAst ParsedSource
moduleSrc)
#endif
case Maybe (LocatedAn NameAnn RdrName, Int)
matchedDeclNameMay of
Just (LocatedAn NameAnn RdrName
matchedDeclName, Int
numPats) -> IdP GhcPs
-> (LHsSigType GhcPs -> LHsSigType GhcPs)
-> ParsedSource
-> TransformT (Either PluginError) ParsedSource
forall a (m :: * -> *).
(HasDecls a, Monad m, ExactPrint a) =>
IdP GhcPs
-> (LHsSigType GhcPs -> LHsSigType GhcPs) -> a -> TransformT m a
modifySigWithM (LocatedAn NameAnn RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LocatedAn NameAnn RdrName
matchedDeclName) (Int -> LHsSigType GhcPs -> LHsSigType GhcPs
addTyHoleToTySigArg Int
numPats) ParsedSource
moduleSrc'
Maybe (LocatedAn NameAnn RdrName, Int)
Nothing -> ParsedSource -> TransformT (Either PluginError) ParsedSource
forall a. a -> TransformT (Either PluginError) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParsedSource
moduleSrc'
let diff :: [TextEdit]
diff = Text -> Text -> [TextEdit]
makeDiffTextEdit (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParsedSource -> String
forall ast. ExactPrint ast => ast -> String
exactPrint ParsedSource
moduleSrc) (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParsedSource -> String
forall ast. ExactPrint ast => ast -> String
exactPrint ParsedSource
newSource)
[(Text, [TextEdit])] -> Either PluginError [(Text, [TextEdit])]
forall a. a -> Either PluginError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Text
"Add argument ‘" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"’ to function", [TextEdit]
diff)]
where
addNameAsLastArgOfMatchingDecl :: ParsedSource
-> TransformT
(Either PluginError)
(ParsedSource, Maybe (Maybe (LocatedAn NameAnn RdrName, Int)))
addNameAsLastArgOfMatchingDecl = (SrcSpan -> Either PluginError Bool)
-> (LHsDecl GhcPs
-> TransformT
(Either PluginError)
([LHsDecl GhcPs], Maybe (LocatedAn NameAnn RdrName, Int)))
-> ParsedSource
-> TransformT
(Either PluginError)
(ParsedSource, Maybe (Maybe (LocatedAn NameAnn RdrName, Int)))
forall a (m :: * -> *) r.
(HasDecls a, Monad m) =>
(SrcSpan -> m Bool)
-> (LHsDecl GhcPs -> TransformT m ([LHsDecl GhcPs], r))
-> a
-> TransformT m (a, Maybe r)
modifySmallestDeclWithM SrcSpan -> Either PluginError Bool
spanContainsRangeOrErr LHsDecl GhcPs
-> TransformT
(Either PluginError)
([LHsDecl GhcPs], Maybe (LocatedAn NameAnn RdrName, Int))
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
-> TransformT
(Either PluginError)
([GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)],
Maybe (LocatedAn NameAnn RdrName, Int))
addNameAsLastArg
addNameAsLastArg :: GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
-> TransformT
(Either PluginError)
([GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)],
Maybe (LocatedAn NameAnn RdrName, Int))
addNameAsLastArg = ((GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs),
Maybe (LocatedAn NameAnn RdrName, Int))
-> ([GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)],
Maybe (LocatedAn NameAnn RdrName, Int)))
-> TransformT
(Either PluginError)
(GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs),
Maybe (LocatedAn NameAnn RdrName, Int))
-> TransformT
(Either PluginError)
([GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)],
Maybe (LocatedAn NameAnn RdrName, Int))
forall a b.
(a -> b)
-> TransformT (Either PluginError) a
-> TransformT (Either PluginError) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
-> [GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)])
-> (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs),
Maybe (LocatedAn NameAnn RdrName, Int))
-> ([GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)],
Maybe (LocatedAn NameAnn RdrName, Int))
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
-> [GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)]
-> [GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)]
forall a. a -> [a] -> [a]
:[])) (TransformT
(Either PluginError)
(GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs),
Maybe (LocatedAn NameAnn RdrName, Int))
-> TransformT
(Either PluginError)
([GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)],
Maybe (LocatedAn NameAnn RdrName, Int)))
-> (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
-> TransformT
(Either PluginError)
(GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs),
Maybe (LocatedAn NameAnn RdrName, Int)))
-> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
-> TransformT
(Either PluginError)
([GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)],
Maybe (LocatedAn NameAnn RdrName, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> LHsDecl GhcPs
-> TransformT
(Either PluginError)
(LHsDecl GhcPs, Maybe (LocatedAn NameAnn RdrName, Int))
appendFinalPatToMatches Text
name
spanContainsRangeOrErr :: SrcSpan -> Either PluginError Bool
spanContainsRangeOrErr = PluginError -> Maybe Bool -> Either PluginError Bool
forall a b. a -> Maybe b -> Either a b
maybeToEither (Text -> PluginError
PluginInternalError Text
"SrcSpan was not valid range") (Maybe Bool -> Either PluginError Bool)
-> (SrcSpan -> Maybe Bool) -> SrcSpan -> Either PluginError Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SrcSpan -> Range -> Maybe Bool
`spanContainsRange` Range
range)
hsTypeToFunTypeAsList :: LHsType GhcPs -> ([(SrcSpanAnnA, XFunTy GhcPs, HsArrow GhcPs, LHsType GhcPs)], LHsType GhcPs)
hsTypeToFunTypeAsList :: LHsType GhcPs
-> ([(SrcSpanAnn' (EpAnn AnnListItem), XFunTy GhcPs, HsArrow GhcPs,
LHsType GhcPs)],
LHsType GhcPs)
hsTypeToFunTypeAsList = \case
L SrcSpanAnn' (EpAnn AnnListItem)
spanAnnA (HsFunTy XFunTy GhcPs
xFunTy HsArrow GhcPs
arrow LHsType GhcPs
lhs LHsType GhcPs
rhs) ->
let ([(SrcSpanAnn' (EpAnn AnnListItem), XFunTy GhcPs, HsArrow GhcPs,
LHsType GhcPs)]
rhsArgs, LHsType GhcPs
rhsRes) = LHsType GhcPs
-> ([(SrcSpanAnn' (EpAnn AnnListItem), XFunTy GhcPs, HsArrow GhcPs,
LHsType GhcPs)],
LHsType GhcPs)
hsTypeToFunTypeAsList LHsType GhcPs
rhs
in ((SrcSpanAnn' (EpAnn AnnListItem)
spanAnnA, XFunTy GhcPs
EpAnnCO
xFunTy, HsArrow GhcPs
arrow, LHsType GhcPs
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs)
lhs)(SrcSpanAnn' (EpAnn AnnListItem), EpAnnCO, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))
-> [(SrcSpanAnn' (EpAnn AnnListItem), EpAnnCO, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
-> [(SrcSpanAnn' (EpAnn AnnListItem), EpAnnCO, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
forall a. a -> [a] -> [a]
:[(SrcSpanAnn' (EpAnn AnnListItem), EpAnnCO, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
rhsArgs, LHsType GhcPs
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs)
rhsRes)
LHsType GhcPs
ty -> ([], LHsType GhcPs
ty)
hsTypeFromFunTypeAsList :: ([(SrcSpanAnnA, XFunTy GhcPs, HsArrow GhcPs, LHsType GhcPs)], LHsType GhcPs) -> LHsType GhcPs
hsTypeFromFunTypeAsList :: ([(SrcSpanAnn' (EpAnn AnnListItem), XFunTy GhcPs, HsArrow GhcPs,
LHsType GhcPs)],
LHsType GhcPs)
-> LHsType GhcPs
hsTypeFromFunTypeAsList ([(SrcSpanAnn' (EpAnn AnnListItem), XFunTy GhcPs, HsArrow GhcPs,
LHsType GhcPs)]
args, LHsType GhcPs
res) =
((SrcSpanAnn' (EpAnn AnnListItem), EpAnnCO, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))
-> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs)
-> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))
-> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs)
-> [(SrcSpanAnn' (EpAnn AnnListItem), EpAnnCO, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
-> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(SrcSpanAnn' (EpAnn AnnListItem)
spanAnnA, EpAnnCO
xFunTy, HsArrow GhcPs
arrow, GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs)
argTy) GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs)
res -> SrcSpanAnn' (EpAnn AnnListItem)
-> HsType GhcPs
-> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnn' (EpAnn AnnListItem)
spanAnnA (HsType GhcPs
-> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))
-> HsType GhcPs
-> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs)
forall a b. (a -> b) -> a -> b
$ XFunTy GhcPs
-> HsArrow GhcPs -> LHsType GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass.
XFunTy pass
-> HsArrow pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy XFunTy GhcPs
EpAnnCO
xFunTy HsArrow GhcPs
arrow LHsType GhcPs
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs)
argTy LHsType GhcPs
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs)
res) LHsType GhcPs
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs)
res [(SrcSpanAnn' (EpAnn AnnListItem), XFunTy GhcPs, HsArrow GhcPs,
LHsType GhcPs)]
[(SrcSpanAnn' (EpAnn AnnListItem), EpAnnCO, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
args
addTyHoleToTySigArg :: Int -> LHsSigType GhcPs -> LHsSigType GhcPs
addTyHoleToTySigArg :: Int -> LHsSigType GhcPs -> LHsSigType GhcPs
addTyHoleToTySigArg Int
loc (L SrcSpanAnn' (EpAnn AnnListItem)
annHsSig (HsSig XHsSig GhcPs
xHsSig HsOuterSigTyVarBndrs GhcPs
tyVarBndrs LHsType GhcPs
lsigTy)) =
let ([(SrcSpanAnn' (EpAnn AnnListItem), XFunTy GhcPs, HsArrow GhcPs,
LHsType GhcPs)]
args, LHsType GhcPs
res) = LHsType GhcPs
-> ([(SrcSpanAnn' (EpAnn AnnListItem), XFunTy GhcPs, HsArrow GhcPs,
LHsType GhcPs)],
LHsType GhcPs)
hsTypeToFunTypeAsList LHsType GhcPs
lsigTy
#if MIN_VERSION_ghc(9,9,0)
wildCardAnn = noAnnSrcSpanDP1
newArg =
( noAnn
, noExtField
, HsUnrestrictedArrow (EpUniTok d1 NormalSyntax)
, L wildCardAnn $ HsWildCardTy noExtField
)
#elif MIN_VERSION_ghc(9,4,0)
wildCardAnn :: SrcSpanAnn' (EpAnn AnnListItem)
wildCardAnn = EpAnn AnnListItem -> SrcSpan -> SrcSpanAnn' (EpAnn AnnListItem)
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (Anchor -> AnnListItem -> EpAnnComments -> EpAnn AnnListItem
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
genAnchor1 ([TrailingAnn] -> AnnListItem
AnnListItem []) EpAnnComments
emptyComments) SrcSpan
generatedSrcSpan
arrowAnn :: TokenLocation
arrowAnn = EpaLocation -> TokenLocation
TokenLoc (Int -> EpaLocation
epl Int
1)
newArg :: (SrcSpanAnn' (EpAnn AnnListItem), EpAnn a, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))
newArg =
( EpAnn AnnListItem -> SrcSpan -> SrcSpanAnn' (EpAnn AnnListItem)
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn EpAnn AnnListItem
forall a. Monoid a => a
mempty SrcSpan
generatedSrcSpan
, EpAnn a
forall a. EpAnn a
noAnn
, LHsUniToken "->" "\8594" GhcPs -> HsArrow GhcPs
forall pass. LHsUniToken "->" "\8594" pass -> HsArrow pass
HsUnrestrictedArrow (TokenLocation
-> HsUniToken "->" "\8594"
-> GenLocated TokenLocation (HsUniToken "->" "\8594")
forall l e. l -> e -> GenLocated l e
L TokenLocation
arrowAnn HsUniToken "->" "\8594"
forall (tok :: Symbol) (utok :: Symbol). HsUniToken tok utok
HsNormalTok)
, SrcSpanAnn' (EpAnn AnnListItem)
-> HsType GhcPs
-> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnn' (EpAnn AnnListItem)
wildCardAnn (HsType GhcPs
-> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))
-> HsType GhcPs
-> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs)
forall a b. (a -> b) -> a -> b
$ XWildCardTy GhcPs -> HsType GhcPs
forall pass. XWildCardTy pass -> HsType pass
HsWildCardTy XWildCardTy GhcPs
NoExtField
noExtField
)
#else
wildCardAnn = SrcSpanAnn (EpAnn genAnchor1 (AnnListItem [AddRarrowAnn d1]) emptyComments) generatedSrcSpan
newArg =
( SrcSpanAnn mempty generatedSrcSpan
, noAnn
, HsUnrestrictedArrow NormalSyntax
, L wildCardAnn $ HsWildCardTy noExtField
)
#endif
insertArg :: t
-> [(SrcSpanAnn' (EpAnn AnnListItem), EpAnn a, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
-> [(SrcSpanAnn' (EpAnn AnnListItem), EpAnn a, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
insertArg t
n [(SrcSpanAnn' (EpAnn AnnListItem), EpAnn a, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
_ | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
0 = String
-> [(SrcSpanAnn' (EpAnn AnnListItem), EpAnn a, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
forall a. HasCallStack => String -> a
error String
"Not possible"
insertArg t
0 [(SrcSpanAnn' (EpAnn AnnListItem), EpAnn a, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
as = (SrcSpanAnn' (EpAnn AnnListItem), EpAnn a, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))
forall {a}.
(SrcSpanAnn' (EpAnn AnnListItem), EpAnn a, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))
newArg(SrcSpanAnn' (EpAnn AnnListItem), EpAnn a, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))
-> [(SrcSpanAnn' (EpAnn AnnListItem), EpAnn a, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
-> [(SrcSpanAnn' (EpAnn AnnListItem), EpAnn a, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
forall a. a -> [a] -> [a]
:[(SrcSpanAnn' (EpAnn AnnListItem), EpAnn a, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
as
insertArg t
_ [] = []
insertArg t
n ((SrcSpanAnn' (EpAnn AnnListItem), EpAnn a, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))
a:[(SrcSpanAnn' (EpAnn AnnListItem), EpAnn a, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
as) = (SrcSpanAnn' (EpAnn AnnListItem), EpAnn a, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))
a (SrcSpanAnn' (EpAnn AnnListItem), EpAnn a, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))
-> [(SrcSpanAnn' (EpAnn AnnListItem), EpAnn a, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
-> [(SrcSpanAnn' (EpAnn AnnListItem), EpAnn a, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
forall a. a -> [a] -> [a]
: t
-> [(SrcSpanAnn' (EpAnn AnnListItem), EpAnn a, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
-> [(SrcSpanAnn' (EpAnn AnnListItem), EpAnn a, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
insertArg (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) [(SrcSpanAnn' (EpAnn AnnListItem), EpAnn a, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
as
lsigTy' :: LHsType GhcPs
lsigTy' = ([(SrcSpanAnn' (EpAnn AnnListItem), XFunTy GhcPs, HsArrow GhcPs,
LHsType GhcPs)],
LHsType GhcPs)
-> LHsType GhcPs
hsTypeFromFunTypeAsList (Int
-> [(SrcSpanAnn' (EpAnn AnnListItem), EpAnnCO, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
-> [(SrcSpanAnn' (EpAnn AnnListItem), EpAnnCO, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
forall {t} {a}.
(Ord t, Num t) =>
t
-> [(SrcSpanAnn' (EpAnn AnnListItem), EpAnn a, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
-> [(SrcSpanAnn' (EpAnn AnnListItem), EpAnn a, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
insertArg Int
loc [(SrcSpanAnn' (EpAnn AnnListItem), EpAnnCO, HsArrow GhcPs,
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs))]
args, LHsType GhcPs
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs)
res)
in SrcSpanAnn' (EpAnn AnnListItem)
-> HsSigType GhcPs
-> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsSigType GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnn' (EpAnn AnnListItem)
annHsSig (XHsSig GhcPs
-> HsOuterSigTyVarBndrs GhcPs -> LHsType GhcPs -> HsSigType GhcPs
forall pass.
XHsSig pass
-> HsOuterSigTyVarBndrs pass -> LHsType pass -> HsSigType pass
HsSig XHsSig GhcPs
xHsSig HsOuterSigTyVarBndrs GhcPs
tyVarBndrs LHsType GhcPs
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs)
lsigTy')