Implement Applicative based API

vector-bench-papi/benchmarks/Main.hs

@@ -12,6 +12,8 @@ import Bench.Vector.Algo.Spectral   (spectral)
 import Bench.Vector.Algo.Tridiag    (tridiag)
 import Bench.Vector.Algo.FindIndexR (findIndexR, findIndexR_naive, findIndexR_manual)
 import Bench.Vector.Algo.NextPermutation (generatePermTests)
+import Bench.Vector.Algo.Applicative ( generateState, generateStateUnfold, generateIO, generateIOPrim
+                                     , lensSum, lensMap, baselineSum, baselineMap)
 
 import Bench.Vector.TestData.ParenTree (parenTree)
 import Bench.Vector.TestData.Graph     (randomGraph)
@@ -68,4 +70,14 @@ main = do
     , bench "minimumOn"  $ whnf (U.minimumOn (\x -> x*x*x)) as
     , bench "maximumOn"  $ whnf (U.maximumOn (\x -> x*x*x)) as
     , bgroup "(next|prev)Permutation" $ map (\(name, act) -> bench name $ whnfIO act) permTests
+    , bgroup "Applicative"
+      [ bench "generateState"       $ whnf generateState useSize
+      , bench "generateStateUnfold" $ whnf generateStateUnfold useSize
+      , bench "generateIO"     $ whnfIO (generateIO useSize)
+      , bench "generateIOPrim" $ whnfIO (generateIOPrim useSize)
+      , bench "sum[lens]"      $ whnf lensSum as
+      , bench "sum[base]"      $ whnf baselineSum as
+      , bench "map[lens]"      $ whnf lensMap as
+      , bench "map[base]"      $ whnf baselineMap as
+      ]
     ]

vector/benchlib/Bench/Vector/Algo/Applicative.hs

