module GHC.Tc.Gen.Annotation ( tcAnnotations, annCtxt ) where
import GHC.Prelude
import GHC.Tc.Gen.Splice ( runAnnotation )
import GHC.Unit.Module
import GHC.Driver.Session
import Control.Monad ( when )
import GHC.Hs
import GHC.Types.Name
import GHC.Types.Annotations
import GHC.Tc.Utils.Monad
import GHC.Types.SrcLoc
import GHC.Utils.Outputable
import GHC.Driver.Types
tcAnnotations :: [LAnnDecl GhcRn] -> TcM [Annotation]
tcAnnotations anns = do
hsc_env <- getTopEnv
case hsc_interp hsc_env of
Just _ -> mapM tcAnnotation anns
Nothing -> warnAnns anns
warnAnns :: [LAnnDecl GhcRn] -> TcM [Annotation]
warnAnns [] = return []
warnAnns anns@(L loc _ : _)
= do { setSrcSpan loc $ addWarnTc NoReason $
(text "Ignoring ANN annotation" <> plural anns <> comma
<+> text "because this is a stage-1 compiler without -fexternal-interpreter or doesn't support GHCi")
; return [] }
tcAnnotation :: LAnnDecl GhcRn -> TcM Annotation
tcAnnotation (L loc ann@(HsAnnotation _ _ provenance expr)) = do
mod <- getModule
let target = annProvenanceToTarget mod provenance
setSrcSpan loc $ addErrCtxt (annCtxt ann) $ do
dflags <- getDynFlags
when (safeLanguageOn dflags) $ failWithTc safeHsErr
runAnnotation target expr
where
safeHsErr = vcat [ text "Annotations are not compatible with Safe Haskell."
, text "See https://gitlab.haskell.org/ghc/ghc/issues/10826" ]
annProvenanceToTarget :: Module -> AnnProvenance Name
-> AnnTarget Name
annProvenanceToTarget _ (ValueAnnProvenance (L _ name)) = NamedTarget name
annProvenanceToTarget _ (TypeAnnProvenance (L _ name)) = NamedTarget name
annProvenanceToTarget mod ModuleAnnProvenance = ModuleTarget mod
annCtxt :: (OutputableBndrId p) => AnnDecl (GhcPass p) -> SDoc
annCtxt ann
= hang (text "In the annotation:") 2 (ppr ann)