diff --git a/registry.cabal b/registry.cabal
--- a/registry.cabal
+++ b/registry.cabal
@@ -4,10 +4,10 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 591911740b5ea4e2d73e6ab67dcec50fb357c1d1552a9c00dc26119c705c25ee
+-- hash: 9a42dc0b45e4a76624b48f457789494c6d57502a863d3397c88a28a0e85d57cf
 
 name:           registry
-version:        0.1.2.6
+version:        0.1.3.0
 synopsis:       data structure for assembling components
 description:    This library provides a "Registry" which is a data structure containing a list of functions and values representing dependencies in a directed acyclic graph. A `make` function can then be used to create a value of a specific type out of the registry.
                 You can start with the [README](https://github.com/etorreborre/registry/blob/master/README.md) for a full description of the library.
@@ -40,6 +40,7 @@
       Data.Registry.RIO
       Data.Registry.Solver
       Data.Registry.Statistics
+      Data.Registry.TH
       Data.Registry.Warmup
   other-modules:
       Paths_registry
@@ -49,22 +50,24 @@
   ghc-options: -Wall -Wcompat -Wincomplete-record-updates -fhide-source-paths -fprint-potential-instances -optP-Wno-nonportable-include-path -Wincomplete-uni-patterns
   build-depends:
       base >=4.7 && <5
-    , containers <0.7
-    , exceptions <0.11
-    , hashable <1.3
-    , mtl <3
-    , protolude <0.3
-    , resourcet <1.3
-    , semigroupoids <5.4
-    , semigroups <0.19
-    , text <2
-    , transformers-base <0.5
+    , containers >=0.5 && <0.7
+    , exceptions >=0.8 && <0.11
+    , hashable >=1.2 && <1.3
+    , mtl >=2.0 && <3
+    , protolude >=0.2 && <0.3
+    , resourcet >=1.1 && <1.3
+    , semigroupoids >=5.0 && <5.4
+    , semigroups >=0.15 && <0.19
+    , template-haskell >=2.13 && <3.0
+    , text >=1.1 && <2
+    , transformers-base >=0.4 && <0.5
   default-language: Haskell2010
 
 test-suite spec
   type: exitcode-stdio-1.0
   main-is: test.hs
   other-modules:
+      AutoDiscoveredSpecs
       Test.Data.Registry.DotSpec
       Test.Data.Registry.GenSpec
       Test.Data.Registry.Internal.CacheSpec
@@ -83,6 +86,7 @@
       Test.Data.Registry.RIOSpec
       Test.Data.Registry.SimpleExamples
       Test.Data.Registry.SmallExample
+      Test.Data.Registry.THSpec
       Test.Data.Registry.WarmupSpec
       Test.Tasty.Extensions
       Paths_registry
@@ -94,23 +98,27 @@
       MonadRandom <0.6
     , async <2.3
     , base >=4.7 && <5
-    , containers <0.7
-    , exceptions <0.11
-    , hashable <1.3
+    , containers >=0.5 && <0.7
+    , exceptions >=0.8 && <0.11
+    , generic-lens <2
+    , hashable >=1.2 && <1.3
     , hedgehog <0.7
     , hedgehog-corpus <0.2
     , io-memoize <1.2
-    , mtl <3
-    , protolude <0.3
+    , mtl >=2.0 && <3
+    , multimap <1.3
+    , protolude >=0.2 && <0.3
     , random <2.0
     , registry
-    , resourcet <1.3
-    , semigroupoids <5.4
+    , resourcet >=1.1 && <1.3
+    , semigroupoids >=5.0 && <5.4
     , semigroups <0.19
     , tasty <1.3
     , tasty-discover <4.3
     , tasty-hedgehog <0.3
     , tasty-th <0.2
+    , template-haskell >=2.13 && <3.0
     , text <2
-    , transformers-base <0.5
+    , transformers-base >=0.4 && <0.5
+    , universum <2
   default-language: Haskell2010
diff --git a/src/Data/Registry/RIO.hs b/src/Data/Registry/RIO.hs
--- a/src/Data/Registry/RIO.hs
+++ b/src/Data/Registry/RIO.hs
@@ -122,6 +122,12 @@
 
 -- * For testing
 
+-- | This runs a RIO value without closing down resources or executing startup actions
+unsafeRunRIO :: (Typeable a, MonadIO m) => RIO a -> m a
+unsafeRunRIO rio = liftIO $ do
+  is <- createInternalState
+  fst <$> runRIO rio (Stop is)
+
 -- | Use a RIO value and make sure that resources are closed
 --   Don't run the warmup
 withNoWarmupRIO :: (MonadIO m) => RIO a -> (a -> IO b) -> m b
@@ -152,7 +158,6 @@
   is <- liftIO createInternalState
   (a, w) <- runRIO (make @(RIO a) registry) (Stop is)
   pure (a, w, Stop is)
-
 
 -- | Instantiate the component but don't execute the warmup (it may take time) and lose a way to cleanu up resources
 -- | Almost no compilation time is spent on checking that component resolution is possible
diff --git a/src/Data/Registry/TH.hs b/src/Data/Registry/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Registry/TH.hs
@@ -0,0 +1,129 @@
+{-# LANGUAGE QuasiQuotes     #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Data.Registry.TH (
+  TypeclassOptions
+, makeTypeclass
+, makeTypeclassWith
+) where
+
+import           Data.Text                  as T (drop, splitOn)
+import           Language.Haskell.TH
+import           Language.Haskell.TH.Syntax
+import           Protolude                  hiding (Type, Strict)
+
+
+{-
+  This module generates a typeclass for a given "record of functions". For this component:
+
+data Logger m = Logger {
+  _info :: Text -> m ()
+, _error :: Text -> m ()
+}
+
+-- `makeTypeClass ''Logger` generates
+
+class WithLogger m where
+  info :: Text -> m ()
+  error :: Text -> m ()
+
+-- This requires the import of `Data.Generics.Product.Typed` from `generic-lens`
+instance HasType (Logger m) s => WithLogger (ReaderT s m) where
+  info t = ReaderT (\l -> _info (getTyped l) t)
+  error t = ReaderT (\l -> _error (getType l) t)
+
+-}
+
+-- | Create the haskell code presented in the module description
+makeTypeclass :: Name -> DecsQ
+makeTypeclass = makeTypeclassWith (TypeclassOptions ("With" <>) (T.drop 1))
+
+-- | These generation options can be used to tweak the generated names
+data TypeclassOptions = TypeclassOptions {
+  -- adjust the typeclass name based on the component constructor name
+  _typeclassName :: Text -> Text
+  -- adjust the typeclass function names based on the component function names
+, _functionName  :: Text -> Text
+}
+
+-- | Make a typeclass using some specific generation options
+makeTypeclassWith :: TypeclassOptions -> Name -> DecsQ
+makeTypeclassWith (TypeclassOptions typeclassNameMaker functionNameMaker) componentType = do
+  info <- reify componentType
+  case info of
+        TyConI (DataD _ name typeVars _ [RecC _ types] _) -> do
+          readertInstance <- createReadertInstance typeclassNameMaker functionNameMaker name typeVars types
+          pure $ createTypeclass typeclassNameMaker functionNameMaker name typeVars types
+                 <> readertInstance
+
+        TyConI (NewtypeD _ name typeVars _ (RecC _ types) _) -> do
+          readertInstance <- createReadertInstance typeclassNameMaker functionNameMaker name typeVars types
+          pure $ createTypeclass typeclassNameMaker functionNameMaker name typeVars types
+                 <> readertInstance
+
+        other -> do
+          qReport True ("can only generate a typeclass for a record of functions, got: " <> show other)
+          pure []
+
+
+createTypeclass :: (Text -> Text) -> (Text -> Text) -> Name -> [TyVarBndr] -> [VarBangType] -> [Dec]
+createTypeclass typeclassNameMaker functionNameMaker name typeVars types =
+  let typeclassName = modifyName typeclassNameMaker (dropQualified name)
+      functions = fmap (makeFunctionDeclaration functionNameMaker) types
+  in [ClassD [] typeclassName typeVars [] functions]
+
+-- | Create an instance definition using a ReaderT instance
+--     instance WithLogger (ReaderT (Logger m) m) where ...
+createReadertInstance :: (Text -> Text) -> (Text -> Text) -> Name -> [TyVarBndr] -> [VarBangType] -> DecsQ
+createReadertInstance typeclassNameMaker functionNameMaker name [tvar] types =
+  let tvarName = case tvar of PlainTV v -> v; KindedTV v _ -> v
+      typeclassName = modifyName typeclassNameMaker (dropQualified name)
+      functions = fmap (makeFunctionInstance functionNameMaker (mkName "ReaderT")) types
+      typeclassT = ConT typeclassName
+      components = mkName "c"
+      componentTypeT = ConT name
+      componentsTypeT = VarT components
+      readerT = ConT (mkName "ReaderT")
+      hasTypeT = ConT (mkName "HasType")
+      tvarT   = VarT tvarName
+  in pure [InstanceD Nothing
+            [AppT (AppT hasTypeT (AppT componentTypeT tvarT)) componentsTypeT]
+            (AppT typeclassT (AppT (AppT readerT componentsTypeT) tvarT))
+            functions]
+
+createReadertInstance _ _ _ tvars _ = do
+  qReport True ("can only generate a instance for a component typeclass when it has only one type variable, got: " <> show tvars)
+  pure []
+
+-- | Make the function declaration of the typeclass based on the function name in the "record of functions"
+makeFunctionDeclaration :: (Text -> Text) -> VarBangType -> Dec
+makeFunctionDeclaration functionNameMaker (name, _, type') =
+  SigD (modifyName functionNameMaker (dropQualified name)) type'
+
+-- | This produces: info p1 p2 = ReaderT (\component -> _info component p1 p2)
+makeFunctionInstance :: (Text -> Text) -> Name -> VarBangType -> Dec
+makeFunctionInstance functionNameMaker runnerName (name, _, functionType) =
+  let functionName = modifyName functionNameMaker (dropQualified name)
+      readerT = ConE runnerName
+      component = mkName "component"
+      numberOfParameters = countNumberOfParameters functionType
+      parameterNames = (\i -> mkName ("p" <> show i)) <$> [1..numberOfParameters]
+      parameters = VarP <$> parameterNames
+      firstApplication = AppE (VarE name) (AppE (VarE (mkName "getTyped")) (VarE component))
+      body = foldl' (\r p -> AppE r (VarE p)) firstApplication parameterNames
+  in
+    FunD functionName [Clause parameters (NormalB (AppE readerT (LamE [VarP component] body))) []]
+
+-- | count the number of parameters for a function type
+countNumberOfParameters :: Type -> Int
+countNumberOfParameters (ForallT _ _ t) = countNumberOfParameters t
+countNumberOfParameters (AppT (AppT ArrowT _) t) = 1 +  countNumberOfParameters t
+countNumberOfParameters _ = 0
+
+-- | Modify a template haskell name
+modifyName :: (Text -> Text) -> Name -> Name
+modifyName f n = mkName (toS . f . show $ n)
+
+-- | Remove the module name from a qualified name
+dropQualified :: Name -> Name
+dropQualified name =  maybe name (mkName . toS) (lastMay (T.splitOn "." (show name)))
diff --git a/test/AutoDiscoveredSpecs.hs b/test/AutoDiscoveredSpecs.hs
new file mode 100644
--- /dev/null
+++ b/test/AutoDiscoveredSpecs.hs
@@ -0,0 +1,1 @@
+{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --generated-module=AutoDiscoveredSpecs #-}
diff --git a/test/Test/Data/Registry/DotSpec.hs b/test/Test/Data/Registry/DotSpec.hs
--- a/test/Test/Data/Registry/DotSpec.hs
+++ b/test/Test/Data/Registry/DotSpec.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE TemplateHaskell       #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 
 module Test.Data.Registry.DotSpec where
@@ -37,7 +36,3 @@
       , "\"Test.Data.Registry.Make.SpecializationSpec.Supervisor-4\" -> \"Test.Data.Registry.Make.SpecializationSpec.SupervisorConfig-4\\nSupervisorConfig for sql in general\";"
       , "}"
       ]
-
-
-----
-tests = $(testGroupGenerator)
diff --git a/test/Test/Data/Registry/GenSpec.hs b/test/Test/Data/Registry/GenSpec.hs
--- a/test/Test/Data/Registry/GenSpec.hs
+++ b/test/Test/Data/Registry/GenSpec.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE TemplateHaskell       #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 
 {-
@@ -89,7 +88,7 @@
   +: fun genDouble
   +: end
 
-test_company_with_one_employee = noShrink $ prop "generate just one employee" $ run $ do
+test_company_with_one_employee = noShrink $ prop "generate just one employee" $ runR $ do
   setMinimalCompany
   company <- forall @Company
   let allEmployees = company & departments >>= (& employees)
@@ -127,10 +126,8 @@
 tweakGen :: forall a m . (Typeable a, Monad m) => (Gen a -> Gen a) -> RegistryProperty m ()
 tweakGen f = modify $ tweakUnsafe @(Gen a) f
 
-run :: Monad m => RegistryProperty m a -> PropertyT m a
-run = runWith registry
+runR :: Monad m => RegistryProperty m a -> PropertyT m a
+runR = runWith registry
 
 runWith :: Monad m => Registry ins out -> RegistryProperty m a -> PropertyT m a
 runWith = flip evalStateT
-----
-tests = $(testGroupGenerator)
diff --git a/test/Test/Data/Registry/Internal/CacheSpec.hs b/test/Test/Data/Registry/Internal/CacheSpec.hs
--- a/test/Test/Data/Registry/Internal/CacheSpec.hs
+++ b/test/Test/Data/Registry/Internal/CacheSpec.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE TemplateHaskell #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 
 module Test.Data.Registry.Internal.CacheSpec where
@@ -21,6 +20,3 @@
     cachedAction
 
   cached === 1
-
-----
-tests = $(testGroupGenerator)
diff --git a/test/Test/Data/Registry/Internal/DynamicSpec.hs b/test/Test/Data/Registry/Internal/DynamicSpec.hs
--- a/test/Test/Data/Registry/Internal/DynamicSpec.hs
+++ b/test/Test/Data/Registry/Internal/DynamicSpec.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell     #-}
 {-# LANGUAGE TypeApplications    #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
@@ -46,6 +45,3 @@
 
 dynType :: forall a . (Typeable a) => a -> SomeTypeRep
 dynType = dynTypeRep . toDyn
-
-----
-tests = $(testGroupGenerator)
diff --git a/test/Test/Data/Registry/Internal/MakeSpec.hs b/test/Test/Data/Registry/Internal/MakeSpec.hs
--- a/test/Test/Data/Registry/Internal/MakeSpec.hs
+++ b/test/Test/Data/Registry/Internal/MakeSpec.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE TemplateHaskell     #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 
@@ -29,7 +28,3 @@
   case result of
     Left e  -> annotateShow e >> "cycle detected!" `T.isPrefixOf` e === True
     Right _ -> failure
-
-
-----
-tests = $(testGroupGenerator)
diff --git a/test/Test/Data/Registry/Internal/ReflectionSpec.hs b/test/Test/Data/Registry/Internal/ReflectionSpec.hs
--- a/test/Test/Data/Registry/Internal/ReflectionSpec.hs
+++ b/test/Test/Data/Registry/Internal/ReflectionSpec.hs
@@ -1,6 +1,4 @@
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell     #-}
-{-# LANGUAGE TypeApplications    #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 
@@ -77,6 +75,3 @@
 
 fun3 :: IO (Mod Int) -> IO Int
 fun3 = undefined
-
-----
-tests = $(testGroupGenerator)
diff --git a/test/Test/Data/Registry/Internal/RegistrySpec.hs b/test/Test/Data/Registry/Internal/RegistrySpec.hs
--- a/test/Test/Data/Registry/Internal/RegistrySpec.hs
+++ b/test/Test/Data/Registry/Internal/RegistrySpec.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell     #-}
 {-# LANGUAGE TypeApplications    #-}
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
@@ -85,6 +84,3 @@
 -- *
 
 fromValueDyn = fromDynamic . valueDyn
-
-----
-tests = $(testGroupGenerator)
diff --git a/test/Test/Data/Registry/Internal/TypesSpec.hs b/test/Test/Data/Registry/Internal/TypesSpec.hs
--- a/test/Test/Data/Registry/Internal/TypesSpec.hs
+++ b/test/Test/Data/Registry/Internal/TypesSpec.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE TemplateHaskell #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 
 module Test.Data.Registry.Internal.TypesSpec where
@@ -40,6 +39,3 @@
 d = someTypeRep $ typeOf D
 e = someTypeRep $ typeOf E
 f = someTypeRep $ typeOf F
-
-----
-tests = $(testGroupGenerator)
diff --git a/test/Test/Data/Registry/Make/MakeSpec.hs b/test/Test/Data/Registry/Make/MakeSpec.hs
--- a/test/Test/Data/Registry/Make/MakeSpec.hs
+++ b/test/Test/Data/Registry/Make/MakeSpec.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE DataKinds       #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 
 module Test.Data.Registry.Make.MakeSpec where
@@ -41,6 +40,3 @@
 -- inverse of add1 (in terms of type signature)
 dda1 :: Text -> Int
 dda1 = T.length
-
-----
-tests = $(testGroupGenerator)
diff --git a/test/Test/Data/Registry/Make/MemoizeSpec.hs b/test/Test/Data/Registry/Make/MemoizeSpec.hs
--- a/test/Test/Data/Registry/Make/MemoizeSpec.hs
+++ b/test/Test/Data/Registry/Make/MemoizeSpec.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE DataKinds        #-}
-{-# LANGUAGE TemplateHaskell  #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 
 module Test.Data.Registry.Make.MemoizeSpec where
@@ -97,8 +96,3 @@
   pure c
 
 data App = App { a :: A, b :: B }
-
-
-
-----
-tests = $(testGroupGenerator)
diff --git a/test/Test/Data/Registry/Make/SpecializationSpec.hs b/test/Test/Data/Registry/Make/SpecializationSpec.hs
--- a/test/Test/Data/Registry/Make/SpecializationSpec.hs
+++ b/test/Test/Data/Registry/Make/SpecializationSpec.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE PartialTypeSignatures #-}
 {-# LANGUAGE RecordWildCards       #-}
-{-# LANGUAGE TemplateHaskell       #-}
 {-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 
@@ -195,6 +194,3 @@
 newStatsStore client sql supervisor = StatsStore {
   statsStoreConfig = (twitterConfig client, sqlConfig sql, supervisorConfig supervisor)
 }
-
-----
-tests = $(testGroupGenerator)
diff --git a/test/Test/Data/Registry/Make/TweakingSpec.hs b/test/Test/Data/Registry/Make/TweakingSpec.hs
--- a/test/Test/Data/Registry/Make/TweakingSpec.hs
+++ b/test/Test/Data/Registry/Make/TweakingSpec.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE DataKinds        #-}
-{-# LANGUAGE TemplateHaskell  #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 
 module Test.Data.Registry.Make.TweakingSpec where
@@ -27,6 +26,3 @@
 
 newtype UseConfig1 = UseConfig1 { printConfig1 :: Config }
 newUseConfig1 config = UseConfig1 { printConfig1 = config }
-
-----
-tests = $(testGroupGenerator)
diff --git a/test/Test/Data/Registry/MonadRandomSpec.hs b/test/Test/Data/Registry/MonadRandomSpec.hs
--- a/test/Test/Data/Registry/MonadRandomSpec.hs
+++ b/test/Test/Data/Registry/MonadRandomSpec.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE RecordWildCards     #-}
-{-# LANGUAGE TemplateHaskell     #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 
 {-
@@ -125,7 +124,3 @@
 
   -- everytime we call the generator we get the same value
   length (nub results) === 1
-
-
-----
-tests = $(testGroupGenerator)
diff --git a/test/Test/Data/Registry/RIOSpec.hs b/test/Test/Data/Registry/RIOSpec.hs
--- a/test/Test/Data/Registry/RIOSpec.hs
+++ b/test/Test/Data/Registry/RIOSpec.hs
@@ -1,7 +1,4 @@
-{-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell     #-}
-{-# LANGUAGE TypeApplications    #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 
@@ -35,6 +32,3 @@
   ref <- liftIO $ withNoWarmupRIO rio $ \ref -> modifyIORef ref (<>["use"]) $> ref
   content <- liftIO $ readIORef ref
   content === ["start", "use", "close" :: Text]
-
-----
-tests = $(testGroupGenerator)
diff --git a/test/Test/Data/Registry/RegistrySpec.hs b/test/Test/Data/Registry/RegistrySpec.hs
--- a/test/Test/Data/Registry/RegistrySpec.hs
+++ b/test/Test/Data/Registry/RegistrySpec.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell     #-}
 {-# LANGUAGE TypeApplications    #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
@@ -35,6 +34,3 @@
 registry =
      fun newLogger
   +: end
-
-----
-tests = $(testGroupGenerator)
diff --git a/test/Test/Data/Registry/SmallExample.hs b/test/Test/Data/Registry/SmallExample.hs
--- a/test/Test/Data/Registry/SmallExample.hs
+++ b/test/Test/Data/Registry/SmallExample.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE RecordWildCards     #-}
-{-# LANGUAGE TemplateHaskell     #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 
 {-
@@ -14,7 +13,7 @@
 import           Data.Text             (splitOn)
 import           Data.Typeable         (Typeable)
 import           Protolude             as P
-import           Test.Tasty.Extensions
+import           Test.Tasty.Extensions hiding (run)
 
 -- | Components of the application
 --     - a Logger
@@ -68,7 +67,7 @@
 registry =
      funAs @IO (newS3 @IO)
   +: funAs @IO (newApplication @IO)
-  +: funTo @IO newLogger
+  +: funTo @IO noLogging
   +: funTo @IO newLinesCounter
   +: valTo @IO (S3Config "bucket" "key")
   +: end
@@ -84,6 +83,3 @@
   app <- liftIO createApplication -- nothing should crash!
   r   <- liftIO $ (app & run) "hello\nworld"
   r === 2
-
-----
-tests = $(testGroupGenerator)
diff --git a/test/Test/Data/Registry/THSpec.hs b/test/Test/Data/Registry/THSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Data/Registry/THSpec.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE TemplateHaskell     #-}
+
+module Test.Data.Registry.THSpec where
+
+import           Data.Generics.Product.Typed
+import           Data.Registry.TH
+import           Protolude
+import           Universum                   ((...))
+
+-- | Example of TemplateHaskell usage
+
+-- | We define 2 low-level components: Logger and Tracer
+--   We make the corresponding typeclasses
+data Logger m = Logger {
+  -- a function taking 2 arguments
+  _info  :: Text -> Text -> m ()
+  -- a function having a constraint
+, _error :: forall a . (Monoid a) => a -> Text -> m ()
+}
+
+makeTypeclass ''Logger
+
+newtype Tracer m = Tracer {
+  _traceIt :: Text -> m ()
+}
+
+makeTypeclass ''Tracer
+
+-- | Now we make a component which is going to use both components
+newtype Service m = Service {
+  doIt :: Int -> Text -> m ()
+}
+
+newService :: Monad m => Logger m -> Tracer m -> Service m
+newService logger tracer = Service {
+  doIt = run ... implementService
+} where
+    -- the typeclass instances can be resolved by using a Reader containing
+    --  a tuple with all the components
+    run = flip runReaderT (logger, tracer)
+
+-- | Implement the service using typeclasses
+implementService ::
+     Monad m
+  => WithLogger m
+  => WithTracer m
+  => Int
+  -> Text
+  -> m ()
+implementService n t = do
+  info "doing it" t
+  traceIt (show n)
diff --git a/test/Test/Data/Registry/WarmupSpec.hs b/test/Test/Data/Registry/WarmupSpec.hs
--- a/test/Test/Data/Registry/WarmupSpec.hs
+++ b/test/Test/Data/Registry/WarmupSpec.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE TemplateHaskell      #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
@@ -73,6 +72,3 @@
 genEmpty  = pure Empty
 genFailed = failed <$> element simpsons
 genOk     = ok     <$> element colours
-
-----
-tests = $(testGroupGenerator)
diff --git a/test/Test/Tasty/Extensions.hs b/test/Test/Tasty/Extensions.hs
--- a/test/Test/Tasty/Extensions.hs
+++ b/test/Test/Tasty/Extensions.hs
@@ -17,31 +17,40 @@
   module Hedgehog
 , module Tasty
 , gotException
+, groupByModuleName
+, minTestsOk
 , noShrink
 , prop
+, run
+, runOnly
 , test
-, minTestsOk
 , withSeed
 ) where
 
-import           Data.Maybe          (fromJust)
+import           Data.Maybe           (fromJust)
+import           Data.MultiMap
 import           GHC.Stack
-import           Hedgehog            as Hedgehog hiding (test)
-import           Hedgehog.Corpus     as Hedgehog
-import           Hedgehog.Gen        as Hedgehog hiding (discard, print)
-import qualified Prelude             as Prelude
-import           Protolude           hiding ((.&.))
-import           Test.Tasty          as Tasty
-import           Test.Tasty.Options  as Tasty
-import           Test.Tasty.Hedgehog as Tasty
-import           Test.Tasty.TH       as Tasty
+import           Hedgehog             as Hedgehog hiding (test)
+import           Hedgehog.Corpus      as Hedgehog
+import           Hedgehog.Gen         as Hedgehog hiding (discard, print)
+import qualified Prelude              as Prelude
+import           Protolude            hiding (empty, toList, (.&.))
+import           System.Environment
+import           Test.Tasty           as Tasty
+import           Test.Tasty.Hedgehog  as Tasty
+import           Test.Tasty.Options   as Tasty
+import           Test.Tasty.Providers as Tasty (singleTest)
+import           Test.Tasty.Runners   as Tasty (foldSingle, foldTestTree, trivialFold, TestTree(..))
 
 -- | Create a Tasty test from a Hedgehog property
-prop :: HasCallStack => TestName -> PropertyT IO () -> [TestTree]
-prop name p = [withFrozenCallStack $ testProperty name (Hedgehog.property p)]
+prop :: HasCallStack => TestName -> PropertyT IO () -> TestTree
+prop name p =
+  let aModuleName = getModuleName
+  in  withFrozenCallStack . localOption (ModuleName (toS aModuleName)) $
+      testProperty name (Hedgehog.property p)
 
 -- | Create a Tasty test from a Hedgehog property called only once
-test :: HasCallStack => TestName -> PropertyT IO () -> [TestTree]
+test :: HasCallStack => TestName -> PropertyT IO () -> TestTree
 test name p = withFrozenCallStack (minTestsOk 1 . noShrink $ prop name p)
 
 gotException :: forall a . (HasCallStack, Show a) => a -> PropertyT IO ()
@@ -53,11 +62,78 @@
 
 -- * Parameters
 
-minTestsOk :: Int -> [TestTree] -> [TestTree]
-minTestsOk n = fmap (localOption (HedgehogTestLimit (Just (toEnum n :: TestLimit))))
+minTestsOk :: Int -> TestTree -> TestTree
+minTestsOk n = localOption (HedgehogTestLimit (Just (toEnum n :: TestLimit)))
 
-noShrink :: [TestTree] -> [TestTree]
-noShrink = fmap (localOption (HedgehogShrinkLimit (Just (0 :: ShrinkLimit))))
+noShrink :: TestTree -> TestTree
+noShrink = localOption (HedgehogShrinkLimit (Just (0 :: ShrinkLimit)))
 
-withSeed :: Prelude.String -> [TestTree] -> [TestTree]
-withSeed seed = fmap (localOption (fromJust (parseValue seed :: Maybe HedgehogReplay)))
+withSeed :: Prelude.String -> TestTree -> TestTree
+withSeed seed = localOption (fromJust (parseValue seed :: Maybe HedgehogReplay))
+
+-- * GROUPING
+
+-- | Extract the ModuleName option value for a given test and
+--   group all the tests with that option into the same test group
+groupByModuleName :: TestTree -> TestTree
+groupByModuleName testTree =
+  let grouped = assocs $ foldTestTree (trivialFold { foldSingle = \os n t ->
+        let (ModuleName aModuleName) = lookupOption os :: ModuleName
+        in insert (toS aModuleName) (setOptionSet os $ singleTest n t) empty
+        }) mempty testTree
+  in  TestGroup "All" (uncurry TestGroup <$> grouped)
+
+instance (Ord k) => Semigroup (MultiMap k v) where
+  (<>) m1 m2 = fromList (toList m1 <> toList m2)
+
+instance (Ord k) => Monoid (MultiMap k v) where
+  mempty = empty
+  mappend = (<>)
+
+-- | This is unfortunate. Due to the API for `foldTestTree` in Tasty
+--   giving back the current `OptionSet` applicable to a single test
+--   it is not possible to re-set those option values on that test
+--   without listing them exhaustively. This means
+--   that if other options are set on tests in that file, they need to be
+--   added in that function
+setOptionSet :: OptionSet -> TestTree -> TestTree
+setOptionSet os =
+  localOption (lookupOption os :: HedgehogTestLimit) .
+  localOption (lookupOption os :: HedgehogShrinkLimit) .
+  localOption (lookupOption os :: HedgehogReplay)
+
+getModuleName :: HasCallStack => Prelude.String
+getModuleName =
+  case getCallStack  callStack of
+    ((_, loc):_) -> srcLocModule loc
+    _            -> "root"
+
+-- | Option describing the current module name
+newtype ModuleName = ModuleName Text deriving (Eq, Show)
+
+-- | The option triggering the database tests is called 'postgres' for compatibility reasons
+instance IsOption ModuleName where
+  defaultValue = ModuleName "root"
+  parseValue = fmap ModuleName . safeRead
+  optionName = pure "module-name"
+  optionHelp = pure "internal option used to group tests into the same module"
+  optionCLParser = mkFlagCLParser mempty (ModuleName "root")
+
+-- * GHCi run functions
+
+run :: Runnable t => t -> IO ()
+run tests = runIt tests >>= defaultMain . groupByModuleName
+
+runOnly :: Runnable t => Text -> t -> IO ()
+runOnly p tests = do
+  setEnv "TASTY_PATTERN" (toS p)
+  run tests `finally` unsetEnv "TASTY_PATTERN"
+
+class Runnable t where
+  runIt :: t -> IO TestTree
+
+instance Runnable (IO TestTree) where
+  runIt t = t
+
+instance Runnable TestTree where
+  runIt = pure
diff --git a/test/test.hs b/test/test.hs
--- a/test/test.hs
+++ b/test/test.hs
@@ -1,1 +1,5 @@
-{-# OPTIONS_GHC -F -pgmF tasty-discover #-}
+import           AutoDiscoveredSpecs   (tests)
+import           Protolude
+import           Test.Tasty.Extensions
+
+main = tests >>= defaultMain . groupByModuleName