{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}

module Refact.Utils
  ( -- * Synonyms
    Module,
    Stmt,
    Expr,
    Decl,
    Name,
    Pat,
    Type,
    Import,
    FunBind,
    pattern RealSrcLoc',
    pattern RealSrcSpan',

    -- * Monad
    M,

    -- * Utility
    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

-- Types
-- type M a = StateT (Anns, AnnKeyMap) IO a
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

-- | Perform the necessary adjustments to annotations when replacing
-- one Located thing with another Located thing.
--
-- For example, this function will ensure the correct relative position and
-- make sure that any trailing semi colons or commas are transferred.
-- modifyAnnKey ::
--   (Data old, Data new, Data mod) =>
--   mod ->
--   GHC.Located old ->
--   GHC.Located new ->
--   M (GHC.Located new)
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
  -- liftIO $ putStrLn $ "modifyAnnKey:e1" ++ showAst e1
  -- liftIO $ putStrLn $ "modifyAnnKey:e2" ++ showAst e2
  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
  -- liftIO $ putStrLn $ "modifyAnnKey:e2_0" ++ showAst e2_0
  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
  -- liftIO $ putStrLn $ "modifyAnnKey:e2'" ++ showAst e2'
  forall (m :: * -> *) a. Monad m => a -> m a
return LocatedAn t new
e2'

-- | This function handles backquotes in two scenarios:
--
--     1. When the template contains a backquoted substitution variable, but the substitute
--        is not backquoted, we must add the corresponding 'GHC.NameBackquotes'. See
--        tests/examples/Backquotes.hs for an example.
--     2. When the template contains a substitution variable without backquote, and the
--        substitute is backquoted, we remove the 'GHC.NameBackquotes' annotation. See
--        tests/examples/Uncurry.hs for an example.
--        N.B.: this is not always correct, since it is possible that the refactoring output
--        should keep the backquotes, but currently no test case fails because of it.
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
_)))
                -- scenario 1
                | 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
                -- scenario 2
                | 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

-- | Convert a @Refact.Types.SrcSpan@ to a @SrcLoc.SrcSpan@
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

-- | Convert a @Refact.Types.SrcSpan@ to a @SrcLoc.SrcSpan@
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