{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
module Refact.Utils
(
Module,
Stmt,
Expr,
Decl,
Name,
Pat,
Type,
Import,
FunBind,
pattern RealSrcLoc',
pattern RealSrcSpan',
M,
modifyAnnKey,
getAnnSpan,
getAnnSpanA,
toGhcSrcSpan,
toGhcSrcSpan',
annSpanToSrcSpan,
srcSpanToAnnSpan,
setAnnSpanFile,
setSrcSpanFile,
setRealSrcSpanFile,
)
where
import Control.Monad.Trans.State.Strict (StateT)
import Data.Data
( Data (),
)
import Data.Generics (everywhere, mkT)
import Data.Typeable
import qualified GHC
import Language.Haskell.GHC.ExactPrint
import Refact.Compat
( AnnSpan,
FastString,
FunBind,
Module,
annSpanToSrcSpan,
mkFastString,
setAnnSpanFile,
setRealSrcSpanFile,
setSrcSpanFile,
srcSpanToAnnSpan,
pattern RealSrcLoc',
pattern RealSrcSpan',
)
import qualified Refact.Types as R
type M a = StateT () IO a
type Expr = GHC.LHsExpr GHC.GhcPs
type Type = GHC.LHsType GHC.GhcPs
type Decl = GHC.LHsDecl GHC.GhcPs
type Pat = GHC.LPat GHC.GhcPs
type Name = GHC.LocatedN GHC.RdrName
type Stmt = GHC.ExprLStmt GHC.GhcPs
type Import = GHC.LImportDecl GHC.GhcPs
getAnnSpanA :: forall an a. GHC.LocatedAn an a -> AnnSpan
getAnnSpanA :: forall an a. LocatedAn an a -> AnnSpan
getAnnSpanA = SrcSpan -> AnnSpan
srcSpanToAnnSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
GHC.getLocA
getAnnSpan :: forall a. GHC.Located a -> AnnSpan
getAnnSpan :: forall a. Located a -> AnnSpan
getAnnSpan = SrcSpan -> AnnSpan
srcSpanToAnnSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> l
GHC.getLoc
modifyAnnKey ::
(Data mod, Data t, Data old, Data new, Monoid t, Typeable t) =>
mod ->
GHC.LocatedAn t old ->
GHC.LocatedAn t new ->
M (GHC.LocatedAn t new)
modifyAnnKey :: forall mod t old new.
(Data mod, Data t, Data old, Data new, Monoid t, Typeable t) =>
mod -> LocatedAn t old -> LocatedAn t new -> M (LocatedAn t new)
modifyAnnKey mod
_m LocatedAn t old
e1 LocatedAn t new
e2 = do
let e2_0 :: LocatedAn t new
e2_0 = forall t old new.
(Data t, Data old, Data new, Monoid t, Typeable t) =>
LocatedAn t old -> LocatedAn t new -> LocatedAn t new
handleBackquotes LocatedAn t old
e1 LocatedAn t new
e2
let (LocatedAn t new
e2', Int
_, [String]
_) = forall a. Transform a -> (a, Int, [String])
runTransform forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) t2 t1 a b.
(Monad m, Monoid t2, Typeable t1, Typeable t2) =>
LocatedAn t1 a -> LocatedAn t2 b -> TransformT m (LocatedAn t2 b)
transferEntryDP LocatedAn t old
e1 LocatedAn t new
e2_0
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedAn t new
e2'
handleBackquotes ::
forall t old new.
(Data t, Data old, Data new, Monoid t, Typeable t) =>
GHC.LocatedAn t old ->
GHC.LocatedAn t new ->
GHC.LocatedAn t new
handleBackquotes :: forall t old new.
(Data t, Data old, Data new, Monoid t, Typeable t) =>
LocatedAn t old -> LocatedAn t new -> LocatedAn t new
handleBackquotes LocatedAn t old
old new :: LocatedAn t new
new@(GHC.L SrcAnn t
loc new
_) =
(forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere (forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT LHsExpr GhcPs -> LHsExpr GhcPs
update) LocatedAn t new
new
where
update :: GHC.LHsExpr GHC.GhcPs -> GHC.LHsExpr GHC.GhcPs
update :: LHsExpr GhcPs -> LHsExpr GhcPs
update (GHC.L SrcSpanAnnA
l (GHC.HsVar XVar GhcPs
x (GHC.L SrcSpanAnn' (EpAnn NameAnn)
ln RdrName
n))) = forall l e. l -> e -> GenLocated l e
GHC.L SrcSpanAnnA
l (forall p. XVar p -> LIdP p -> HsExpr p
GHC.HsVar XVar GhcPs
x (forall l e. l -> e -> GenLocated l e
GHC.L SrcSpanAnn' (EpAnn NameAnn)
ln' RdrName
n))
where
ln' :: SrcSpanAnn' (EpAnn NameAnn)
ln' =
if forall a. SrcSpanAnn' a -> SrcSpan
GHC.locA SrcSpanAnnA
l forall a. Eq a => a -> a -> Bool
== forall a. SrcSpanAnn' a -> SrcSpan
GHC.locA SrcAnn t
loc
then case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast LocatedAn t old
old :: Maybe (GHC.LHsExpr GHC.GhcPs) of
Just (GHC.L SrcSpanAnnA
_ (GHC.HsVar XVar GhcPs
_ (GHC.L (GHC.SrcSpanAnn (GHC.EpAnn Anchor
_ NameAnn
ann EpAnnComments
_) SrcSpan
_) RdrName
_)))
| GHC.NameAnn NameAdornment
GHC.NameBackquotes EpaLocation
_ EpaLocation
_ EpaLocation
_ [TrailingAnn]
_ <- NameAnn
ann ->
case SrcSpanAnn' (EpAnn NameAnn)
ln of
(GHC.SrcSpanAnn (GHC.EpAnn Anchor
a NameAnn
_ EpAnnComments
cs) SrcSpan
ll) -> forall a. a -> SrcSpan -> SrcSpanAnn' a
GHC.SrcSpanAnn (forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
GHC.EpAnn Anchor
a NameAnn
ann EpAnnComments
cs) SrcSpan
ll
(GHC.SrcSpanAnn EpAnn NameAnn
GHC.EpAnnNotUsed SrcSpan
ll) ->
forall a. a -> SrcSpan -> SrcSpanAnn' a
GHC.SrcSpanAnn (forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
GHC.EpAnn (SrcSpan -> Anchor
GHC.spanAsAnchor SrcSpan
ll) NameAnn
ann EpAnnComments
GHC.emptyComments) SrcSpan
ll
| GHC.SrcSpanAnn (GHC.EpAnn Anchor
a NameAnn
ann' EpAnnComments
cs) SrcSpan
ll <- SrcSpanAnn' (EpAnn NameAnn)
ln,
GHC.NameAnn NameAdornment
GHC.NameBackquotes EpaLocation
_ EpaLocation
_ EpaLocation
_ [TrailingAnn]
_ <- NameAnn
ann' ->
forall a. a -> SrcSpan -> SrcSpanAnn' a
GHC.SrcSpanAnn (forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
GHC.EpAnn Anchor
a NameAnn
ann EpAnnComments
cs) SrcSpan
ll
Just LHsExpr GhcPs
_ -> SrcSpanAnn' (EpAnn NameAnn)
ln
Maybe (LHsExpr GhcPs)
Nothing -> SrcSpanAnn' (EpAnn NameAnn)
ln
else SrcSpanAnn' (EpAnn NameAnn)
ln
update LHsExpr GhcPs
x = LHsExpr GhcPs
x
toGhcSrcSpan :: FilePath -> R.SrcSpan -> GHC.SrcSpan
toGhcSrcSpan :: String -> SrcSpan -> SrcSpan
toGhcSrcSpan = FastString -> SrcSpan -> SrcSpan
toGhcSrcSpan' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString
toGhcSrcSpan' :: FastString -> R.SrcSpan -> GHC.SrcSpan
toGhcSrcSpan' :: FastString -> SrcSpan -> SrcSpan
toGhcSrcSpan' FastString
file R.SrcSpan {Int
startLine :: SrcSpan -> Int
startCol :: SrcSpan -> Int
endLine :: SrcSpan -> Int
endCol :: SrcSpan -> Int
endCol :: Int
endLine :: Int
startCol :: Int
startLine :: Int
..} = SrcLoc -> SrcLoc -> SrcSpan
GHC.mkSrcSpan (Int -> Int -> SrcLoc
f Int
startLine Int
startCol) (Int -> Int -> SrcLoc
f Int
endLine Int
endCol)
where
f :: Int -> Int -> SrcLoc
f = FastString -> Int -> Int -> SrcLoc
GHC.mkSrcLoc FastString
file