make Data.Vector.Generic.Base.Mutable injective (haskell#160)

* make Data.Vector.Generic.Base.Mutable injective

* Add test, use __GLASGOW_HASKELL__

Data/Vector/Generic/Base.hs

@@ -1,5 +1,9 @@
 {-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleContexts,
              TypeFamilies, ScopedTypeVariables, BangPatterns #-}
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 800
+{-# LANGUAGE TypeFamilyDependencies #-}
+#endif
 {-# OPTIONS_HADDOCK hide #-}
 
 -- |
@@ -24,9 +28,13 @@ import qualified Data.Vector.Generic.Mutable.Base as M
 import Control.Monad.Primitive
 
 -- | @Mutable v s a@ is the mutable version of the pure vector type @v a@ with
--- the state token @s@
+-- the state token @s@. It is injective on GHC 8 and newer.
 --
+#if MIN_VERSION_base(4,9,0)
+type family Mutable (v :: * -> *) = (mv :: * -> * -> *) | mv -> v
+#else
 type family Mutable (v :: * -> *) :: * -> * -> *
+#endif
 
 -- | Class of immutable vectors. Every immutable vector is associated with its
 -- mutable version through the 'Mutable' type family. Methods of this class

tests/Tests/Vector/UnitTests.hs

@@ -1,8 +1,11 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Tests.Vector.UnitTests (tests) where
 
 import Control.Applicative as Applicative
+import Control.Monad.Primitive
+import qualified Data.Vector.Generic  as Generic
 import qualified Data.Vector.Storable as Storable
 import Foreign.Ptr
 import Foreign.Storable
@@ -46,3 +49,11 @@ alignedDoubleVec = Storable.fromList $ map Aligned [1, 2, 3, 4, 5]
 
 alignedIntVec :: Storable.Vector (Aligned Int)
 alignedIntVec = Storable.fromList $ map Aligned [1, 2, 3, 4, 5]
+
+#if __GLASGOW_HASKELL__ >= 800
+-- Ensure that Mutable is really an injective type family by typechecking a
+-- function which relies on injectivity.
+_f :: (Generic.Vector v a, Generic.Vector w a, PrimMonad f)
+   => Generic.Mutable v (PrimState f) a -> f (w a)
+_f v = Generic.convert `fmap` Generic.unsafeFreeze v
+#endif

vector.cabal

@@ -188,7 +188,7 @@ test-suite vector-tests-O0
 
   hs-source-dirs: tests
   Build-Depends: base >= 4.5 && < 5, template-haskell, vector,
-                 random,
+                 primitive, random,
                  QuickCheck >= 2.9 && < 2.10 , HUnit, test-framework,
                  test-framework-hunit, test-framework-quickcheck2,
                  transformers >= 0.2.0.0
@@ -226,7 +226,7 @@ test-suite vector-tests-O2
 
   hs-source-dirs: tests
   Build-Depends: base >= 4.5 && < 5, template-haskell, vector,
-                 random,
+                 primitive, random,
                  QuickCheck >= 2.9 && < 2.10 , HUnit, test-framework,
                  test-framework-hunit, test-framework-quickcheck2,
                  transformers >= 0.2.0.0