diff --git a/semiring-num.cabal b/semiring-num.cabal
--- a/semiring-num.cabal
+++ b/semiring-num.cabal
@@ -1,5 +1,5 @@
 name:                semiring-num
-version:             1.6.0.1
+version:             1.6.0.3
 synopsis:            Basic semiring class and instances
 description:         Adds a basic semiring class
 homepage:            https://github.com/oisdk/semiring-num
@@ -45,12 +45,14 @@
                      , Fraction
                      , Vectors
                      , LimitSize
+                     , TypeLevel
+                     , Properties
   build-depends:       base >=4.9 && <5
                      , semiring-num
-                     , smallcheck >=0.2.1
+                     , smallcheck >=1.1.3
                      , doctest >=0.3.0
                      , containers >=0.5
-                     , QuickCheck >=1.0
+                     , QuickCheck >=2.10
                      , nat-sized-numbers >=0.1.0.0
                      , tasty >=0.1
                      , tasty-smallcheck >=0.1
diff --git a/src/Data/Semiring.hs b/src/Data/Semiring.hs
--- a/src/Data/Semiring.hs
+++ b/src/Data/Semiring.hs
@@ -218,7 +218,6 @@
 -- 'Control.Applicative.Alternative'.
 class Semiring a =>
       StarSemiring a  where