@@ -0,0 +1,101 @@
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+-- |
+-- This module provides benchmarks for functions which use API based
+-- on applicative. We use @generateA@ based benchmark for state and IO
+-- and also benchmark folds and mapping using lens since it's one of
+-- important consumers of this API.
+module Bench.Vector.Algo.Applicative
+  ( -- * Standard benchmarks
+    generateState
+  , generateStateUnfold
+  , generateIO
+  , generateIOPrim
+    -- * Lens benchmarks
+  , lensSum
+  , baselineSum
+  , lensMap
+  , baselineMap
+  ) where
+
+import Control.Applicative
+import Data.Coerce
+import Data.Functor.Identity
+import Data.Int
+import Data.Monoid
+import Data.Word
+import qualified Data.Vector.Generic as VG
+import qualified Data.Vector.Generic.Mutable as MVG
+import qualified Data.Vector.Unboxed as VU
+import System.Random.Stateful
+import System.Mem (getAllocationCounter)
+
+-- | Benchmark which is running in state monad.
+generateState :: Int -> VU.Vector Word64
+generateState n
+  = runStateGen_ (mkStdGen 42)
+  $ \g -> VG.generateA n (\_ -> uniformM g)
+
+-- | Benchmark which is running in state monad.
+generateStateUnfold :: Int -> VU.Vector Word64
+generateStateUnfold n = VU.unfoldrExactN n genWord64 (mkStdGen 42) 
+
+-- | Benchmark for running @generateA@ in IO monad.
+generateIO :: Int -> IO (VU.Vector Int64)
+generateIO n = VG.generateA n (\_ -> getAllocationCounter)
+
+-- | Baseline for 'generateIO' it uses primitive operations
+generateIOPrim :: Int -> IO (VU.Vector Int64)
+generateIOPrim n = VG.unsafeFreeze =<< MVG.replicateM n getAllocationCounter
+
+-- | Sum using lens
+lensSum :: VU.Vector Double -> Double
+{-# NOINLINE lensSum #-}
+lensSum = foldlOf' VG.traverse (+) 0 
+
+-- | Baseline for sum.
+baselineSum :: VU.Vector Double -> Double
+{-# NOINLINE baselineSum #-}
+baselineSum = VU.sum
+
+-- | Mapping over vector elements using 
+lensMap :: VU.Vector Double -> VU.Vector Double
+{-# NOINLINE lensMap #-}
+lensMap = over VG.traverse (*2)
+
+-- | Baseline for map
+baselineMap :: VU.Vector Double -> VU.Vector Double
+{-# NOINLINE baselineMap #-}
+baselineMap = VU.map (*2)
+
+----------------------------------------------------------------
+-- Bits and pieces of lens
+--
+-- We don't want to depend on lens so we just copy relevant
+-- parts. After all we don't need much
+----------------------------------------------------------------
+
+type ASetter s t a b = (a -> Identity b) -> s -> Identity t
+type Getting r s a = (a -> Const r a) -> s -> Const r s
+
+foldlOf' :: Getting (Endo (Endo r)) s a -> (r -> a -> r) -> r -> s -> r
+foldlOf' l f z0 = \xs ->
+  let f' x (Endo k) = Endo $ \z -> k $! f z x
+  in foldrOf l f' (Endo id) xs `appEndo` z0
+{-# INLINE foldlOf' #-}
+
+foldrOf :: Getting (Endo r) s a -> (a -> r -> r) -> r -> s -> r
+foldrOf l f z = flip appEndo z . foldMapOf l (Endo #. f)
+{-# INLINE foldrOf #-}
+
+foldMapOf :: Getting r s a -> (a -> r) -> s -> r
+foldMapOf = coerce
+{-# INLINE foldMapOf #-}
+
+( #. ) :: Coercible c b => (b -> c) -> (a -> b) -> (a -> c)
+( #. ) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b
+{-# INLINE (#.) #-}
+
+over :: ASetter s t a b -> (a -> b) -> s -> t
+over = coerce
+{-# INLINE over #-}

vector/benchmarks/Main.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE BangPatterns #-}
 module Main where
 
+
 import Bench.Vector.Algo.MutableSet      (mutableSet)
 import Bench.Vector.Algo.ListRank        (listRank)
 import Bench.Vector.Algo.Rootfix         (rootfix)
@@ -12,6 +13,8 @@ import Bench.Vector.Algo.Spectral        (spectral)
 import Bench.Vector.Algo.Tridiag         (tridiag)
 import Bench.Vector.Algo.FindIndexR      (findIndexR, findIndexR_naive, findIndexR_manual)
 import Bench.Vector.Algo.NextPermutation (generatePermTests)
+import Bench.Vector.Algo.Applicative ( generateState, generateStateUnfold, generateIO, generateIOPrim
+                                     , lensSum, lensMap, baselineSum, baselineMap)
 
 import Bench.Vector.TestData.ParenTree (parenTree)
 import Bench.Vector.TestData.Graph     (randomGraph)
@@ -69,4 +72,14 @@ main = do
     , bench "minimumOn"  $ whnf (U.minimumOn (\x -> x*x*x)) as
     , bench "maximumOn"  $ whnf (U.maximumOn (\x -> x*x*x)) as
     , bgroup "(next|prev)Permutation" $ map (\(name, act) -> bench name $ whnfIO act) permTests
+    , bgroup "Applicative"
+      [ bench "generateState"       $ whnf generateState useSize
+      , bench "generateStateUnfold" $ whnf generateStateUnfold useSize
+      , bench "generateIO"     $ whnfIO (generateIO useSize)
+      , bench "generateIOPrim" $ whnfIO (generateIOPrim useSize)
+      , bench "sum[lens]"      $ whnf lensSum as
+      , bench "sum[base]"      $ whnf baselineSum as
+      , bench "map[lens]"      $ whnf lensMap as
+      , bench "map[base]"      $ whnf baselineMap as
+      ]
     ]

vector/changelog.md

@@ -1,3 +1,11 @@
+# Changes in version NEXT_VERSION
+
+ * [#522](https://github.com/haskell/vector/pull/522) API using Applicatives
+   added: `traverse` & friends.
+   * [#518](https://github.com/haskell/vector/pull/518) `UnboxViaStorable` added.
+   Vector constructors are reexported for `DoNotUnbox*`.
+ * [#531](https://github.com/haskell/vector/pull/531) `iconcatMap` added.
+
 # Changes in version 0.13.2.0
 
  * Strict boxed vector `Data.Vector.Strict` and `Data.Vector.Strict.Mutable` is

vector/src/Data/Vector.hs

@@ -156,6 +156,10 @@ module Data.Vector (
   scanr, scanr', scanr1, scanr1',
   iscanr, iscanr',
 
+  -- * Applicative API
+  replicateA, generateA, traverse, itraverse, forA, iforA,
+  traverse_, itraverse_, forA_, iforA_,
+
   -- ** Comparisons
   eqBy, cmpBy,
 
@@ -174,6 +178,7 @@ module Data.Vector (
   freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy
 ) where
 
+import Control.Applicative (Applicative)
 import Data.Vector.Mutable  ( MVector(..) )
 import Data.Primitive.Array
 import qualified Data.Vector.Fusion.Bundle as Bundle
@@ -453,12 +458,7 @@ instance Foldable.Foldable Vector where
 
 instance Traversable.Traversable Vector where
   {-# INLINE traverse #-}
-  traverse f xs =
-      -- Get the length of the vector in /O(1)/ time
-      let !n = G.length xs
-      -- Use fromListN to be more efficient in construction of resulting vector
-      -- Also behaves better with compact regions, preventing runtime exceptions
-      in  Data.Vector.fromListN n Applicative.<$> Traversable.traverse f (toList xs)
+  traverse = traverse
 
   {-# INLINE mapM #-}
   mapM = mapM
@@ -2205,6 +2205,97 @@ fromListN :: Int -> [a] -> Vector a
 {-# INLINE fromListN #-}
 fromListN = G.fromListN
 
+-- Applicative
+-- -----------
+
+-- | Construct a vector of the given length by applying the applicative
+-- action to each index.
+--
+-- @since NEXT_VERSION
+generateA :: (Applicative f) => Int -> (Int -> f a) -> f (Vector a)
+generateA = G.generateA
+
+-- | Execute the applicative action the given number of times and store the
+-- results in a vector.
+--
+-- @since NEXT_VERSION
+replicateA :: (Applicative f) => Int -> f a -> f (Vector a)
+{-# INLINE replicateA #-}
+replicateA = G.replicateA
+
+-- | Apply the applicative action to all elements of the vector, yielding a
+-- vector of results.
+--
+-- @since NEXT_VERSION
+traverse :: (Applicative f)
+         => (a -> f b) -> Vector a -> f (Vector b)
+{-# INLINE traverse #-}
+traverse = G.traverse
+
+-- | Apply the applicative action to every element of a vector and its
+-- index, yielding a vector of results.
+--
+-- @since NEXT_VERSION
+itraverse :: (Applicative f)
+          => (Int -> a -> f b) -> Vector a -> f (Vector b)
+{-# INLINE itraverse #-}
+itraverse = G.itraverse
+
+-- | Apply the applicative action to all elements of the vector, yielding a
+-- vector of results. This is flipped version of 'traverse'.
+--
+-- @since NEXT_VERSION
+forA :: (Applicative f)
+     => Vector a -> (a -> f b) -> f (Vector b)
+{-# INLINE forA #-}
+forA = G.forA
+
+-- | Apply the applicative action to every element of a vector and its
+--   index, yielding a vector of results. This is flipped version of 'itraverse'.
+--
+-- @since NEXT_VERSION
+iforA :: (Applicative f)
+      => Vector a -> (Int -> a -> f b) -> f (Vector b)
+{-# INLINE iforA #-}
+iforA = G.iforA
+
+-- | Map each element of a structure to an 'Applicative' action, evaluate these
+--   actions from left to right, and ignore the results.
+--
+-- @since NEXT_VERSION
+traverse_ :: (Applicative f)
+          => (a -> f b) -> Vector a -> f ()
+{-# INLINE traverse_ #-}
+traverse_ = G.traverse_
+
+-- | Map each element of a structure to an 'Applicative' action, evaluate these
+--   actions from left to right, and ignore the results.
+--
+-- @since NEXT_VERSION
+itraverse_ :: (Applicative f)
+           => (Int -> a -> f b) -> Vector a -> f ()
+{-# INLINE itraverse_ #-}
+itraverse_ = G.itraverse_
+
+-- | Map each element of a structure to an 'Applicative' action, evaluate these
+--   actions from left to right, and ignore the results.
+--
+-- @since NEXT_VERSION
+forA_ :: (Applicative f)
+      => Vector a -> (a -> f b) -> f ()
+{-# INLINE forA_ #-}
+forA_ = G.forA_
+
+-- | Map each element of a structure to an 'Applicative' action, evaluate these
+--   actions from left to right, and ignore the results.
+--
+-- @since NEXT_VERSION
+iforA_ :: (Applicative f)
+      => Vector a -> (Int -> a -> f b) -> f ()
+{-# INLINE iforA_ #-}
+iforA_ = G.iforA_
+
+
 -- Conversions - Arrays
 -- -----------------------------