    {-
    (c) The University of Glasgow 2006
    (c) The AQUA Project, Glasgow University, 1993-1998

    -}

    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE TypeFamilies #-}

    -- | Typechecking annotations
    module GHC.Tc.Gen.Annotation ( tcAnnotations, annCtxt ) where

    import GHC.Prelude

    import GHC.Driver.Session
    import GHC.Driver.Env

    import GHC.Tc.Errors.Types
    import {-# SOURCE #-} GHC.Tc.Gen.Splice ( runAnnotation )
    import GHC.Tc.Utils.Monad

    import GHC.Unit.Module

    import GHC.Hs

    import GHC.Utils.Outputable

    import GHC.Types.Name
    import GHC.Types.Annotations
    import GHC.Types.SrcLoc

    import Control.Monad ( when )

    -- Some platforms don't support the interpreter, and compilation on those
    -- platforms shouldn't fail just due to annotations
    tcAnnotations :: [LAnnDecl GhcRn] -> TcM [Annotation]
    tcAnnotations :: [LAnnDecl GhcRn] -> TcM [Annotation]
    tcAnnotations [LAnnDecl GhcRn]
    anns = do
      hsc_env <- TcRnIf TcGblEnv TcLclEnv HscEnv
    forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv
      case hsc_interp hsc_env of
        Just Interp
    _  -> (GenLocated SrcSpanAnnA (AnnDecl GhcRn)
     -> IOEnv (Env TcGblEnv TcLclEnv) Annotation)
    -> [GenLocated SrcSpanAnnA (AnnDecl GhcRn)] -> TcM [Annotation]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM LAnnDecl GhcRn -> IOEnv (Env TcGblEnv TcLclEnv) Annotation
    GenLocated SrcSpanAnnA (AnnDecl GhcRn)
    -> IOEnv (Env TcGblEnv TcLclEnv) Annotation
    tcAnnotation [LAnnDecl GhcRn]
    [GenLocated SrcSpanAnnA (AnnDecl GhcRn)]
    anns
        Maybe Interp
    Nothing -> [LAnnDecl GhcRn] -> TcM [Annotation]
    warnAnns [LAnnDecl GhcRn]
    anns

    warnAnns :: [LAnnDecl GhcRn] -> TcM [Annotation]
    --- No GHCI; emit a warning (not an error) and ignore. cf #4268
    warnAnns :: [LAnnDecl GhcRn] -> TcM [Annotation]
    warnAnns [] = [Annotation] -> TcM [Annotation]
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    warnAnns anns :: [LAnnDecl GhcRn]
    anns@(L SrcSpanAnnA
    loc AnnDecl GhcRn
    _ : [LAnnDecl GhcRn]
    _)
      = do { SrcSpanAnnA -> TcRn () -> TcRn ()
    forall ann a. EpAnn ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ TcRnMessage -> TcRn ()
    addDiagnosticTc ([LAnnDecl GhcRn] -> TcRnMessage
    TcRnIgnoringAnnotations [LAnnDecl GhcRn]
    anns)
           ; [Annotation] -> TcM [Annotation]
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [] }

    tcAnnotation :: LAnnDecl GhcRn -> TcM Annotation
    tcAnnotation :: LAnnDecl GhcRn -> IOEnv (Env TcGblEnv TcLclEnv) Annotation
    tcAnnotation (L SrcSpanAnnA
    loc ann :: AnnDecl GhcRn
    ann@(HsAnnotation XHsAnnotation GhcRn
    _ AnnProvenance GhcRn
    provenance XRec GhcRn (HsExpr GhcRn)
    expr)) = do
        -- Work out what the full target of this annotation was
        mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
    forall (m :: * -> *). HasModule m => m Module
    getModule
        let target = Module -> AnnProvenance GhcRn -> AnnTarget Name
    annProvenanceToTarget Module
    mod AnnProvenance GhcRn
    provenance

        -- Run that annotation and construct the full Annotation data structure
        setSrcSpanA loc $ addErrCtxt (annCtxt ann) $ do
          -- See #10826 -- Annotations allow one to bypass Safe Haskell.
          dflags <- getDynFlags
          when (safeLanguageOn dflags) $ failWithTc TcRnAnnotationInSafeHaskell
          runAnnotation target expr

    annProvenanceToTarget :: Module -> AnnProvenance GhcRn
                          -> AnnTarget Name
    annProvenanceToTarget :: Module -> AnnProvenance GhcRn -> AnnTarget Name
    annProvenanceToTarget Module
    _   (ValueAnnProvenance (L SrcSpanAnnN
    _ Name
    name)) = Name -> AnnTarget Name
    forall name. name -> AnnTarget name
    NamedTarget Name
    name
    annProvenanceToTarget Module
    _   (TypeAnnProvenance (L SrcSpanAnnN
    _ Name
    name))  = Name -> AnnTarget Name
    forall name. name -> AnnTarget name
    NamedTarget Name
    name
    annProvenanceToTarget Module
    mod AnnProvenance GhcRn
    ModuleAnnProvenance             = Module -> AnnTarget Name
    forall name. Module -> AnnTarget name
    ModuleTarget Module
    mod

    annCtxt :: (OutputableBndrId p) => AnnDecl (GhcPass p) -> SDoc
    annCtxt :: forall (p :: Pass).
    OutputableBndrId p =>
    AnnDecl (GhcPass p) -> SDoc
    annCtxt AnnDecl (GhcPass p)
    ann
      = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "In the annotation:") Int
    2 (AnnDecl (GhcPass p) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr AnnDecl (GhcPass p)
    ann)