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: e570c9eb12f1d7452ae6ba23b2fd2fde606bc45719f4bc981ddea25dc2b18704
+-- hash: 875841de93fa8c39edcfa699e24ae654224e8f39182a77262a4dff5f67e8938d
 
 name:           registry
-version:        0.1.2.3
+version:        0.1.2.4
 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.
diff --git a/src/Data/Registry/Lift.hs b/src/Data/Registry/Lift.hs
--- a/src/Data/Registry/Lift.hs
+++ b/src/Data/Registry/Lift.hs
@@ -1,7 +1,9 @@
-{-# LANGUAGE AllowAmbiguousTypes   #-}
-{-# LANGUAGE IncoherentInstances   #-}
-{-# LANGUAGE TypeFamilies          #-}
-{-# LANGUAGE UndecidableInstances  #-}
+{-# LANGUAGE AllowAmbiguousTypes  #-}
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE IncoherentInstances  #-}
+{-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
 
 {- |
   This code is taken from https://stackoverflow.com/questions/28003135/is-it-possible-to-encode-a-generic-lift-function-in-haskell
@@ -18,7 +20,7 @@
 -}
 module Data.Registry.Lift where
 
-import           Protolude
+import           Protolude hiding (Nat)
 
 -- | Typeclass for lifting pure functions to effectful arguments and results
 class Applicative f => ApplyVariadic f a b where
@@ -50,15 +52,67 @@
 
 -- | Typeclass for lifting a function with a result of type m b into a function
 --   with a result of type n b
-class Applicative f => ApplyVariadic2 f g a b where
+class ApplyVariadic2 f g a b where
   applyVariadic2 :: (forall x . f x -> g x) -> a -> b
 
-instance (Applicative f, b ~ g a) => ApplyVariadic2 f g (f a) b where
+instance (b ~ g a) => ApplyVariadic2 f g (f a) b where
   applyVariadic2 natfg = natfg
 
-instance (Applicative f, ApplyVariadic2 f g a' b', b ~ (a -> b')) => ApplyVariadic2 f g (a -> a') b where
+instance (ApplyVariadic2 f g a' b', b ~ (a -> b')) => ApplyVariadic2 f g (a -> a') b where
   applyVariadic2 natfg f a = applyVariadic2 natfg (f a)
 
 -- | Lift a function returning an effectful result to a function returning another effectful result
 outTo :: forall g f a b . ApplyVariadic2 f g a b => (forall x . f x -> g x) -> a -> b
 outTo natfg = applyVariadic2 natfg :: a -> b
+
+-- *  Tagging
+
+-- | The output of some constructors can be "tagged" with a string to indicate how a given
+--   value was built.
+newtype Tag (s :: Symbol) a = Tag { unTag :: a } deriving (Eq, Show)
+
+instance Functor (Tag s) where
+  fmap f (Tag a) = Tag @s (f a)
+
+instance Applicative (Tag s) where
+  pure = Tag
+  Tag f <*> Tag a = Tag @s (f a)
+
+-- | Tag a given constructor f with a string s. The 'applyLast' function only applies the tag to the output
+--   type of the constructor. For example
+--   data Salary = Fixed Int | Variable Int Double
+--   tag @"Variable" Variable :: Int -> Double -> Tag "Variable" Salary
+tag :: forall (s :: Symbol) fun . (CNumArgs (CountArgs fun) fun) => fun -> Apply (Tag s) (CountArgs fun) fun
+tag = applyLast @(Tag s)
+
+-- | ApplyLast typeclass provided by @neongreen
+--   It uses an auxiliary typeclass to count the arguments of a function
+data Nat = Z | S Nat
+
+data NumArgs :: Nat -> * -> * where
+  NAZ :: NumArgs Z a
+  NAS :: NumArgs n b -> NumArgs (S n) (a -> b)
+
+type family CountArgs (f :: *) :: Nat where
+  CountArgs (a -> b) = S (CountArgs b)
+  CountArgs result = Z
+
+class CNumArgs (numArgs :: Nat) (arrows :: *) where
+  getNA :: NumArgs numArgs arrows
+
+instance CNumArgs Z a where
+  getNA = NAZ
+
+instance CNumArgs n b => CNumArgs (S n) (a -> b) where
+  getNA = NAS getNA
+
+type family Apply (f :: * -> *) (n :: Nat) (arrows :: *) :: * where
+  Apply f (S n) (a -> b) = a -> Apply f n b
+  Apply f Z a = f a
+
+applyLast :: forall f fun . (Applicative f, CNumArgs (CountArgs fun) fun) => fun -> Apply f (CountArgs fun) fun
+applyLast = applyLast' @f (getNA :: NumArgs (CountArgs fun) fun)
+
+applyLast' :: forall f n fun . Applicative f => NumArgs n fun -> fun -> Apply f n fun
+applyLast' NAZ x     = pure x
+applyLast' (NAS n) f = applyLast' @f n . f
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,3 +1,4 @@
+{-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE PartialTypeSignatures #-}
 {-# LANGUAGE TemplateHaskell       #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
@@ -7,6 +8,7 @@
 -}
 module Test.Data.Registry.GenSpec where
 
+import           Data.List             (partition)
 import           Data.Registry
 import           Hedgehog.Gen          as Gen
 import           Hedgehog.Range        as Range
@@ -37,6 +39,9 @@
   | Variable Int Double
   deriving (Eq, Show)
 
+isFixed (Fixed _) = True
+isFixed _ = False
+
 -- * GENERATORS
 
 genText :: Gen Text
@@ -90,6 +95,28 @@
   let allEmployees = company & departments >>= (& employees)
   length allEmployees === 1
 
+
+-- * WITH VARIANTS
+
+registry' =
+     fun (sequence . replicate @(Gen Salary) 10)
+  +: fun salaryGen
+  +: funTo @Gen (tag @"Fixed" Fixed)
+  +: funTo @Gen (tag @"Variable" Variable)
+  +: registry
+
+salaryGen :: Gen (Tag "Fixed" Salary) -> Gen (Tag "Variable" Salary) -> Gen Salary
+salaryGen fixed variable = choice [unTag <$> fixed, unTag <$> variable]
+
+test_with_different_salaries = noShrink $ prop "generate both fixed and variable salaries" $ runWith registry' $ do
+  salaries <- forall @[Salary]
+  let (fixed, variables) = partition isFixed salaries
+
+  annotate "the choice operator allows us to generate both fixed and variable salaries"
+  not (null fixed)     === True
+  not (null variables) === True
+
+
 -- * HELPERS
 
 type RegistryProperty m a = forall ins out . StateT (Registry ins out) (PropertyT m) a
@@ -101,6 +128,9 @@
 tweakGen f = modify $ tweakUnsafe @(Gen a) f
 
 run :: Monad m => RegistryProperty m a -> PropertyT m a
-run = flip evalStateT registry
+run = runWith registry
+
+runWith :: Monad m => Registry ins out -> RegistryProperty m a -> PropertyT m a
+runWith = flip evalStateT
 ----
 tests = $(testGroupGenerator)