module Language.Haskell.Tools.AST.FromGHC.Monad where
import SrcLoc
import GHC
import Name
import ApiAnnotation
import Outputable (ppr, showSDocUnsafe)
import Control.Monad.Reader
import Language.Haskell.Tools.AST.FromGHC.SourceMap
import Language.Haskell.Tools.AST.FromGHC.GHCUtils
import Data.Map as Map
import Data.Maybe
import Debug.Trace
type Trf = ReaderT TrfInput Ghc
data TrfInput
= TrfInput { srcMap :: SourceMap
, pragmaComms :: Map String [Located String]
, contRange :: SrcSpan
, localsInScope :: [[GHC.Name]]
, defining :: Bool
, definingTypeVars :: Bool
, originalNames :: Map SrcSpan RdrName
}
trfInit :: Map ApiAnnKey [SrcSpan] -> Map String [Located String] -> TrfInput
trfInit annots comments
= TrfInput { srcMap = annotationsToSrcMap annots
, pragmaComms = comments
, contRange = noSrcSpan
, localsInScope = []
, defining = False
, definingTypeVars = False
, originalNames = empty
}
define :: Trf a -> Trf a
define = local (\s -> s { defining = True })
defineTypeVars :: Trf a -> Trf a
defineTypeVars = local (\s -> s { definingTypeVars = True })
typeVarTransform :: Trf a -> Trf a
typeVarTransform = local (\s -> s { defining = defining s || definingTypeVars s })
transformingPossibleVar :: HsHasName n => n -> Trf a -> Trf a
transformingPossibleVar n = case hsGetNames n of
[name] | isVarName name || isTyVarName name -> typeVarTransform
_ -> id
addToScope :: HsHasName e => e -> Trf a -> Trf a
addToScope e = local (\s -> s { localsInScope = hsGetNames e : localsInScope s })
addToCurrentScope :: HsHasName e => e -> Trf a -> Trf a
addToCurrentScope e = local (\s -> s { localsInScope = case localsInScope s of lastScope:rest -> (hsGetNames e ++ lastScope):rest
[] -> [hsGetNames e] })
runTrf :: Map ApiAnnKey [SrcSpan] -> Map String [Located String] -> Trf a -> Ghc a
runTrf annots comments trf = runReaderT trf (trfInit annots comments)
setOriginalNames :: Map SrcSpan RdrName -> Trf a -> Trf a
setOriginalNames names = local (\s -> s { originalNames = names })
getOriginalName :: RdrName -> Trf String
getOriginalName n = do sp <- asks contRange
asks (rdrNameStr . fromMaybe n . (Map.lookup sp) . originalNames)