Add instances for strict boxed vector added in vector-0.13.2.0

Author: Shimuuar

CHANGELOG.markdown

@@ -1,3 +1,9 @@
+NEXT VERSION
+------------------
+* `Ixed`, `Cons`, `Each`, `AsEmpty`, `Reversing`, `Rewrapped` instances are
+  added for strict boxed vectors (`vector>=0.13.2`)
+* `AsEmpty` instance added for primitive vector.
+
 5.3.3 [2024.12.28]
 ------------------
 * Add `makeFieldsId`, which generates overloaded field accessors using the

src/Control/Lens/At.hs

@@ -85,6 +85,9 @@ import Data.Vector.Primitive (Prim)
 import qualified Data.Vector.Storable as Storable
 import qualified Data.Vector.Unboxed as Unboxed
 import Data.Vector.Unboxed (Unbox)
+#if MIN_VERSION_vector(0,13,2)
+import qualified Data.Vector.Strict as VectorStrict
+#endif
 import Data.Word
 import Foreign.Storable (Storable)
 
@@ -113,6 +116,9 @@ type instance Index (Vector.Vector a) = Int
 type instance Index (Prim.Vector a) = Int
 type instance Index (Storable.Vector a) = Int
 type instance Index (Unboxed.Vector a) = Int
+#if MIN_VERSION_vector(0,13,2)
+type instance Index (VectorStrict.Vector a) = Int
+#endif
 type instance Index (Complex a) = Int
 type instance Index (Identity a) = ()
 type instance Index (Maybe a) = ()
