match on some data constructors, useful for writing smart constructors?

MatchDataCon.hs

{-# LANGUAGE GADTs, DataKinds, KindSignatures, TemplateHaskell, QuasiQuotes #-}
module Foo (bar, Foo(..), SBool(..))
where

import Language.Haskell.TH

data SBool b where
  STrue :: SBool True
  SFalse :: SBool False

data Foo :: * -> * where
  A :: SBool b -> Foo ()
  B :: SBool b -> Int -> Foo Int
  C :: SBool b -> Int -> Char -> Foo Char
  D :: Foo ()

bar :: String -> Name -> DecsQ
bar fname t = do
  let fn = mkName fname
  let tp = [p| STrue |]
  let bt = normalB [| True |]
  let bf = normalB [| False |]
      
  let buzz (ForallC _ _ (NormalC name [_]))
        = clause [conP name [tp]] bt []
      buzz (ForallC _ _ (NormalC name (_:ns)))
        = clause [conP name (tp:(replicate (length ns) wildP))] bt []
      buzz _ = clause [wildP] bf []
      
  TyConI (DataD _ _ _ constructors _) <- reify t
  n <- newName "a"
  y <- sigD fn $ forallT [PlainTV n] (cxt [])
                         (appT (appT arrowT (appT (conT t) (varT n)))
                               [t| Bool |])
  ps <- mapM buzz constructors
  x  <- funD fn $ map return ps
  return $ [y, x]

Bar.hs:1:1: Splicing declarations bar "foo" ''Foo ======> Bar.hs:7:3-17 foo :: forall a_a2yN. Foo a_a2yN -> Bool foo (A STrue) = True foo (B STrue _) = True foo (C STrue _ _) = True foo _ = False