diff --git a/Data/Vector/Generic.hs b/Data/Vector/Generic.hs
index 78f7260588e32f941f4eb00a34d95661d61bf0dc..0d3a88e28da9f7e0b8741d6d8469e985823da644 100644
--- a/Data/Vector/Generic.hs
+++ b/Data/Vector/Generic.hs
@@ -194,7 +194,12 @@ import Prelude hiding ( length, null,
                         showsPrec )
 
 import qualified Text.Read as Read
+
+#if __GLASGOW_HASKELL__ >= 707
+import Data.Typeable ( Typeable, gcast1 )
+#else
 import Data.Typeable ( Typeable1, gcast1 )
+#endif
 
 #include "vector.h"
 
@@ -2020,7 +2025,11 @@ mkType :: String -> DataType
 {-# INLINE mkType #-}
 mkType = mkNoRepType
 
+#if __GLASGOW_HASKELL__ >= 707
+dataCast :: (Vector v a, Data a, Typeable v, Typeable t)
+#else
 dataCast :: (Vector v a, Data a, Typeable1 v, Typeable1 t)
+#endif
          => (forall d. Data  d => c (t d)) -> Maybe  (c (v a))
 {-# INLINE dataCast #-}
 dataCast f = gcast1 f
diff --git a/Data/Vector/Unboxed/Base.hs b/Data/Vector/Unboxed/Base.hs
index 00350cb653f477cc18775e64da002ef905910ab5..3fcc4f02e3d630adedc3baa5166ff6be4982ba18 100644
--- a/Data/Vector/Unboxed/Base.hs
+++ b/Data/Vector/Unboxed/Base.hs
@@ -1,4 +1,7 @@
 {-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}
+#if __GLASGOW_HASKELL__ >= 707
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+#endif
 {-# OPTIONS_HADDOCK hide #-}
 
 -- |
@@ -31,6 +34,9 @@ import Data.Word ( Word, Word8, Word16, Word32, Word64 )
 import Data.Int  ( Int8, Int16, Int32, Int64 )
 import Data.Complex
 
+#if __GLASGOW_HASKELL__ >= 707
+import Data.Typeable ( Typeable )
+#else
 import Data.Typeable ( Typeable1(..), Typeable2(..), mkTyConApp,
 #if MIN_VERSION_base(4,4,0)
                        mkTyCon3
@@ -38,6 +44,8 @@ import Data.Typeable ( Typeable1(..), Typeable2(..), mkTyConApp,
                        mkTyCon
 #endif
                      )
+#endif
+
 import Data.Data     ( Data(..) )
 
 #include "vector.h"
@@ -58,7 +66,10 @@ instance NFData (MVector s a)
 -- -----------------
 -- Data and Typeable
 -- -----------------
-
+#if __GLASGOW_HASKELL__ >= 707
+deriving instance Typeable Vector
+deriving instance Typeable MVector
+#else
 #if MIN_VERSION_base(4,4,0)
 vectorTyCon = mkTyCon3 "vector"
 #else
@@ -70,6 +81,7 @@ instance Typeable1 Vector where
 
 instance Typeable2 MVector where
   typeOf2 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed.Mutable" "MVector") []
+#endif
 
 instance (Data a, Unbox a) => Data (Vector a) where
   gfoldl       = G.gfoldl