{-# LANGUAGE NamedFieldPuns #-}

module GHC.Util.HsDecl (declName,bindName)
where

import GHC.Hs
import GHC.Types.SrcLoc
import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader

-- | @declName x@ returns the \"new name\" that is created (for
-- example a function declaration) by @x@.  If @x@ isn't a declaration
-- that creates a new name (for example an instance declaration),
-- 'Nothing' is returned instead.  This is useful because we don't
-- want to tell users to rename binders that they aren't creating
-- right now and therefore usually cannot change.
declName :: LHsDecl GhcPs -> Maybe String
declName :: LHsDecl GhcPs -> Maybe String
declName (L SrcSpanAnnA
_ HsDecl GhcPs
x) = RdrName -> String
occNameStr (RdrName -> String) -> Maybe RdrName -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case HsDecl GhcPs
x of
    TyClD XTyClD GhcPs
_ FamDecl{tcdFam :: forall pass. TyClDecl pass -> FamilyDecl pass
tcdFam=FamilyDecl{LIdP GhcPs
fdLName :: LIdP GhcPs
fdLName :: forall pass. FamilyDecl pass -> LIdP pass
fdLName}} -> RdrName -> Maybe RdrName
forall a. a -> Maybe a
Just (RdrName -> Maybe RdrName) -> RdrName -> Maybe RdrName
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
fdLName
    TyClD XTyClD GhcPs
_ SynDecl{LIdP GhcPs
tcdLName :: LIdP GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName} -> RdrName -> Maybe RdrName
forall a. a -> Maybe a
Just (RdrName -> Maybe RdrName) -> RdrName -> Maybe RdrName
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
tcdLName
    TyClD XTyClD GhcPs
_ DataDecl{LIdP GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName :: LIdP GhcPs
tcdLName} -> RdrName -> Maybe RdrName
forall a. a -> Maybe a
Just (RdrName -> Maybe RdrName) -> RdrName -> Maybe RdrName
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
tcdLName
    TyClD XTyClD GhcPs
_ ClassDecl{LIdP GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName :: LIdP GhcPs
tcdLName} -> RdrName -> Maybe RdrName
forall a. a -> Maybe a
Just (RdrName -> Maybe RdrName) -> RdrName -> Maybe RdrName
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
tcdLName
    ValD XValD GhcPs
_ FunBind{LIdP GhcPs
fun_id :: LIdP GhcPs
fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id}  -> RdrName -> Maybe RdrName
forall a. a -> Maybe a
Just (RdrName -> Maybe RdrName) -> RdrName -> Maybe RdrName
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
fun_id
    ValD XValD GhcPs
_ VarBind{IdP GhcPs
var_id :: IdP GhcPs
var_id :: forall idL idR. HsBindLR idL idR -> IdP idL
var_id}  -> RdrName -> Maybe RdrName
forall a. a -> Maybe a
Just IdP GhcPs
RdrName
var_id
    ValD XValD GhcPs
_ (PatSynBind XPatSynBind GhcPs GhcPs
_ PSB{LIdP GhcPs
psb_id :: LIdP GhcPs
psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_id}) -> RdrName -> Maybe RdrName
forall a. a -> Maybe a
Just (RdrName -> Maybe RdrName) -> RdrName -> Maybe RdrName
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
psb_id
    SigD XSigD GhcPs
_ (TypeSig XTypeSig GhcPs
_ (LIdP GhcPs
x:[LIdP GhcPs]
_) LHsSigWcType GhcPs
_) -> RdrName -> Maybe RdrName
forall a. a -> Maybe a
Just (RdrName -> Maybe RdrName) -> RdrName -> Maybe RdrName
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
x
    SigD XSigD GhcPs
_ (PatSynSig XPatSynSig GhcPs
_ (LIdP GhcPs
x:[LIdP GhcPs]
_) LHsSigType GhcPs
_) -> RdrName -> Maybe RdrName
forall a. a -> Maybe a
Just (RdrName -> Maybe RdrName) -> RdrName -> Maybe RdrName
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
x
    SigD XSigD GhcPs
_ (ClassOpSig XClassOpSig GhcPs
_ Bool
_ (LIdP GhcPs
x:[LIdP GhcPs]
_) LHsSigType GhcPs
_) -> RdrName -> Maybe RdrName
forall a. a -> Maybe a
Just (RdrName -> Maybe RdrName) -> RdrName -> Maybe RdrName
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
x
    ForD XForD GhcPs
_ ForeignImport{LIdP GhcPs
fd_name :: LIdP GhcPs
fd_name :: forall pass. ForeignDecl pass -> LIdP pass
fd_name} -> RdrName -> Maybe RdrName
forall a. a -> Maybe a
Just (RdrName -> Maybe RdrName) -> RdrName -> Maybe RdrName
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
fd_name
    ForD XForD GhcPs
_ ForeignExport{LIdP GhcPs
fd_name :: forall pass. ForeignDecl pass -> LIdP pass
fd_name :: LIdP GhcPs
fd_name} -> RdrName -> Maybe RdrName
forall a. a -> Maybe a
Just (RdrName -> Maybe RdrName) -> RdrName -> Maybe RdrName
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
fd_name
    HsDecl GhcPs
_ -> Maybe RdrName
forall a. Maybe a
Nothing


bindName :: LHsBind GhcPs -> Maybe String
bindName :: LHsBind GhcPs -> Maybe String
bindName (L SrcSpanAnnA
_ FunBind{LIdP GhcPs
fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id :: LIdP GhcPs
fun_id}) = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> String
rdrNameStr LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
fun_id
bindName (L SrcSpanAnnA
_ VarBind{IdP GhcPs
var_id :: forall idL idR. HsBindLR idL idR -> IdP idL
var_id :: IdP GhcPs
var_id}) = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ RdrName -> String
occNameStr IdP GhcPs
RdrName
var_id
bindName LHsBind GhcPs
_ = Maybe String
forall a. Maybe a
Nothing