{-# LANGUAGE TypeApplications #-}

-- | COMPLETE signature
module GHC.Types.CompleteMatch where

import GHC.Prelude
import GHC.Core.TyCo.Rep
import GHC.Types.Unique.DSet
import GHC.Core.ConLike
import GHC.Core.TyCon
import GHC.Core.Type ( splitTyConApp_maybe )
import GHC.Utils.Outputable

-- | A list of conlikes which represents a complete pattern match.
-- These arise from @COMPLETE@ signatures.
-- See also Note [Implementation of COMPLETE pragmas].
data CompleteMatch = CompleteMatch
  { CompleteMatch -> UniqDSet ConLike
cmConLikes :: UniqDSet ConLike -- ^ The set of `ConLike` values
  , CompleteMatch -> Maybe TyCon
cmResultTyCon :: Maybe TyCon   -- ^ The optional, concrete result TyCon the set applies to
  }

vanillaCompleteMatch :: UniqDSet ConLike -> CompleteMatch
vanillaCompleteMatch :: UniqDSet ConLike -> CompleteMatch
vanillaCompleteMatch UniqDSet ConLike
cls = CompleteMatch { cmConLikes :: UniqDSet ConLike
cmConLikes = UniqDSet ConLike
cls, cmResultTyCon :: Maybe TyCon
cmResultTyCon = Maybe TyCon
forall a. Maybe a
Nothing }

instance Outputable CompleteMatch where
  ppr :: CompleteMatch -> SDoc
ppr (CompleteMatch UniqDSet ConLike
cls Maybe TyCon
mty) = case Maybe TyCon
mty of
    Maybe TyCon
Nothing -> UniqDSet ConLike -> SDoc
forall a. Outputable a => a -> SDoc
ppr UniqDSet ConLike
cls
    Just TyCon
ty -> UniqDSet ConLike -> SDoc
forall a. Outputable a => a -> SDoc
ppr UniqDSet ConLike
cls SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"@" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
ty)

type CompleteMatches = [CompleteMatch]

completeMatchAppliesAtType :: Type -> CompleteMatch -> Bool
completeMatchAppliesAtType :: Type -> CompleteMatch -> Bool
completeMatchAppliesAtType Type
ty CompleteMatch
cm = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all @Maybe TyCon -> Bool
ty_matches (CompleteMatch -> Maybe TyCon
cmResultTyCon CompleteMatch
cm)
  where
    ty_matches :: TyCon -> Bool
ty_matches TyCon
sig_tc
      | Just (TyCon
tc, [Type]
_arg_tys) <- HasDebugCallStack => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
ty
      , TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
sig_tc
      = Bool
True
      | Bool
otherwise
      = Bool
False