-    {-# MINIMAL star | plus #-}
     star :: a -> a
     plus :: a -> a
     star x = one <+> plus x
@@ -415,35 +414,11 @@
     {-# INLINE one #-}
     {-# INLINE zero #-}
     {-# SPECIALISE (<.>) :: BinaryWrapped [] Int #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped [] Int8 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped [] Int16 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped [] Int32 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped [] Int64 #-}
     {-# SPECIALISE (<.>) :: BinaryWrapped [] Word #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped [] Word8 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped [] Word16 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped [] Word32 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped [] Word64 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped [] Integer #-}
     {-# SPECIALISE (<.>) :: BinaryWrapped [] Double #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped [] Float #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped [] Natural #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped [] Bool #-}
     {-# SPECIALISE (<+>) :: BinaryWrapped [] Int #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped [] Int8 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped [] Int16 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped [] Int32 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped [] Int64 #-}
     {-# SPECIALISE (<+>) :: BinaryWrapped [] Word #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped [] Word8 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped [] Word16 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped [] Word32 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped [] Word64 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped [] Integer #-}
     {-# SPECIALISE (<+>) :: BinaryWrapped [] Double #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped [] Float #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped [] Natural #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped [] Bool #-}
 
 
 listAdd :: Semiring a => [a] -> [a] -> [a]
@@ -452,20 +427,8 @@
 listAdd (x:xs) (y:ys) = (x <+> y) : listAdd xs ys
 {-# NOINLINE [0] listAdd #-}
 {-# SPECIALISE listAdd :: BinaryWrapped [] Int #-}
-{-# SPECIALISE listAdd :: BinaryWrapped [] Int8 #-}
-{-# SPECIALISE listAdd :: BinaryWrapped [] Int16 #-}
-{-# SPECIALISE listAdd :: BinaryWrapped [] Int32 #-}
-{-# SPECIALISE listAdd :: BinaryWrapped [] Int64 #-}
 {-# SPECIALISE listAdd :: BinaryWrapped [] Word #-}
-{-# SPECIALISE listAdd :: BinaryWrapped [] Word8 #-}
-{-# SPECIALISE listAdd :: BinaryWrapped [] Word16 #-}
-{-# SPECIALISE listAdd :: BinaryWrapped [] Word32 #-}
-{-# SPECIALISE listAdd :: BinaryWrapped [] Word64 #-}
-{-# SPECIALISE listAdd :: BinaryWrapped [] Integer #-}
 {-# SPECIALISE listAdd :: BinaryWrapped [] Double #-}
-{-# SPECIALISE listAdd :: BinaryWrapped [] Float #-}
-{-# SPECIALISE listAdd :: BinaryWrapped [] Natural #-}
-{-# SPECIALISE listAdd :: BinaryWrapped [] Bool #-}
 
 -- a definition of addition which can be fused on its left argument
 listAddFBL :: Semiring a => ListBuilder a -> [a] -> [a]
@@ -475,20 +438,8 @@
 
 type FBL a = ListBuilder a -> [a] -> [a]
 {-# SPECIALISE listAddFBL :: FBL Int #-}
-{-# SPECIALISE listAddFBL :: FBL Int8 #-}
-{-# SPECIALISE listAddFBL :: FBL Int16 #-}
-{-# SPECIALISE listAddFBL :: FBL Int32 #-}
-{-# SPECIALISE listAddFBL :: FBL Int64 #-}
 {-# SPECIALISE listAddFBL :: FBL Word #-}
-{-# SPECIALISE listAddFBL :: FBL Word8 #-}
-{-# SPECIALISE listAddFBL :: FBL Word16 #-}
-{-# SPECIALISE listAddFBL :: FBL Word32 #-}
-{-# SPECIALISE listAddFBL :: FBL Word64 #-}
-{-# SPECIALISE listAddFBL :: FBL Integer #-}
 {-# SPECIALISE listAddFBL :: FBL Double #-}
-{-# SPECIALISE listAddFBL :: FBL Float #-}
-{-# SPECIALISE listAddFBL :: FBL Natural #-}
-{-# SPECIALISE listAddFBL :: FBL Bool #-}
 
 -- a definition of addition which can be fused on its right argument
 listAddFBR :: Semiring a => [a] -> ListBuilder a -> [a]
@@ -498,20 +449,8 @@
 
 type FBR a = [a] -> ListBuilder a -> [a]
 {-# SPECIALISE listAddFBR :: FBR Int #-}
-{-# SPECIALISE listAddFBR :: FBR Int8 #-}
-{-# SPECIALISE listAddFBR :: FBR Int16 #-}
-{-# SPECIALISE listAddFBR :: FBR Int32 #-}
-{-# SPECIALISE listAddFBR :: FBR Int64 #-}
 {-# SPECIALISE listAddFBR :: FBR Word #-}
-{-# SPECIALISE listAddFBR :: FBR Word8 #-}
-{-# SPECIALISE listAddFBR :: FBR Word16 #-}
-{-# SPECIALISE listAddFBR :: FBR Word32 #-}
-{-# SPECIALISE listAddFBR :: FBR Word64 #-}
-{-# SPECIALISE listAddFBR :: FBR Integer #-}
 {-# SPECIALISE listAddFBR :: FBR Double #-}
-{-# SPECIALISE listAddFBR :: FBR Float #-}
-{-# SPECIALISE listAddFBR :: FBR Natural #-}
-{-# SPECIALISE listAddFBR :: FBR Bool #-}
 
 type ListBuilder a = forall b. (a -> b -> b) -> b -> b
 
@@ -527,13 +466,7 @@
       xst = star x
     {-# SPECIALISE star :: [Bool] -> [Bool] #-}
     {-# SPECIALISE star :: [Min Double]  -> [Min Double] #-}
-    {-# SPECIALISE star :: [Min Float]   -> [Min Float] #-}
-    {-# SPECIALISE star :: [Min CDouble] -> [Min CDouble] #-}
-    {-# SPECIALISE star :: [Min CFloat]  -> [Min CFloat] #-}
     {-# SPECIALISE star :: [Max Double]  -> [Max Double] #-}
-    {-# SPECIALISE star :: [Max Float]   -> [Max Float] #-}
-    {-# SPECIALISE star :: [Max CDouble] -> [Max CDouble] #-}
-    {-# SPECIALISE star :: [Max CFloat]  -> [Max CFloat] #-}
 
 instance DetectableZero a =>
          DetectableZero [a] where
@@ -568,31 +501,11 @@
         !slen = Vector.length signal
         !klen = Vector.length kernel
     {-# SPECIALISE (<.>) :: BinaryWrapped Vector.Vector Double #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped Vector.Vector Float #-}
     {-# SPECIALISE (<.>) :: BinaryWrapped Vector.Vector Int #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped Vector.Vector Bool #-}
     {-# SPECIALISE (<.>) :: BinaryWrapped Vector.Vector Word #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped Vector.Vector Int8 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped Vector.Vector Int16 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped Vector.Vector Int32 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped Vector.Vector Int64 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped Vector.Vector Word8 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped Vector.Vector Word16 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped Vector.Vector Word32 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped Vector.Vector Word64 #-}
     {-# SPECIALISE (<+>) :: BinaryWrapped Vector.Vector Double #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped Vector.Vector Float #-}
     {-# SPECIALISE (<+>) :: BinaryWrapped Vector.Vector Int #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped Vector.Vector Bool #-}
     {-# SPECIALISE (<+>) :: BinaryWrapped Vector.Vector Word #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped Vector.Vector Int8 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped Vector.Vector Int16 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped Vector.Vector Int32 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped Vector.Vector Int64 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped Vector.Vector Word8 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped Vector.Vector Word16 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped Vector.Vector Word32 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped Vector.Vector Word64 #-}
 
 instance DetectableZero a => DetectableZero (Vector.Vector a) where
     isZero = Vector.all isZero
@@ -625,31 +538,11 @@
         slen = UnboxedVector.length signal
         klen = UnboxedVector.length kernel
     {-# SPECIALISE (<.>) :: BinaryWrapped UnboxedVector.Vector Double #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped UnboxedVector.Vector Float #-}
     {-# SPECIALISE (<.>) :: BinaryWrapped UnboxedVector.Vector Int #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped UnboxedVector.Vector Bool #-}
     {-# SPECIALISE (<.>) :: BinaryWrapped UnboxedVector.Vector Word #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped UnboxedVector.Vector Int8 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped UnboxedVector.Vector Int16 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped UnboxedVector.Vector Int32 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped UnboxedVector.Vector Int64 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped UnboxedVector.Vector Word8 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped UnboxedVector.Vector Word16 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped UnboxedVector.Vector Word32 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped UnboxedVector.Vector Word64 #-}
     {-# SPECIALISE (<+>) :: BinaryWrapped UnboxedVector.Vector Double #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped UnboxedVector.Vector Float #-}
     {-# SPECIALISE (<+>) :: BinaryWrapped UnboxedVector.Vector Int #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped UnboxedVector.Vector Bool #-}
     {-# SPECIALISE (<+>) :: BinaryWrapped UnboxedVector.Vector Word #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped UnboxedVector.Vector Int8 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped UnboxedVector.Vector Int16 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped UnboxedVector.Vector Int32 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped UnboxedVector.Vector Int64 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped UnboxedVector.Vector Word8 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped UnboxedVector.Vector Word16 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped UnboxedVector.Vector Word32 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped UnboxedVector.Vector Word64 #-}
 
 instance (UnboxedVector.Unbox a, DetectableZero a) => DetectableZero (UnboxedVector.Vector a) where
     isZero = UnboxedVector.all isZero
@@ -685,31 +578,11 @@
         slen = StorableVector.length signal
         klen = StorableVector.length kernel
     {-# SPECIALISE (<.>) :: BinaryWrapped StorableVector.Vector Double #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped StorableVector.Vector Float #-}
     {-# SPECIALISE (<.>) :: BinaryWrapped StorableVector.Vector Int #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped StorableVector.Vector Bool #-}
     {-# SPECIALISE (<.>) :: BinaryWrapped StorableVector.Vector Word #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped StorableVector.Vector Int8 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped StorableVector.Vector Int16 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped StorableVector.Vector Int32 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped StorableVector.Vector Int64 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped StorableVector.Vector Word8 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped StorableVector.Vector Word16 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped StorableVector.Vector Word32 #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped StorableVector.Vector Word64 #-}
     {-# SPECIALISE (<+>) :: BinaryWrapped StorableVector.Vector Double #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped StorableVector.Vector Float #-}
     {-# SPECIALISE (<+>) :: BinaryWrapped StorableVector.Vector Int #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped StorableVector.Vector Bool #-}
     {-# SPECIALISE (<+>) :: BinaryWrapped StorableVector.Vector Word #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped StorableVector.Vector Int8 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped StorableVector.Vector Int16 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped StorableVector.Vector Int32 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped StorableVector.Vector Int64 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped StorableVector.Vector Word8 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped StorableVector.Vector Word16 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped StorableVector.Vector Word32 #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped StorableVector.Vector Word64 #-}
 
 instance (StorableVector.Storable a, DetectableZero a) =>
          DetectableZero (StorableVector.Vector a) where
@@ -790,9 +663,7 @@
     {-# INLINE add #-}
 
     {-# SPECIALISE (<.>) :: BinaryWrapped Log Double #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped Log Float #-}
     {-# SPECIALISE (<+>) :: BinaryWrapped Log Double #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped Log Float #-}
 
 instance (Precise a, RealFloat a) => DetectableZero (Log a) where
     isZero = isZeroEq
@@ -809,9 +680,7 @@
     {-# INLINE zero #-}
 
     {-# SPECIALISE (<.>) :: BinaryWrapped SignedLog Double #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped SignedLog Float #-}
     {-# SPECIALISE (<+>) :: BinaryWrapped SignedLog Double #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped SignedLog Float #-}
 
 instance (Precise a, RealFloat a) => DetectableZero (SignedLog a) where
     isZero = isZeroEq
@@ -1112,9 +981,6 @@
     {-# INLINE (<>) #-}
     stimes = stimesIdempotent
     {-# SPECIALISE (<>) :: BinaryWrapped Max Double #-}
-    {-# SPECIALISE (<>) :: BinaryWrapped Max Float #-}
-    {-# SPECIALISE (<>) :: BinaryWrapped Max CDouble #-}
-    {-# SPECIALISE (<>) :: BinaryWrapped Max CFloat #-}
 
 instance Ord a =>
          Semigroup (Min a) where
@@ -1122,9 +988,6 @@
     {-# INLINE (<>) #-}
     stimes = stimesIdempotent
     {-# SPECIALISE (<>) :: BinaryWrapped Min Double #-}
-    {-# SPECIALISE (<>) :: BinaryWrapped Min Float #-}
-    {-# SPECIALISE (<>) :: BinaryWrapped Min CDouble #-}
-    {-# SPECIALISE (<>) :: BinaryWrapped Min CFloat #-}
 
 -- | >>> (getMax . foldMap Max) [1..10]
 -- 10.0
@@ -1135,9 +998,6 @@
     {-# INLINE mempty #-}
     {-# INLINE mappend #-}
     {-# SPECIALISE mappend :: BinaryWrapped Max Double #-}
-    {-# SPECIALISE mappend :: BinaryWrapped Max Float #-}
-    {-# SPECIALISE mappend :: BinaryWrapped Max CDouble #-}
-    {-# SPECIALISE mappend :: BinaryWrapped Max CFloat #-}
 
 -- | >>> (getMin . foldMap Min) [1..10]
 -- 1.0
@@ -1148,9 +1008,6 @@
     {-# INLINE mempty #-}
     {-# INLINE mappend #-}
     {-# SPECIALISE mappend :: BinaryWrapped Min Double #-}
-    {-# SPECIALISE mappend :: BinaryWrapped Min Float #-}
-    {-# SPECIALISE mappend :: BinaryWrapped Min CDouble #-}
-    {-# SPECIALISE mappend :: BinaryWrapped Min CFloat #-}
 
 instance (Semiring a, Ord a, HasNegativeInfinity a) =>
          Semiring (Max a) where
@@ -1164,21 +1021,7 @@
     {-# INLINE (<.>) #-}
 
     {-# SPECIALISE (<+>) :: BinaryWrapped Max Double #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped Max Float #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped Max CDouble #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped Max CFloat #-}
     {-# SPECIALISE (<.>) :: BinaryWrapped Max Double #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped Max Float #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped Max CDouble #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped Max CFloat #-}
-    {-# SPECIALISE one   :: Max Double #-}
-    {-# SPECIALISE one   :: Max Float #-}
-    {-# SPECIALISE one   :: Max CDouble #-}
-    {-# SPECIALISE one   :: Max CFloat #-}
-    {-# SPECIALISE zero  :: Max Double #-}
-    {-# SPECIALISE zero  :: Max Float #-}
-    {-# SPECIALISE zero  :: Max CDouble #-}
-    {-# SPECIALISE zero  :: Max CFloat #-}
 
 instance (Semiring a, Ord a, HasPositiveInfinity a) =>
          Semiring (Min a) where
@@ -1191,21 +1034,7 @@
     {-# INLINE (<+>) #-}
     {-# INLINE (<.>) #-}
     {-# SPECIALISE (<+>) :: BinaryWrapped Min Double #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped Min Float #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped Min CDouble #-}
-    {-# SPECIALISE (<+>) :: BinaryWrapped Min CFloat #-}
     {-# SPECIALISE (<.>) :: BinaryWrapped Min Double #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped Min Float #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped Min CDouble #-}
-    {-# SPECIALISE (<.>) :: BinaryWrapped Min CFloat #-}
-    {-# SPECIALISE one   :: Min Double #-}
-    {-# SPECIALISE one   :: Min Float #-}
-    {-# SPECIALISE one   :: Min CDouble #-}
-    {-# SPECIALISE one   :: Min CFloat #-}
-    {-# SPECIALISE zero  :: Min Double #-}
-    {-# SPECIALISE zero  :: Min Float #-}
-    {-# SPECIALISE zero  :: Min CDouble #-}
-    {-# SPECIALISE zero  :: Min CFloat #-}
 
 instance (Semiring a, Ord a, HasPositiveInfinity a, HasNegativeInfinity a) =>
          StarSemiring (Max a) where
@@ -1213,9 +1042,6 @@
       | x > zero = Max positiveInfinity
       | otherwise = Max zero
     {-# SPECIALISE star :: Max Double  -> Max Double  #-}
-    {-# SPECIALISE star :: Max Float   -> Max Float   #-}
-    {-# SPECIALISE star :: Max CDouble -> Max CDouble #-}
-    {-# SPECIALISE star :: Max CFloat  -> Max CFloat  #-}
 
 instance (Semiring a, Ord a, HasPositiveInfinity a, HasNegativeInfinity a) =>
          StarSemiring (Min a) where
@@ -1223,9 +1049,6 @@
       | x < zero = Min negativeInfinity
       | otherwise = Min zero
     {-# SPECIALISE star :: Min Double  -> Min Double  #-}
-    {-# SPECIALISE star :: Min Float   -> Min Float   #-}
-    {-# SPECIALISE star :: Min CDouble -> Min CDouble #-}
-    {-# SPECIALISE star :: Min CFloat  -> Min CFloat  #-}
 
 instance (Semiring a, Ord a, HasPositiveInfinity a) =>
          DetectableZero (Min a) where
diff --git a/src/Data/Semiring/Infinite.hs b/src/Data/Semiring/Infinite.hs
--- a/src/Data/Semiring/Infinite.hs
+++ b/src/Data/Semiring/Infinite.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP                   #-}
 {-# LANGUAGE DeriveFoldable        #-}
 {-# LANGUAGE DeriveFunctor         #-}
 {-# LANGUAGE DeriveGeneric         #-}
@@ -28,7 +29,7 @@
                                               sizeOf)
 
 import           Data.Coerce
-import           Data.Monoid
+import           Data.Semigroup as Sem
 import           Data.Bool
 
 import           Data.Semiring
@@ -262,28 +263,49 @@
   enumFrom Negative   = Negative : map pure [minBound..] ++ [Positive]
   enumFrom (Finite x) = map pure (enumFrom x) ++ [Positive]
 
-instance Monoid a => Monoid (NegativeInfinite a) where
+-- Follows advice for compatible Semigroup/Monoid code from
+-- https://prime.haskell.org/wiki/Libraries/Proposals/SemigroupMonoid#Writingcompatiblecode
+
+instance Sem.Semigroup a => Sem.Semigroup (NegativeInfinite a) where
+  {-# INLINE (<>) #-}
+  (<>) = liftA2 (<>)
+
+instance (Sem.Semigroup a, Monoid a) => Monoid (NegativeInfinite a) where
   {-# INLINE mempty #-}
-  {-# INLINE mappend #-}
   mempty = pure mempty
-  mappend = liftA2 mappend
+#if !(MIN_VERSION_base(4,11,0))
+  {-# INLINE mappend #-}
+  mappend = (<>)
+#endif
 
-instance Monoid a => Monoid (PositiveInfinite a) where
+instance Sem.Semigroup a => Sem.Semigroup (PositiveInfinite a) where
+  {-# INLINE (<>) #-}
+  (<>) = liftA2 (<>)
+
+instance (Sem.Semigroup a, Monoid a) => Monoid (PositiveInfinite a) where
   {-# INLINE mempty #-}
-  {-# INLINE mappend #-}
   mempty = pure mempty
-  mappend = liftA2 mappend
+#if !(MIN_VERSION_base(4,11,0))
+  {-# INLINE mappend #-}
+  mappend = (<>)
+#endif
 
-instance Monoid a => Monoid (Infinite a) where
+instance Sem.Semigroup a => Sem.Semigroup (Infinite a) where
+  {-# INLINE (<>) #-}
+  Negative <> Positive = Positive
+  Positive <> Negative = Positive
+  Finite x <> Finite y = pure (x <> y)
+  Negative <> _ = Negative
+  Positive <> _ = Positive
+  _ <> y = y
+
+instance (Sem.Semigroup a, Monoid a) => Monoid (Infinite a) where
   {-# INLINE mempty #-}
-  {-# INLINE mappend #-}
   mempty = pure mempty
-  Negative `mappend` Positive = Positive
-  Positive `mappend` Negative = Positive
-  Finite x `mappend` Finite y = pure (x `mappend` y)
-  Negative `mappend` _ = Negative
-  Positive `mappend` _ = Positive
-  _ `mappend` y = y
+#if !(MIN_VERSION_base(4,11,0))
+  {-# INLINE mappend #-}
+  mappend = (<>)
+#endif
 
 instance Num a => Num (NegativeInfinite a) where
   fromInteger = pure . fromInteger
diff --git a/test/CompUtils.hs b/test/CompUtils.hs
--- a/test/CompUtils.hs
+++ b/test/CompUtils.hs
@@ -16,3 +16,8 @@
 infixl 4 <#$>
 (<#$>) :: Coercible (f a) (f b) => (a -> b) -> f a -> f b
 (<#$>) _ = coerce
+
+infixr 9 |.|
+(|.|) :: (b -> c) -> (a -> b) -> a -> c
+(|.|) f g x = f (g x)
+{-# NOINLINE (|.|) #-}
diff --git a/test/Orphans.hs b/test/Orphans.hs
--- a/test/Orphans.hs
+++ b/test/Orphans.hs
@@ -6,7 +6,8 @@
 
 module Orphans where
 
-import           Test.QuickCheck hiding (Positive(..), generate)
+import           Test.QuickCheck as QC hiding (Positive(..), generate)
+import           Test.QuickCheck.Poly
 import           Test.SmallCheck.Series hiding (Positive(..))
 import qualified Test.SmallCheck.Series as SC
 
@@ -96,9 +97,6 @@
 instance (Monad m, Serial m a) => Serial m (Infinite a) where
   series = fmap (either (bool Positive Negative) Finite) series
 
-instance Monad m => Serial m Natural where
-  series = generate (`take` [0..])
-
 instance Monad m => Serial m Any where
   series = fmap Any series
 
@@ -111,6 +109,10 @@
 instance (Monad m, Serial m a) => Serial m (Max a) where
   series = fmap Max series
 
+instance Arbitrary Natural where
+  arbitrary = fmap (fromInteger . QC.getNonNegative) arbitrary
+  shrink = fmap (fromInteger . QC.getNonNegative) . shrink . QC.NonNegative . toInteger
+
 instance (Ord a, Arbitrary a) => Arbitrary (Free a) where
   arbitrary = fmap Free arbitrary
 
@@ -135,3 +137,10 @@
          Arbitrary (Storable.Vector a) where
     arbitrary = fmap Storable.fromList arbitrary
     shrink = map Storable.fromList . shrink . Storable.toList
+
+deriving instance Ord A
+
+instance Read A where
+    readsPrec p xs =
+        [ (A x, rs)
+        | (x,rs) <- readsPrec p xs ]
diff --git a/test/Properties.hs b/test/Properties.hs
new file mode 100644
--- /dev/null
+++ b/test/Properties.hs
@@ -0,0 +1,427 @@
+{-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TypeOperators        #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ConstraintKinds      #-}
+{-# LANGUAGE RankNTypes           #-}
+
+module Properties where
+
+import           Data.Semiring
+import           Test.Semiring
+
+import           Test.QuickCheck          hiding (Positive (..), generate,
+                                           (.&.))
+import           Test.SmallCheck.Series hiding (Positive)
+import           Test.Tasty
+import qualified Test.Tasty.QuickCheck  as QC
+import qualified Test.Tasty.SmallCheck  as SC
+import           Test.QuickCheck.Poly
+
+import qualified Data.Vector.Storable     as Storable
+import           Data.Proxy
+import           Data.Typeable
+import           Data.Functor.Classes
+import           GHC.Exts (IsList(..))
+
+import           TypeLevel
+import           Orphans ()
+import           CompUtils
+
+--------------------------------------------------------------------------------
+-- Property lists, generic to the test framework
+--------------------------------------------------------------------------------
+
+semiringLawsCL
+    :: (Show r
+       ,Eq r
+       ,Semiring r
+       ,testable (r -> Either String String)
+       ,testable (r -> r -> Either String String)
+       ,testable (r -> r -> r -> Either String String))
+    => Proxy testable
+    -> (forall f. testable f =>
+                  String -> f -> TestTree)
+    -> Proxy r
+    -> [TestTree]
+semiringLawsCL _ f (_ :: Proxy r) =
+  [ f "plusId" (plusId :: r -> Either String String)
+  , f "mulId" (mulId  :: r -> Either String String)
+  , f "annihilateL" (annihilateL  :: r -> Either String String)
+  , f "annihilateR" (annihilateR  :: r -> Either String String)
+  , f "plusComm" (plusComm  :: r -> r -> Either String String)
+  , f "plusAssoc" (plusAssoc  :: r -> r -> r -> Either String String)
+  , f "mulAssoc" (mulAssoc  :: r -> r -> r -> Either String String)
+  , f "mulDistribL" (mulDistribL  :: r -> r -> r -> Either String String)
+  , f "mulDistribR" (mulDistribR  :: r -> r -> r -> Either String String)]
+
+starLawsCL
+    :: (Show r, Eq r, StarSemiring r, testable (r -> Either String String))
+    => Proxy testable
+    -> (forall f. testable f =>
+                  String -> f -> TestTree)
+    -> Proxy r
+    -> [TestTree]
+starLawsCL _ f (_ :: Proxy r) =
+  [ f "starLaw" (starLaw :: r -> Either String String)
+  , f "plusLaw" (plusLaw :: r -> Either String String)]
+
+ordLawsCL
+    :: (Show r, Ord r, Semiring r, testable (r -> r -> r -> Either String String))
+    => Proxy testable
+    -> (forall f. testable f =>
+                  String -> f -> TestTree)
+    -> Proxy r
+    -> [TestTree]
+ordLawsCL _ f (_ :: Proxy r) =
+  [ f "mulLaw" (ordMulLaw :: r -> r -> r -> Either String String)
+  , f "addLaw" (ordAddLaw :: r -> r -> r -> Either String String)]
+
+--------------------------------------------------------------------------------
+-- Property lists: SmallCheck
+--------------------------------------------------------------------------------
+
+semiringLawsSCL :: (Show r, Eq r, Semiring r, Serial IO r) => f r -> [TestTree]
+semiringLawsSCL (_ :: f r) =
+    semiringLawsCL
+        (Proxy :: Proxy (SC.Testable IO))
+        SC.testProperty
+        (Proxy :: Proxy r)
+
+starLawsSCL
+    :: (Show r, Eq r, StarSemiring r, Serial IO r)
+    => f r -> [TestTree]
+starLawsSCL (_ :: f r) =
+    starLawsCL
+        (Proxy :: Proxy (SC.Testable IO))
+        SC.testProperty
+        (Proxy :: Proxy r)
+
+zeroLawsSCL
+    :: (Show r, Eq r, DetectableZero r, Serial IO r)
+    => f r -> [TestTree]
+zeroLawsSCL (_ :: f r) =
+    [ SC.testProperty "zeroLaw" (zeroLaw :: r -> Either String String)
+    , SC.testProperty "zeroIsZero" (zeroIsZero (Proxy :: Proxy r))]
+
+ordLawsSCL
+    :: (Show r, Ord r, Semiring r, Serial IO r)
+    => f r -> [TestTree]
+ordLawsSCL (_ :: f r) =
+    ordLawsCL
+        (Proxy :: Proxy (SC.Testable IO))
+        SC.testProperty
+        (Proxy :: Proxy r)
+
+--------------------------------------------------------------------------------
+-- Property lists: QuickCheck
+--------------------------------------------------------------------------------
+
+semiringLawsQCL :: (Show r, Eq r, Semiring r, Arbitrary r) => f r -> [TestTree]
+semiringLawsQCL (_ :: f r) =
+    semiringLawsCL
+        (Proxy :: Proxy QC.Testable)
+        QC.testProperty
+        (Proxy :: Proxy r)
+
+starLawsQCL
+    :: (Show r, Eq r, StarSemiring r, Arbitrary r)
+    => f r -> [TestTree]
+starLawsQCL (_ :: f r) =
+    starLawsCL (Proxy :: Proxy QC.Testable) QC.testProperty (Proxy :: Proxy r)
+
+zeroLawsQCL
+    :: (Show r, Eq r, DetectableZero r, Arbitrary r)
+    => f r -> [TestTree]
+zeroLawsQCL (_ :: f r) =
+    [ QC.testProperty "zeroLaw" (zeroLaw :: r -> Either String String)
+    , QC.testProperty "zeroIsZero" (once $ zeroIsZero (Proxy :: Proxy r))]
+
+ordLawsQCL
+    :: (Show r, Ord r, Semiring r, Arbitrary r)
+    => f r -> [TestTree]
+ordLawsQCL (_ :: f r) =
+    ordLawsCL
+        (Proxy :: Proxy QC.Testable)
+        QC.testProperty
+        (Proxy :: Proxy r)
+
+storableQCL
+    :: (Show r, Eq r, Arbitrary r, Storable.Storable r)
+    => f r -> [TestTree]
+storableQCL (_ :: f r) =
+        [ QC.testProperty
+              "unstore . store == id"
+              (\(xs :: [r]) ->
+                    (Storable.toList |.| Storable.fromList) xs === xs)]
+
+liftedQCL
+    :: (Show1 r
+       ,Eq1 r
+       ,Ord1 r
+       ,Read1 r
+       ,Arbitrary (r A)
+       ,Show (r A)
+       ,Eq (r A)
+       ,Ord (r A)
+       ,Read A)
+    => f r -> [TestTree]
+liftedQCL (_ :: f r) =
+    [ testGroup
+          "Eq1"
+          [ QC.testProperty
+                "x == x"
+                (\(x :: r A) ->
+                      eq1 x x)
+          , QC.testProperty
+                "same as =="
+                (\(x :: r A) (y :: r A) ->
+                      counterexample (show (x, y)) ((x == y) == eq1 x y))]
+    , testGroup
+          "Ord1"
+          [ QC.testProperty
+                "cmp x x == EQ"
+                (\(x :: r A) ->
+                      counterexample (show x) (compare1 x x === EQ))
+          , QC.testProperty
+                "compare1 == compare"
+                (\(x :: r A) (y :: r A) ->
+                      counterexample
+                          (show (x, y))
+                          (compare x y == compare1 x y))]
+    , testGroup
+          "Show1"
+          [ QC.testProperty
+                "show1 == show"
+                (\(x :: r A) ->
+                      liftShowsPrec showsPrec showList 0 x "" === show x)]
+    , testGroup
+          "Read1"
+          [ QC.testProperty
+                "read1 . show == id"
+                (\(x :: r A) ->
+                      (liftReadsPrec readsPrec readList 0 . show) x ===
+                      [(x, "")])]]
+
+--------------------------------------------------------------------------------
+-- Single-type tests: SmallCheck
+--------------------------------------------------------------------------------
+
+ordLawsSC :: (Show r, Ord r, Semiring r, Serial IO r) => f r -> TestTree
+ordLawsSC (p :: f r) = testGroup "Ordering laws" (ordLawsSCL p)
+
+zeroLawsSC :: (Show r, Eq r, DetectableZero r, Serial IO r) => f r -> TestTree
+zeroLawsSC (p :: f r) = testGroup "Zero laws" (zeroLawsSCL p)
+
+--------------------------------------------------------------------------------
+-- Single-type tests: QuickCheck
+--------------------------------------------------------------------------------
+
+semiringLawsQC
+    :: (Show r, Eq r, Semiring r, Arbitrary r)
+    => f r -> TestTree
+semiringLawsQC (p :: f r) = testGroup "Semiring Laws" (semiringLawsQCL p)
+
+zeroLawsQC :: (Show r, Eq r, DetectableZero r, Arbitrary r) => f r -> TestTree
+zeroLawsQC (p :: f r) = testGroup "Zero laws" (zeroLawsQCL p)
+
+refListMulQC
+    :: (Semiring (Item t), Semiring t, Eq (Item t), Show (Item t), IsList t)
+    => Proxy t -> [Item t] -> [Item t] -> Property
+refListMulQC (_ :: Proxy t) xs ys =
+    refListMul xs ys ===
+    (toList :: t -> [Item t]) (fromList xs <.> fromList ys)
+  where
+    refListMul [] _ = []
+    refListMul _ [] = []
+    refListMul (x:xs') yys@(y:ys') = (x <.> y) : map (x <.>) ys' <+> xs' <.> yys
+
+--------------------------------------------------------------------------------
+-- Multi-type tests: SmallCheck
+--------------------------------------------------------------------------------
+
+semiringLawsSCT
+    :: (Reifiable xs
+       ,AllAre (Diffable & Semiring & Serial IO) xs)
+    => Proxy xs -> TestTree
+semiringLawsSCT p =
+    testGroup
+        "Semiring Laws"
+        (reify
+             (Proxy :: Proxy (Diffable & Semiring & Serial IO))
+             p
+             (nameType semiringLawsSCL))
+
+starLawsSCT
+    :: (Reifiable xs
+       ,AllAre (Diffable & StarSemiring & Serial IO) xs)
+    => Proxy xs -> TestTree
+starLawsSCT p =
+    testGroup
+        "Star Laws"
+        (reify
+             (Proxy :: Proxy (Diffable & StarSemiring & Serial IO))
+             p
+             (nameType starLawsSCL))
+
+ordLawsSCT
+    :: (Reifiable xs
+       ,AllAre (Diffable & Serial IO & Semiring & Ord) xs)
+    => Proxy xs -> TestTree
+ordLawsSCT p =
+    testGroup
+        "Ordering laws"
+        (reify
+             (Proxy :: Proxy (Diffable & Serial IO & Semiring & Ord))
+             p
+             (nameType ordLawsSCL))
+
+zeroLawsSCT
+    :: (Reifiable xs
+       ,AllAre (Diffable & Serial IO & DetectableZero) xs)
+    => Proxy xs -> TestTree
+zeroLawsSCT p =
+    testGroup
+        "Zero laws"
+        (reify
+             (Proxy :: Proxy (Diffable & Serial IO & DetectableZero))
+             p
+             (nameType zeroLawsSCL))
+
+--------------------------------------------------------------------------------
+-- Multi-type tests: QuickCheck
+--------------------------------------------------------------------------------
+
+starLawsQCT
+    :: (Reifiable xs
+       ,AllAre (Diffable & StarSemiring & Arbitrary) xs)
+    => Proxy xs -> TestTree
+starLawsQCT p =
+    testGroup
+        "Star Laws"
+        (reify
+             (Proxy :: Proxy (Diffable & StarSemiring & Arbitrary))
+             p
+             (nameType starLawsQCL))
+
+semiringLawsQCT
+    :: (Reifiable xs
+       ,AllAre (Show & Eq & Semiring & Arbitrary & Typeable) xs)
+    => Proxy xs -> TestTree
+semiringLawsQCT p =
+    testGroup
+        "Semiring Laws"
+        (reify
+             (Proxy :: Proxy (Show & Eq & Semiring & Arbitrary & Typeable))
+             p
+             (nameType semiringLawsQCL))
+
+ordLawsQCT
+    :: (Reifiable xs
+       ,AllAre (Diffable & Arbitrary & Semiring & Ord) xs)
+    => Proxy xs -> TestTree
+ordLawsQCT p =
+    testGroup
+        "Ordering laws"
+        (reify
+             (Proxy :: Proxy (Diffable & Arbitrary & Semiring & Ord))
+             p
+             (nameType ordLawsQCL))
+
+zeroLawsQCT
+    :: (Reifiable xs
+       ,AllAre (Diffable & Arbitrary & DetectableZero) xs)
+    => Proxy xs -> TestTree
+zeroLawsQCT p =
+    testGroup
+        "Zero laws"
+        (reify
+             (Proxy :: Proxy (Diffable & Arbitrary & DetectableZero))
+             p
+             (nameType zeroLawsQCL))
+
+storableQCT
+    :: (Reifiable xs
+       ,AllAre (Diffable & Arbitrary & Storable.Storable) xs)
+    => Proxy xs -> TestTree
+storableQCT p =
+    testGroup
+        "Storable implementation"
+        (reify
+             (Proxy :: Proxy (Diffable & Arbitrary & Storable.Storable))
+             p
+             (nameType storableQCL))
+
+class (IsList t
+      ,Semiring (Item t)
+      ,Arbitrary (Item t)
+      ,Show (Item t)
+      ,Eq (Item t)
+      ,Typeable t
+      ,Semiring t) =>
+      ListPoly t
+instance (IsList t
+         ,Semiring (Item t)
+         ,Arbitrary (Item t)
+         ,Show (Item t)
+         ,Eq (Item t)
+         ,Typeable t
+         ,Semiring t) =>
+         ListPoly t
+
+refListMulQCT
+    :: (Reifiable xs, AllAre ListPoly xs)
+    => Proxy xs -> TestTree
+refListMulQCT p =
+    testGroup
+        "Reference convolution"
+        (reify
+             (Proxy :: Proxy ListPoly)
+             p
+             (\(t :: Proxy l) ->
+                   QC.testProperty (show (typeRep t)) (refListMulQC t)))
+
+class (Show1 r
+      ,Eq1 r
+      ,Ord1 r
+      ,Read1 r
+      ,Arbitrary (r A)
+      ,Show (r A)
+      ,Eq (r A)
+      ,Ord (r A)
+      ,Typeable (r A)) =>
+      Lifted r
+instance (Show1 r
+         ,Eq1 r
+         ,Ord1 r
+         ,Read1 r
+         ,Arbitrary (r A)
+         ,Show (r A)
+         ,Eq (r A)
+         ,Ord (r A)
+         ,Typeable (r A)) =>
+         Lifted r
+
+liftedQCT
+    :: (Reifiable xs, AllAre Lifted xs)
+    => Proxy xs -> TestTree
+liftedQCT p =
+    testGroup
+        "Lifted Classes"
+        (reify
+             (Proxy :: Proxy Lifted)
+             p
+             (\(t :: Proxy f) ->
+                   testGroup
+                       (show (typeRep (Proxy :: Proxy (f A))))
+                       (liftedQCL t)))
+
+--------------------------------------------------------------------------------
+-- Utils
+--------------------------------------------------------------------------------
+
+nameType :: Typeable a => (Proxy a -> [TestTree]) -> Proxy a -> TestTree
+nameType f p = testGroup (show (typeRep p)) (f p)
+
+type Diffable = Show & Eq & Typeable
diff --git a/test/Spec.hs b/test/Spec.hs
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -6,12 +6,11 @@
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeOperators         #-}
 {-# LANGUAGE UndecidableInstances  #-}
-{-# OPTIONS_GHC -fno-warn-orphans       #-}
 
 module Main (main) where
 
 import           Data.Proxy
-
+import           Data.Typeable
 import           Data.Monoid
 
 import           Data.Map.Strict          (Map)
@@ -21,20 +20,13 @@
 import qualified Data.Vector.Unboxed      as Unboxed
 
 import           Data.Semiring
-import           Data.Semiring.Free
 import           Data.Semiring.Infinite
 import           Data.Semiring.Numeric
 
-import           Data.Functor.Classes
-
 import           Numeric.Natural
 import           Numeric.Sized.WordOfSize
 
 import           Test.DocTest
-import           Test.QuickCheck          hiding (Positive (..), generate,
-                                           (.&.))
-import           Test.QuickCheck.Poly
-import           Test.SmallCheck.Series   hiding (Positive)
 import           Test.Tasty
 import qualified Test.Tasty.QuickCheck    as QC
 import qualified Test.Tasty.SmallCheck    as SC
@@ -47,133 +39,7 @@
 import           LimitSize
 import           Orphans                  ()
 import           Vectors
-
-------------------------------------------------------------------------
-
-semiringLawsSC :: (Show r, Eq r, Semiring r, Serial IO r) => f r -> TestTree
-semiringLawsSC (_ :: f r) = testGroup "Semiring Laws"
-  [ SC.testProperty "plusId" (plusId :: r -> Either String String)
-  , SC.testProperty "mulId" (mulId  :: r -> Either String String)
-  , SC.testProperty "annihilateL" (annihilateL  :: r -> Either String String)
-  , SC.testProperty "annihilateR" (annihilateR  :: r -> Either String String)
-  , SC.testProperty "plusComm" (plusComm  :: r -> r -> Either String String)
-  , SC.testProperty "plusAssoc" (plusAssoc  :: r -> r -> r -> Either String String)
-  , SC.testProperty "mulAssoc" (mulAssoc  :: r -> r -> r -> Either String String)
-  , SC.testProperty "mulDistribL" (mulDistribL  :: r -> r -> r -> Either String String)
-  , SC.testProperty "mulDistribR" (mulDistribR  :: r -> r -> r -> Either String String)]
-
-semiringLawsQC :: (Show r, Eq r, Semiring r, Arbitrary r) => f r -> TestTree
-semiringLawsQC (_ :: f r) = testGroup "Semiring Laws"
-  [ QC.testProperty "plusId" (plusId :: r -> Either String String)
-  , QC.testProperty "mulId" (mulId  :: r -> Either String String)
-  , QC.testProperty "annihilateL" (annihilateL  :: r -> Either String String)
-  , QC.testProperty "annihilateR" (annihilateR  :: r -> Either String String)
-  , QC.testProperty "plusComm" (plusComm  :: r -> r -> Either String String)
-  , QC.testProperty "plusAssoc" (plusAssoc  :: r -> r -> r -> Either String String)
-  , QC.testProperty "mulAssoc" (mulAssoc  :: r -> r -> r -> Either String String)
-  , QC.testProperty "mulDistribL" (mulDistribL  :: r -> r -> r -> Either String String)
-  , QC.testProperty "mulDistribR" (mulDistribR  :: r -> r -> r -> Either String String)]
-
-starLawsQC :: (Show r, Eq r, StarSemiring r, Arbitrary r) => f r -> TestTree
-starLawsQC (_ :: f r) = testGroup "Star laws"
-  [ QC.testProperty "starLaw" (starLaw :: r -> Either String String)
-  , QC.testProperty "plusLaw" (plusLaw :: r -> Either String String)]
-
-starLawsSC :: (Show r, Eq r, StarSemiring r, Serial IO r) => f r -> TestTree
-starLawsSC (_ :: f r) = testGroup "Star laws"
-  [ SC.testProperty "starLaw" (starLaw :: r -> Either String String)
-  , SC.testProperty "plusLaw" (plusLaw :: r -> Either String String)]
-
-ordLawsQC :: (Show r, Ord r, Semiring r, Arbitrary r) => f r -> TestTree
-ordLawsQC (_ :: f r) = testGroup "Ordering laws"
-  [ QC.testProperty "mulLaw" (ordMulLaw :: r -> r -> r -> Either String String)
-  , QC.testProperty "addLaw" (ordAddLaw :: r -> r -> r -> Either String String)]
-
-zeroLawsQC :: (Show r, Eq r, DetectableZero r, Arbitrary r) => f r -> TestTree
-zeroLawsQC (_ :: f r) = testGroup "Zero laws"
-  [ QC.testProperty "zeroLaw" (zeroLaw :: r -> Either String String)
-  , QC.testProperty "zeroIsZero" (once $ zeroIsZero (Proxy :: Proxy r))]
-
-ordLawsSC :: (Show r, Ord r, Semiring r, Serial IO r) => f r -> TestTree
-ordLawsSC (_ :: f r) = testGroup "Ordering laws"
-  [ SC.testProperty "mulLaw" (ordMulLaw :: r -> r -> r -> Either String String)
-  , SC.testProperty "addLaw" (ordAddLaw :: r -> r -> r -> Either String String)]
-
-zeroLawsSC :: (Show r, Eq r, DetectableZero r, Serial IO r) => f r -> TestTree
-zeroLawsSC (_ :: f r) = testGroup "Zero laws"
-  [ SC.testProperty "zeroLaw" (zeroLaw :: r -> Either String String)
-  , SC.testProperty "zeroIsZero" (zeroIsZero (Proxy :: Proxy r))]
-
-storableQC :: (Show r, Eq r, Arbitrary r, Storable.Storable r) => f r -> TestTree
-storableQC (_ :: f r) =
-    testGroup
-        "Storable implementation"
-        [ QC.testProperty
-              "unstore . store == id"
-              (\(xs :: [r]) ->
-                    (Storable.toList |.| Storable.fromList) xs === xs)]
-
-infixr 9 |.|
-(|.|) :: (b -> c) -> (a -> b) -> a -> c
-(|.|) f g x = f (g x)
-{-# NOINLINE (|.|) #-}
-
-deriving instance Ord A
-
-instance Read A where
-    readsPrec p xs =
-        [ (A x, rs)
-        | (x,rs) <- readsPrec p xs ]
-
-liftedQC
-    :: (Show1 r
-       ,Eq1 r
-       ,Ord1 r
-       ,Read1 r
-       ,Arbitrary (r A)
-       ,Show (r A)
-       ,Eq (r A)
-       ,Ord (r A)
-       ,Read A)
-    => f (r b) -> TestTree
-liftedQC (_ :: f (r b)) =
-    testGroup
-        "liftedClasses"
-        [ testGroup
-              "Eq1"
-              [ QC.testProperty
-                    "x == x"
-                    (\(x :: r A) ->
-                          eq1 x x)
-              , QC.testProperty
-                    "same as =="
-                    (\(x :: r A) (y :: r A) ->
-                          counterexample (show (x, y)) ((x == y) == eq1 x y))]
-        , testGroup
-              "Ord1"
-              [ QC.testProperty
-                    "cmp x x == EQ"
-                    (\(x :: r A) ->
-                          counterexample (show x) (compare1 x x === EQ))
-              , QC.testProperty
-                    "compare1 == compare"
-                    (\(x :: r A) (y :: r A) ->
-                          counterexample
-                              (show (x, y))
-                              (compare x y == compare1 x y))]
-        , testGroup
-              "Show1"
-              [ QC.testProperty
-                    "show1 == show"
-                    (\(x :: r A) ->
-                          liftShowsPrec showsPrec showList 0 x "" === show x)]
-        , testGroup
-              "Read1"
-              [ QC.testProperty
-                    "read1 . show == id"
-                    (\(x :: r A) ->
-                          (liftReadsPrec readsPrec readList 0 . show) x ===
-                          [(x, "")])]]
+import           Properties
 
 type Tup2 a = (a,a)
 type Tup3 a = (a,a,a)
@@ -184,73 +50,139 @@
 type Tup8 a = (a,a,a,a,a,a,a,a)
 type Tup9 a = (a,a,a,a,a,a,a,a,a)
 
-refListMul
-    :: Semiring a
-    => [a] -> [a] -> [a]
-refListMul [] _              = []
-refListMul _ []              = []
-refListMul (x:xs) yys@(y:ys) = (x <.> y) : map (x <.>) ys <+> xs <.> yys
+groupType :: Typeable a => Proxy a -> [Proxy a -> TestTree] -> TestTree
+groupType p = testGroup (show (typeRep p)) . map ($p)
 
 typeclassTests :: TestTree
 typeclassTests =
     testGroup
         "typeclass tests"
-        [ let p = Proxy :: Proxy (PositiveInfinite Int)
-          in testGroup "PositiveInfinite" [storableQC p, liftedQC p]
-        , let p = Proxy :: Proxy (NegativeInfinite Int)
-          in testGroup "NegativeInfinite" [storableQC p, liftedQC p]
-        , let p = Proxy :: Proxy (Infinite Int)
-          in testGroup "Infinite" [storableQC p, liftedQC p]
-        , let p = Proxy :: Proxy (Add A)
-          in testGroup "Add" [liftedQC p]
-        , let p = Proxy :: Proxy (Mul A)
-          in testGroup "Mul" [liftedQC p]
-        , let p = Proxy :: Proxy (Max A)
-          in testGroup "Max" [liftedQC p]
-        , let p = Proxy :: Proxy (Min A)
-          in testGroup "Min" [liftedQC p]
-        , let p = Proxy :: Proxy (Bottleneck A)
-          in testGroup "Min" [liftedQC p]
-        , let p = Proxy :: Proxy (Division A)
-          in testGroup "Min" [liftedQC p]
-        , let p = Proxy :: Proxy (Łukasiewicz A)
-          in testGroup "Min" [liftedQC p]
-        , let p = Proxy :: Proxy (Viterbi A)
-          in testGroup "Min" [liftedQC p]
-        , let p = Proxy :: Proxy (PosFrac A)
-          in testGroup "Min" [liftedQC p]
-        , let p = Proxy :: Proxy (PosInt A)
-          in testGroup "Min" [liftedQC p]
-        ]
+        [ storableQCT (Proxy :: Proxy
+              [ PositiveInfinite Int
+              , NegativeInfinite Int
+              , Infinite Int
+              ])
+        , liftedQCT (Proxy :: Proxy
+              [ PositiveInfinite
+              , NegativeInfinite
+              , Infinite
+              , Add
+              , Mul
+              , Max
+              , Min
+              , Bottleneck
+              , Division
+              , Łukasiewicz
+              , Viterbi
+              , PosFrac
+              , PosInt
+              ])]
 
 semiringLawTests :: TestTree
 semiringLawTests =
     testGroup
         "Semiring/StarSemiring Laws"
-        [ let p = Proxy :: Proxy (ApproxLog Double)
-          in testGroup "Log" [semiringLawsSC p]
-        , let p = Proxy :: Proxy (SApproxLog Double)
-          in testGroup "Log" [semiringLawsSC p]
-        , let p = Proxy :: Proxy (Map String Int)
-          in testGroup
-                 "Map"
-                 [localOption (QC.QuickCheckMaxSize 10) $ semiringLawsQC p]
-        , let p0 = Proxy :: Proxy (Matrix V0 V0 Integer)
-              p1 = Proxy :: Proxy (Matrix V1 V1 Integer)
-              p2 = Proxy :: Proxy (Matrix V2 V2 Integer)
-              p5 = Proxy :: Proxy (Matrix V5 V5 Integer)
-          in testGroup
-                 "Matrix"
-                 [ testGroup "0" [semiringLawsQC p0]
-                 , testGroup "1" [semiringLawsQC p1]
-                 , testGroup "2" [semiringLawsQC p2]
-                 , testGroup "5" [semiringLawsQC p5]]
-        , let p = Proxy :: Proxy Integer
-          in testGroup
-                 "Integer"
-                 [semiringLawsSC p, ordLawsSC p, zeroLawsSC p, ordLawsQC p]
-        , let p = Proxy :: Proxy (Func Bool Bool)
-          in testGroup "Bool -> Bool" [semiringLawsQC p]
+        [ semiringLawsSCT (Proxy :: Proxy
+              [ ApproxLog Double
+              , SApproxLog Double
+              , Integer
+              , PositiveInfinite Natural
+              , Int
+              , WordOfSize 2
+              , Tup2 (WordOfSize 2)
+              , ()
+              , Bool
+              , Any
+              , All
+              , Min (PositiveInfinite Integer)
+              , Max (NegativeInfinite Integer)
+              , Division Integer
+              , Viterbi Fraction
+              , Łukasiewicz Fraction
+              ])
+        , semiringLawsQCT (Proxy :: Proxy
+              [ Matrix V0 V0 Integer
+              , Matrix V1 V1 Integer
+              , Matrix V2 V2 Integer
+              , Matrix V5 V5 Integer
+              , Func Bool Bool
+              , Tup3 (WordOfSize 2)
+              , Tup4 Int
+              , Tup5 Int
+              , Tup6 Int
+              , Tup7 Int
+              , Tup8 Int
+              , Tup9 Int
+              , [Int]
+              , Vector.Vector Int
+              , Storable.Vector Int
+              , Unboxed.Vector Int
+              ])
+        , starLawsQCT (Proxy :: Proxy
+              [ Tup4 (PositiveInfinite Int)
+              , Tup5 (PositiveInfinite Int)
+              , Tup6 (PositiveInfinite Int)
+              , Tup7 (PositiveInfinite Int)
+              , Tup8 (PositiveInfinite Int)
+              , Tup9 (PositiveInfinite Int)
+              , LimitSize 100 (PositiveInfinite Integer)
+              ])
+        , starLawsSCT (Proxy :: Proxy
+              [ Tup2 (PositiveInfinite (WordOfSize 2))
+              , Tup3 (PositiveInfinite (WordOfSize 2))
+              , ()
+              , Bool
+              , Any
+              , All
+              , Min (Infinite Integer)
+              , Max (Infinite Integer)
+              ])
+        , ordLawsQCT (Proxy :: Proxy '[])
+        , ordLawsSCT (Proxy :: Proxy
+              [ Integer
+              , PositiveInfinite Natural
+              , Int
+              , ()
+              , Bool
+              , Any
+              , All
+              ])
+        , zeroLawsQCT (Proxy :: Proxy
+              [ Tup3 (WordOfSize 2)
+              , Tup4 Int
+              , Tup5 Int
+              , Tup6 Int
+              , Tup7 Int
+              , Tup8 Int
+              , Tup9 Int
+              ])
+        , zeroLawsSCT (Proxy :: Proxy
+              [ Integer
+              , PositiveInfinite Natural
+              , Int
+              , WordOfSize 2
+              , Tup2 (WordOfSize 2)
+              , ()
+              , Bool
+              , Any
+              , All
+              , Min (PositiveInfinite Integer)
+              , Max (NegativeInfinite Integer)
+              , Division Integer
+              , Viterbi Fraction
+              , Łukasiewicz Fraction
+              ])
+        , refListMulQCT (Proxy :: Proxy
+              [ [Int]
+              , Vector.Vector Int
+              , Unboxed.Vector Int
+              , Storable.Vector Int
+              , Unboxed.Vector (NegativeInfinite Int)
+              , Unboxed.Vector (Infinite Int)
+              ])
+        , groupType
+              (Proxy :: Proxy (Map String Int))
+              [localOption (QC.QuickCheckMaxSize 10) . semiringLawsQC]
         , testGroup
               "Endo Bool"
               [ QC.testProperty
@@ -275,46 +207,6 @@
               , QC.testProperty
                     "mulDistribR"
                     (mulDistribR :: TernaryLaws (EndoFunc (Add Bool)))]
-        , let p = Proxy :: Proxy (PositiveInfinite Natural)
-          in testGroup
-                 "PosInf Natural"
-                 [semiringLawsSC p, ordLawsSC p, zeroLawsSC p]
-        , let p = Proxy :: Proxy Int
-          in testGroup "Int" [semiringLawsSC p, ordLawsSC p, zeroLawsSC p]
-        , let p = Proxy :: Proxy (WordOfSize 2)
-          in testGroup "WordOfSize 2" [semiringLawsSC p, zeroLawsSC p]
-        , let p = Proxy :: Proxy (Tup2 (WordOfSize 2))
-          in testGroup "Tup2 (WordOfSize 2)" [semiringLawsSC p, zeroLawsSC p]
-        , let p = Proxy :: Proxy (Tup3 (WordOfSize 2))
-          in testGroup "Tup3 (WordOfSize 2)" [semiringLawsQC p, zeroLawsQC p]
-        , let p = Proxy :: Proxy (Tup4 Int)
-          in testGroup "Tup4 Int" [semiringLawsQC p, zeroLawsQC p]
-        , let p = Proxy :: Proxy (Tup5 Int)
-          in testGroup "Tup5 Int" [semiringLawsQC p, zeroLawsQC p]
-        , let p = Proxy :: Proxy (Tup6 Int)
-          in testGroup "Tup6 Int" [semiringLawsQC p, zeroLawsQC p]
-        , let p = Proxy :: Proxy (Tup7 Int)
-          in testGroup "Tup7 Int" [semiringLawsQC p, zeroLawsQC p]
-        , let p = Proxy :: Proxy (Tup8 Int)
-          in testGroup "Tup8 Int" [semiringLawsQC p, zeroLawsQC p]
-        , let p = Proxy :: Proxy (Tup9 Int)
-          in testGroup "Tup9 Int" [semiringLawsQC p, zeroLawsQC p]
-        , let p = Proxy :: Proxy (Tup2 (PositiveInfinite (WordOfSize 2)))
-          in testGroup "Tup2 (WordOfSize 2)" [starLawsSC p]
-        , let p = Proxy :: Proxy (Tup3 (PositiveInfinite (WordOfSize 2)))
-          in testGroup "Tup3 (WordOfSize 2)" [starLawsSC p]
-        , let p = Proxy :: Proxy (Tup4 (PositiveInfinite Int))
-          in testGroup "Tup4 Int" [starLawsQC p]
-        , let p = Proxy :: Proxy (Tup5 (PositiveInfinite Int))
-          in testGroup "Tup5 Int" [starLawsQC p]
-        , let p = Proxy :: Proxy (Tup6 (PositiveInfinite Int))
-          in testGroup "Tup6 Int" [starLawsQC p]
-        , let p = Proxy :: Proxy (Tup7 (PositiveInfinite Int))
-          in testGroup "Tup7 Int" [starLawsQC p]
-        , let p = Proxy :: Proxy (Tup8 (PositiveInfinite Int))
-          in testGroup "Tup8 Int" [starLawsQC p]
-        , let p = Proxy :: Proxy (Tup9 (PositiveInfinite Int))
-          in testGroup "Tup9 Int" [starLawsQC p]
         , testGroup
               "Negative Infinite Integer"
               [ SC.testProperty
@@ -363,97 +255,7 @@
               , SC.testProperty
                     "mulAssoc"
                     (mulAssoc :: TernaryLaws (Infinite Integer))]
-        , let p = Proxy :: Proxy ()
-          in testGroup
-                 "()"
-                 [semiringLawsSC p, ordLawsSC p, zeroLawsSC p, starLawsSC p]
-        , let p = Proxy :: Proxy Bool
-          in testGroup
-                 "Bool"
-                 [semiringLawsSC p, ordLawsSC p, zeroLawsSC p, starLawsSC p]
-        , let p = Proxy :: Proxy Any
-          in testGroup
-                 "Any"
-                 [semiringLawsSC p, ordLawsSC p, zeroLawsSC p, starLawsSC p]
-        , let p = Proxy :: Proxy All
-          in testGroup
-                 "All"
-                 [semiringLawsSC p, ordLawsSC p, zeroLawsSC p, starLawsSC p]
-        , let p = Proxy :: Proxy [Integer]
-          in testGroup
-                 "[Integer]"
-                 [ semiringLawsQC p
-                 , starLawsQC
-                       (Proxy :: Proxy (LimitSize 100 (PositiveInfinite Integer)))
-                 , QC.testProperty
-                       "reference implementation of <.>"
-                       (\xs ys ->
-                             (xs <.> ys) ===
-                             refListMul xs (ys :: [WordOfSize 2]))]
-        , let p = Proxy :: Proxy (Vector.Vector Int)
-          in testGroup
-                 "Vector Int"
-                 [ semiringLawsQC p
-                 , QC.testProperty
-                       "reference implementation of <.>"
-                       (\xs ys ->
-                             (xs <.> ys :: [Int]) ===
-                             Vector.toList
-                                 (Vector.fromList xs <.> Vector.fromList ys))]
-        , let p = Proxy :: Proxy (Storable.Vector Int)
-          in testGroup
-                 "Storable Vector Int"
-                 [ semiringLawsQC p
-                 , QC.testProperty
-                       "reference implementation of <.>"
-                       (\xs ys ->
-                             (xs <.> ys :: [Int]) ===
-                             Vector.toList
-                                 (Vector.fromList xs <.> Vector.fromList ys))]
-        , let p = Proxy :: Proxy (Unboxed.Vector Int)
-          in testGroup
-                 "Unboxed Vector Int"
-                 [ semiringLawsQC p
-                 , QC.testProperty
-                       "reference implementation of <.>"
-                       (\xs ys ->
-                             (xs <.> ys :: [Int]) ===
-                             Unboxed.toList
-                                 (Unboxed.fromList xs <.> Unboxed.fromList ys))]
-        , testGroup
-              "Unboxed Vector (NegativeInfinite Int)"
-              [ QC.testProperty
-                    "reference implementation of <.>"
-                    (\xs ys ->
-                          (xs <.> ys :: [NegativeInfinite Int]) ===
-                          Unboxed.toList
-                              (Unboxed.fromList xs <.> Unboxed.fromList ys))]
-        , testGroup
-              "Unboxed Vector (Infinite Int)"
-              [ QC.testProperty
-                    "reference implementation of <.>"
-                    (\xs ys ->
-                          (xs <.> ys :: [Infinite Int]) ===
-                          Unboxed.toList
-                              (Unboxed.fromList xs <.> Unboxed.fromList ys))]
-        , let p = Proxy :: Proxy (Min (PositiveInfinite Integer))
-          in testGroup "Min Inf Integer" [semiringLawsSC p, zeroLawsSC p]
-        , let p = Proxy :: Proxy (Min (Infinite Integer))
-          in testGroup "Min Inf Integer" [starLawsSC p]
-        , let p = Proxy :: Proxy (Max (NegativeInfinite Integer))
-          in testGroup "Max NegInf Integer" [semiringLawsSC p, zeroLawsSC p]
-        , let p = Proxy :: Proxy (Max (Infinite Integer))
-          in testGroup "Max Inf Integer" [starLawsSC p]
-        , let p = Proxy :: Proxy (Free (WordOfSize 2))
-          in testGroup
-                 "Free (WordOfSize 2)"
-                 [localOption (QC.QuickCheckMaxSize 10) $ semiringLawsQC p]
-        , let p = Proxy :: Proxy (Division Integer)
-          in testGroup "Division Integer" [semiringLawsSC p, zeroLawsSC p]
-        , let p = Proxy :: Proxy (Łukasiewicz Fraction)
-          in testGroup "Łukasiewicz Fraction" [semiringLawsSC p, zeroLawsSC p]
-        , let p = Proxy :: Proxy (Viterbi Fraction)
-          in testGroup "Viterbi Fraction" [semiringLawsSC p, zeroLawsSC p]]
+        ]
 
 main :: IO ()
 main = do
diff --git a/test/TypeLevel.hs b/test/TypeLevel.hs
new file mode 100644
--- /dev/null
+++ b/test/TypeLevel.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE ConstraintKinds         #-}
+{-# LANGUAGE DataKinds               #-}
+{-# LANGUAGE FlexibleContexts        #-}
+{-# LANGUAGE FlexibleInstances       #-}
+{-# LANGUAGE KindSignatures          #-}
+{-# LANGUAGE MultiParamTypeClasses   #-}
+{-# LANGUAGE PolyKinds               #-}
+{-# LANGUAGE RankNTypes              #-}
+{-# LANGUAGE ScopedTypeVariables     #-}
+{-# LANGUAGE TypeFamilies            #-}
+{-# LANGUAGE TypeOperators           #-}
+{-# LANGUAGE UndecidableSuperClasses #-}
+
+module TypeLevel where
+
+import           Data.Proxy
+import           GHC.Exts
+
+type family AllAre (c :: k -> Constraint) (xs :: [k]) :: Constraint where
+        AllAre c '[] = ()
+        AllAre c (x ': xs) = (c x, AllAre c xs)
+
+class Reifiable (xs :: [k]) where
+    reify
+        :: AllAre c xs
+        => Proxy c
+        -> Proxy xs
+        -> (forall a. c a =>
+                      Proxy a -> b)
+        -> [b]
+
+instance Reifiable '[] where
+    reify _ _ _ = []
+
+instance Reifiable xs =>
+         Reifiable (x ': xs) where
+    reify p _ f = f (Proxy :: Proxy x) : reify p (Proxy :: Proxy xs) f
+
+class (c a, d a) => (c & d) a where
+instance (c a, d a) => (c & d) a