never executed always true always false
    1 {-# LANGUAGE ExistentialQuantification #-}
    2 module GHC.Tc.Errors.Hole.FitTypes (
    3   TypedHole (..), HoleFit (..), HoleFitCandidate (..),
    4   CandPlugin, FitPlugin, HoleFitPlugin (..), HoleFitPluginR (..),
    5   hfIsLcl, pprHoleFitCand
    6   ) where
    7 
    8 import GHC.Prelude
    9 
   10 import GHC.Tc.Types
   11 import GHC.Tc.Types.Constraint
   12 import GHC.Tc.Utils.TcType
   13 
   14 import GHC.Types.Name.Reader
   15 
   16 import GHC.Hs.Doc
   17 import GHC.Types.Id
   18 
   19 import GHC.Utils.Outputable
   20 import GHC.Types.Name
   21 
   22 import Data.Function ( on )
   23 
   24 data TypedHole = TypedHole { th_relevant_cts :: Cts
   25                            -- ^ Any relevant Cts to the hole
   26                            , th_implics :: [Implication]
   27                            -- ^ The nested implications of the hole with the
   28                            --   innermost implication first.
   29                            , th_hole :: Maybe Hole
   30                            -- ^ The hole itself, if available. Only for debugging.
   31                            }
   32 
   33 instance Outputable TypedHole where
   34   ppr (TypedHole { th_relevant_cts = rels
   35                  , th_implics      = implics
   36                  , th_hole         = hole })
   37     = hang (text "TypedHole") 2
   38         (ppr rels $+$ ppr implics $+$ ppr hole)
   39 
   40 -- | HoleFitCandidates are passed to hole fit plugins and then
   41 -- checked whether they fit a given typed-hole.
   42 data HoleFitCandidate = IdHFCand Id             -- An id, like locals.
   43                       | NameHFCand Name         -- A name, like built-in syntax.
   44                       | GreHFCand GlobalRdrElt  -- A global, like imported ids.
   45 
   46 instance Eq HoleFitCandidate where
   47   IdHFCand i1 == IdHFCand i2 = i1 == i2
   48   NameHFCand n1 == NameHFCand n2 = n1 == n2
   49   GreHFCand gre1 == GreHFCand gre2 = gre_name gre1 == gre_name gre2
   50   _ == _ = False
   51 
   52 instance Outputable HoleFitCandidate where
   53   ppr = pprHoleFitCand
   54 
   55 pprHoleFitCand :: HoleFitCandidate -> SDoc
   56 pprHoleFitCand (IdHFCand cid) = text "Id HFC: " <> ppr cid
   57 pprHoleFitCand (NameHFCand cname) = text "Name HFC: " <> ppr cname
   58 pprHoleFitCand (GreHFCand cgre) = text "Gre HFC: " <> ppr cgre
   59 
   60 instance NamedThing HoleFitCandidate where
   61   getName hfc = case hfc of
   62                      IdHFCand cid -> idName cid
   63                      NameHFCand cname -> cname
   64                      GreHFCand cgre -> greMangledName cgre
   65   getOccName hfc = case hfc of
   66                      IdHFCand cid -> occName cid
   67                      NameHFCand cname -> occName cname
   68                      GreHFCand cgre -> occName (greMangledName cgre)
   69 
   70 instance HasOccName HoleFitCandidate where
   71   occName = getOccName
   72 
   73 instance Ord HoleFitCandidate where
   74   compare = compare `on` getName
   75 
   76 -- | HoleFit is the type we use for valid hole fits. It contains the
   77 -- element that was checked, the Id of that element as found by `tcLookup`,
   78 -- and the refinement level of the fit, which is the number of extra argument
   79 -- holes that this fit uses (e.g. if hfRefLvl is 2, the fit is for `Id _ _`).
   80 data HoleFit =
   81   HoleFit { hfId   :: Id       -- ^ The elements id in the TcM
   82           , hfCand :: HoleFitCandidate  -- ^ The candidate that was checked.
   83           , hfType :: TcType -- ^ The type of the id, possibly zonked.
   84           , hfRefLvl :: Int  -- ^ The number of holes in this fit.
   85           , hfWrap :: [TcType] -- ^ The wrapper for the match.
   86           , hfMatches :: [TcType]
   87           -- ^ What the refinement variables got matched with, if anything
   88           , hfDoc :: Maybe HsDocString
   89           -- ^ Documentation of this HoleFit, if available.
   90           }
   91  | RawHoleFit SDoc
   92  -- ^ A fit that is just displayed as is. Here so thatHoleFitPlugins
   93  --   can inject any fit they want.
   94 
   95 -- We define an Eq and Ord instance to be able to build a graph.
   96 instance Eq HoleFit where
   97    (==) = (==) `on` hfId
   98 
   99 instance Outputable HoleFit where
  100   ppr (RawHoleFit sd) = sd
  101   ppr (HoleFit _ cand ty _ _ mtchs _) =
  102     hang (name <+> holes) 2 (text "where" <+> name <+> dcolon <+> (ppr ty))
  103     where name = ppr $ getName cand
  104           holes = sep $ map (parens . (text "_" <+> dcolon <+>) . ppr) mtchs
  105 
  106 -- We compare HoleFits by their name instead of their Id, since we don't
  107 -- want our tests to be affected by the non-determinism of `nonDetCmpVar`,
  108 -- which is used to compare Ids. When comparing, we want HoleFits with a lower
  109 -- refinement level to come first.
  110 instance Ord HoleFit where
  111   compare (RawHoleFit _) (RawHoleFit _) = EQ
  112   compare (RawHoleFit _) _ = LT
  113   compare _ (RawHoleFit _) = GT
  114   compare a@(HoleFit {}) b@(HoleFit {}) = cmp a b
  115     where cmp  = if hfRefLvl a == hfRefLvl b
  116                  then compare `on` (getName . hfCand)
  117                  else compare `on` hfRefLvl
  118 
  119 hfIsLcl :: HoleFit -> Bool
  120 hfIsLcl hf@(HoleFit {}) = case hfCand hf of
  121                             IdHFCand _    -> True
  122                             NameHFCand _  -> False
  123                             GreHFCand gre -> gre_lcl gre
  124 hfIsLcl _ = False
  125 
  126 
  127 -- | A plugin for modifying the candidate hole fits *before* they're checked.
  128 type CandPlugin = TypedHole -> [HoleFitCandidate] -> TcM [HoleFitCandidate]
  129 
  130 -- | A plugin for modifying hole fits  *after* they've been found.
  131 type FitPlugin =  TypedHole -> [HoleFit] -> TcM [HoleFit]
  132 
  133 -- | A HoleFitPlugin is a pair of candidate and fit plugins.
  134 data HoleFitPlugin = HoleFitPlugin
  135   { candPlugin :: CandPlugin
  136   , fitPlugin :: FitPlugin }
  137 
  138 -- | HoleFitPluginR adds a TcRef to hole fit plugins so that plugins can
  139 -- track internal state. Note the existential quantification, ensuring that
  140 -- the state cannot be modified from outside the plugin.
  141 data HoleFitPluginR = forall s. HoleFitPluginR
  142   { hfPluginInit :: TcM (TcRef s)
  143     -- ^ Initializes the TcRef to be passed to the plugin
  144   , hfPluginRun :: TcRef s -> HoleFitPlugin
  145     -- ^ The function defining the plugin itself
  146   , hfPluginStop :: TcRef s -> TcM ()
  147     -- ^ Cleanup of state, guaranteed to be called even on error
  148   }