diff --git a/changelog.md b/changelog.md index a0fa673..7d4de32 100644 --- a/changelog.md +++ b/changelog.md @@ -2,9 +2,12 @@ ## WIP +## [1.6.0] - 2022-01-22 + +- Add instances of `FunctorWithIndex`, `FoldableWithIndex` and + `TraversableWithIndex` for `Vector n a`. - Drop support for GHC older than 8.10 -- Safe construction of vectors from linked lists - - https://github.com/expipiplus1/vector-sized/pull/88 +- Safe construction of vectors from linked lists (https://github.com/expipiplus1/vector-sized/pull/88) Thanks to @sheaf and @kozross diff --git a/src/Data/Vector/Generic/Sized.hs b/src/Data/Vector/Generic/Sized.hs index 7be71d1..4035139 100755 --- a/src/Data/Vector/Generic/Sized.hs +++ b/src/Data/Vector/Generic/Sized.hs @@ -13,6 +13,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoStarIsType #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -285,12 +286,13 @@ import Prelude zip3, unzip, unzip3, elem, notElem, foldl, foldl1, foldr, foldr1, all, any, and, or, sum, product, maximum, minimum, scanl, scanl1, scanr, scanr1, mapM, mapM_, sequence, sequence_) - - import Data.IndexedListLiterals hiding (toList, fromList) import Data.Hashable (Hashable(..)) import qualified Data.IndexedListLiterals as ILL import Data.Vector.Unboxed (Unbox) +import qualified Data.Traversable.WithIndex as ITraversable +import qualified Data.Foldable.WithIndex as IFoldable +import qualified Data.Functor.WithIndex as IFunctor instance (KnownNat n, VG.Vector v a, Read (v a)) => Read (Vector v n a) where readPrec = parens $ prec 10 $ do @@ -651,15 +653,23 @@ singleton a = Vector (VG.singleton a) -- fromTuple (1,2) :: Vector v 2 Int -- fromTuple ("hey", "what's", "going", "on") :: Vector v 4 String -- @ +-- +-- @since 1.6.0 fromTuple :: forall v a input length. (VG.Vector v a, IndexedListLiterals input length a, KnownNat length) => input -> Vector v length a fromTuple = Vector . VG.fromListN (fromIntegral $ natVal $ Proxy @length) . ILL.toList infixr 5 :< + +-- | @since 1.6.0 data BuildVector (n :: Nat) a where + -- | @since 1.6.0 Nil :: BuildVector 0 a + -- | @since 1.6.0 (:<) :: a -> BuildVector n a -> BuildVector (1 + n) a + +-- | @since 1.6.0 deriving instance Show a => Show (BuildVector n a) -- | /O(n)/ Construct a vector in a type-safe manner using a sized linked list. @@ -668,6 +678,8 @@ deriving instance Show a => Show (BuildVector n a) -- Build ("not" :< "much" :< Nil) :: Vector v 2 String -- @ -- Can also be used as a pattern. +-- +-- @since 1.6.0 pattern Build :: VG.Vector v a => BuildVector n a -> Vector v n a pattern Build build <- ( ( \ ( Vector v ) -> unsafeCoerce $ VG.toList v ) -> build ) where @@ -2027,3 +2039,27 @@ instance (VG.Vector v a, Bits (v a), Bits a, KnownNat n) => Bits (Vector v n a) instance (VG.Vector v a, Bits (v a), FiniteBits a, KnownNat n) => FiniteBits (Vector v n a) where finiteBitSize _ = finiteBitSize @a undefined * fromIntegral (natVal (Proxy @n)) +-- | @since 1.6.0 +instance IFunctor.FunctorWithIndex (Finite n) (Vector Boxed.Vector n) where + {-# INLINEABLE imap #-} + imap = imap + +-- | @since 1.6.0 +instance IFoldable.FoldableWithIndex (Finite n) (Vector Boxed.Vector n) where + {-# INLINEABLE ifoldMap #-} + ifoldMap f = ifoldl (\acc ix x -> acc `mappend` f ix x) mempty + {-# INLINEABLE ifoldMap' #-} + ifoldMap' f = ifoldl' (\acc ix x -> acc `mappend` f ix x) mempty + {-# INLINEABLE ifoldr #-} + ifoldr = ifoldr + {-# INLINEABLE ifoldl #-} + ifoldl f x = ifoldl (\acc ix -> f ix acc) x + {-# INLINEABLE ifoldr' #-} + ifoldr' = ifoldr' + {-# INLINEABLE ifoldl' #-} + ifoldl' f x = ifoldl' (\acc ix -> f ix acc) x + +-- | @since 1.6.0 +instance ITraversable.TraversableWithIndex (Finite n) (Vector Boxed.Vector n) where + {-# INLINEABLE itraverse #-} + itraverse f = traverse (uncurry f) . indexed diff --git a/src/Data/Vector/Sized.hs b/src/Data/Vector/Sized.hs index 54d9b67..cbacf4f 100644 --- a/src/Data/Vector/Sized.hs +++ b/src/Data/Vector/Sized.hs @@ -490,6 +490,8 @@ singleton = V.singleton -- fromTuple (1,2) :: Vector 2 Int -- fromTuple ("hey", "what's", "going", "on") :: Vector 4 String -- @ +-- +-- @since 1.6.0 fromTuple :: forall input length ty. (IndexedListLiterals input length ty, KnownNat length) => input -> Vector length ty @@ -501,6 +503,8 @@ fromTuple = V.fromTuple -- Build ("not" :< "much" :< Nil) :: Vector 2 String -- @ -- Can also be used as a pattern. +-- +-- @since 1.6.0 pattern Build :: V.BuildVector n a -> Vector n a pattern Build build = V.Build build diff --git a/src/Data/Vector/Storable/Sized.hs b/src/Data/Vector/Storable/Sized.hs index 848b1a2..01898a6 100644 --- a/src/Data/Vector/Storable/Sized.hs +++ b/src/Data/Vector/Storable/Sized.hs @@ -497,6 +497,8 @@ singleton = V.singleton -- fromTuple (1,2) :: Vector 2 Int -- fromTuple ("hey", "what's", "going", "on") :: Vector 4 String -- @ +-- +-- @since 1.6.0 fromTuple :: forall a input length. (Storable a, IndexedListLiterals input length a, KnownNat length) => input -> Vector length a @@ -509,6 +511,8 @@ fromTuple = V.fromTuple -- Build ("not" :< "much" :< Nil) :: Vector 2 String -- @ -- Can also be used as a pattern. +-- +-- @since 1.6.0 pattern Build :: Storable a => V.BuildVector n a -> Vector n a pattern Build vec = V.Build vec diff --git a/src/Data/Vector/Unboxed/Sized.hs b/src/Data/Vector/Unboxed/Sized.hs index 8bf4f3f..218e620 100644 --- a/src/Data/Vector/Unboxed/Sized.hs +++ b/src/Data/Vector/Unboxed/Sized.hs @@ -498,6 +498,8 @@ singleton = V.singleton -- fromTuple (1,2) :: Vector 2 Int -- fromTuple ("hey", "what's", "going", "on") :: Vector 4 String -- @ +-- +-- @since 1.6.0 fromTuple :: forall a input length. (Unbox a, IndexedListLiterals input length a, KnownNat length) => input -> Vector length a @@ -510,6 +512,8 @@ fromTuple = V.fromTuple -- Build ("not" :< "much" :< Nil) :: Vector 2 String -- @ -- Can also be used as a pattern. +-- +-- @since 1.6.0 pattern Build :: Unbox a => V.BuildVector n a -> Vector n a pattern Build vec = V.Build vec diff --git a/stack.yaml b/stack.yaml index 8e32cdf..3b7d6db 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,3 +1,6 @@ resolver: lts-18.22 packages: - '.' + +extra-deps: + - indexed-traversable-0.1.2@sha256:d66228887242f93ccb4fc7101a1e25a6560c8e4708f6e9ee1d3dd21901756c65,2519 diff --git a/vector-sized.cabal b/vector-sized.cabal index 12e3444..62b29c8 100644 --- a/vector-sized.cabal +++ b/vector-sized.cabal @@ -1,13 +1,6 @@ -cabal-version: 1.12 - --- This file has been generated from package.yaml by hpack version 0.34.4. --- --- see: https://github.com/sol/hpack --- --- hash: 8cc33c7ff1b35236dcaed143ba951337eb4f12e3c53c616fa15ec2a073c0942b - +cabal-version: 3.0 name: vector-sized -version: 1.5.0 +version: 1.6.0 synopsis: Size tagged vectors description: Please see README.md category: Data @@ -16,7 +9,7 @@ bug-reports: https://github.com/expipiplus1/vector-sized/issues author: Ellie Hermaszewska maintainer: whats.our.vector.victor@monoid.al copyright: 2016 Ellie Hermaszewska -license: BSD3 +license: BSD-3-Clause license-file: LICENSE build-type: Simple tested-with: GHC ==8.10.7 || ==9.0.1 || ==9.2.1 @@ -43,8 +36,6 @@ library Data.Vector.Storable.Sized Data.Vector.Unboxed.Mutable.Sized Data.Vector.Unboxed.Sized - other-modules: - Paths_vector_sized hs-source-dirs: src build-depends: @@ -58,5 +49,6 @@ library , hashable >=1.2.4.0 , indexed-list-literals >=0.2.0.0 , primitive >=0.5 && <0.8 + , indexed-traversable >=0.1.2 && <0.2 , vector >=0.12 && <0.13 default-language: Haskell2010