@@ -396,6 +402,15 @@ instance Unbox a => Ixed (Unboxed.Vector a) where
     | otherwise                      = pure v
   {-# INLINE ix #-}
 
+#if MIN_VERSION_vector(0,13,2)
+type instance IxValue (VectorStrict.Vector a) = a
+instance Ixed (VectorStrict.Vector a) where
+  ix i f v
+    | 0 <= i && i < VectorStrict.length v = f (v VectorStrict.! i) <&> \a -> v VectorStrict.// [(i, a)]
+    | otherwise                           = pure v
+  {-# INLINE ix #-}
+#endif
+
 type instance IxValue StrictT.Text = Char
 instance Ixed StrictT.Text where
   ix e f s 

src/Control/Lens/Cons.hs

@@ -64,6 +64,9 @@ import           Data.Vector.Primitive (Prim)
 import qualified Data.Vector.Primitive as Prim
 import           Data.Vector.Unboxed (Unbox)
 import qualified Data.Vector.Unboxed as Unbox
+#if MIN_VERSION_vector(0,13,2)
+import qualified Data.Vector.Strict as VectorStrict
+#endif
 import           Data.Word
 import           Control.Applicative (ZipList(..))
 import           Control.Monad.State.Class as State
@@ -180,6 +183,15 @@ instance (Unbox a, Unbox b) => Cons (Unbox.Vector a) (Unbox.Vector b) a b where
     else Right (Unbox.unsafeHead v, Unbox.unsafeTail v)
   {-# INLINE _Cons #-}
 
+#if MIN_VERSION_vector(0,13,2)
+instance Cons (VectorStrict.Vector a) (VectorStrict.Vector b) a b where
+  _Cons = prism (uncurry VectorStrict.cons) $ \v ->
+    if VectorStrict.null v
+    then Left VectorStrict.empty
+    else Right (VectorStrict.unsafeHead v, VectorStrict.unsafeTail v)
+  {-# INLINE _Cons #-}
+#endif
+
 -- | 'cons' an element onto a container.
 --
 -- This is an infix alias for 'cons'.

src/Control/Lens/Each.hs

@@ -54,6 +54,9 @@ import Data.Vector.Primitive (Prim)
 import qualified Data.Vector.Storable as Storable
 import Data.Vector.Storable (Storable)
 import qualified Data.Vector.Unboxed as Unboxed
+#if MIN_VERSION_vector(0,13,2)
+import qualified Data.Vector.Strict as VectorStrict
+#endif
 import Data.Vector.Unboxed (Unbox)
 import Data.Word
 import qualified Data.Strict as S
@@ -195,6 +198,13 @@ instance (Unbox a, Unbox b) => Each (Unboxed.Vector a) (Unboxed.Vector b) a b wh
   each = vectorTraverse
   {-# INLINE each #-}
 
+#if MIN_VERSION_vector(0,13,2)
+-- | @'each' :: 'Traversal' ('Vector.Vector' a) ('Vector.Vector' b) a b@
+instance Each (VectorStrict.Vector a) (VectorStrict.Vector b) a b where
+  each = vectorTraverse
+  {-# INLINE each #-}
+#endif
+
 -- | @'each' :: 'Traversal' 'StrictT.Text' 'StrictT.Text' 'Char' 'Char'@
 instance (a ~ Char, b ~ Char) => Each StrictT.Text StrictT.Text a b where
   each = text

src/Control/Lens/Empty.hs

@@ -53,6 +53,10 @@ import qualified Data.Vector as Vector
 import qualified Data.Vector.Unboxed as Unboxed
 import Data.Vector.Unboxed (Unbox)
 import qualified Data.Vector.Storable as Storable
+import qualified Data.Vector.Primitive as Prim
+#if MIN_VERSION_vector(0,13,2)
+import qualified Data.Vector.Strict as VectorStrict
+#endif
 import Foreign.Storable (Storable)
 
 #if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS)
@@ -161,10 +165,20 @@ instance Unbox a => AsEmpty (Unboxed.Vector a) where
   _Empty = nearly Unboxed.empty Unboxed.null
   {-# INLINE _Empty #-}
 
+instance Prim.Prim a => AsEmpty (Prim.Vector a) where
+  _Empty = nearly Prim.empty Prim.null
+  {-# INLINE _Empty #-}
+
 instance Storable a => AsEmpty (Storable.Vector a) where
   _Empty = nearly Storable.empty Storable.null
   {-# INLINE _Empty #-}
 
+#if MIN_VERSION_vector(0,13,2)
+instance AsEmpty (VectorStrict.Vector a) where
+  _Empty = nearly VectorStrict.empty VectorStrict.null
+  {-# INLINE _Empty #-}
+#endif
+
 instance AsEmpty (Seq.Seq a) where
   _Empty = nearly Seq.empty Seq.null
   {-# INLINE _Empty #-}

src/Control/Lens/Internal/Iso.hs

@@ -33,6 +33,9 @@ import Data.Vector.Primitive (Prim)
 import qualified Data.Vector.Storable  as Storable
 import qualified Data.Vector.Unboxed   as Unbox
 import Data.Vector.Unboxed (Unbox)
+#if MIN_VERSION_vector(0,13,2)
+import qualified Data.Vector.Strict as VectorStrict
+#endif
 import qualified Data.Sequence         as Seq
 import Data.Sequence (Seq)
 import Foreign.Storable (Storable)
@@ -100,3 +103,8 @@ instance Unbox a => Reversing (Unbox.Vector a) where
 
 instance Storable a => Reversing (Storable.Vector a) where
   reversing = Storable.reverse
+
+#if MIN_VERSION_vector(0,13,2)
+instance Reversing (VectorStrict.Vector a) where
+  reversing = VectorStrict.reverse
+#endif

src/Control/Lens/Wrapped.hs

@@ -150,6 +150,9 @@ import qualified Data.Set as Set
 import           Data.Set (Set)
 import           Data.Tagged
 import qualified Data.Vector as Vector
+#if MIN_VERSION_vector(0,13,2)
+import qualified Data.Vector.Strict as VectorStrict
+#endif
 import qualified Data.Vector.Primitive as Prim
 import           Data.Vector.Primitive (Prim)
 import qualified Data.Vector.Unboxed as Unboxed
@@ -676,6 +679,14 @@ instance Storable a => Wrapped (Storable.Vector a) where
   _Wrapped' = iso Storable.toList Storable.fromList
   {-# INLINE _Wrapped' #-}
 
+#if MIN_VERSION_vector(0,13,2)
+instance (t ~ Vector.Vector a') => Rewrapped (VectorStrict.Vector a) t
+instance Wrapped (VectorStrict.Vector a) where
+  type Unwrapped (VectorStrict.Vector a) = [a]
+  _Wrapped' = iso VectorStrict.toList VectorStrict.fromList
+  {-# INLINE _Wrapped' #-}
+#endif
+
 -- * semigroupoids
 
 instance (t ~ WrappedApplicative f' a') => Rewrapped (WrappedApplicative f a) t