diff --git a/Test/Feat.hs b/Test/Feat.hs
--- a/Test/Feat.hs
+++ b/Test/Feat.hs
@@ -1,6 +1,8 @@
+-- | This module contains a (hopefully) manageable subset of the functionality
+-- of Feat. The rest resides only in the Test.Feat.* modules.
 module Test.Feat(
   Enumerate(..),
-  -- ** The type class
+  -- * The type class
   Enumerable(..),
   nullary,
   unary,
@@ -8,12 +10,13 @@
   consts,
   deriveEnumerable,
   FreePair(..),
-  -- ** Accessing data
+  -- * Accessing data
   optimised,
   index,
   values,
   bounded,
   uniform,
+  ioFeat,
   ioAll,
   ioBounded  
   ) where
diff --git a/Test/Feat/Access.hs b/Test/Feat/Access.hs
--- a/Test/Feat/Access.hs
+++ b/Test/Feat/Access.hs
@@ -1,5 +1,5 @@
 -- | Functions for accessing the values of enumerations including 
--- compatability with the property based testing frameworks QuickCheck and
+-- compatibility with the property based testing frameworks QuickCheck and
 -- SmallCheck.
 module Test.Feat.Access(
   -- ** Accessing functions
@@ -13,7 +13,7 @@
   ioAll,
   ioBounded,
   
-  -- ** Compatability
+  -- ** Compatibility
   -- *** QuickCheck
   uniform,
   -- *** SmallCheck
@@ -47,12 +47,12 @@
      else go (i-crd) (p+1)
 
 -- | Mainly as a proof of concept we can use the isomorphism between 
--- natural numbers and (Part,Index) pairs to index into a type
+-- natural numbers and @(Part,Index)@ pairs to index into a type.
 -- May not terminate for finite types.
 -- Might be slow the first time it is used with a specific enumeration 
 -- because cardinalities need to be calculated.
--- The computation complexity after cardinalities are computed is a polynomial
--- of the size of the resulting value.
+-- The computational complexity (after cardinalities are computed) is a polynomial
+-- in the size of the resulting value.
 index :: Enumerate a -> Integer -> a 
 index e = uncurry (select e) . split e
 
@@ -74,34 +74,34 @@
 bounded = boundedWith optimised
 
 -- | A rather simple but general property testing driver.
--- The property is a (funcurried) IO function that both tests and reports the 
+-- The property is an (funcurried) IO function that both tests and reports the 
 -- error. The driver goes on forever or until the list is exhausted, 
 -- reporting the coverage and the number of
 -- tests before each new part.
 ioFeat :: [(Integer,[a])] -> (a -> IO ()) -> IO ()
-ioFeat vs f = go vs 0 where
-  go ((c,xs):xss) s = do
-    putStrLn $ "--- Testing "++show c++" vales at size " ++ show s
+ioFeat vs f = go vs 0 0 where
+  go ((c,xs):xss) s tot = do
+    putStrLn $ "--- Testing "++show c++" values at size " ++ show s
     mapM f xs
-    go xss (s+1)
-  go []           s = putStrLn $ "--- Done. Tested "++ show s++" values"
+    go xss (s+1) (tot + c)
+  go []           s tot = putStrLn $ "--- Done. Tested "++ show tot++" values"
 
--- | ioAll = 'ioFeat' values
+-- | Defined as @ioAll = 'ioFeat' 'values' @
 ioAll :: Enumerable a => (a -> IO ()) -> IO ()
 ioAll = ioFeat values
 
--- | ioBounded @n = 'ioFeat' (bounded n)@
+-- | Defined as @ioBounded n = 'ioFeat' ('bounded' n)@
 ioBounded :: Enumerable a => Integer -> (a -> IO ()) -> IO ()
 ioBounded n = ioFeat (bounded n)
 
 
 
--- | Compatability with QuickCheck. Distribution is uniform generator over 
+-- | Compatibility with QuickCheck. Distribution is uniform generator over 
 -- values bounded by the given size. Typical use: @sized uniform@.
 uniform :: Enumerable a => Int -> Gen a
 uniform = uniformWith optimised
 
--- | Compatability with SmallCheck. 
+-- | Compatibility with SmallCheck. 
 toSeries :: Enumerable a => Int -> [a] 
 toSeries = toSeriesWith optimised
 
diff --git a/Test/Feat/Class.hs b/Test/Feat/Class.hs
--- a/Test/Feat/Class.hs
+++ b/Test/Feat/Class.hs
@@ -30,21 +30,25 @@
   FreePair(..),
   
   
-  -- ** Deriving instances with template haskell
+  -- ** Deriving instances with template Haskell
   deriveEnumerable,
+  deriveEnumerable',
+  ConstructorDeriv,
+  dAll,
+  dExcluding,
+  dExcept
   -- autoCon,
   -- autoCons
-  
-  
-
   ) where
 
 -- testing-feat
 import Test.Feat.Enumerate
 import Test.Feat.Internals.Tag(Tag(Class))
 import Test.Feat.Internals.Derive
+import Test.Feat.Internals.Newtypes
 -- base
 import Data.Typeable
+import Data.Monoid
 -- template-haskell
 import Language.Haskell.TH
 import Language.Haskell.TH.Syntax
@@ -52,6 +56,7 @@
 import Data.Word
 import Data.Int
 import Data.Bits
+import Data.Ratio
 
 -- | A class of functionally enumerable types
 class Typeable a => Enumerable a where
@@ -61,7 +66,7 @@
   enumerate  :: Enumerate a
   
   -- | Version of enumerate that ensures it is shared between
-  -- all accessing functions. Should alwasy be used when 
+  -- all accessing functions. Should always be used when 
   -- combining enumerations.
   -- Should typically be left to default behaviour.
   shared     :: Enumerate a
@@ -112,30 +117,53 @@
 
 -- | Derive an instance of Enumberable with Template Haskell.
 deriveEnumerable :: Name -> Q [Dec]
-deriveEnumerable = fmap return . instanceFor ''Enumerable [enumDef]
+deriveEnumerable = deriveEnumerable' . dAll
+  -- fmap return . instanceFor ''Enumerable [enumDef]
 
--- -- | Derive the enumeration of a single constructor. Useful 
--- if 'deriveEnumerable' does not work for all constructors. 
--- autoCon :: Name -> Q Exp
--- autoCon = undefined
+type ConstructorDeriv = (Name, [(Name, ExpQ)])
+dAll :: Name -> ConstructorDeriv
+dAll n = (n,[])
+dExcluding :: Name -> ConstructorDeriv -> ConstructorDeriv
+dExcluding n (t,nrs) = (t,(n,[|mempty|]):nrs)
+dExcept :: Name -> ExpQ -> ConstructorDeriv -> ConstructorDeriv
+dExcept n e (t,nrs) = (t,(n,e):nrs)
 
