From 3c51c33e0f9f5ac4abd438503458c76b5b0d2c13 Mon Sep 17 00:00:00 2001
From: M Farkas-Dyck <strake888@gmail.com>
Date: Sun, 20 Aug 2017 12:06:44 -0800
Subject: [PATCH] make Data.Vector.Generic.Base.Mutable injective (#160)

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

* Add test, use __GLASGOW_HASKELL__
---
 Data/Vector/Generic/Base.hs     | 10 +++++++++-
 tests/Tests/Vector/UnitTests.hs | 11 +++++++++++
 vector.cabal                    |  4 ++--
 3 files changed, 22 insertions(+), 3 deletions(-)

diff --git a/Data/Vector/Generic/Base.hs b/Data/Vector/Generic/Base.hs
index a760329c..5aceeec7 100644
--- a/Data/Vector/Generic/Base.hs
+++ b/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
diff --git a/tests/Tests/Vector/UnitTests.hs b/tests/Tests/Vector/UnitTests.hs
index 5827640d..57987b28 100644
--- a/tests/Tests/Vector/UnitTests.hs
+++ b/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
diff --git a/vector.cabal b/vector.cabal
index 767e3734..326454cf 100644
--- a/vector.cabal
+++ b/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