diff --git a/mono-traversable/ChangeLog.md b/mono-traversable/ChangeLog.md index 2a4db776..5860e8e8 100644 --- a/mono-traversable/ChangeLog.md +++ b/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. diff --git a/mono-traversable/mono-traversable.cabal b/mono-traversable/mono-traversable.cabal index f2b53864..f4aa2448 100644 --- a/mono-traversable/mono-traversable.cabal +++ b/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 category: Data diff --git a/mono-traversable/package.yaml b/mono-traversable/package.yaml index e2af2aed..dea1509a 100644 --- a/mono-traversable/package.yaml +++ b/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 category: Data diff --git a/mono-traversable/src/Data/MonoTraversable.hs b/mono-traversable/src/Data/MonoTraversable.hs index 2093406f..ef579d69 100644 --- a/mono-traversable/src/Data/MonoTraversable.hs +++ b/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 diff --git a/mono-traversable/src/Data/Sequences.hs b/mono-traversable/src/Data/Sequences.hs index 2d82ee60..fd4eefd7 100644 --- a/mono-traversable/src/Data/Sequences.hs +++ b/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 diff --git a/mono-traversable/test/Main.hs b/mono-traversable/test/Main.hs index e862269f..87166598 100644 --- a/mono-traversable/test/Main.hs +++ b/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