{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Safe #-}
module Data.Generics.Is.Data (
   -- | Given a constructor @K@ for a type @T@ which implements 'Data',
   --   and a value @a@ of type @T@, 'is K a' evaluates @a@ to WHNF, and
   --   returns True if @K@ is the head constructor of the result.
   --
   --   prop> $(is 'K)   ≡ is K
   is
   -- | prop> not . is K ≡ isNot K
  ,isNot
  ) where

import Data.Data
import Data.Generics.Is.Internal

is, isNot :: forall a b. (Constructs a b, Data b) => a -> b -> Bool

is    c' = let c = toConstr (construct c' :: b) in \a -> c == toConstr a
isNot c' = let c = toConstr (construct c' :: b) in \a -> c /= toConstr a