{-# LANGUAGE TemplateHaskell #-}
-- | Generate predicates from constructor names or from quoted patterns.
--
--   You must enable the @TemplateHaskell@ extension to use this module
module Data.Generics.Is(
   -- * From constructors
   -- | Given a constructor for type @T@, 'is' generates a function of type
   --   @T -> Bool@.
   --
   --   The function evaluates its argument to WHNF, and returns
   --   'True' if the head constructor matches the given one, 'False'
   --   otherwise.
   --
   --   prop> $(isNot 'Con) ≡ not . $(is 'Con)
   -- 
   --   >>> $(is 'Just) (Just 5)
   --   True
   --   >>> $(isNot 'Left) (Left "a")
   --   False
   is
  ,isNot

   -- * From patterns
   -- | Given a pattern for type @T@, 'isP' generates a function of type
   --   @T -> Bool@.
   --
   --   The function returns 'True' if the expression matches the pattern; a
   --   and 'False' otherwise. 
   --
   --   prop> $(isNot patQ) ≡ not . $(isP patQ)
   --   prop> $(isP [p| Con{} |]) ≡ $(is 'Con)
   --
   --   >>> $(isP [p| Just _ |]) Nothing
   --   False
   --   >>> $(isNotP [_,_,_]) [2,1]
   --   True
  ,isP
  ,isNotP
  ) where

import Language.Haskell.TH

is, isNot :: Name -> Q Exp
is     = isBase  'True  'False 
isNot  = isBase  'False 'True

isP, isNotP :: Q Pat -> Q Exp
isP    = isPBase 'True  'False 
isNotP = isPBase 'False 'True

isPBase yes no patm = do
  x <- newName "x"
  pat <- patm
  return $
    LamE [VarP x] $
      CaseE (VarE x)
        [Match pat   (NormalB $ ConE yes) []
        ,Match WildP (NormalB $ ConE no ) []]

isBase yes no n = isPBase yes no (return (RecP n []))