Fix #244. Instances for Data.Vector.Strict

mono-traversable/ChangeLog.md

@@ -1,5 +1,10 @@
 # ChangeLog for mono-traversable
 
+## 1.0.21.0
+
+* Support for vector 0.13.2.0, adding instances for [`Data.Vector.Strict`](https://hackage.haskell.org/package/vector-0.13.2.0/docs/Data-Vector-Strict.html) data structure.
+  [#244](https://github.com/snoyberg/mono-traversable/issues/244)
+
 ## 1.0.20.0
 
 * Added instances for [`Reverse`](https://hackage.haskell.org/package/transformers-0.6.1.1/docs/Data-Functor-Reverse.html#t:Reverse) data structure.

mono-traversable/mono-traversable.cabal

@@ -1,11 +1,11 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.36.0.
+-- This file has been generated from package.yaml by hpack version 0.37.0.
 --
 -- see: https://github.com/sol/hpack
 
 name:           mono-traversable
-version:        1.0.19.0
+version:        1.0.21.0
 synopsis:       Type classes for mapping, folding, and traversing monomorphic containers
 description:    Please see the README at <https://www.stackage.org/package/mono-traversable>
 category:       Data

mono-traversable/package.yaml

@@ -1,5 +1,5 @@
 name:        mono-traversable
-version:     1.0.20.0
+version:     1.0.21.0
 synopsis:    Type classes for mapping, folding, and traversing monomorphic containers
 description: Please see the README at <https://www.stackage.org/package/mono-traversable>
 category:    Data

mono-traversable/src/Data/MonoTraversable.hs

@@ -93,6 +93,11 @@ import Data.Hashable (Hashable)
 import qualified Data.Vector as V
 import qualified Data.Vector.Unboxed as U
 import qualified Data.Vector.Storable as VS
+#if MIN_VERSION_vector(0,13,2)
+import qualified Data.Vector.Strict as VSC
+#else
+{-# DependencyDeprecation "Support for vector < 0.13.2 will be removed when GHC 9.12 reaches Stackage nightly. Please upgrade to vector >= 0.13.2." #-}
+#endif
 import qualified Data.IntSet as IntSet
 import Data.Semigroup
   ( Semigroup
@@ -159,6 +164,10 @@ type instance Element (Compose f g a) = a
 type instance Element (Product f g a) = a
 type instance Element (U.Vector a) = a
 type instance Element (VS.Vector a) = a
+#if MIN_VERSION_vector(0,13,2)
+-- | @since 1.0.21.0
+type instance Element (VSC.Vector a) = a
+#endif
 type instance Element (Arg a b) = b
 type instance Element ((f :.: g) a) = a
 type instance Element ((f :*: g) a) = a
@@ -258,6 +267,10 @@ instance U.Unbox a => MonoFunctor (U.Vector a) where
 instance VS.Storable a => MonoFunctor (VS.Vector a) where
     omap = VS.map
     {-# INLINE omap #-}
+#if MIN_VERSION_vector(0,13,2)
+-- | @since 1.0.21.0
+instance MonoFunctor (VSC.Vector a)
+#endif
 -- | @since 1.0.20.0
 instance MonoFunctor (f a) => MonoFunctor (Reverse f a) where
     omap f (Reverse t) = Reverse (omap f t)
@@ -765,6 +778,39 @@ instance VS.Storable a => MonoFoldable (VS.Vector a) where
     {-# INLINE unsafeHead #-}
     {-# INLINE maximumByEx #-}
     {-# INLINE minimumByEx #-}
+#if MIN_VERSION_vector(0,13,2)
+-- | @since 1.0.21.0
+instance MonoFoldable (VSC.Vector a) where
+    ofoldr = VSC.foldr
+    ofoldl' = VSC.foldl'
+    otoList = VSC.toList
+    oall = VSC.all
+    oany = VSC.any
+    onull = VSC.null
+    olength = VSC.length
+    ofoldr1Ex = VSC.foldr1
+    ofoldl1Ex' = VSC.foldl1'
+    headEx = VSC.head
+    lastEx = VSC.last
+    unsafeHead = VSC.unsafeHead
+    unsafeLast = VSC.unsafeLast
+    maximumByEx = VSC.maximumBy
+    minimumByEx = VSC.minimumBy
+    {-# INLINE ofoldr #-}
+    {-# INLINE ofoldl' #-}
+    {-# INLINE otoList #-}
+    {-# INLINE oall #-}
+    {-# INLINE oany #-}
+    {-# INLINE onull #-}
+    {-# INLINE olength #-}
+    {-# INLINE ofoldr1Ex #-}
+    {-# INLINE ofoldl1Ex' #-}
+    {-# INLINE headEx #-}
+    {-# INLINE lastEx #-}
+    {-# INLINE unsafeHead #-}
+    {-# INLINE maximumByEx #-}
+    {-# INLINE minimumByEx #-}
+#endif
 instance MonoFoldable (Either a b) where
     ofoldMap f = ofoldr (mappend . f) mempty
     ofoldr f b (Right a) = f a b
@@ -1061,6 +1107,10 @@ instance VS.Storable a => MonoTraversable (VS.Vector a) where
     omapM = otraverse
     {-# INLINE otraverse #-}
     {-# INLINE omapM #-}
+#if MIN_VERSION_vector(0,13,2)
+-- | @since 1.0.21.0
+instance MonoTraversable (VSC.Vector a)
+#endif
 instance MonoTraversable (Either a b) where
     otraverse _ (Left a) = pure (Left a)
     otraverse f (Right b) = fmap Right (f b)
@@ -1228,6 +1278,10 @@ instance U.Unbox a => MonoPointed (U.Vector a) where
 instance VS.Storable a => MonoPointed (VS.Vector a) where
     opoint = VS.singleton
     {-# INLINE opoint #-}
+#if MIN_VERSION_vector(0,13,2)
+-- | @since 1.0.21.0
+instance MonoPointed (VSC.Vector a)
+#endif
 instance MonoPointed (Either a b) where
     opoint = Right
     {-# INLINE opoint #-}
@@ -1338,6 +1392,10 @@ instance GrowingAppend [a]
 instance GrowingAppend (V.Vector a)
 instance U.Unbox a => GrowingAppend (U.Vector a)
 instance VS.Storable a => GrowingAppend (VS.Vector a)
+#if MIN_VERSION_vector(0,13,2)
+-- | @since 1.0.21.0
+instance GrowingAppend (VSC.Vector a)
+#endif
 instance GrowingAppend S.ByteString
 instance GrowingAppend L.ByteString
 instance GrowingAppend T.Text

mono-traversable/src/Data/Sequences.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -29,6 +30,11 @@ import qualified Data.Sequence as Seq
 import qualified Data.Vector as V
 import qualified Data.Vector.Unboxed as U
 import qualified Data.Vector.Storable as VS
+#if MIN_VERSION_vector(0,13,2)
+import qualified Data.Vector.Strict as VSC
+#else
+{-# DependencyDeprecation "Support for vector < 0.13.2 will be removed when GHC 9.12 reaches Stackage nightly. Please upgrade to vector >= 0.13.2." #-}
+#endif
 import Data.String (IsString)
 import qualified Data.List.NonEmpty as NE
 import qualified Data.ByteString.Unsafe as SU
@@ -1095,6 +1101,84 @@ instance IsSequence (V.Vector a) where
     {-# INLINE indexEx #-}
     {-# INLINE unsafeIndex #-}
 
+#if MIN_VERSION_vector(0,13,2)
+-- | @since 1.0.21.0
+instance SemiSequence (VSC.Vector a) where
+    type Index (VSC.Vector a) = Int
+    reverse = VSC.reverse
+    find = VSC.find
+    cons = VSC.cons
+    snoc = VSC.snoc
+
+    sortBy = vectorSortBy
+    intersperse = defaultIntersperse
+    {-# INLINE intersperse #-}
+    {-# INLINE reverse #-}
+    {-# INLINE find #-}
+    {-# INLINE sortBy #-}
+    {-# INLINE cons #-}
+    {-# INLINE snoc #-}
+
+-- | @since 1.0.21.0
+instance IsSequence (VSC.Vector a) where
+    fromList = VSC.fromList
+    lengthIndex = VSC.length
+    replicate = VSC.replicate
+    replicateM = VSC.replicateM
+    filter = VSC.filter
+    filterM = VSC.filterM
+    break = VSC.break
+    span = VSC.span
+    dropWhile = VSC.dropWhile
+    takeWhile = VSC.takeWhile
+    splitAt = VSC.splitAt
+    take = VSC.take
+    drop = VSC.drop
+    unsafeTake = VSC.unsafeTake
+    unsafeDrop = VSC.unsafeDrop
+    partition = VSC.partition
+    uncons v
+        | VSC.null v = Nothing
+        | otherwise = Just (VSC.head v, VSC.tail v)
+    unsnoc v
+        | VSC.null v = Nothing
+        | otherwise = Just (VSC.init v, VSC.last v)
+    groupBy = VSC.groupBy
+    tailEx = VSC.tail
+    initEx = VSC.init
+    unsafeTail = VSC.unsafeTail
+    unsafeInit = VSC.unsafeInit
+    {-# INLINE fromList #-}
+    {-# INLINE break #-}
+    {-# INLINE span #-}
+    {-# INLINE dropWhile #-}
+    {-# INLINE takeWhile #-}
+    {-# INLINE splitAt #-}
+    {-# INLINE take #-}
+    {-# INLINE unsafeTake #-}
+    {-# INLINE drop #-}
+    {-# INLINE unsafeDrop #-}
+    {-# INLINE partition #-}
+    {-# INLINE uncons #-}
+    {-# INLINE unsnoc #-}
+    {-# INLINE filter #-}
+    {-# INLINE filterM #-}
+    {-# INLINE replicate #-}
+    {-# INLINE replicateM #-}
+    {-# INLINE groupBy #-}
+    {-# INLINE tailEx #-}
+    {-# INLINE initEx #-}
+    {-# INLINE unsafeTail #-}
+    {-# INLINE unsafeInit #-}
+
+    index = (VSC.!?)
+    indexEx = (VSC.!)
+    unsafeIndex = VSC.unsafeIndex
+    {-# INLINE index #-}
+    {-# INLINE indexEx #-}
+    {-# INLINE unsafeIndex #-}
+#endif
+
 instance U.Unbox a => SemiSequence (U.Vector a) where
     type Index (U.Vector a) = Int
 

mono-traversable/test/Main.hs

@@ -33,6 +33,11 @@ import qualified Data.ByteString.Lazy as L
 import qualified Data.Vector as V
 import qualified Data.Vector.Unboxed as U
 import qualified Data.Vector.Storable as VS
+#if MIN_VERSION_vector(0,13,2)
+import qualified Data.Vector.Strict as VSC
+#else
+{-# MissingTests "Tests for Data.Vector.Strict are disabled due to vector < 0.13.2. Please upgrade vector to >= 0.13.2 to enable these tests." #-}
+#endif
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Semigroup as SG
 import qualified Data.Map as Map
@@ -98,6 +103,9 @@ mapFromListAs xs _ = mapFromList xs
 instance IsString (V.Vector Char) where fromString = V.fromList
 instance IsString (U.Vector Char) where fromString = U.fromList
 instance IsString (VS.Vector Char) where fromString = VS.fromList
+#if MIN_VERSION_vector(0,13,2)
+instance IsString (VSC.Vector Char) where fromString = VSC.fromList
+#endif
 
 main :: IO ()
 main = hspec $ do
@@ -141,6 +149,27 @@ main = hspec $ do
         prop "works on lists" $ \(Positive i) j ->
             ocompareLength (replicate i () :: [()]) j @?= compare i j
 
+    describe "groupBy" $ do
+        let test name dummy = prop name $ \xs (Fn2 g) -> do
+                let seq' = fromListAs xs dummy
+                let listDef f = Prelude.fmap fromList . List.groupBy f . otoList
+                groupBy (==) seq' @?= listDef (==) seq'
+                groupBy (/=) seq' @?= listDef (/=) seq'
+                groupBy (<) seq' @?= listDef (<) seq'
+                groupBy (>) seq' @?= listDef (>) seq'
+                groupBy g seq' @?= listDef g seq'
+        test "works on lists" ([] :: [Char])
+        test "works on texts" ("" :: Text)
+        test "works on strict bytestrings" S.empty
+        test "works on lazy bytestrings" L.empty
+        test "works on Vector" (V.singleton ('a' :: Char))
+        test "works on SVector" (VS.singleton ('a' :: Char))
+#if MIN_VERSION_vector(0,13,2)
+        test "works on StrictVector" (VSC.singleton ('a' :: Char))
+#endif
+        test "works on UVector" (U.singleton ('a' :: Char))
+        test "works on Seq" (Seq.fromList ['a' :: Char])
+
     describe "groupAll" $ do
         it "works on lists" $ groupAll ("abcabcabc" :: String) @?= ["aaa", "bbb", "ccc"]
         it "works on texts" $ groupAll ("abcabcabc" :: Text)   @?= ["aaa", "bbb", "ccc"]
@@ -176,6 +205,9 @@ main = hspec $ do
         test "works on lazy bytestrings" L.empty
         test "works on Vector" (V.singleton (1 :: Int))
         test "works on SVector" (VS.singleton (1 :: Int))
+#if MIN_VERSION_vector(0,13,2)
+        test "works on StrictVector" (VSC.singleton (1 :: Int))
+#endif
         test "works on UVector" (U.singleton (1 :: Int))
         test "works on Seq" (Seq.fromList [1 :: Int])
 
@@ -225,6 +257,9 @@ main = hspec $ do
         test "Vector" (mempty :: V.Vector Char)
         test "Unboxed Vector" (mempty :: U.Vector Char)
         test "Storable Vector" (mempty :: VS.Vector Char)
+#if MIN_VERSION_vector(0,13,2)
+        test "Strict Vector" (mempty :: VSC.Vector Char)
+#endif
 
     describe "tails" $ do
         let test typ emptyTyp = describe typ $ do
@@ -240,6 +275,9 @@ main = hspec $ do
         test "Vector" (mempty :: V.Vector Char)
         test "Unboxed Vector" (mempty :: U.Vector Char)
         test "Storable Vector" (mempty :: VS.Vector Char)
+#if MIN_VERSION_vector(0,13,2)
+        test "Strict Vector" (mempty :: VSC.Vector Char)
+#endif
 
     describe "initTails" $ do
         let test typ emptyTyp = describe typ $ do
@@ -255,6 +293,9 @@ main = hspec $ do
         test "Vector" (mempty :: V.Vector Char)
         test "Unboxed Vector" (mempty :: U.Vector Char)
         test "Storable Vector" (mempty :: VS.Vector Char)
+#if MIN_VERSION_vector(0,13,2)
+        test "Strict Vector" (mempty :: VSC.Vector Char)
+#endif
 
     describe "NonNull" $ do
         describe "fromNonEmpty" $ do
@@ -310,6 +351,9 @@ main = hspec $ do
         test "Vector" (V.empty :: V.Vector Int)
         test "Unboxed Vector" (U.empty :: U.Vector Int)
         test "Storable Vector" (VS.empty :: VS.Vector Int)
+#if MIN_VERSION_vector(0,13,2)
+        test "Strict Vector" (VSC.empty :: VSC.Vector Int)
+#endif
         test "List" ([5 :: Int])
 
     describe "Containers" $ do
@@ -467,6 +511,9 @@ main = hspec $ do
         test "Vector" (V.empty :: V.Vector Int)
         test "Storable Vector" (VS.empty :: VS.Vector Int)
         test "Unboxed Vector" (U.empty :: U.Vector Int)
+#if MIN_VERSION_vector(0,13,2)
+        test "Strict Vector" (VSC.empty :: VSC.Vector Int)
+#endif
         test "Strict ByteString" S.empty
         test "Lazy ByteString" L.empty
         test "Strict Text" T.empty
@@ -483,6 +530,9 @@ main = hspec $ do
         test "Vector" (V.empty :: V.Vector Int)
         test "Storable Vector" (VS.empty :: VS.Vector Int)
         test "Unboxed Vector" (U.empty :: U.Vector Int)
+#if MIN_VERSION_vector(0,13,2)
+        test "Strict Vector" (VSC.empty :: VSC.Vector Int)
+#endif
         test "Strict ByteString" S.empty
         test "Lazy ByteString" L.empty
         test "Strict Text" T.empty
@@ -498,6 +548,9 @@ main = hspec $ do
         test "Vector" (V.empty :: V.Vector Int)
         test "Storable Vector" (VS.empty :: VS.Vector Int)
         test "Unboxed Vector" (U.empty :: U.Vector Int)
+#if MIN_VERSION_vector(0,13,2)
+        test "Strict Vector" (VSC.empty :: VSC.Vector Int)
+#endif
         test "Strict ByteString" S.empty
         test "Lazy ByteString" L.empty
         test "Strict Text" T.empty
@@ -536,6 +589,9 @@ main = hspec $ do
         test "Vector" (V.empty :: V.Vector Int)
         test "Storable Vector" (VS.empty :: VS.Vector Int)
         test "Unboxed Vector" (U.empty :: U.Vector Int)
+#if MIN_VERSION_vector(0,13,2)
+        test "Strict Vector" (VSC.empty :: VSC.Vector Int)
+#endif
         test "Strict ByteString" S.empty
         test "Lazy ByteString" L.empty
         test "Strict Text" T.empty