--- -- | Splices a list of automatically derived constructors.
--- autoCons :: [Name] -> Q Exp
--- autoCons = listE . map autoCon
+-- | Derive an instance of Enumberable with Template Haskell, with 
+-- rules for some specific constructors
+deriveEnumerable' :: ConstructorDeriv -> Q [Dec]
+deriveEnumerable' (n,cse) =
+  fmap return $ instanceFor ''Enumerable [enumDef] n 
+  where
+    enumDef :: [(Name,[Type])] -> Q Dec
+    enumDef cons = do
+      sanityCheck
+      fmap mk_freqs_binding [|consts $ex |] 
+      where
+        ex = listE $ map cone cons
+        cone xs@(n,_) = maybe (cone' xs) id $ lookup n cse
+        cone' (n,[]) = [|nullary $(conE n)|]
+        cone' (n,_:vs) = 
+          [|unary $(foldr appE (conE n) (map (const [|funcurry|] ) vs) )|]
+        mk_freqs_binding :: Exp -> Dec
+        mk_freqs_binding e = ValD (VarP 'enumerate ) (NormalB e) []
+        sanityCheck = case filter (`notElem` map fst cons) (map fst cse) of
+          [] -> return ()
+          xs -> error $ "Invalid constructors for "++show n++": "++show xs
+        
+-- do
+--          (_,ns,_) <- extractData n
+--          if all (map snd nse) (`elem` ns) 
+--            then return () 
+--            else error $ "Invalid constructors for "++show n++": "++
+--                        show (filter (`notElem` ns) (map fst nse)) 
 
-enumDef :: [(Name,[Type])] -> [Q Dec]
-enumDef cons = [fmap mk_freqs_binding [|consts $ex |]] where
-  ex = listE $ map cone cons
-  cone (n,[]) = [|pure $(conE n)|]
-  cone (n,_:vs) = 
-    [|unary $(foldr appE (conE n) (map (const [|funcurry|] ) vs) )|]
-  mk_freqs_binding :: Exp -> Dec
-  mk_freqs_binding e = ValD (VarP 'enumerate) (NormalB e) []
 
 
 
 
 
+
+
 ---------------------------------------------------------------------
 -- Instances
 
@@ -156,8 +184,8 @@
     , ''Ordering
     ]
   -- Circumventing the stage restrictions by means of code repetition.
-  enumDef :: [(Name,[Type])] -> [Q Dec]
-  enumDef cons = [fmap mk_freqs_binding [|consts $ex |]] where
+  enumDef :: [(Name,[Type])] -> Q Dec
+  enumDef cons = fmap mk_freqs_binding [|consts $ex |] where
     ex = listE $ map cone cons
     cone (n,[]) = [|pure $(conE n)|]
     cone (n,_:vs) = 
@@ -170,8 +198,7 @@
 
 -- This instance is quite important. It needs to be exponential for 
 -- the other instances to work.
-newtype Natural = Natural {natural :: Integer} deriving (Typeable, Show)
-instance Enumerable Natural where 
+instance Infinite a => Enumerable (Nat a) where 
   enumerate = let e = Enumerate{
     card = crd,
     select = sel,
@@ -180,20 +207,24 @@
         | p <= 0     = 0
         | p == 1     = 1
         | otherwise  = 2^(p-2)
-      sel 1 0 = Natural 0
-      sel p i = Natural $ 2^(p-2) + i
+      sel :: Num a => Part -> Index -> Nat a
+      sel 1 0 = Nat 0
+      sel p i = Nat $ 2^(p-2) + fromInteger i
 
+
 -- This instance is used by the Int* instances and needs to be exponential as 
 -- well.
 instance Enumerable Integer where 
   enumerate = unary f  where
-    f (Free (b,Natural i)) = if b then -i-1 else i
-           
+    f (Free (b,Nat i)) = if b then -i-1 else i
 
+instance (Infinite a, Enumerable a) => Enumerable (NonZero a) where 
+  enumerate = unary (\a -> NonZero $ if a >= 0 then a+1 else a)            
+
 -- An exported version would have to use $tag instead of Class
 word :: (Bits a, Integral a) => Enumerate a 
 word = e where
-  e = cutOff (bitSize' e+1) $ unary (fromInteger . natural)
+  e = cutOff (bitSize' e+1) $ unary (fromInteger . nat)
   
 int :: (Bits a, Integral a) => Enumerate a 
 int = e where
@@ -240,7 +271,15 @@
 instance Enumerable Float where
   enumerate = unary (funcurry encodeFloat)
 
+-- This should be fixed with a bijective funtion.
+-- | Not injective
+instance (Infinite a, Enumerable a) => Enumerable (Ratio a) where
+  enumerate = unary $ funcurry $ \a b -> a % nonZero b
+
 -- | Contains only ASCII characters
 instance Enumerable Char where
   enumerate = cutOff 8 $ unary (toEnum . fromIntegral :: Word -> Char)
 
+
+  
+  
diff --git a/Test/Feat/Class/Override.hs b/Test/Feat/Class/Override.hs
new file mode 100644
--- /dev/null
+++ b/Test/Feat/Class/Override.hs
@@ -0,0 +1,43 @@
+-- | Anexperimental feature to override the 'Enumerable' instance for any type.
+
+module Test.Feat.Class.Override (
+  Override,
+  noOverride,
+  addOverride,
+  override
+  ) where
+
+import Test.Feat.Enumerate
+import Test.Feat.Class
+import Test.Feat.Internals.Tag(Tag(Class))
+import Test.Feat.Modifiers
+import Control.Monad.TagShare
+import Control.Monad.State
+
+type Override = DynMap Tag
+
+noOverride :: Override
+noOverride  = dynEmpty
+
+addOverride :: Enumerable a => Enumerate a -> Override -> Override
+addOverride = dynInsert Class
+
+-- | This function is best described with an example:
+-- 
+--  @
+--    let e1 = override $ addOverride (unary 'printable') noOverride :: Enumerate T
+--  @
+-- 
+-- @e1@ enumerates values of type @T@ where all characters (accessed using 
+-- the @Enumerable@ instance for @Char@) are printable. Sometimes this can save 
+-- you from placing lots of 'printable' modifiers in your instances or 
+-- newtypes in your data type definitions.
+--
+-- This works for any type (not just characters) as long as the instance does 
+-- not override the default definition of 'shared' so it does not use 
+-- 'tagShare' (no instance in the library does this).This function should not 
+-- be used for defining instances (doing so might increase memory usage).
+override :: Enumerable a => Override -> Enumerate a
+override = evalState (optimal shared) 
+
+
diff --git a/Test/Feat/Enumerate.hs b/Test/Feat/Enumerate.hs
--- a/Test/Feat/Enumerate.hs
+++ b/Test/Feat/Enumerate.hs
@@ -1,6 +1,6 @@
 {-#LANGUAGE DeriveDataTypeable, TemplateHaskell #-}
 
--- | Basic combinators fo building enumerations
+-- | Basic combinators for building enumerations
 -- most users will want to use the type class 
 -- based combinators in "Test.Feat.Class" instead. 
 
@@ -11,8 +11,10 @@
   Enumerate(..),
   
   -- ** Combinators for building enumerations
-  module Control.Applicative,
   module Data.Monoid,
+  union,
+  module Control.Applicative,
+  singleton,
   pay,
   
   -- ** Memoisation
@@ -44,8 +46,8 @@
 type Part = Int
 type Index = Integer
 
--- | A functional enumeration of type t is a partition of
--- t into finite numbered sets called Parts. The number that
+-- | A functional enumeration of type @t@ is a partition of
+-- @t@ into finite numbered sets called Parts. The number that
 -- identifies each part is called the cost of the values in 
 -- that part.
 data Enumerate a = Enumerate
@@ -53,9 +55,9 @@
    -- | Computes the cardinality of a given part.
    card      ::  Part -> Index,
    -- | Selects a value from the enumeration
-   -- For @select e p i@, @i@ should be less than @card e p@
+   -- For @select e p i@, the index @i@ should be less than @card e p@
    select    ::  Part -> Index -> a,
-   -- | A self-optimising function. 
+   -- | A self-optimising function (mainly for internal use). 
    optimal   ::  Sharing Tag (Enumerate a)
    } deriving Typeable     
 
@@ -65,7 +67,7 @@
     {select    = \p n -> f (select cf p n)
     , optimal  = liftM (fmap f) (optimal cf) }
 
--- | mappend = union
+-- | The @'mappend'@ is (disjoint) @'union'@
 instance Monoid (Enumerate a) where
   mempty      = let e = Enumerate  (\p -> 0) 
                                    (\p i -> error "select: empty")
@@ -77,7 +79,7 @@
 union a b  =  infinite part (liftM2 union (optimal a) (optimal b)) where
   part p   =  finUnion (finite a p) (finite b p)
 
--- | <*> corresponds to product (as with lists)
+-- | Pure is 'singleton' and '<*>' corresponds to cartesian product (as with lists)
 instance Applicative Enumerate where
   pure     = singleton
   f <*> a  = fmap (uncurry ($)) (cartesian f a)
@@ -88,7 +90,7 @@
   [finCart (finite a x) (finite b (p-x))| x <- [0..p]])
     (liftM2 cartesian (optimal a) (optimal b))
 
--- | The definition of @pure@ for the applicaive instance. 
+-- | The definition of @pure@ for the applicative instance. 
 singleton :: a -> Enumerate a
 singleton a = let e = Enumerate car sel (return e) in e 
   where  car p    = if p == 0 then 1 else 0
@@ -113,7 +115,7 @@
     , optimal   = fmap mem (optimal sel)
     }
 
--- | A conventient combination of memoisation and guarded recursion.
+-- | A convenient combination of memoisation and guarded recursion.
 mempay :: Enumerate a -> Enumerate a
 mempay = mem . pay
            
@@ -157,6 +159,4 @@
   car = fCard f1 * fCard f2
   sel i = let (q, r) = (i `quotRem` fCard f2) 
     in (fSelect f1 q, fSelect f2 r)
-
-
-
+ 
diff --git a/Test/Feat/Internals/Derive.hs b/Test/Feat/Internals/Derive.hs
--- a/Test/Feat/Internals/Derive.hs
+++ b/Test/Feat/Internals/Derive.hs
@@ -3,7 +3,7 @@
 import Language.Haskell.TH
 
 -- General combinator for class derivation
-instanceFor :: Name -> [[(Name,[Type])] -> [Q Dec]] -> Name -> Q Dec
+instanceFor :: Name -> [[(Name,[Type])] -> Q Dec] -> Name -> Q Dec
 instanceFor clname confs dtname = do
   (cxt,dtvs,cons) <- extractData dtname
   cd              <- mapM conData cons
@@ -12,7 +12,7 @@
     mkTyp = mkInstanceType clname dtname dtvs
     mkDecs conf = conf cd
 
-  instanceD mkCxt mkTyp (concatMap mkDecs confs)
+  instanceD mkCxt mkTyp (map mkDecs confs)
 
 
 mkInstanceType :: Name -> Name -> [Name] -> Q Type
diff --git a/Test/Feat/Internals/Newtypes.hs b/Test/Feat/Internals/Newtypes.hs
new file mode 100644
--- /dev/null
+++ b/Test/Feat/Internals/Newtypes.hs
@@ -0,0 +1,22 @@
+{-#LANGUAGE DeriveDataTypeable #-}
+module Test.Feat.Internals.Newtypes (
+  Infinite(..),
+  Nat(..),
+  NonZero(..)
+  )where
+
+import Data.Typeable
+
+-- | A class of infinite precision integral types. 'Integer' is the principal 
+-- class member.
+class (Typeable a, Integral a) => Infinite a
+
+instance Infinite Integer
+
+-- | A type of (infinite precision) natural numbers such that @ nat a >= 0 @.
+newtype Nat a = Nat {nat :: a} 
+  deriving (Typeable, Show, Eq, Ord)
+
+-- | A type of (infinite precision) non-zero integers such that @ nonZero a /= 0 @.
+newtype NonZero a = NonZero {nonZero :: a}
+  deriving (Typeable, Show, Eq, Ord)
diff --git a/Test/Feat/Modifiers.hs b/Test/Feat/Modifiers.hs
--- a/Test/Feat/Modifiers.hs
+++ b/Test/Feat/Modifiers.hs
@@ -1,38 +1,50 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 
--- | Types with invariants. Currently these are mostly examples of how to 
--- define such types, suggestions on useful types are appreciated.
+-- | Modifiers for types, i.e. newtype wrappers where the values satisfy some 
+-- constraint (non-empty, positive etc.). Suggestions on useful types are 
+-- appreciated.
 --
--- To use the invariant types you can use the record label. For instance:
+-- To apply the modifiers types you can use the record label. For instance:
 --
 -- @
---  data C a = C [a] [a] deriving Typeable
---  instance Enumerable a => Enumerable (C a) where
---     enumerate = unary $ funcurry $ 
---       \xs ys -> C (nonEmpty xs) (nonEmpty ys)
+--  data C a = C [a] [a] deriving 'Typeable'
+--  instance 'Enumerable' a => 'Enumerable' (C a) where
+--     'enumerate' = 'unary' $ 'funcurry' $ 
+--       \xs ys -> C ('nonEmpty' xs) ('nonEmpty' ys)
 -- @
 --
 -- Alternatively you can put everything in pattern postition:
 --
 -- @
---  instance Enumerable a => Enumerable (C a) where
---     enumerate = unary $ funcurry $ 
---       \(Free (NonEmpty xs,NonEmpty ys)) -> C xs ys)
+--  instance 'Enumerable' a => 'Enumerable' (C a) where
+--     'enumerate' = 'unary' $ 'funcurry' $ 
+--       \('Free' ('NonEmpty' xs,'NonEmpty' ys)) -> C xs ys)
 -- @
 --
 -- The first approach has the advantage of being usable with a 
--- point free style: @ \xs -> C (nonEmpty xs) . nonEmpty @.
+-- point free style: @ \xs -> C ('nonEmpty' xs) . 'nonEmpty' @.
 module Test.Feat.Modifiers(
+  -- ** List modifiers
   NonEmpty(..),
   mkNonEmpty,
 
+  -- ** Numeric modifiers
+  Infinite(..),
   Nat(..),
-    
+  NonZero(..),
+  
+  -- ** Character and string modifiers
+  Unicode(..),
+  unicodes,
+  Printable(..),
+  printables
+  
   ) where
 
 -- testing-feat
 import Test.Feat.Enumerate 
 import Test.Feat.Class
+import Test.Feat.Internals.Newtypes
 -- quickcheck -- Should be made compatible at some point.
 -- import Test.QuickCheck.Modifiers
 
@@ -40,24 +52,45 @@
 -- | A type of non empty lists.
 newtype NonEmpty a = NonEmpty {nonEmpty :: [a]} 
   deriving (Typeable, Show)
-mkNonEmpty x xs = x:xs
+mkNonEmpty :: (a,[a]) -> NonEmpty a
+mkNonEmpty (x,xs) = NonEmpty $ x:xs
 instance Enumerable a => Enumerable (NonEmpty a) where
-  enumerate = unary NonEmpty
+  enumerate = unary $ mkNonEmpty
 
--- Copy paste from Enumerate.hs
--- | A type of natural numbers.
-newtype Nat = Nat {nat :: Integer} 
+
+enumerateBounded :: (Enum a) => Int -> Int -> Enumerate a
+enumerateBounded from to = let e = Enumerate crd sel (return e) in e 
+  where
+    crd p
+       | p <= 0          = 0
+       | p == 1          = 1
+       | 2^(p-1) > num   = max 0 (num - 2^(p-2))
+       | otherwise       = 2^(p-2)
+    sel 1 0 = toEnum from
+    sel p i = toEnum $ 2^(p-2) + fromInteger i + from
+    num    = toInteger $ to - from
+
+-- | Any unicode character.
+newtype Unicode = Unicode {unicode :: Char} 
+  deriving (Typeable, Show, Eq, Ord)
+
+instance Enumerable Unicode where
+  enumerate = mempay $ fmap Unicode $ enumerateBounded 
+    (fromEnum (minBound :: Char)) 
+    (fromEnum (maxBound :: Char))
+
+-- | Smart constructor for unicode strings.
+unicodes :: [Unicode] -> String
+unicodes = map unicode
+
+-- | Printable ASCII characters
+newtype Printable = Printable {printable :: Char}
   deriving (Typeable, Show)
-instance Enumerable Nat where 
-  enumerate = let e = Enumerate{
-    card = crd,
-    select = sel,
-    optimal = return e} in e where
-      crd p
-        | p <= 0     = 0
-        | p == 1     = 1
-        | otherwise  = 2^(p-2)
-      sel 1 0 = Nat 0
-      sel p i = Nat $ 2^(p-2) + i
 
+instance Enumerable Printable where
+  enumerate = mempay $ fmap Printable $ enumerateBounded 32 126
 
+-- | Smart constructor for printable ASCII strings
+printables :: [Printable] -> String
+printables = map printable
+  
diff --git a/examples/TestTH.hs b/examples/TestTH.hs
deleted file mode 100644
--- a/examples/TestTH.hs
+++ /dev/null
@@ -1,451 +0,0 @@
-{-#LANGUAGE MagicHash, TemplateHaskell, DeriveDataTypeable, StandaloneDeriving, GeneralizedNewtypeDeriving #-} 
--- BangPatterns, ScopedTypeVariables, ViewPatterns, KindSignatures
-
-module TestTH where 
-
-import Language.Haskell.TH.Syntax
-  ( Exp(..), Pat(..), Stmt(..), Type(..), Dec(..), 
-    Range(..), Lit(..), Kind(..), 
-    Body(..), Guard(..), Con(..), Match(..), 
-    Name(..), mkName, NameFlavour(..), NameSpace(..), 
-    Clause(..), Pragma(..), FamFlavour(..), 
-    Pred(..), TyVarBndr(..), 
-    Foreign, Callconv(..), FunDep(..), 
-    Safety(..), Strict(..), InlineSpec(..))
--- testing-feat
-import Test.Feat
-import Test.Feat.Access
-import Test.Feat.Modifiers
--- template-haskell
-import Language.Haskell.TH.Syntax.Internals(OccName(OccName), ModName(ModName), PkgName)
-import Language.Haskell.TH.Ppr(pprint,Ppr)
--- haskell-src-meta
-import Language.Haskell.Meta(toExp)
--- haskell-src-exts
-import qualified Language.Haskell.Exts as E
--- quickcheck
-import Test.QuickCheck hiding (NonEmpty, (><))
---base
-import Data.Typeable(Typeable)
-import Data.Ord
-import Data.List
--- smallcheck
-import Test.SmallCheck.Series hiding (Nat)
-import Test.SmallCheck
-
--- Currently both of these spit out a lot of errors. Disabling a few of the
--- buggier constructors might help.
-test_parsesAll = ioAll report_parses
-test_parsesBounded = ioBounded 10000 report_parses
-
-report_parses e = case prop_parsesM e of
-    Nothing -> return ()
-    Just s  -> do
-               putStrLn "Failure:"
-               putStrLn (pprint e)
-               print e
-               putStrLn s
-               putStrLn ""
-
-prop_parsesM e = case myParse $ pprint (e :: Exp) :: E.ParseResult E.Exp of
-  E.ParseOk _       -> Nothing
-  E.ParseFailed _ s -> Just s
-
-
-test_cycleAll = ioAll report_cycle
-test_cycleBounded = ioBounded 10000 report_cycle
-report_cycle e = case prop_cycle e of
-    Nothing       -> return ()
-    Just (ee,ex)  -> do
-               putStrLn "Failure:"
-               putStrLn (pprint ex)
-               print ex
-               putStrLn (E.prettyPrint  ee)
-               putStrLn ""
-
--- Round-trip property: TH -> String -> HSE -> TH
--- Uses haskell-src-meta for HSE -> TH
-prop_cycle :: Exp -> Maybe (E.Exp,Exp)
-prop_cycle e = case myParse $ pprint (e :: Exp) :: E.ParseResult E.Exp of
-  E.ParseOk hse       -> if e == toExp hse then Nothing else Just $ (hse, toExp hse)
-  E.ParseFailed _ s   -> Nothing -- Parse failures do not count as errors!
-
-
-
--- Haskell parser
-myParse :: String -> E.ParseResult E.Exp
-myParse = E.parseWithMode E.defaultParseMode{E.extensions = 
-    [ E.BangPatterns
-    , E.ScopedTypeVariables
-    , E.ViewPatterns
-    , E.KindSignatures
-    , E.ExplicitForAll
-    , E.TypeFamilies
-    ]}
-
-
-
-  
--- We define both SmallCheck and Feat enumerators for comparison.  
-c1 :: (Serial a, Enumerable a) => (a -> b) -> (Enumerate b, Series b)
-c1 f = (unary f,cons1 f)
-c0 f = (nullary f, cons0 f)
-
-instance (Serial a, Serial b) => Serial (FreePair a b) where
-  series = map Free . (series >< series) 
-  coseries = undefined
-
-toSel :: [(Enumerate b, Series b)] -> Enumerate b
-toSel xs = consts $ map fst xs
-
-toSerial :: [(Enumerate b, Series b)] -> Series b
-toSerial xs = foldl1 (\/) $ map snd xs
-
-
-
--- These statements are always expressions
-newtype ExpStmt = ExpStmt Exp deriving Typeable
-
--- Declarations allowed in where clauses
-newtype WhereDec = WhereDec{unWhere :: Dec} deriving Typeable
-
--- Lowecase names
-newtype LcaseN = LcaseN {lcased :: Name} deriving Typeable
--- Uppercase names
-newtype UpcaseName = UpcaseName {ucased :: Name} deriving Typeable
-newtype BindN = BindN Name deriving Typeable
-
-
-instance (Enumerable a, Serial a) => Serial (NonEmpty a) where
-  series = toSerial [c1 $ NonEmpty . funcurry (:)] 
-  coseries = undefined 
-  
-instance Serial Nat where
-  series = map (\(N a) -> Nat a) . series
-  coseries = undefined 
-
-
-newtype CPair a b = CPair {cPair :: (a,b)} deriving Typeable
-
-instance (Enumerable a, Serial a,Enumerable b, Serial b) => Serial (CPair a b) where
-  series = toSerial [c1 $ CPair . funcurry (,)] 
-  coseries = undefined 
-instance (Serial a,Enumerable a,Enumerable b, Serial b) => Enumerable (CPair a b) where
-  enumerate = toSel [c1 $ CPair . funcurry (,)] 
-
-cExp =   
-  [c1 $ VarE . lcased
-  ,c1 $ ConE . ucased
-  ,c1 LitE
-  ,c1 $ funcurry AppE
-  ,c1 $ \(ExpStmt a,o)   -> InfixE (Just a) (either ConE VarE o) Nothing
-  ,c1 $ \(ExpStmt a,o)   -> InfixE Nothing  (either ConE VarE o) (Just a)
-  ,c1 $ \(a,o,b) -> InfixE (Just a) (either ConE VarE o) (Just b)
---  ,c1 $ funcurry $ funcurry $ \a o b -> UInfixE a (VarE o) b
---  ,c1 $ funcurry $ funcurry $ \a o b -> UInfixE a (ConE o) b 
---  ,c1 ParensE
-  ,c1 $ funcurry $ LamE . nonEmpty
-  ,c1 $ \(x1,x2,xs) -> TupE (x1:x2:xs)
---  ,c1 UnboxedTupE
-  ,c1 $ funcurry $ funcurry CondE
-  ,c1 $ \(d,ds,e) -> LetE (map unWhere $ d:ds) e -- DISABLED BUGGY EMPTY LETS
-  ,c1 $ \(e,NonEmpty m) -> CaseE e m
-  ,c1 $ \(e,ss) -> DoE (ss ++ [NoBindS e])
-  ,c1 $ (\((p,e),(CPair (xs,e'))) -> CompE ([BindS p e] ++ xs ++ [NoBindS e']))
---  ,c1 ArithSeqE -- BUGGY!
-  ,c1 ListE
---  ,c1 $ funcurry SigE -- BUGGY!
-  ,c1 $ \(e,x) -> RecConE e $ map unCase (nonEmpty x)
-  ,c1 $ \(e,fe) -> RecUpdE e $ map unCase (nonEmpty fe)
-  ]
-instance Enumerable Exp where
-  enumerate = toSel cExp
-instance Serial Exp where
-  series = toSerial cExp
-  coseries = undefined
-
-unCase (LcaseN n,e) = (n,e)
-
-cExpStmt = 
-  [ c1 $ ExpStmt . VarE
-  , c1 $ ExpStmt . ConE
-  , c1 $ ExpStmt . LitE
-  , c1 $ \(e1,e2) -> ExpStmt (AppE e1 e2)
-  , c1 $ ExpStmt . LitE
-  -- , c1 parS
-  -- Removed paralell comprehensions
-  ]
-instance Enumerable ExpStmt where
- enumerate = toSel cExpStmt
-instance Serial ExpStmt where
-  series = toSerial cExpStmt
-  coseries = undefined
-  
-cPat =   
-  [ c1 LitP
-  , c1 $ \(BindN n) -> VarP n
-  , c1 TupP 
-  , c1 $ \(UpcaseName n,ps) -> ConP n ps
-  , c1 $ \(p1,UpcaseName n,p2) -> InfixP p1 n p2
-  , c1 TildeP
---  , c1 $ \(LcaseN n) -> BangP $ VarP n
-  , c1 $ \(BindN n,p) -> AsP n p
-  , c0 WildP
-  , c1 $ \(UpcaseName e,x) -> RecP e (map (\(BindN n, p) -> (n,p)) (nonEmpty x))
-  , c1 ListP
---  , c1 $ funcurry SigP -- BUGGY!
---  , c1 $ funcurry ViewP -- BUGGY!
-  ]
-instance Enumerable Pat where
- enumerate = toSel cPat
-instance Serial Pat where
-  series = toSerial cPat
-  coseries = undefined
-
-
-
--- deriveEnumerable ''Match  -- Should remove decs
-cMatch = 
-  [c1 $ funcurry $ funcurry $ \x y ds -> Match x y (map unWhere ds)
-  ]
-instance Enumerable Match where
- enumerate = toSel cMatch
-instance Serial Match where
-  series = toSerial cMatch
-  coseries = undefined  
-  
-cStmt = 
-  [ c1 $ funcurry BindS
-  , c1 $ \(d) -> LetS $ map unWhere $ nonEmpty d
-  , c1 $ NoBindS
-  -- , c1 parS
-  -- Removed paralell comprehensions
-  ]
-instance Enumerable Stmt where
- enumerate = toSel cStmt
-instance Serial Stmt where
-  series = toSerial cStmt
-  coseries = undefined
-
-
-cName = [ c1 (funcurry Name) ]
-instance Enumerable Name where
- enumerate = toSel cName
-instance Serial Name where
-  series = toSerial cName
-  coseries = undefined
-
-cType = 
-  [c1 $ funcurry $ funcurry $ (\(x) -> ForallT (nonEmpty x))
-  ,c1 $ \(BindN a) -> VarT a
-  ,c1 $ \(UpcaseName a) -> ConT a
-  ,c1 $ \n -> TupleT (abs n)
-  ,c0 ArrowT
-  ,c0 ListT
-  ,c1 $ funcurry AppT
-  -- ,c1 $ funcurry SigT -- BUGGY!
-  ]
-instance Enumerable Type where
- enumerate = toSel cType
-instance Serial Type where
-  series = toSerial cType
-  coseries = undefined
-
-
--- deriveEnumerable ''Dec
-
-cWhereDec = 
-  [ c1 $ \(n,c)  -> WhereDec $ FunD n (nonEmpty c)
-  , c1 $ \(n,p,wds) -> WhereDec $ ValD n p (map unWhere wds)
-  , c1 $ \(BindN a,b)     -> WhereDec $ SigD a b
-  -- , c1 $ WhereDec . PragmaD -- Removed pragmas
-  -- , c1 parS -- Removed paralell comprehensions
-  ]
-instance Enumerable WhereDec where
-  enumerate = toSel cWhereDec
-instance Serial WhereDec where
-  series = toSerial cWhereDec
-  coseries = undefined
-
-
-  
-cLit = 
-  [ c1 StringL
-  , c1 CharL    -- TODO: Fair char generation
-  , c1 $ IntegerL . nat
-  -- , c1 RationalL -- BUGGY!
-  -- Removed primitive litterals
-  ]
-instance Enumerable Lit where
-  enumerate = toSel cLit
-instance Serial Lit where
-  series = toSerial cLit
-  coseries = undefined
-
-
-cClause = 
- [c1 $ funcurry (funcurry $ \ps bs ds -> Clause ps bs (map unWhere ds))]
-instance Enumerable Clause where
-  enumerate = toSel cClause
-instance Serial Clause where
-  series = toSerial cClause
-  coseries = undefined
-
-
-
-
-
--- deriveEnumerable ''Pred
-cPred = 
-  [ c1 $ funcurry ClassP
-  , c1 $ funcurry EqualP
-  ]
-instance Enumerable Pred where
-  enumerate = toSel cPred
-instance Serial Pred where
-  series = toSerial cPred
-  coseries = undefined
-
--- deriveEnumerable ''TyVarBndr
-cTyVarBndr = 
-  [ c1 $ PlainTV
-  , c1 $ funcurry KindedTV
-  ]
-instance Enumerable TyVarBndr where
-  enumerate = toSel cTyVarBndr
-instance Serial TyVarBndr where
-  series = toSerial cTyVarBndr
-  coseries = undefined
-
-
-cKind = 
-  [c0 StarK
-  ,c1 (funcurry ArrowK)
-  ]
-instance Enumerable Kind where
-  enumerate = toSel cKind
-instance Serial Kind where
-  series = toSerial cKind
-  coseries = undefined
-
-
-cBody =
-  [ c1 NormalB
-  , c1 $ \(x) -> GuardedB (nonEmpty x)
-  -- Removed primitive litterals
-  ]
-instance Enumerable Body where
- enumerate = toSel cBody
-instance Serial Body where
-  series = toSerial cBody
-  coseries = undefined
-
-cGuard = 
-  [c1 $ NormalG
-  ,c1 $ \(s) -> PatG (nonEmpty s)
-  ]
-instance Enumerable Guard where
- enumerate = toSel cGuard
-instance Serial Guard where
-  series = toSerial cGuard
-  coseries = undefined
-  
-
-cCallconv = [c0 CCall, c0 StdCall]
-instance Enumerable Callconv where
-  enumerate = toSel cCallconv
-instance Serial Callconv where
-  series = toSerial cCallconv
-  coseries = undefined
-
-
-cSafety = [c0 Unsafe, c0 Safe, c0 Interruptible]
-instance Enumerable Safety where
-  enumerate = toSel cSafety
-instance Serial Safety where
-  series = toSerial cSafety
-  coseries = undefined
-  
-
-cStrict = [c0 IsStrict, c0 NotStrict, c0 Unpacked]
-instance Enumerable Strict where
-  enumerate = toSel cStrict
-instance Serial Strict where
-  series = toSerial cStrict
-  coseries = undefined
-
-cInlineSpec = [c1 (funcurry $ funcurry $ InlineSpec)]
-instance Enumerable InlineSpec where
-  enumerate = toSel cInlineSpec
-instance Serial InlineSpec where
-  series = toSerial cInlineSpec
-  coseries = undefined
-
-cOccName = 
-   [ c0 $ OccName "Con"
-   , c0 $ OccName "var"
-   ]
-instance Enumerable OccName where
-  enumerate = toSel cOccName
-instance Serial OccName where
-  series = toSerial cOccName
-  coseries = undefined
-
-cBindN = [c0 $ BindN $ Name (OccName "var") NameS]
-instance Enumerable BindN where
-  enumerate = toSel cBindN
-instance Serial BindN where
-  series = toSerial cBindN
-  coseries = undefined
-  
-cLcaseN = [c1 $ \nf -> LcaseN $ Name (OccName "var") nf]
-instance Enumerable LcaseN where
-  enumerate = toSel cLcaseN
-instance Serial LcaseN where
-  series = toSerial cLcaseN
-  coseries = undefined
-  
-cUpcaseName = [c1 $ \nf -> UpcaseName $ Name (OccName "Con") nf]
-instance Serial UpcaseName where
-  series = toSerial cUpcaseName
-  coseries = undefined
-instance Enumerable UpcaseName where
-  enumerate = toSel cUpcaseName
-  
-cModName = [c0 $ ModName "M", c0 $ ModName "C.M"]
-instance Enumerable ModName where
-  enumerate = toSel cModName
-instance Serial ModName where
-  series = toSerial cModName
-  coseries = undefined
-   
-
-cRange = 
-  [ c1 FromR
-  , c1 (funcurry FromThenR)
-  , c1 (funcurry FromToR)
-  , c1 (funcurry $ funcurry FromThenToR)
-  ]
-instance Enumerable Range where
-  enumerate = toSel cRange
-instance Serial Range where
-  series = toSerial cRange
-  coseries = undefined
-
-cNameFlavour = (
-  [ c1 NameQ
---    , funcurry $ funcurry NameG 
---    , \(I# x) -> NameU x
---    , \(I# x) -> NameL x
-  , c0 NameS
-  ])
-instance Enumerable NameFlavour where
-  enumerate = toSel cNameFlavour
-instance Serial NameFlavour where
-  series = toSerial cNameFlavour
-  coseries = undefined
-
--- instance (Enumerable a, Integral a) => Enumerable (Ratio a) where
---   enumerate = consts [c1 $ funcurry (:%)]
-
-
diff --git a/examples/haskell-src-exts/hse.hs b/examples/haskell-src-exts/hse.hs
new file mode 100644
--- /dev/null
+++ b/examples/haskell-src-exts/hse.hs
@@ -0,0 +1,202 @@
+{-# Language TemplateHaskell #-}
+import Test.Feat
+import Test.Feat.Class
+import Test.Feat.Modifiers
+
+import Language.Haskell.Exts
+import Language.Haskell.Exts.Syntax
+
+import Control.Exception as Ex
+
+-- Welcome to the automatic HSE tester!
+-- Things to try while youre here: 
+--   switch between Exp/Module/Decl etc. as testing types (e.g. TestRoundtrip)
+--   to discover bugs in the various entry-points of the grammar.
+
+-- TODOs: add some newtypes and modifiers to deal with syntax type invariants 
+-- (such as only enumerating non-empty do-expressions with a statement as last 
+-- expression).
+--
+-- Catalogue and report all the bugs found.
+
+
+main = main_parse 100
+
+run n = main_parse n
+
+
+-- Everything which is produced by the pretty printer and is parseable is 
+-- semantically euivalent to the original.
+type TestRoundtrip = Exp
+main_round n = ioFeat (take n values) (rep_round :: TestRoundtrip -> IO())
+
+rep_round :: (Eq a,Parseable a, Show a, Pretty a) => a -> IO ()
+rep_round e = case myParse $ prettyPrint e of
+  ParseOk e' -> if e == e' || prettyPrint e == prettyPrint e' then return () else do
+    putStrLn $ "------ Error ------"
+    putStrLn $ "e:          "++ (show  e)
+    putStrLn $ "e(Pretty):  "++(prettyPrint e)
+    putStrLn $ "e':         "++ (show  e')
+    putStrLn $ "e'(Pretty): "++(prettyPrint e')
+    putStrLn ""
+  ParseFailed _ err -> return ()
+  
+
+
+-- Everything produced by the pretty printer is parseable.
+type TestParse = Module
+main_parse n = ioFeat (take n values) (rep_parse :: TestParse -> IO())
+
+rep_parse :: (Parseable a, Show a, Pretty a) => a -> IO ()
+rep_parse e = case myParse $ prettyPrint e of
+  ParseOk e' -> const (return ()) (e' `asTypeOf` e)
+  ParseFailed _ err -> do
+    putStrLn (show  e)
+    putStrLn (prettyPrint e)
+    putStrLn err
+    putStrLn ""
+
+
+-- The pretty printer doesnt fail, for testing the enumerators.
+type TestPrint = Module
+
+main_print n = ioFeat (take n values) (rep_print :: TestPrint -> IO())
+
+main_print' n = ioFeat (take n $ bounded 100000) (rep_print :: TestPrint -> IO())
+
+
+prop_print :: Pretty a => a -> Bool
+prop_print e = length (prettyPrint e) >= 0
+
+rep_print :: (Show a, Pretty a) => a -> IO ()
+rep_print e = Ex.catch 
+  (prop_print e `seq` return ())
+  (\err -> do
+    putStrLn (show  e)
+    if show (err::SomeException) == "user interrupt" then undefined else return ()
+    putStrLn $ show (err::SomeException)
+    putStrLn "")
+
+myParse :: Parseable a => String ->  ParseResult a
+myParse = parseWithMode defaultParseMode{
+  extensions = knownExtensions 
+  }
+
+sureParse :: Parseable a => String -> a
+sureParse s = case myParse s of
+  ParseOk a -> a
+  ParseFailed _ err -> error err
+  
+parse_print :: (Parseable a, Pretty a) => String -> (a,String)
+parse_print s = let a = sureParse s in (a,prettyPrint a)
+
+
+
+-- Uncomment the dExcluding line to enable known bugs
+(let 
+  buggy1 = 
+    dExcluding 'UnboxedSingleCon . 
+    dAll
+  buggy2 = 
+    dExcluding 'PQuasiQuote . 
+    dAll
+    
+  buggy3 = 
+    dExcluding 'XPcdata .
+    dExcluding 'XExpTag .
+    dExcluding 'XChildTag .
+    dExcept 'XPcdata [| unary $ XPcdata . nonEmpty |] . dAll
+  
+
+ in fmap concat $ mapM deriveEnumerable' [
+  dAll ''Module,
+--  dAll ''SrcLoc,
+  dExcept 'LanguagePragma [|unary $ funcurry $ \x -> LanguagePragma x . nonEmpty|] 
+    $ dAll ''ModulePragma,
+  dExcept 'WarnText [|unary $ WarnText . nonEmpty|]
+    $ dExcept 'DeprText [|unary $ DeprText . nonEmpty|]  
+    $ dAll ''WarningText,
+  dAll ''ExportSpec,
+  dAll ''ImportDecl,
+  dAll ''Decl,
+  dAll ''Tool,
+  dAll ''QName,
+  dAll ''ImportSpec,
+  dAll ''Annotation,
+  dAll ''Type,
+  dAll ''Activation,
+  dAll ''Rule,
+  dAll ''CallConv,
+  dAll ''Safety,
+  buggy2 ''Pat,
+  dAll ''Rhs,
+  dAll ''Binds,
+  dAll ''Match,
+  buggy3 ''Exp,
+  dAll ''Assoc,
+  dAll ''Op,
+  dAll ''Asst,
+  dAll ''InstDecl,
+  dAll ''TyVarBind,
+  dAll ''FunDep,
+  dAll ''ClassDecl,
+  dAll ''DataOrNew,
+  dAll ''Kind,
+  dAll ''GadtDecl,
+  dAll ''QualConDecl,
+  buggy1 ''SpecialCon,
+  dAll ''Boxed,
+  dAll ''RuleVar,
+  dAll ''XName,
+  dAll ''PXAttr,
+  dAll ''RPat,
+  dAll ''PatField,
+  dAll ''GuardedRhs,
+  dAll ''IPBind,
+  dAll ''XAttr,
+  dAll ''Splice,
+  dAll ''Bracket,
+  dAll ''QualStmt,
+  dAll ''FieldUpdate,
+  dAll ''QOp,
+  dAll ''Stmt,
+  dAll ''Alt,
+  dAll ''Literal,
+  dAll ''IPName,
+  dAll ''ConDecl,
+  dAll ''RPatOp,
+  dAll ''GuardedAlts,
+  dAll ''BangType,
+  dAll ''GuardedAlt
+  ])
+
+
+
+instance Enumerable ModuleName where 
+  enumerate = consts 
+    [ nullary $ ModuleName "M"
+    , nullary $ ModuleName "C.M"
+    ]
+
+-- Will probably need to be broken into constructor/variable/symbol names
+instance Enumerable Name where
+  enumerate = consts 
+    [ nullary $ Ident "C"
+    , nullary $ Ident "v"
+    , nullary $ Symbol "*"
+    ]
+
+instance Enumerable CName where
+  enumerate = consts
+    [ nullary $ VarName (Ident "v")
+    , nullary $ ConName (Ident "C")
+    ]
+
+instance Enumerable SrcLoc where
+  enumerate = consts
+    [ nullary (SrcLoc "File.hs" 0 0)]
+
+
+
+
+
diff --git a/examples/template-haskell/th.hs b/examples/template-haskell/th.hs
new file mode 100644
--- /dev/null
+++ b/examples/template-haskell/th.hs
@@ -0,0 +1,450 @@
+{-#LANGUAGE MagicHash, TemplateHaskell, DeriveDataTypeable, StandaloneDeriving, GeneralizedNewtypeDeriving #-} 
+-- BangPatterns, ScopedTypeVariables, ViewPatterns, KindSignatures
+
+
+import Language.Haskell.TH.Syntax
+  ( Exp(..), Pat(..), Stmt(..), Type(..), Dec(..), 
+    Range(..), Lit(..), Kind(..), 
+    Body(..), Guard(..), Con(..), Match(..), 
+    Name(..), mkName, NameFlavour(..), NameSpace(..), 
+    Clause(..), Pragma(..), FamFlavour(..), 
+    Pred(..), TyVarBndr(..), 
+    Foreign, Callconv(..), FunDep(..), 
+    Safety(..), Strict(..), InlineSpec(..))
+-- testing-feat
+import Test.Feat
+import Test.Feat.Access
+import Test.Feat.Modifiers
+-- template-haskell
+import Language.Haskell.TH.Syntax.Internals(OccName(OccName), ModName(ModName), PkgName)
+import Language.Haskell.TH.Ppr(pprint,Ppr)
+-- haskell-src-meta
+import Language.Haskell.Meta(toExp)
+-- haskell-src-exts
+import qualified Language.Haskell.Exts as E
+-- quickcheck
+import Test.QuickCheck hiding (NonEmpty, (><))
+--base
+import Data.Typeable(Typeable)
+import Data.Ord
+import Data.List
+-- smallcheck
+import Test.SmallCheck.Series hiding (Nat)
+import Test.SmallCheck
+
+-- Currently both of these spit out a lot of errors. Disabling a few of the
+-- buggier constructors might help.
+test_parsesAll = ioAll report_parses
+test_parsesBounded = ioBounded 10000 report_parses
+
+report_parses e = case prop_parsesM e of
+    Nothing -> return ()
+    Just s  -> do
+               putStrLn "Failure:"
+               putStrLn (pprint e)
+               print e
+               putStrLn s
+               putStrLn ""
+
+prop_parsesM e = case myParse $ pprint (e :: Exp) :: E.ParseResult E.Exp of
+  E.ParseOk _       -> Nothing
+  E.ParseFailed _ s -> Just s
+
+
+test_cycleAll = ioAll report_cycle
+test_cycleBounded = ioBounded 10000 report_cycle
+report_cycle e = case prop_cycle e of
+    Nothing       -> return ()
+    Just (ee,ex)  -> do
+               putStrLn "Failure:"
+               putStrLn (pprint ex)
+               print ex
+               putStrLn (E.prettyPrint  ee)
+               putStrLn ""
+
+-- Round-trip property: TH -> String -> HSE -> TH
+-- Uses haskell-src-meta for HSE -> TH
+prop_cycle :: Exp -> Maybe (E.Exp,Exp)
+prop_cycle e = case myParse $ pprint (e :: Exp) :: E.ParseResult E.Exp of
+  E.ParseOk hse       -> if e == toExp hse then Nothing else Just $ (hse, toExp hse)
+  E.ParseFailed _ s   -> Nothing -- Parse failures do not count as errors!
+
+
+
+-- Haskell parser
+myParse :: String -> E.ParseResult E.Exp
+myParse = E.parseWithMode E.defaultParseMode{E.extensions = 
+    [ E.BangPatterns
+    , E.ScopedTypeVariables
+    , E.ViewPatterns
+    , E.KindSignatures
+    , E.ExplicitForAll
+    , E.TypeFamilies
+    ]}
+
+
+
+  
+-- We define both SmallCheck and Feat enumerators for comparison.  
+c1 :: (Serial a, Enumerable a) => (a -> b) -> (Enumerate b, Series b)
+c1 f = (unary f,cons1 f)
+c0 f = (nullary f, cons0 f)
+
+instance (Serial a, Serial b) => Serial (FreePair a b) where
+  series = map Free . (series >< series) 
+  coseries = undefined
+
+toSel :: [(Enumerate b, Series b)] -> Enumerate b
+toSel xs = consts $ map fst xs
+
+toSerial :: [(Enumerate b, Series b)] -> Series b
+toSerial xs = foldl1 (\/) $ map snd xs
+
+
+
+-- These statements are always expressions
+newtype ExpStmt = ExpStmt Exp deriving Typeable
+
+-- Declarations allowed in where clauses
+newtype WhereDec = WhereDec{unWhere :: Dec} deriving Typeable
+
+-- Lowecase names
+newtype LcaseN = LcaseN {lcased :: Name} deriving Typeable
+-- Uppercase names
+newtype UpcaseName = UpcaseName {ucased :: Name} deriving Typeable
+newtype BindN = BindN Name deriving Typeable
+
+
+instance (Enumerable a, Serial a) => Serial (NonEmpty a) where
+  series = toSerial [c1 $ NonEmpty . funcurry (:)] 
+  coseries = undefined 
+  
+instance (Serial a, Infinite a) => Serial (Nat a) where
+  series = map (\(N a) -> Nat a) . series
+  coseries = undefined 
+
+
+newtype CPair a b = CPair {cPair :: (a,b)} deriving Typeable
+
+instance (Enumerable a, Serial a,Enumerable b, Serial b) => Serial (CPair a b) where
+  series = toSerial [c1 $ CPair . funcurry (,)] 
+  coseries = undefined 
+instance (Serial a,Enumerable a,Enumerable b, Serial b) => Enumerable (CPair a b) where
+  enumerate = toSel [c1 $ CPair . funcurry (,)] 
+
+cExp =   
+  [c1 $ VarE . lcased
+  ,c1 $ ConE . ucased
+  ,c1 LitE
+  ,c1 $ funcurry AppE
+  ,c1 $ \(ExpStmt a,o)   -> InfixE (Just a) (either ConE VarE o) Nothing
+  ,c1 $ \(ExpStmt a,o)   -> InfixE Nothing  (either ConE VarE o) (Just a)
+  ,c1 $ \(a,o,b) -> InfixE (Just a) (either ConE VarE o) (Just b)
+--  ,c1 $ funcurry $ funcurry $ \a o b -> UInfixE a (VarE o) b
+--  ,c1 $ funcurry $ funcurry $ \a o b -> UInfixE a (ConE o) b 
+--  ,c1 ParensE
+  ,c1 $ funcurry $ LamE . nonEmpty
+  ,c1 $ \(x1,x2,xs) -> TupE (x1:x2:xs)
+--  ,c1 UnboxedTupE
+  ,c1 $ funcurry $ funcurry CondE
+  ,c1 $ \(d,ds,e) -> LetE (map unWhere $ d:ds) e -- DISABLED BUGGY EMPTY LETS
+  ,c1 $ \(e,NonEmpty m) -> CaseE e m
+  ,c1 $ \(e,ss) -> DoE (ss ++ [NoBindS e])
+  ,c1 $ (\((p,e),(CPair (xs,e'))) -> CompE ([BindS p e] ++ xs ++ [NoBindS e']))
+--  ,c1 ArithSeqE -- BUGGY!
+  ,c1 ListE
+--  ,c1 $ funcurry SigE -- BUGGY!
+  ,c1 $ \(e,x) -> RecConE e $ map unCase (nonEmpty x)
+  ,c1 $ \(e,fe) -> RecUpdE e $ map unCase (nonEmpty fe)
+  ]
+instance Enumerable Exp where
+  enumerate = toSel cExp
+instance Serial Exp where
+  series = toSerial cExp
+  coseries = undefined
+
+unCase (LcaseN n,e) = (n,e)
+
+cExpStmt = 
+  [ c1 $ ExpStmt . VarE
+  , c1 $ ExpStmt . ConE
+  , c1 $ ExpStmt . LitE
+  , c1 $ \(e1,e2) -> ExpStmt (AppE e1 e2)
+  , c1 $ ExpStmt . LitE
+  -- , c1 parS
+  -- Removed paralell comprehensions
+  ]
+instance Enumerable ExpStmt where
+ enumerate = toSel cExpStmt
+instance Serial ExpStmt where
+  series = toSerial cExpStmt
+  coseries = undefined
+  
+cPat =   
+  [ c1 LitP
+  , c1 $ \(BindN n) -> VarP n
+  , c1 TupP 
+  , c1 $ \(UpcaseName n,ps) -> ConP n ps
+  , c1 $ \(p1,UpcaseName n,p2) -> InfixP p1 n p2
+  , c1 TildeP
+--  , c1 $ \(LcaseN n) -> BangP $ VarP n
+  , c1 $ \(BindN n,p) -> AsP n p
+  , c0 WildP
+  , c1 $ \(UpcaseName e,x) -> RecP e (map (\(BindN n, p) -> (n,p)) (nonEmpty x))
+  , c1 ListP
+--  , c1 $ funcurry SigP -- BUGGY!
+--  , c1 $ funcurry ViewP -- BUGGY!
+  ]
+instance Enumerable Pat where
+ enumerate = toSel cPat
+instance Serial Pat where
+  series = toSerial cPat
+  coseries = undefined
+
+
+
+-- deriveEnumerable ''Match  -- Should remove decs
+cMatch = 
+  [c1 $ funcurry $ funcurry $ \x y ds -> Match x y (map unWhere ds)
+  ]
+instance Enumerable Match where
+ enumerate = toSel cMatch
+instance Serial Match where
+  series = toSerial cMatch
+  coseries = undefined  
+  
+cStmt = 
+  [ c1 $ funcurry BindS
+  , c1 $ \(d) -> LetS $ map unWhere $ nonEmpty d
+  , c1 $ NoBindS
+  -- , c1 parS
+  -- Removed paralell comprehensions
+  ]
+instance Enumerable Stmt where
+ enumerate = toSel cStmt
+instance Serial Stmt where
+  series = toSerial cStmt
+  coseries = undefined
+
+
+cName = [ c1 (funcurry Name) ]
+instance Enumerable Name where
+ enumerate = toSel cName
+instance Serial Name where
+  series = toSerial cName
+  coseries = undefined
+
+cType = 
+  [c1 $ funcurry $ funcurry $ (\(x) -> ForallT (nonEmpty x))
+  ,c1 $ \(BindN a) -> VarT a
+  ,c1 $ \(UpcaseName a) -> ConT a
+  ,c1 $ \n -> TupleT (abs n)
+  ,c0 ArrowT
+  ,c0 ListT
+  ,c1 $ funcurry AppT
+  -- ,c1 $ funcurry SigT -- BUGGY!
+  ]
+instance Enumerable Type where
+ enumerate = toSel cType
+instance Serial Type where
+  series = toSerial cType
+  coseries = undefined
+
+
+-- deriveEnumerable ''Dec
+
+cWhereDec = 
+  [ c1 $ \(n,c)  -> WhereDec $ FunD n (nonEmpty c)
+  , c1 $ \(n,p,wds) -> WhereDec $ ValD n p (map unWhere wds)
+  , c1 $ \(BindN a,b)     -> WhereDec $ SigD a b
+  -- , c1 $ WhereDec . PragmaD -- Removed pragmas
+  -- , c1 parS -- Removed paralell comprehensions
+  ]
+instance Enumerable WhereDec where
+  enumerate = toSel cWhereDec
+instance Serial WhereDec where
+  series = toSerial cWhereDec
+  coseries = undefined
+
+
+  
+cLit = 
+  [ c1 StringL
+  , c1 CharL    -- TODO: Fair char generation
+  , c1 $ IntegerL . nat
+  -- , c1 RationalL -- BUGGY!
+  -- Removed primitive litterals
+  ]
+instance Enumerable Lit where
+  enumerate = toSel cLit
+instance Serial Lit where
+  series = toSerial cLit
+  coseries = undefined
+
+
+cClause = 
+ [c1 $ funcurry (funcurry $ \ps bs ds -> Clause ps bs (map unWhere ds))]
+instance Enumerable Clause where
+  enumerate = toSel cClause
+instance Serial Clause where
+  series = toSerial cClause
+  coseries = undefined
+
+
+
+
+
+-- deriveEnumerable ''Pred
+cPred = 
+  [ c1 $ funcurry ClassP
+  , c1 $ funcurry EqualP
+  ]
+instance Enumerable Pred where
+  enumerate = toSel cPred
+instance Serial Pred where
+  series = toSerial cPred
+  coseries = undefined
+
+-- deriveEnumerable ''TyVarBndr
+cTyVarBndr = 
+  [ c1 $ PlainTV
+  , c1 $ funcurry KindedTV
+  ]
+instance Enumerable TyVarBndr where
+  enumerate = toSel cTyVarBndr
+instance Serial TyVarBndr where
+  series = toSerial cTyVarBndr
+  coseries = undefined
+
+
+cKind = 
+  [c0 StarK
+  ,c1 (funcurry ArrowK)
+  ]
+instance Enumerable Kind where
+  enumerate = toSel cKind
+instance Serial Kind where
+  series = toSerial cKind
+  coseries = undefined
+
+
+cBody =
+  [ c1 NormalB
+  , c1 $ \(x) -> GuardedB (nonEmpty x)
+  -- Removed primitive litterals
+  ]
+instance Enumerable Body where
+ enumerate = toSel cBody
+instance Serial Body where
+  series = toSerial cBody
+  coseries = undefined
+
+cGuard = 
+  [c1 $ NormalG
+  ,c1 $ \(s) -> PatG (nonEmpty s)
+  ]
+instance Enumerable Guard where
+ enumerate = toSel cGuard
+instance Serial Guard where
+  series = toSerial cGuard
+  coseries = undefined
+  
+
+cCallconv = [c0 CCall, c0 StdCall]
+instance Enumerable Callconv where
+  enumerate = toSel cCallconv
+instance Serial Callconv where
+  series = toSerial cCallconv
+  coseries = undefined
+
+
+cSafety = [c0 Unsafe, c0 Safe, c0 Interruptible]
+instance Enumerable Safety where
+  enumerate = toSel cSafety
+instance Serial Safety where
+  series = toSerial cSafety
+  coseries = undefined
+  
+
+cStrict = [c0 IsStrict, c0 NotStrict, c0 Unpacked]
+instance Enumerable Strict where
+  enumerate = toSel cStrict
+instance Serial Strict where
+  series = toSerial cStrict
+  coseries = undefined
+
+cInlineSpec = [c1 (funcurry $ funcurry $ InlineSpec)]
+instance Enumerable InlineSpec where
+  enumerate = toSel cInlineSpec
+instance Serial InlineSpec where
+  series = toSerial cInlineSpec
+  coseries = undefined
+
+cOccName = 
+   [ c0 $ OccName "Con"
+   , c0 $ OccName "var"
+   ]
+instance Enumerable OccName where
+  enumerate = toSel cOccName
+instance Serial OccName where
+  series = toSerial cOccName
+  coseries = undefined
+
+cBindN = [c0 $ BindN $ Name (OccName "var") NameS]
+instance Enumerable BindN where
+  enumerate = toSel cBindN
+instance Serial BindN where
+  series = toSerial cBindN
+  coseries = undefined
+  
+cLcaseN = [c1 $ \nf -> LcaseN $ Name (OccName "var") nf]
+instance Enumerable LcaseN where
+  enumerate = toSel cLcaseN
+instance Serial LcaseN where
+  series = toSerial cLcaseN
+  coseries = undefined
+  
+cUpcaseName = [c1 $ \nf -> UpcaseName $ Name (OccName "Con") nf]
+instance Serial UpcaseName where
+  series = toSerial cUpcaseName
+  coseries = undefined
+instance Enumerable UpcaseName where
+  enumerate = toSel cUpcaseName
+  
+cModName = [c0 $ ModName "M", c0 $ ModName "C.M"]
+instance Enumerable ModName where
+  enumerate = toSel cModName
+instance Serial ModName where
+  series = toSerial cModName
+  coseries = undefined
+   
+
+cRange = 
+  [ c1 FromR
+  , c1 (funcurry FromThenR)
+  , c1 (funcurry FromToR)
+  , c1 (funcurry $ funcurry FromThenToR)
+  ]
+instance Enumerable Range where
+  enumerate = toSel cRange
+instance Serial Range where
+  series = toSerial cRange
+  coseries = undefined
+
+cNameFlavour = (
+  [ c1 NameQ
+--    , funcurry $ funcurry NameG 
+--    , \(I# x) -> NameU x
+--    , \(I# x) -> NameL x
+  , c0 NameS
+  ])
+instance Enumerable NameFlavour where
+  enumerate = toSel cNameFlavour
+instance Serial NameFlavour where
+  series = toSerial cNameFlavour
+  coseries = undefined
+
+-- instance (Enumerable a, Integral a) => Enumerable (Ratio a) where
+--   enumerate = consts [c1 $ funcurry (:%)]
+
+
diff --git a/testing-feat.cabal b/testing-feat.cabal
--- a/testing-feat.cabal
+++ b/testing-feat.cabal
@@ -1,5 +1,5 @@
 Name:                testing-feat
-Version:             0.1
+Version:             0.2
 Synopsis:            Functional enumeration for systematic and random testing
 Description:         Feat (Functional Enumeration of Abstract Types) 
                      provides an enumeration as a function from natural 
@@ -12,8 +12,9 @@
                      class instance for most types.
                      "Test.Feat" contain a subset of the other modules that 
                      should be sufficient for most test usage. There 
-                     is a large scale example in the tar ball (testing the 
-                     Template Haskell pretty printer).
+                     are two (somewhat similar) large scale example in the tar 
+                     ball: testing the Template Haskell pretty printer and 
+                     testing haskell-src-exts.
                                           
 License:             BSD3
 License-file:        LICENSE
@@ -24,7 +25,8 @@
 Build-type:          Simple
 
 Extra-source-files:  
-    examples/TestTH.hs
+    examples/template-haskell/th.hs
+    examples/haskell-src-exts/hse.hs
 
 Cabal-version:       >=1.2
 
@@ -34,6 +36,7 @@
     Test.Feat, 
     Test.Feat.Access,
     Test.Feat.Class,
+    Test.Feat.Class.Override,
     Test.Feat.Enumerate,
     Test.Feat.Modifiers 
     Control.Monad.TagShare
@@ -50,5 +53,5 @@
   Other-modules:
     Test.Feat.Internals.Derive
     Test.Feat.Internals.Tag
-    
+    Test.Feat.Internals.Newtypes