Automagically create predicates that detect components of a sum type?

Question

What I mean is this:

data D = A Int | B String  -- A sum type.

isA, isB :: D -> Bool  -- Component predicates.
isA (A _) = True
isA _     = False
isB (B _) = True
isB _     = False

This is tedious to define. Surely there is a better way. And one way there is:

data D = A Int | B String deriving (Typeable, Data)

isA', isB' :: D -> Bool
isA' x = toConstr x == toConstr (A undefined)
isB' x = toConstr x == toConstr (B undefined)

But it requires me to provide an example value.

There is a trick that allows one to "fold" functions of any number of variables with an "inductive" class, which lets us define a method that obtains a value from a constructor of any arity:

class C a v where createValue :: a -> v
instance C b D => C (a -> b) D where createValue f = createValue (f undefined)
instance C D D where createValue = id

compareConstructor :: forall a v. (C a v, Data v) => v -> a -> Bool
compareConstructor x c = toConstr x == toConstr (createValue c :: v)

This is how it works:

data D = A Int | B String | C Bool Char deriving (Typeable, Data, Show)

λ compareConstructor (B "z") (C True)
False
λ compareConstructor (C True 'c') C
True

I like this solution, but I wonder if there is a more straightforward way to solve this simple, everyday problem.

Motivation:

I have a list of values of type D, mostly filled with A _, and I need to find out whether a B _ value occurs before C _ _. I can solve this problem by comparing two findIndex invocations, but I need to parametrize them appropriately.

Answer 1

GHC.Generics is another way.

You can use the is function from the lens library and generic prisms from the generic-lens library to check whether a value starts with a given constructor MyCon:

is (_Ctor @"MyCon") myValue
  :: Bool

Compilable example:

{-# LANGUAGE DeriveGeneric, TypeApplications, DataKinds #-}

import GHC.Generics
import Data.Generics.Sum
import Control.Lens.Extras

data D = A Int | B String
  deriving Generic

main :: IO ()
main = do
  print $ is (_Ctor @"A") (A 0)   -- True
  print $ is (_Ctor @"A") (B "")  -- False
  print $ is (_Ctor @"B") (A 0)   -- False
  print $ is (_Ctor @"B") (B "")  -- True