{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE Trustworthy #-}
-- |
-- Module       : Data.Vector.NonEmpty
-- Copyright 	: (c) 2019-2020 Emily Pillmore
-- License	: BSD-style
--
-- Maintainer	: Emily Pillmore <emilypi@cohomolo.gy>
-- Stability	: Experimental
-- Portability	: DataTypeable, CPP
--
-- A library for non-empty boxed vectors (that is, polymorphic arrays capable of
-- holding any Haskell value). Non-empty vectors come in two flavors:
--
--  * mutable
--
--  * immutable
--
-- This library attempts to provide support for all standard 'Vector' operations
-- in the API, with some slight variation in types and implementation. For example,
-- since 'head' and 'foldr' are always gauranteed to be over a non-empty 'Vector',
-- it is safe to make use of the 'unsafe-*' 'Vector' operations and semigroupal
-- folds available in the API in lieu of the standard implementations.
--
-- In contrast, some operations such as 'filter' may "break out" of a 'NonEmptyVector'
-- due to the fact that there are no guarantees that may be made on the types of
-- 'Bool'-valued functions passed in, hence one could write the following:
--
-- @
-- filter (const false) v
-- @
--
-- which always produces an empty vector. Thus, some operations must return either
-- a 'Maybe' containing a 'NonEmptyVector' or a 'Vector' whenever appropriate. Generally
-- The former is used in initialization and generation operations, and the latter
-- is used in iterative operations where the intent is not to create an instance
-- of 'NonEmptyVector'.
--
-- Credit to Roman Leshchinskiy for the original Vector library  upon which this is based.
--
module Data.Vector.NonEmpty
( -- * Boxed non-empty vectors
  NonEmptyVector

  -- * Accessors

  -- ** Length information
, length

  -- ** Indexing
, head, last, (!), (!?)
, unsafeIndex

  -- ** Monadic Indexing
, headM, lastM, indexM, unsafeIndexM

  -- ** Extracting subvectors (slicing)
, tail, slice, init, take, drop
, uncons, unsnoc, splitAt
, unsafeSlice, unsafeTake, unsafeDrop

  -- * Construction

  -- ** Initialization
, singleton
, replicate, replicate1
, generate, generate1
, iterateN, iterateN1

  -- ** Monad Initialization
, replicateM, replicate1M
, generateM, generate1M
, iterateNM, iterateN1M
, create, unsafeCreate
, createT, unsafeCreateT

  -- ** Unfolding
, unfoldr, unfoldr1
, unfoldrN, unfoldr1N
, unfoldrM, unfoldr1M
, unfoldrNM, unfoldr1NM
, constructN, constructrN

  -- ** Enumeration
, enumFromN, enumFromN1
, enumFromStepN, enumFromStepN1
, enumFromTo, enumFromThenTo

  -- ** Concatenation
, cons, consV, snoc, snocV, (++), concat, concat1

  -- ** Restricting memory usage
, force

  -- * Conversion

  -- ** To/from non-empty lists
, toNonEmpty, fromNonEmpty
, fromNonEmptyN, fromNonEmptyN1
, unsafeFromList

  -- ** To/from vector
, toVector, fromVector, unsafeFromVector

  -- ** To/from list
, toList, fromList, fromListN

  -- * Modifying non-empty vectors

  -- ** Bulk Updates
, (//), update, update_
, unsafeUpd, unsafeUpdate, unsafeUpdate_

  -- * Accumulations
, accum, accumulate, accumulate_
, unsafeAccum, unsafeAccumulate, unsafeAccumulate_

  -- * Permutations
, reverse, backpermute, unsafeBackpermute

  -- * Safe destructive updates
, modify

  -- * Elementwise operations

  -- ** Indexing
, indexed

  -- ** Mapping
, map, imap, concatMap

  -- ** Monadic mapping
, mapM, imapM, mapM_, imapM_
, forM, forM_

  -- ** Zipping
, zipWith, zipWith3, zipWith4, zipWith5, zipWith6
, izipWith, izipWith3, izipWith4, izipWith5, izipWith6
, zip, zip3, zip4, zip5, zip6

  -- ** Monadic Zipping
, zipWithM, zipWithM_, izipWithM, izipWithM_

  -- ** Unzipping
, unzip, unzip3, unzip4, unzip5, unzip6

  -- * Working with predicates

  -- ** Filtering
, uniq, mapMaybe, imapMaybe
, filter, ifilter, filterM, ifilterM
, takeWhile, dropWhile

  -- * Partitioning
, partition, unstablePartition, span, break

  -- * Searching
, elem, notElem, find, findIndex, findIndices, elemIndex
, elemIndices

  -- * Folding
, foldl, foldl1, foldl', foldl1'
, foldr, foldr1, foldr', foldr1'
, ifoldl, ifoldl', ifoldr, ifoldr'

  -- * Specialized folds
, all, any, and, or, sum, product
, maximum, maximumBy, minimum, minimumBy
, maxIndex, maxIndexBy, minIndex, minIndexBy

  -- * Monadic Folds
, foldM, foldM', fold1M, fold1M', foldM_, foldM'_, fold1M_
, fold1M'_, ifoldM, ifoldM', ifoldM_, ifoldM'_

  -- * Monadic Sequencing
, sequence, sequence_

  -- * Prefix sums (scans)
, prescanl, prescanl', postscanl, postscanl'
, scanl, scanl', scanl1, scanl1', iscanl, iscanl'
, prescanr, prescanr', postscanr, postscanr'
, scanr, scanr', scanr1, scanr1', iscanr, iscanr'
) where


import Prelude ( Bool, Eq, Ord, Num, Enum
               , (.), Ordering, max, uncurry, snd)

import Control.Monad (Monad)
import Control.Monad.ST

import qualified Data.Foldable as Foldable
import Data.Functor
import Data.Int
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Maybe (Maybe(..))
import Data.Semigroup (Semigroup(..), (<>))
import Data.Traversable (Traversable)
import Data.Vector (Vector)
import qualified Data.Vector as V
import qualified Data.Vector.Generic as G
import Data.Vector.Mutable (MVector)
import Data.Vector.NonEmpty.Internal


-- $setup
-- >>> import Prelude (Int, String, ($), (.), (+), (<), const, return)
-- >>> import Data.Bool
-- >>> import Data.Eq
-- >>> import qualified Prelude as P
-- >>> import qualified Data.Vector as V
-- >>> import Data.List.NonEmpty (NonEmpty(..))
-- >>> import qualified Data.List.NonEmpty as NEL
-- >>> :set -XTypeApplications
-- >>> :set -XScopedTypeVariables

-- ---------------------------------------------------------------------- --
-- Accessors + Indexing

-- | /O(1)/ Length.
--
-- >>> length $ unsafeFromList [1..10]
-- 10
--
length :: NonEmptyVector a -> Int
length :: NonEmptyVector a -> Int
length = Vector a -> Int
forall a. Vector a -> Int
V.length (Vector a -> Int)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE length #-}

-- | /O(1)/ First element. Since head is gauranteed, bounds checks
-- are bypassed by deferring to 'unsafeHead'.
--
--
-- >>> head $ unsafeFromList [1..10]
-- 1
--
head :: NonEmptyVector a -> a
head :: NonEmptyVector a -> a
head = Vector a -> a
forall a. Vector a -> a
V.unsafeHead (Vector a -> a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE head #-}

-- | /O(1)/ Last element. Since a last element is gauranteed, bounds checks
-- are bypassed by deferring to 'unsafeLast'.
--
--
-- >>> last $ unsafeFromList [1..10]
-- 10
--
last :: NonEmptyVector a -> a
last :: NonEmptyVector a -> a
last = Vector a -> a
forall a. Vector a -> a
V.unsafeLast (Vector a -> a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE last #-}

-- | /O(1)/ Indexing.
--
--
-- >>> (unsafeFromList [1..10]) ! 0
-- 1
--
(!) :: NonEmptyVector a -> Int -> a
(!) (NonEmptyVector Vector a
as) Int
n = Vector a
as Vector a -> Int -> a
forall a. Vector a -> Int -> a
V.! Int
n
{-# INLINE (!) #-}

-- | /O(1)/ Safe indexing.
--
--
-- >>> (unsafeFromList [1..10]) !? 0
-- Just 1
--
-- >>> (unsafeFromList [1..10]) !? 11
-- Nothing
--
(!?) :: NonEmptyVector a -> Int -> Maybe a
(NonEmptyVector Vector a
as) !? :: NonEmptyVector a -> Int -> Maybe a
!? Int
n = Vector a
as Vector a -> Int -> Maybe a
forall a. Vector a -> Int -> Maybe a
V.!? Int
n
{-# INLINE (!?) #-}

-- | /O(1)/ Unsafe indexing without bounds checking
--
unsafeIndex :: NonEmptyVector a -> Int -> a
unsafeIndex :: NonEmptyVector a -> Int -> a
unsafeIndex (NonEmptyVector Vector a
as) Int
n = Vector a -> Int -> a
forall a. Vector a -> Int -> a
V.unsafeIndex Vector a
as Int
n
{-# INLINE unsafeIndex #-}

-- ---------------------------------------------------------------------- --
-- Monadic Indexing

-- | /O(1)/ Indexing in a monad.
--
-- The monad allows operations to be strict in the non-empty vector when
-- necessary.
--
-- See 'V.indexM' for more details
--
--
-- >>> indexM @[] (unsafeFromList [1..10]) 3
-- [4]
--
indexM :: Monad m => NonEmptyVector a -> Int -> m a
indexM :: NonEmptyVector a -> Int -> m a
indexM (NonEmptyVector Vector a
v) Int
n = Vector a -> Int -> m a
forall (m :: * -> *) a. Monad m => Vector a -> Int -> m a
V.indexM Vector a
v Int
n
{-# INLINE indexM #-}

-- | /O(1)/ First element of a non-empty vector in a monad.
--
-- See 'V.indexM' for an explanation of why this is useful.
--
-- Note that this function defers to 'unsafeHeadM' since head is
-- gauranteed to be safe by construction.
--
--
-- >>> headM @[] (unsafeFromList [1..10])
-- [1]
--
headM :: Monad m => NonEmptyVector a -> m a
headM :: NonEmptyVector a -> m a
headM (NonEmptyVector Vector a
v) = Vector a -> m a
forall (m :: * -> *) a. Monad m => Vector a -> m a
V.unsafeHeadM Vector a
v
{-# INLINE headM #-}

-- | /O(1)/ Last element of a non-empty vector in a monad. See 'V.indexM' for an
-- explanation of why this is useful.
--
-- Note that this function defers to 'unsafeHeadM' since a last element is
-- gauranteed.
--
--
-- >>> lastM @[] (unsafeFromList [1..10])
-- [10]
--
lastM :: Monad m => NonEmptyVector a -> m a
lastM :: NonEmptyVector a -> m a
lastM (NonEmptyVector Vector a
v) = Vector a -> m a
forall (m :: * -> *) a. Monad m => Vector a -> m a
V.unsafeLastM Vector a
v
{-# INLINE lastM #-}

-- | O(1) Indexing in a monad without bounds checks. See 'indexM' for an
-- explanation of why this is useful.
--
unsafeIndexM :: Monad m => NonEmptyVector a -> Int -> m a
unsafeIndexM :: NonEmptyVector a -> Int -> m a
unsafeIndexM (NonEmptyVector Vector a
v) Int
n = Vector a -> Int -> m a
forall (m :: * -> *) a. Monad m => Vector a -> Int -> m a
V.unsafeIndexM Vector a
v Int
n
{-# INLINE unsafeIndexM #-}

-- ---------------------------------------------------------------------- --
-- Extracting subvectors (slicing)

-- | /O(1)/ Yield all but the first element without copying. Since the
-- vector returned may be empty (i.e. input was a singleton), this function
-- returns a normal 'Vector'
--
--
-- >>> tail (unsafeFromList [1..10])
-- [2,3,4,5,6,7,8,9,10]
--
tail :: NonEmptyVector a -> Vector a
tail :: NonEmptyVector a -> Vector a
tail = Vector a -> Vector a
forall a. Vector a -> Vector a
V.unsafeTail (Vector a -> Vector a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE tail #-}

-- | /O(1)/ Yield a slice of a non-empty vector without copying at
-- the @0@th and @1@st indices.
--
--
-- >>> uncons (unsafeFromList [1..10])
-- (1,[2,3,4,5,6,7,8,9,10])
--
uncons :: NonEmptyVector a -> (a, Vector a)
uncons :: NonEmptyVector a -> (a, Vector a)
uncons NonEmptyVector a
v = (NonEmptyVector a -> a
forall a. NonEmptyVector a -> a
head NonEmptyVector a
v, NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
tail NonEmptyVector a
v)
{-# INLINE uncons #-}

-- | /O(1)/ Yield a slice of a non-empty vector without copying at
-- the @n-1@th and @nth@ indices
--
--
-- >>> unsnoc (unsafeFromList [1..10])
-- ([1,2,3,4,5,6,7,8,9],10)
--
unsnoc :: NonEmptyVector a -> (Vector a, a)
unsnoc :: NonEmptyVector a -> (Vector a, a)
unsnoc NonEmptyVector a
v = (NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
init NonEmptyVector a
v, NonEmptyVector a -> a
forall a. NonEmptyVector a -> a
last NonEmptyVector a
v)
{-# INLINE unsnoc #-}

-- | /O(1)/ Yield a slice of the non-empty vector without copying it.
-- The vector must contain at least i+n elements. Because this is not
-- guaranteed, this function returns a 'Vector' which could be empty
--
--
-- >>> slice 0 3 (unsafeFromList [1..10])
-- [1,2,3]
--
slice :: Int -> Int -> NonEmptyVector a -> Vector a
slice :: Int -> Int -> NonEmptyVector a -> Vector a
slice Int
i Int
n = Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
i Int
n (Vector a -> Vector a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE slice #-}

-- | /O(1)/ Yield all but the last element without copying. Since the
-- vector returned may be empty (i.e. input was a singleton), this function
-- returns a normal 'Vector'
--
--
-- >>> init (unsafeFromList [1..3])
-- [1,2]
--
init :: NonEmptyVector a -> Vector a
init :: NonEmptyVector a -> Vector a
init = Vector a -> Vector a
forall a. Vector a -> Vector a
V.unsafeInit (Vector a -> Vector a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE init #-}

-- | /O(1)/ Yield at the first n elements without copying. The non-empty vector may
-- contain less than n elements in which case it is returned as a vector unchanged.
--
--
-- >>> take 2 (unsafeFromList [1..3])
-- [1,2]
--
take :: Int -> NonEmptyVector a -> Vector a
take :: Int -> NonEmptyVector a -> Vector a
take Int
n = Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.take Int
n (Vector a -> Vector a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE take #-}

-- | /O(1)/ Yield all but the first n elements without copying. The non-empty vector
-- may contain less than n elements in which case an empty vector is returned.
--
--
-- >>> drop 2 (unsafeFromList [1..3])
-- [3]
--
drop :: Int -> NonEmptyVector a -> Vector a
drop :: Int -> NonEmptyVector a -> Vector a
drop Int
n = Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.drop Int
n (Vector a -> Vector a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE drop #-}

-- | /O(1)/ Yield the first n elements paired with the remainder without copying.
--
-- This function returns a pair of vectors, as one may slice a (0, n+1).
--
--
-- >>> splitAt 2 (unsafeFromList [1..3])
-- ([1,2],[3])
--
splitAt :: Int -> NonEmptyVector a -> (Vector a, Vector a)
splitAt :: Int -> NonEmptyVector a -> (Vector a, Vector a)
splitAt Int
n = Int -> Vector a -> (Vector a, Vector a)
forall a. Int -> Vector a -> (Vector a, Vector a)
V.splitAt Int
n (Vector a -> (Vector a, Vector a))
-> (NonEmptyVector a -> Vector a)
-> NonEmptyVector a
-> (Vector a, Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE splitAt #-}

-- | /O(1)/ Yield a slice of the vector without copying. The vector must contain at
-- least i+n elements but this is not checked.
--
unsafeSlice :: Int -> Int -> NonEmptyVector a -> Vector a
unsafeSlice :: Int -> Int -> NonEmptyVector a -> Vector a
unsafeSlice Int
i Int
n = Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
i Int
n (Vector a -> Vector a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE unsafeSlice #-}

-- | /O(1)/ Yield the first n elements without copying. The vector must contain at
-- least n elements but this is not checked.
--
unsafeTake :: Int -> NonEmptyVector a -> Vector a
unsafeTake :: Int -> NonEmptyVector a -> Vector a
unsafeTake Int
n = Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.unsafeTake Int
n (Vector a -> Vector a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE unsafeTake #-}

-- | /O(1)/ Yield all but the first n elements without copying. The vector must contain
-- at least n elements but this is not checked.
--
unsafeDrop :: Int -> NonEmptyVector a -> Vector a
unsafeDrop :: Int -> NonEmptyVector a -> Vector a
unsafeDrop Int
n = Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.unsafeDrop Int
n (Vector a -> Vector a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE unsafeDrop #-}

-- ---------------------------------------------------------------------- --
-- Construction

-- | /O(1)/ Non-empty vector with exactly one element
--
--
-- >>> singleton "a"
-- ["a"]
--
singleton :: a -> NonEmptyVector a
singleton :: a -> NonEmptyVector a
singleton = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> NonEmptyVector a)
-> (a -> Vector a) -> a -> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Vector a
forall a. a -> Vector a
V.singleton
{-# INLINE singleton #-}

-- | /O(n)/ Non-empty vector of the given length with the same value in
-- each position.
--
-- When given a index n <= 0, then 'Nothing' is returned, otherwise 'Just'.
--
--
-- >>> replicate 3 "a"
-- Just ["a","a","a"]
--
-- >>> replicate 0 "a"
-- Nothing
--
replicate :: Int -> a -> Maybe (NonEmptyVector a)
replicate :: Int -> a -> Maybe (NonEmptyVector a)
replicate Int
n a
a = Vector a -> Maybe (NonEmptyVector a)
forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (Int -> a -> Vector a
forall a. Int -> a -> Vector a
V.replicate Int
n a
a)
{-# INLINE replicate #-}

-- | /O(n)/ Non-empty vector of the given length with the same value in
-- each position.
--
-- This variant takes @max n 1@ for the supplied length parameter.
--
--
-- >>> replicate1 3 "a"
-- ["a","a","a"]
--
-- >>> replicate1 0 "a"
-- ["a"]
--
-- >>> replicate1 (-1) "a"
-- ["a"]
--
replicate1 :: Int -> a -> NonEmptyVector a
replicate1 :: Int -> a -> NonEmptyVector a
replicate1 Int
n a
a = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
unsafeFromVector (Int -> a -> Vector a
forall a. Int -> a -> Vector a
V.replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
1) a
a)
{-# INLINE replicate1 #-}

-- | /O(n)/ Construct a vector of the given length by applying the function to
-- each index.
--
-- When given a index n <= 0, then 'Nothing' is returned, otherwise 'Just'.
--
--
-- >>> let f 0 = "a"; f _ = "k"; f :: Int -> String
--
-- >>> generate 1 f
-- Just ["a"]
--
-- >>> generate 0 f
-- Nothing
--
-- >>> generate 2 f
-- Just ["a","k"]
--
generate :: Int -> (Int -> a) -> Maybe (NonEmptyVector a)
generate :: Int -> (Int -> a) -> Maybe (NonEmptyVector a)
generate Int
n Int -> a
f = Vector a -> Maybe (NonEmptyVector a)
forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (Int -> (Int -> a) -> Vector a
forall a. Int -> (Int -> a) -> Vector a
V.generate Int
n Int -> a
f)
{-# INLINE generate #-}

-- | /O(n)/ Construct a vector of the given length by applying the function to
-- each index.
--
-- This variant takes @max n 1@ for the supplied length parameter.
--
--
-- >>> let f 0 = "a"; f _ = "k"; f :: Int -> String
--
-- >>> generate1 2 f
-- ["a","k"]
--
-- >>> generate1 0 f
-- ["a"]
--
-- >>> generate1 (-1) f
-- ["a"]
--
generate1 :: Int -> (Int -> a) -> NonEmptyVector a
generate1 :: Int -> (Int -> a) -> NonEmptyVector a
generate1 Int
n Int -> a
f = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
unsafeFromVector (Int -> (Int -> a) -> Vector a
forall a. Int -> (Int -> a) -> Vector a
V.generate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
1) Int -> a
f)
{-# INLINE generate1 #-}

-- | /O(n)/ Apply function n times to value. Zeroth element is original value.
--
-- When given a index n <= 0, then 'Nothing' is returned, otherwise 'Just'.
--
-- >>> iterateN 3 (+1) 0
-- Just [0,1,2]
--
-- >>> iterateN 0 (+1) 0
-- Nothing
--
-- >>> iterateN (-1) (+1) 0
-- Nothing
--
iterateN :: Int -> (a -> a) -> a -> Maybe (NonEmptyVector a)
iterateN :: Int -> (a -> a) -> a -> Maybe (NonEmptyVector a)
iterateN Int
n a -> a
f a
a = Vector a -> Maybe (NonEmptyVector a)
forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (Int -> (a -> a) -> a -> Vector a
forall a. Int -> (a -> a) -> a -> Vector a
V.iterateN Int
n a -> a
f a
a)
{-# INLINE iterateN #-}

-- | /O(n)/ Apply function n times to value. Zeroth element is original value.
--
-- This variant takes @max n 1@ for the supplied length parameter.
--
--
-- >>> iterateN1 3 (+1) 0
-- [0,1,2]
--
-- >>> iterateN1 0 (+1) 0
-- [0]
--
-- >>> iterateN1 (-1) (+1) 0
-- [0]
--
iterateN1 :: Int -> (a -> a) -> a -> NonEmptyVector a
iterateN1 :: Int -> (a -> a) -> a -> NonEmptyVector a
iterateN1 Int
n a -> a
f a
a = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
unsafeFromVector (Int -> (a -> a) -> a -> Vector a
forall a. Int -> (a -> a) -> a -> Vector a
V.iterateN (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
1) a -> a
f a
a)
{-# INLINE iterateN1 #-}

-- ---------------------------------------------------------------------- --
-- Monadic Initialization

-- | /O(n)/ Execute the monadic action the given number of times and store
-- the results in a vector.
--
-- When given a index n <= 0, then 'Nothing' is returned, otherwise 'Just'.
--
--
-- >>> replicateM @Maybe 3 (Just "a")
-- Just (Just ["a","a","a"])
--
-- >>> replicateM @Maybe 3 Nothing
-- Nothing
--
-- >>> replicateM @Maybe 0 (Just "a")
-- Just Nothing
--
-- >>> replicateM @Maybe (-1) (Just "a")
-- Just Nothing
--
replicateM :: Monad m => Int -> m a -> m (Maybe (NonEmptyVector a))
replicateM :: Int -> m a -> m (Maybe (NonEmptyVector a))
replicateM Int
n m a
a = (Vector a -> Maybe (NonEmptyVector a))
-> m (Vector a) -> m (Maybe (NonEmptyVector a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector a -> Maybe (NonEmptyVector a)
forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (Int -> m a -> m (Vector a)
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM Int
n m a
a)
{-# INLINE replicateM #-}

-- | /O(n)/ Execute the monadic action the given number of times and store
-- the results in a vector.
--
-- This variant takes @max n 1@ for the supplied length parameter.
--
--
-- >>> replicate1M @Maybe 3 (Just "a")
-- Just ["a","a","a"]
--
-- >>> replicate1M @Maybe 3 Nothing
-- Nothing
--
-- >>> replicate1M @Maybe 0 (Just "a")
-- Just ["a"]
--
-- >>> replicate1M @Maybe (-1) (Just "a")
-- Just ["a"]
--
replicate1M :: Monad m => Int -> m a -> m (NonEmptyVector a)
replicate1M :: Int -> m a -> m (NonEmptyVector a)
replicate1M Int
n m a
a = (Vector a -> NonEmptyVector a)
-> m (Vector a) -> m (NonEmptyVector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
unsafeFromVector (Int -> m a -> m (Vector a)
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
1) m a
a)
{-# INLINE replicate1M #-}

-- | /O(n)/ Construct a vector of the given length by applying the monadic
-- action to each index
--
-- When given a index n <= 0, then 'Nothing' is returned, otherwise 'Just'.
--
-- >>> generateM 3 (\i -> if i P.< 1 then ["a"] else ["b"])
-- [Just ["a","b","b"]]
--
-- >>> generateM @[] @Int 3 (const [])
-- []
--
-- >>> generateM @[] @Int 0 (const [1])
-- [Nothing]
--
-- >>> generateM @Maybe @Int (-1) (const Nothing)
-- Just Nothing
--
generateM :: Monad m => Int -> (Int -> m a) -> m (Maybe (NonEmptyVector a))
generateM :: Int -> (Int -> m a) -> m (Maybe (NonEmptyVector a))
generateM Int
n Int -> m a
f = (Vector a -> Maybe (NonEmptyVector a))
-> m (Vector a) -> m (Maybe (NonEmptyVector a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector a -> Maybe (NonEmptyVector a)
forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (Int -> (Int -> m a) -> m (Vector a)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
V.generateM Int
n Int -> m a
f)
{-# INLINE generateM #-}

-- | /O(n)/ Construct a vector of the given length by applying the monadic
-- action to each index
--
-- This variant takes @max n 1@ for the supplied length parameter.
--
-- >>> generate1M 3 (\i -> if i P.< 1 then Just "a" else Just "b")
-- Just ["a","b","b"]
--
-- >>> generate1M 3 (const [])
-- []
--
-- >>> generate1M 0 (const $ Just 1)
-- Just [1]
--
-- >>> generate1M (-1) (const Nothing)
-- Nothing
--
generate1M :: Monad m => Int -> (Int -> m a) -> m (NonEmptyVector a)
generate1M :: Int -> (Int -> m a) -> m (NonEmptyVector a)
generate1M Int
n Int -> m a
f = (Vector a -> NonEmptyVector a)
-> m (Vector a) -> m (NonEmptyVector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
unsafeFromVector (Int -> (Int -> m a) -> m (Vector a)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
V.generateM (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
1) Int -> m a
f)
{-# INLINE generate1M #-}

-- | /O(n)/ Apply monadic function n times to value. Zeroth element is
-- original value.
--
-- When given a index n <= 0, then 'Nothing' is returned, otherwise 'Just'.
--
--
-- >>> iterateNM @Maybe 3 return "a"
-- Just (Just ["a","a","a"])
--
-- >>> iterateNM @Maybe 3 (const Nothing) "a"
-- Nothing
--
-- >>> iterateNM @Maybe 0 return "a"
-- Just Nothing
--
iterateNM :: Monad m => Int -> (a -> m a) -> a -> m (Maybe (NonEmptyVector a))
iterateNM :: Int -> (a -> m a) -> a -> m (Maybe (NonEmptyVector a))
iterateNM Int
n a -> m a
f a
a = (Vector a -> Maybe (NonEmptyVector a))
-> m (Vector a) -> m (Maybe (NonEmptyVector a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector a -> Maybe (NonEmptyVector a)
forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (Int -> (a -> m a) -> a -> m (Vector a)
forall (m :: * -> *) a.
Monad m =>
Int -> (a -> m a) -> a -> m (Vector a)
V.iterateNM Int
n a -> m a
f a
a)
{-# INLINE iterateNM #-}

-- | /O(n)/ Apply monadic function n times to value. Zeroth element is
-- original value.
--
-- This variant takes @max n 1@ for the supplied length parameter.
--
--
-- >>> iterateN1M @Maybe 3 return "a"
-- Just ["a","a","a"]
--
-- >>> iterateN1M @Maybe 3 (const Nothing) "a"
-- Nothing
--
-- >>> iterateN1M @Maybe 0 return "a"
-- Just ["a"]
--
-- >>> iterateN1M @Maybe (-1) return "a"
-- Just ["a"]
--
iterateN1M :: Monad m => Int -> (a -> m a) -> a -> m (NonEmptyVector a)
iterateN1M :: Int -> (a -> m a) -> a -> m (NonEmptyVector a)
iterateN1M Int
n a -> m a
f a
a = (Vector a -> NonEmptyVector a)
-> m (Vector a) -> m (NonEmptyVector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
unsafeFromVector (Int -> (a -> m a) -> a -> m (Vector a)
forall (m :: * -> *) a.
Monad m =>
Int -> (a -> m a) -> a -> m (Vector a)
V.iterateNM (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
1) a -> m a
f a
a)
{-# INLINE iterateN1M #-}

-- | Execute the monadic action and freeze the resulting non-empty vector.
--
create :: (forall s. ST s (MVector s a)) -> Maybe (NonEmptyVector a)
create :: (forall s. ST s (MVector s a)) -> Maybe (NonEmptyVector a)
create forall s. ST s (MVector s a)
p = Vector a -> Maybe (NonEmptyVector a)
forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector ((forall s. ST s (Mutable Vector s a)) -> Vector a
forall (v :: * -> *) a.
Vector v a =>
(forall s. ST s (Mutable v s a)) -> v a
G.create forall s. ST s (MVector s a)
forall s. ST s (Mutable Vector s a)
p)
{-# INLINE create #-}

-- | Execute the monadic action and freeze the resulting non-empty vector,
-- bypassing emptiness checks.
--
-- The onus is on the caller to guarantee the created vector is non-empty.
--
unsafeCreate :: (forall s. ST s (MVector s a)) -> NonEmptyVector a
unsafeCreate :: (forall s. ST s (MVector s a)) -> NonEmptyVector a
unsafeCreate forall s. ST s (MVector s a)
p = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
unsafeFromVector ((forall s. ST s (Mutable Vector s a)) -> Vector a
forall (v :: * -> *) a.
Vector v a =>
(forall s. ST s (Mutable v s a)) -> v a
G.create forall s. ST s (MVector s a)
forall s. ST s (Mutable Vector s a)
p)
{-# INLINE unsafeCreate #-}

-- | Execute the monadic action and freeze the resulting non-empty vector.
--
createT
    :: Traversable t
    => (forall s. ST s (t (MVector s a)))
    -> t (Maybe (NonEmptyVector a))
createT :: (forall s. ST s (t (MVector s a))) -> t (Maybe (NonEmptyVector a))
createT forall s. ST s (t (MVector s a))
p = (Vector a -> Maybe (NonEmptyVector a))
-> t (Vector a) -> t (Maybe (NonEmptyVector a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector a -> Maybe (NonEmptyVector a)
forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector ((forall s. ST s (t (Mutable Vector s a))) -> t (Vector a)
forall (f :: * -> *) (v :: * -> *) a.
(Traversable f, Vector v a) =>
(forall s. ST s (f (Mutable v s a))) -> f (v a)
G.createT forall s. ST s (t (MVector s a))
forall s. ST s (t (Mutable Vector s a))
p)
{-# INLINE createT #-}

-- | Execute the monadic action and freeze the resulting non-empty vector.
--
-- The onus is on the caller to guarantee the created vector is non-empty.
--
unsafeCreateT
    :: Traversable t
    => (forall s. ST s (t (MVector s a)))
    -> t (NonEmptyVector a)
unsafeCreateT :: (forall s. ST s (t (MVector s a))) -> t (NonEmptyVector a)
unsafeCreateT forall s. ST s (t (MVector s a))
p = (Vector a -> NonEmptyVector a)
-> t (Vector a) -> t (NonEmptyVector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
unsafeFromVector ((forall s. ST s (t (Mutable Vector s a))) -> t (Vector a)
forall (f :: * -> *) (v :: * -> *) a.
(Traversable f, Vector v a) =>
(forall s. ST s (f (Mutable v s a))) -> f (v a)
G.createT forall s. ST s (t (MVector s a))
forall s. ST s (t (Mutable Vector s a))
p)
{-# INLINE unsafeCreateT #-}

-- ---------------------------------------------------------------------- --
-- Unfolding

-- | /O(n)/ Construct a non-empty vector by repeatedly applying the
-- generator function to a seed. The generator function yields 'Just' the
-- next element and the new seed or 'Nothing' if there are no more
-- elements.
--
-- If an unfold does not create meaningful values, 'Nothing' is
-- returned. Otherwise, 'Just' containing a non-empty vector is returned.
--
--
-- >>> unfoldr (\b -> case b of "a" -> Just ("a", "b"); _ ->  Nothing) "a"
-- Just ["a"]
--
-- >>> unfoldr (const Nothing) "a"
-- Nothing
--
unfoldr :: (b -> Maybe (a, b)) -> b -> Maybe (NonEmptyVector a)
unfoldr :: (b -> Maybe (a, b)) -> b -> Maybe (NonEmptyVector a)
unfoldr b -> Maybe (a, b)
f b
b = Vector a -> Maybe (NonEmptyVector a)
forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector ((b -> Maybe (a, b)) -> b -> Vector a
forall b a. (b -> Maybe (a, b)) -> b -> Vector a
V.unfoldr b -> Maybe (a, b)
f b
b)
{-# INLINE unfoldr #-}

-- | /O(n)/ Construct a non-empty vector by repeatedly applying the
-- generator function to a seed and a first element.
--
-- This variant of 'unfoldr' guarantees the resulting vector is non-
-- empty by supplying an initial element @a@.
--
--
-- >>> unfoldr1 (\b -> case b of "a" -> Just ("a", "b"); _ ->  Nothing) "first" "a"
-- ["first","a"]
--
-- >>> unfoldr1 (const Nothing) "first" "a"
-- ["first"]
--
unfoldr1 :: (b -> Maybe (a, b)) -> a -> b -> NonEmptyVector a
unfoldr1 :: (b -> Maybe (a, b)) -> a -> b -> NonEmptyVector a
unfoldr1 b -> Maybe (a, b)
f a
a b
b = a -> NonEmptyVector a -> NonEmptyVector a
forall a. a -> NonEmptyVector a -> NonEmptyVector a
cons a
a (Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
unsafeFromVector ((b -> Maybe (a, b)) -> b -> Vector a
forall b a. (b -> Maybe (a, b)) -> b -> Vector a
V.unfoldr b -> Maybe (a, b)
f b
b))
{-# INLINE unfoldr1 #-}

-- | /O(n)/ Construct a vector with at most n elements by repeatedly
-- applying the generator function to a seed. The generator function yields
-- 'Just' the next element and the new seed or 'Nothing' if there are no
-- more elements.
--
-- If an unfold does not create meaningful values, 'Nothing' is
-- returned. Otherwise, 'Just' containing a non-empty vector is returned.
--
--
-- >>> unfoldrN 3 (\b -> Just (b+1, b+1)) 0
-- Just [1,2,3]
--
-- >>> unfoldrN 3 (const Nothing) 0
-- Nothing
--
-- >>> unfoldrN 0 (\b -> Just (b+1, b+1)) 0
-- Nothing
--
unfoldrN :: Int -> (b -> Maybe (a, b)) -> b -> Maybe (NonEmptyVector a)
unfoldrN :: Int -> (b -> Maybe (a, b)) -> b -> Maybe (NonEmptyVector a)
unfoldrN Int
n b -> Maybe (a, b)
f b
b = Vector a -> Maybe (NonEmptyVector a)
forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (Int -> (b -> Maybe (a, b)) -> b -> Vector a
forall b a. Int -> (b -> Maybe (a, b)) -> b -> Vector a
V.unfoldrN Int
n b -> Maybe (a, b)
f b
b)
{-# INLINE unfoldrN #-}

-- | /O(n)/ Construct a vector with at most n elements by repeatedly
-- applying the generator function to a seed. The generator function yields
-- 'Just' the next element and the new seed or 'Nothing' if there are no
-- more elements.
--
-- This variant of 'unfoldrN' guarantees the resulting vector is non-
-- empty by supplying an initial element @a@.
--
--
-- >>> unfoldr1N 3 (\b -> Just (b+1, b+1)) 0 0
-- [0,1,2,3]
--
-- >>> unfoldr1N 3 (const Nothing) 0 0
-- [0]
--
-- >>> unfoldr1N 0 (\b -> Just (b+1, b+1)) 0 0
-- [0]
--
unfoldr1N
    :: Int
    -> (b -> Maybe (a, b))
    -> a
    -> b
    -> NonEmptyVector a
unfoldr1N :: Int -> (b -> Maybe (a, b)) -> a -> b -> NonEmptyVector a
unfoldr1N Int
n b -> Maybe (a, b)
f a
a b
b = a -> NonEmptyVector a -> NonEmptyVector a
forall a. a -> NonEmptyVector a -> NonEmptyVector a
cons a
a (Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
unsafeFromVector (Int -> (b -> Maybe (a, b)) -> b -> Vector a
forall b a. Int -> (b -> Maybe (a, b)) -> b -> Vector a
V.unfoldrN Int
n b -> Maybe (a, b)
f b
b))
{-# INLINE unfoldr1N #-}

-- | /O(n)/ Construct a non-empty vector by repeatedly applying the monadic generator
-- function to a seed. The generator function yields Just the next element
-- and the new seed or Nothing if there are no more elements.
--
-- If an unfold does not create meaningful values, 'Nothing' is
-- returned. Otherwise, 'Just' containing a non-empty vector is returned.
--
unfoldrM
    :: Monad m
    => (b -> m (Maybe (a, b)))
    -> b
    -> m (Maybe (NonEmptyVector a))
unfoldrM :: (b -> m (Maybe (a, b))) -> b -> m (Maybe (NonEmptyVector a))
unfoldrM b -> m (Maybe (a, b))
f b
b = (Vector a -> Maybe (NonEmptyVector a))
-> m (Vector a) -> m (Maybe (NonEmptyVector a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector a -> Maybe (NonEmptyVector a)
forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector ((b -> m (Maybe (a, b))) -> b -> m (Vector a)
forall (m :: * -> *) b a.
Monad m =>
(b -> m (Maybe (a, b))) -> b -> m (Vector a)
V.unfoldrM b -> m (Maybe (a, b))
f b
b)
{-# INLINE unfoldrM #-}

-- | /O(n)/ Construct a non-empty vector by repeatedly applying the monadic generator
-- function to a seed. The generator function yields Just the next element
-- and the new seed or Nothing if there are no more elements.
--
-- This variant of 'unfoldrM' guarantees the resulting vector is non-
-- empty by supplying an initial element @a@.
--
unfoldr1M
    :: Monad m
    => (b -> m (Maybe (a, b)))
    -> a
    -> b
    -> m (NonEmptyVector a)
unfoldr1M :: (b -> m (Maybe (a, b))) -> a -> b -> m (NonEmptyVector a)
unfoldr1M b -> m (Maybe (a, b))
f a
a b
b = (Vector a -> NonEmptyVector a)
-> m (Vector a) -> m (NonEmptyVector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> NonEmptyVector a -> NonEmptyVector a
forall a. a -> NonEmptyVector a -> NonEmptyVector a
cons a
a (NonEmptyVector a -> NonEmptyVector a)
-> (Vector a -> NonEmptyVector a) -> Vector a -> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
unsafeFromVector) ((b -> m (Maybe (a, b))) -> b -> m (Vector a)
forall (m :: * -> *) b a.
Monad m =>
(b -> m (Maybe (a, b))) -> b -> m (Vector a)
V.unfoldrM b -> m (Maybe (a, b))
f b
b)
{-# INLINE unfoldr1M #-}

-- | /O(n)/ Construct a non-empty vector by repeatedly applying the monadic generator
-- function to a seed. The generator function yields Just the next element and
-- the new seed or Nothing if there are no more elements.
--
-- If an unfold does not create meaningful values, 'Nothing' is
-- returned. Otherwise, 'Just' containing a non-empty vector is returned.
--
unfoldrNM
    :: Monad m
    => Int
    -> (b -> m (Maybe (a, b)))
    -> b
    -> m (Maybe (NonEmptyVector a))
unfoldrNM :: Int -> (b -> m (Maybe (a, b))) -> b -> m (Maybe (NonEmptyVector a))
unfoldrNM Int
n b -> m (Maybe (a, b))
f b
b = (Vector a -> Maybe (NonEmptyVector a))
-> m (Vector a) -> m (Maybe (NonEmptyVector a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector a -> Maybe (NonEmptyVector a)
forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a)
forall (m :: * -> *) b a.
Monad m =>
Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a)
V.unfoldrNM Int
n b -> m (Maybe (a, b))
f b
b)
{-# INLINE unfoldrNM #-}

-- | /O(n)/ Construct a non-empty vector by repeatedly applying the monadic generator
-- function to a seed. The generator function yields Just the next element and
-- the new seed or Nothing if there are no more elements.
--
-- This variant of 'unfoldrNM' guarantees the resulting vector is non-
-- empty by supplying an initial element @a@.
--
unfoldr1NM
    :: Monad m
    => Int
    -> (b -> m (Maybe (a, b)))
    -> a
    -> b
    -> m (NonEmptyVector a)
unfoldr1NM :: Int -> (b -> m (Maybe (a, b))) -> a -> b -> m (NonEmptyVector a)
unfoldr1NM Int
n b -> m (Maybe (a, b))
f a
a b
b = (Vector a -> NonEmptyVector a)
-> m (Vector a) -> m (NonEmptyVector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> NonEmptyVector a -> NonEmptyVector a
forall a. a -> NonEmptyVector a -> NonEmptyVector a
cons a
a (NonEmptyVector a -> NonEmptyVector a)
-> (Vector a -> NonEmptyVector a) -> Vector a -> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
unsafeFromVector) (Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a)
forall (m :: * -> *) b a.
Monad m =>
Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a)
V.unfoldrNM Int
n b -> m (Maybe (a, b))
f b
b)
{-# INLINE unfoldr1NM #-}

-- | /O(n)/ Construct a non-empty vector with n elements by repeatedly applying the
-- generator function to the already constructed part of the vector.
--
-- If 'constructN' does not create meaningful values, 'Nothing' is
-- returned. Otherwise, 'Just' containing a non-empty vector is returned.
--
constructN :: Int -> (Vector a -> a) -> Maybe (NonEmptyVector a)
constructN :: Int -> (Vector a -> a) -> Maybe (NonEmptyVector a)
constructN Int
n Vector a -> a
f = Vector a -> Maybe (NonEmptyVector a)
forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (Int -> (Vector a -> a) -> Vector a
forall a. Int -> (Vector a -> a) -> Vector a
V.constructN Int
n Vector a -> a
f)
{-# INLINE constructN #-}

-- | /O(n)/ Construct a vector with n elements from right to left by repeatedly
-- applying the generator function to the already constructed part of the vector.
--
-- If 'constructrN' does not create meaningful values, 'Nothing' is
-- returned. Otherwise, 'Just' containing a non-empty vector is returned.
--
constructrN :: Int -> (Vector a -> a) -> Maybe (NonEmptyVector a)
constructrN :: Int -> (Vector a -> a) -> Maybe (NonEmptyVector a)
constructrN Int
n Vector a -> a
f = Vector a -> Maybe (NonEmptyVector a)
forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (Int -> (Vector a -> a) -> Vector a
forall a. Int -> (Vector a -> a) -> Vector a
V.constructrN Int
n Vector a -> a
f)
{-# INLINE constructrN #-}

-- ---------------------------------------------------------------------- --
-- Enumeration

-- | /O(n)/ Yield a non-emptyvector of the given length containing the
-- values x, x+1 etc. This operation is usually more efficient than
-- 'enumFromTo'.
--
-- If an enumeration does not use meaningful indices, 'Nothing' is returned,
-- otherwise, 'Just' containing a non-empty vector.
--
enumFromN :: Num a => a -> Int -> Maybe (NonEmptyVector a)
enumFromN :: a -> Int -> Maybe (NonEmptyVector a)
enumFromN a
a Int
n = Vector a -> Maybe (NonEmptyVector a)
forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (a -> Int -> Vector a
forall a. Num a => a -> Int -> Vector a
V.enumFromN a
a Int
n)
{-# INLINE enumFromN #-}

-- | /O(n)/ Yield a non-emptyvector of length @max n 1@ containing the
-- values x, x+1 etc. This operation is usually more efficient than
-- 'enumFromTo'.
--
enumFromN1 :: Num a => a -> Int -> NonEmptyVector a
enumFromN1 :: a -> Int -> NonEmptyVector a
enumFromN1 a
a Int
n = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
unsafeFromVector (a -> Int -> Vector a
forall a. Num a => a -> Int -> Vector a
V.enumFromN a
a (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
1))
{-# INLINE enumFromN1 #-}

-- | /O(n)/ Yield a non-empty vector of the given length containing the
-- values x, x+y, x+y+y etc. This operations is usually more efficient than
-- 'enumFromThenTo'.
--
-- If an enumeration does not use meaningful indices, 'Nothing' is returned,
-- otherwise, 'Just' containing a non-empty vector.
--
enumFromStepN :: Num a => a -> a -> Int -> Maybe (NonEmptyVector a)
enumFromStepN :: a -> a -> Int -> Maybe (NonEmptyVector a)
enumFromStepN a
a0 a
a1 Int
n = Vector a -> Maybe (NonEmptyVector a)
forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (a -> a -> Int -> Vector a
forall a. Num a => a -> a -> Int -> Vector a
V.enumFromStepN a
a0 a
a1 Int
n)
{-# INLINE enumFromStepN #-}

-- | /O(n)/ Yield a non-empty vector of length @max n 1@ containing the
-- values x, x+y, x+y+y etc. This operations is usually more efficient than
-- 'enumFromThenTo'.
--
enumFromStepN1 :: Num a => a -> a -> Int -> NonEmptyVector a
enumFromStepN1 :: a -> a -> Int -> NonEmptyVector a
enumFromStepN1 a
a0 a
a1 Int
n = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
unsafeFromVector (a -> a -> Int -> Vector a
forall a. Num a => a -> a -> Int -> Vector a
V.enumFromStepN a
a0 a
a1 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
1))
{-# INLINE enumFromStepN1 #-}

-- | /O(n)/ Enumerate values from x to y.
--
-- If an enumeration does not use meaningful indices, 'Nothing' is returned,
-- otherwise, 'Just' containing a non-empty vector.
--
-- /WARNING/: This operation can be very inefficient. If at all possible,
-- use 'enumFromN' instead.
--
--
enumFromTo :: Enum a => a -> a -> Maybe (NonEmptyVector a)
enumFromTo :: a -> a -> Maybe (NonEmptyVector a)
enumFromTo a
a0 a
a1 = Vector a -> Maybe (NonEmptyVector a)
forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (a -> a -> Vector a
forall a. Enum a => a -> a -> Vector a
V.enumFromTo a
a0 a
a1)
{-# INLINE enumFromTo #-}

-- | /O(n)/ Enumerate values from x to y with a specific step z.
--
-- If an enumeration does not use meaningful indices, 'Nothing' is returned,
-- otherwise, 'Just' containing a non-empty vector.
--
-- /WARNING/: This operation can be very inefficient. If at all possible,
-- use 'enumFromStepN' instead.
enumFromThenTo :: Enum a => a -> a -> a -> Maybe (NonEmptyVector a)
enumFromThenTo :: a -> a -> a -> Maybe (NonEmptyVector a)
enumFromThenTo a
a0 a
a1 a
a2 = Vector a -> Maybe (NonEmptyVector a)
forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (a -> a -> a -> Vector a
forall a. Enum a => a -> a -> a -> Vector a
V.enumFromThenTo a
a0 a
a1 a
a2)
{-# INLINE enumFromThenTo #-}

-- ---------------------------------------------------------------------- --
-- Concatenation

-- | /O(n)/ Prepend an element
--
-- >>> cons 1 (unsafeFromList [2,3])
-- [1,2,3]
--
cons :: a -> NonEmptyVector a -> NonEmptyVector a
cons :: a -> NonEmptyVector a -> NonEmptyVector a
cons a
a (NonEmptyVector Vector a
as) = a -> Vector a -> NonEmptyVector a
forall a. a -> Vector a -> NonEmptyVector a
consV a
a Vector a
as
{-# INLINE cons #-}

-- | /O(n)/ Prepend an element to a Vector
--
-- >>> consV 1 (V.fromList [2,3])
-- [1,2,3]
--
consV :: a -> Vector a -> NonEmptyVector a
consV :: a -> Vector a -> NonEmptyVector a
consV a
a = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> NonEmptyVector a)
-> (Vector a -> Vector a) -> Vector a -> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
V.cons a
a
{-# INLINE consV #-}

-- | /O(n)/ Append an element
--
-- >>> snoc (unsafeFromList [1,2]) 3
-- [1,2,3]
--
snoc :: NonEmptyVector a -> a -> NonEmptyVector a
snoc :: NonEmptyVector a -> a -> NonEmptyVector a
snoc (NonEmptyVector Vector a
as) = Vector a -> a -> NonEmptyVector a
forall a. Vector a -> a -> NonEmptyVector a
snocV Vector a
as
{-# INLINE snoc #-}

-- | /O(n)/ Append an element to a Vector
--
-- >>> snocV (V.fromList [1,2]) 3
-- [1,2,3]
--
snocV :: Vector a -> a -> NonEmptyVector a
snocV :: Vector a -> a -> NonEmptyVector a
snocV Vector a
as = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> NonEmptyVector a)
-> (a -> Vector a) -> a -> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> a -> Vector a
forall a. Vector a -> a -> Vector a
V.snoc Vector a
as
{-# INLINE snocV #-}

-- | /O(m+n)/ Concatenate two non-empty vectors
--
-- >>> (unsafeFromList [1..3]) ++ (unsafeFromList [4..6])
-- [1,2,3,4,5,6]
--
(++) :: NonEmptyVector a -> NonEmptyVector a -> NonEmptyVector a
NonEmptyVector Vector a
v ++ :: NonEmptyVector a -> NonEmptyVector a -> NonEmptyVector a
++ NonEmptyVector Vector a
v' = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a
v Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> Vector a
v')
{-# INLINE (++) #-}

-- | /O(n)/ Concatenate all non-empty vectors in the list
--
-- If list is empty, 'Nothing' is returned, otherwise 'Just'
-- containing the concatenated non-empty vectors
--
-- >>> concat [(unsafeFromList [1..3]), (unsafeFromList [4..6])]
-- Just [1,2,3,4,5,6]
--
concat :: [NonEmptyVector a] -> Maybe (NonEmptyVector a)
concat :: [NonEmptyVector a] -> Maybe (NonEmptyVector a)
concat [] = Maybe (NonEmptyVector a)
forall a. Maybe a
Nothing
concat (NonEmptyVector a
a:[NonEmptyVector a]
as) = NonEmptyVector a -> Maybe (NonEmptyVector a)
forall a. a -> Maybe a
Just (NonEmpty (NonEmptyVector a) -> NonEmptyVector a
forall a. NonEmpty (NonEmptyVector a) -> NonEmptyVector a
concat1 (NonEmptyVector a
a NonEmptyVector a
-> [NonEmptyVector a] -> NonEmpty (NonEmptyVector a)
forall a. a -> [a] -> NonEmpty a
:| [NonEmptyVector a]
as))
{-# INLINE concat #-}

-- | O(n) Concatenate all non-empty vectors in a non-empty list.
--
-- >>> concat1 ((unsafeFromList [1..3]) :| [(unsafeFromList [4..6])])
-- [1,2,3,4,5,6]
--
concat1 :: NonEmpty (NonEmptyVector a) -> NonEmptyVector a
concat1 :: NonEmpty (NonEmptyVector a) -> NonEmptyVector a
concat1 = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> NonEmptyVector a)
-> (NonEmpty (NonEmptyVector a) -> Vector a)
-> NonEmpty (NonEmptyVector a)
-> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector a -> NonEmptyVector a -> Vector a)
-> Vector a -> NonEmpty (NonEmptyVector a) -> Vector a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' Vector a -> NonEmptyVector a -> Vector a
forall a. Vector a -> NonEmptyVector a -> Vector a
go Vector a
forall a. Vector a
V.empty
  where
    go :: Vector a -> NonEmptyVector a -> Vector a
go Vector a
v (NonEmptyVector Vector a
a) = Vector a
v Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> Vector a
a
{-# INLINE concat1 #-}

-- ---------------------------------------------------------------------- --
-- Conversions

-- | /O(n)/ Convert a non-empty vector to a non-empty list.
--
-- >>> toNonEmpty (unsafeFromList [1..3])
-- 1 :| [2,3]
--
toNonEmpty :: NonEmptyVector a -> NonEmpty a
toNonEmpty :: NonEmptyVector a -> NonEmpty a
toNonEmpty = [a] -> NonEmpty a
forall a. [a] -> NonEmpty a
NonEmpty.fromList ([a] -> NonEmpty a)
-> (NonEmptyVector a -> [a]) -> NonEmptyVector a -> NonEmpty a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall a. Vector a -> [a]
V.toList (Vector a -> [a])
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE toNonEmpty #-}

-- | O(n) Convert from a non-empty list to a non-empty vector.
--
-- >>> fromNonEmpty (1 :| [2,3])
-- [1,2,3]
--
fromNonEmpty :: NonEmpty a -> NonEmptyVector a
fromNonEmpty :: NonEmpty a -> NonEmptyVector a
fromNonEmpty = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> NonEmptyVector a)
-> (NonEmpty a -> Vector a) -> NonEmpty a -> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Vector a
forall a. [a] -> Vector a
V.fromList ([a] -> Vector a) -> (NonEmpty a -> [a]) -> NonEmpty a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList
{-# INLINE fromNonEmpty #-}

-- | O(n) Convert from the first n-elements of a non-empty list to a
-- non-empty vector.
--
-- Returns 'Nothing' if indices are <= 0, otherwise 'Just' containing
-- the non-empty vector.
--
-- >>> fromNonEmptyN 3 (1 :| [2..5])
-- Just [1,2,3]
--
-- >>> fromNonEmptyN 0 (1 :| [2..5])
-- Nothing
--
fromNonEmptyN :: Int -> NonEmpty a -> Maybe (NonEmptyVector a)
fromNonEmptyN :: Int -> NonEmpty a -> Maybe (NonEmptyVector a)
fromNonEmptyN Int
n NonEmpty a
a = Vector a -> Maybe (NonEmptyVector a)
forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (Int -> [a] -> Vector a
forall a. Int -> [a] -> Vector a
V.fromListN Int
n (NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList NonEmpty a
a))
{-# INLINE fromNonEmptyN #-}

-- | O(n) Convert from the first n-elements of a non-empty list to a
-- non-empty vector. This is a safe version of `fromNonEmptyN` which
-- takes @max n 1@ of the first n-elements of the non-empty list.
--
--
-- >>> fromNonEmptyN1 3 (1 :| [2..5])
-- [1,2,3]
--
-- >>> fromNonEmptyN1 0 (1 :| [2..5])
-- [1]
--
fromNonEmptyN1 :: Int -> NonEmpty a -> NonEmptyVector a
fromNonEmptyN1 :: Int -> NonEmpty a -> NonEmptyVector a
fromNonEmptyN1 Int
n = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
unsafeFromVector
    (Vector a -> NonEmptyVector a)
-> (NonEmpty a -> Vector a) -> NonEmpty a -> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> Vector a
forall a. Int -> [a] -> Vector a
V.fromListN (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
1)
    ([a] -> Vector a) -> (NonEmpty a -> [a]) -> NonEmpty a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList
{-# INLINE fromNonEmptyN1 #-}

-- | /O(1)/ Convert from a non-empty vector to a vector.
--
--
-- >>> let nev :: NonEmptyVector Int = unsafeFromList [1..3] in toVector nev
-- [1,2,3]
--
toVector :: NonEmptyVector a -> Vector a
toVector :: NonEmptyVector a -> Vector a
toVector = NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE toVector #-}

-- | /O(1)/ Convert from a vector to a non-empty vector.
--
-- If the vector is empty, then 'Nothing' is returned,
-- otherwise 'Just' containing the non-empty vector.
--
-- >>> fromVector $ V.fromList [1..3]
-- Just [1,2,3]
--
-- >>> fromVector $ V.fromList []
-- Nothing
--
fromVector :: Vector a -> Maybe (NonEmptyVector a)
fromVector :: Vector a -> Maybe (NonEmptyVector a)
fromVector Vector a
v = if Vector a -> Bool
forall a. Vector a -> Bool
V.null Vector a
v then Maybe (NonEmptyVector a)
forall a. Maybe a
Nothing else NonEmptyVector a -> Maybe (NonEmptyVector a)
forall a. a -> Maybe a
Just (Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector a
v)
{-# INLINE fromVector #-}

-- | /O(1)/ Convert from a vector to a non-empty vector without
-- checking bounds.
--
-- /Warning/: the onus is on the user to ensure that their vector
-- is not empty, otherwise all bets are off!
--
--
-- >>> unsafeFromVector $ V.fromList [1..3]
-- [1,2,3]
--
unsafeFromVector :: Vector a -> NonEmptyVector a
unsafeFromVector :: Vector a -> NonEmptyVector a
unsafeFromVector = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector
{-# INLINE unsafeFromVector #-}

-- | /O(n)/ Convert from a non-empty vector to a list.
--
--
-- >>> let nev :: NonEmptyVector Int = unsafeFromList [1..3] in toList nev
-- [1,2,3]
--
toList :: NonEmptyVector a -> [a]
toList :: NonEmptyVector a -> [a]
toList = Vector a -> [a]
forall a. Vector a -> [a]
V.toList (Vector a -> [a])
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE toList #-}

-- | /O(n)/ Convert from a list to a non-empty vector.
--
--
-- >>> fromList [1..3]
-- Just [1,2,3]
--
-- >>> fromList []
-- Nothing
--
fromList :: [a] -> Maybe (NonEmptyVector a)
fromList :: [a] -> Maybe (NonEmptyVector a)
fromList = Vector a -> Maybe (NonEmptyVector a)
forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (Vector a -> Maybe (NonEmptyVector a))
-> ([a] -> Vector a) -> [a] -> Maybe (NonEmptyVector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Vector a
forall a. [a] -> Vector a
V.fromList
{-# INLINE fromList #-}

-- | /O(n)/ Convert from a list to a non-empty vector.
--
-- /Warning/: the onus is on the user to ensure that their vector
-- is not empty, otherwise all bets are off!
--
-- >>> unsafeFromList [1..3]
-- [1,2,3]
--
unsafeFromList :: [a] -> NonEmptyVector a
unsafeFromList :: [a] -> NonEmptyVector a
unsafeFromList = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
unsafeFromVector (Vector a -> NonEmptyVector a)
-> ([a] -> Vector a) -> [a] -> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Vector a
forall a. [a] -> Vector a
V.fromList
{-# INLINE unsafeFromList #-}

-- | /O(n)/ Convert the first n elements of a list to a non-empty vector.
--
-- If the list is empty or <= 0 elements are chosen, 'Nothing' is
-- returned, otherwise 'Just' containing the non-empty vector
--
-- >>> fromListN 3 [1..5]
-- Just [1,2,3]
--
-- >>> fromListN 3 []
-- Nothing
--
-- >>> fromListN 0 [1..5]
-- Nothing
--
fromListN :: Int -> [a] -> Maybe (NonEmptyVector a)
fromListN :: Int -> [a] -> Maybe (NonEmptyVector a)
fromListN Int
n [a]
as = Vector a -> Maybe (NonEmptyVector a)
forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (Int -> [a] -> Vector a
forall a. Int -> [a] -> Vector a
V.fromListN Int
n [a]
as)
{-# INLINE fromListN #-}

-- ---------------------------------------------------------------------- --
-- Restricting memory usage

-- | /O(n)/ Yield the argument but force it not to retain any extra memory,
-- possibly by copying it.
--
force :: NonEmptyVector a -> NonEmptyVector a
force :: NonEmptyVector a -> NonEmptyVector a
force (NonEmptyVector Vector a
a) = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> Vector a
forall a. Vector a -> Vector a
V.force Vector a
a)
{-# INLINE force #-}

-- ---------------------------------------------------------------------- --
-- Bulk Updates

-- | /O(m+n)/ For each pair (i,a) from the list, replace the non-empty vector
-- element at position i by a.
--
-- >>> unsafeFromList [1..3] // [(2,4)]
-- [1,2,4]
--
-- >>> unsafeFromList [1..3] // []
-- [1,2,3]
--
(//) :: NonEmptyVector a -> [(Int, a)] -> NonEmptyVector a
NonEmptyVector Vector a
v // :: NonEmptyVector a -> [(Int, a)] -> NonEmptyVector a
// [(Int, a)]
us = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a
v Vector a -> [(Int, a)] -> Vector a
forall a. Vector a -> [(Int, a)] -> Vector a
V.// [(Int, a)]
us)
{-# INLINE (//) #-}

-- | O(m+n) For each pair (i,a) from the vector of index/value pairs,
-- replace the vector element at position i by a.
--
-- >>> unsafeFromList [1..3] `update` V.fromList [(2,4)]
-- [1,2,4]
--
-- >>> unsafeFromList [1..3] `update` V.empty
-- [1,2,3]
--
update :: NonEmptyVector a -> Vector (Int, a) -> NonEmptyVector a
update :: NonEmptyVector a -> Vector (Int, a) -> NonEmptyVector a
update (NonEmptyVector Vector a
v) Vector (Int, a)
v' = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> Vector (Int, a) -> Vector a
forall a. Vector a -> Vector (Int, a) -> Vector a
V.update Vector a
v Vector (Int, a)
v')
{-# INLINE update #-}

-- | /O(m+min(n1,n2))/ For each index i from the index vector and the
-- corresponding value a from the value vector, replace the element of
-- the initial vector at position i by a.
--
--
-- >>> update_ (unsafeFromList [1..3]) (V.fromList [2]) (V.fromList [4])
-- [1,2,4]
--
-- >>> update_ (unsafeFromList [1..3]) V.empty V.empty
-- [1,2,3]
--
update_ :: NonEmptyVector a -> Vector Int -> Vector a -> NonEmptyVector a
update_ :: NonEmptyVector a -> Vector Int -> Vector a -> NonEmptyVector a
update_ (NonEmptyVector Vector a
v) Vector Int
is Vector a
as = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> Vector Int -> Vector a -> Vector a
forall a. Vector a -> Vector Int -> Vector a -> Vector a
V.update_ Vector a
v Vector Int
is Vector a
as)
{-# INLINE update_ #-}

-- | Same as '(//)' but without bounds checking.
--
unsafeUpd :: NonEmptyVector a -> [(Int, a)] -> NonEmptyVector a
unsafeUpd :: NonEmptyVector a -> [(Int, a)] -> NonEmptyVector a
unsafeUpd (NonEmptyVector Vector a
v) [(Int, a)]
us = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> [(Int, a)] -> Vector a
forall a. Vector a -> [(Int, a)] -> Vector a
V.unsafeUpd Vector a
v [(Int, a)]
us)
{-# INLINE unsafeUpd #-}

-- | Same as 'update' but without bounds checking.
--
unsafeUpdate :: NonEmptyVector a -> Vector (Int, a) -> NonEmptyVector a
unsafeUpdate :: NonEmptyVector a -> Vector (Int, a) -> NonEmptyVector a
unsafeUpdate (NonEmptyVector Vector a
v) Vector (Int, a)
us = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> Vector (Int, a) -> Vector a
forall a. Vector a -> Vector (Int, a) -> Vector a
V.unsafeUpdate Vector a
v Vector (Int, a)
us)
{-# INLINE unsafeUpdate #-}

-- | Same as 'update_' but without bounds checking.
--
unsafeUpdate_ :: NonEmptyVector a -> Vector Int -> Vector a -> NonEmptyVector a
unsafeUpdate_ :: NonEmptyVector a -> Vector Int -> Vector a -> NonEmptyVector a
unsafeUpdate_ (NonEmptyVector Vector a
v) Vector Int
is Vector a
as = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> Vector Int -> Vector a -> Vector a
forall a. Vector a -> Vector Int -> Vector a -> Vector a
V.unsafeUpdate_ Vector a
v Vector Int
is Vector a
as)
{-# INLINE unsafeUpdate_ #-}

-- ---------------------------------------------------------------------- --
-- Accumulation

-- | /O(m+n)/ For each pair @(i,b)@ from the non-empty list, replace the
-- non-empty vector element @a@ at position @i@ by @f a b@.
--
--
-- >>> accum (+) (unsafeFromList [1..3]) [(2,10)]
-- [1,2,13]
--
-- >>> accum (+) (unsafeFromList [1..3]) []
-- [1,2,3]
--
accum
    :: (a -> b -> a)
      -- ^ accumulating function @f@
    -> NonEmptyVector a
      -- ^ initial non-empty vector (of length @m@)
    -> [(Int, b)]
      -- ^ list of index/value pairs (of length @n@)
    -> NonEmptyVector a
accum :: (a -> b -> a) -> NonEmptyVector a -> [(Int, b)] -> NonEmptyVector a
accum a -> b -> a
f (NonEmptyVector Vector a
v) [(Int, b)]
u = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector ((a -> b -> a) -> Vector a -> [(Int, b)] -> Vector a
forall a b. (a -> b -> a) -> Vector a -> [(Int, b)] -> Vector a
V.accum a -> b -> a
f Vector a
v [(Int, b)]
u)
{-# INLINE accum #-}

-- | /O(m+n)/ For each pair @(i,b)@ from the vector of pairs, replace the
-- non-empty vector element @a@ at position @i@ by @f a b@.
--
-- >>> accumulate (+) (unsafeFromList [1..3]) (V.fromList [(2,10)])
-- [1,2,13]
--
-- >>> accumulate (+) (unsafeFromList [1..3]) V.empty
-- [1,2,3]
--
accumulate
    :: (a -> b -> a)
      -- ^ accumulating function @f@
    -> NonEmptyVector a
      -- ^ initial non-empty vector (of length @m@)
    -> Vector (Int, b)
      -- ^ vector of index/value pairs (of length @n@)
    -> NonEmptyVector a
accumulate :: (a -> b -> a)
-> NonEmptyVector a -> Vector (Int, b) -> NonEmptyVector a
accumulate a -> b -> a
f (NonEmptyVector Vector a
v) Vector (Int, b)
u = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector ((a -> b -> a) -> Vector a -> Vector (Int, b) -> Vector a
forall a b.
(a -> b -> a) -> Vector a -> Vector (Int, b) -> Vector a
V.accumulate a -> b -> a
f Vector a
v Vector (Int, b)
u)
{-# INLINE accumulate #-}

-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the
-- corresponding value @b@ from the the value vector, replace the element
-- of the initial non-empty vector at position @i@ by @f a b@.
--
-- >>> accumulate_ (+) (unsafeFromList [1..3]) (V.fromList [2]) (V.fromList [10])
-- [1,2,13]
--
-- >>> accumulate_ (+) (unsafeFromList [1..3]) V.empty V.empty
-- [1,2,3]
--
accumulate_
    :: (a -> b -> a)
      -- ^ accumulating function @f@
    -> NonEmptyVector a
      -- ^ initial non-empty vector (of length @m@)
    -> Vector Int
       -- ^ vector of indices (of length @n1@)
    -> Vector b
       -- ^ vector of values (of length @n2@)
    -> NonEmptyVector a
accumulate_ :: (a -> b -> a)
-> NonEmptyVector a -> Vector Int -> Vector b -> NonEmptyVector a
accumulate_ a -> b -> a
f (NonEmptyVector Vector a
v) Vector Int
i Vector b
b = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector ((a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a
forall a b.
(a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a
V.accumulate_ a -> b -> a
f Vector a
v Vector Int
i Vector b
b)
{-# INLINE accumulate_ #-}

-- | Same as 'accum' but without bounds checking.
--
unsafeAccum
    :: (a -> b -> a)
      -- ^ accumulating function @f@
    -> NonEmptyVector a
      -- ^ initial non-empty vector (of length @m@)
    -> [(Int, b)]
      -- ^ list of index/value pairs (of length @n@)
    -> NonEmptyVector a
unsafeAccum :: (a -> b -> a) -> NonEmptyVector a -> [(Int, b)] -> NonEmptyVector a
unsafeAccum a -> b -> a
f (NonEmptyVector Vector a
v) [(Int, b)]
u = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector ((a -> b -> a) -> Vector a -> [(Int, b)] -> Vector a
forall a b. (a -> b -> a) -> Vector a -> [(Int, b)] -> Vector a
V.unsafeAccum a -> b -> a
f Vector a
v [(Int, b)]
u)
{-# INLINE unsafeAccum #-}

-- | Same as 'accumulate' but without bounds checking.
--
unsafeAccumulate
    :: (a -> b -> a)
      -- ^ accumulating function @f@
    -> NonEmptyVector a
      -- ^ initial non-empty vector (of length @m@)
    -> Vector (Int, b)
      -- ^ vector of index/value pairs (of length @n@)
    -> NonEmptyVector a
unsafeAccumulate :: (a -> b -> a)
-> NonEmptyVector a -> Vector (Int, b) -> NonEmptyVector a
unsafeAccumulate a -> b -> a
f NonEmptyVector a
v Vector (Int, b)
u = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector ((a -> b -> a) -> Vector a -> Vector (Int, b) -> Vector a
forall a b.
(a -> b -> a) -> Vector a -> Vector (Int, b) -> Vector a
V.unsafeAccumulate a -> b -> a
f Vector a
v' Vector (Int, b)
u)
  where
    v' :: Vector a
v' = NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
v
{-# INLINE unsafeAccumulate #-}

-- | Same as 'accumulate_' but without bounds checking.
--
unsafeAccumulate_
    :: (a -> b -> a)
      -- ^ accumulating function @f@
    -> NonEmptyVector a
      -- ^ initial non-empty vector (of length @m@)
    -> Vector Int
      -- ^ vector of indices of length @n1@
    -> Vector b
      -- ^ vector of values (of length @n2@)
    -> NonEmptyVector a
unsafeAccumulate_ :: (a -> b -> a)
-> NonEmptyVector a -> Vector Int -> Vector b -> NonEmptyVector a
unsafeAccumulate_ a -> b -> a
f NonEmptyVector a
v Vector Int
i Vector b
b = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector ((a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a
forall a b.
(a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a
V.unsafeAccumulate_ a -> b -> a
f Vector a
v' Vector Int
i Vector b
b)
  where
    v' :: Vector a
v' = NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
v
{-# INLINE unsafeAccumulate_ #-}

-- ---------------------------------------------------------------------- --
-- Permutations

-- | /O(n)/ Reverse a non-empty vector
--
-- >>> reverse $ unsafeFromList [1..3]
-- [3,2,1]
--
reverse :: NonEmptyVector a -> NonEmptyVector a
reverse :: NonEmptyVector a -> NonEmptyVector a
reverse = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> NonEmptyVector a)
-> (NonEmptyVector a -> Vector a)
-> NonEmptyVector a
-> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> Vector a
forall a. Vector a -> Vector a
V.reverse (Vector a -> Vector a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE reverse #-}

-- | /O(n)/ Yield the non-empty vector obtained by replacing each element
-- @i@ of the non-empty index vector by @xs'!'i@. This is equivalent to
-- @'map' (xs'!') is@ but is often much more efficient.
--
-- >>> backpermute (unsafeFromList [1..3]) (unsafeFromList [2,0])
-- [3,1]
--
backpermute :: NonEmptyVector a -> NonEmptyVector Int -> NonEmptyVector a
backpermute :: NonEmptyVector a -> NonEmptyVector Int -> NonEmptyVector a
backpermute (NonEmptyVector Vector a
v) (NonEmptyVector Vector Int
i)
    = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> Vector Int -> Vector a
forall a. Vector a -> Vector Int -> Vector a
V.backpermute Vector a
v Vector Int
i)
{-# INLINE backpermute #-}

-- | Same as 'backpermute' but without bounds checking.
--
unsafeBackpermute
    :: NonEmptyVector a
    -> NonEmptyVector Int
    -> NonEmptyVector a
unsafeBackpermute :: NonEmptyVector a -> NonEmptyVector Int -> NonEmptyVector a
unsafeBackpermute (NonEmptyVector Vector a
v) (NonEmptyVector Vector Int
i)
    = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> Vector Int -> Vector a
forall a. Vector a -> Vector Int -> Vector a
V.unsafeBackpermute Vector a
v Vector Int
i)
{-# INLINE unsafeBackpermute #-}

-- ---------------------------------------------------------------------- --
-- Safe destructive updates

-- | Apply a destructive operation to a non-empty vector. The operation
-- will be performed in place if it is safe to do so and will modify a
-- copy of the non-empty vector otherwise.
--
modify
    :: (forall s. MVector s a -> ST s ())
    -> NonEmptyVector a
    -> NonEmptyVector a
modify :: (forall s. MVector s a -> ST s ())
-> NonEmptyVector a -> NonEmptyVector a
modify forall s. MVector s a -> ST s ()
p (NonEmptyVector Vector a
v) = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector ((forall s. MVector s a -> ST s ()) -> Vector a -> Vector a
forall a.
(forall s. MVector s a -> ST s ()) -> Vector a -> Vector a
V.modify forall s. MVector s a -> ST s ()
p Vector a
v)
{-# INLINE modify #-}

-- ---------------------------------------------------------------------- --
-- Indexing

-- | /O(n)/ Pair each element in a vector with its index.
--
-- >>> indexed $ unsafeFromList ["a","b","c"]
-- [(0,"a"),(1,"b"),(2,"c")]
--
indexed :: NonEmptyVector a -> NonEmptyVector (Int, a)
indexed :: NonEmptyVector a -> NonEmptyVector (Int, a)
indexed = Vector (Int, a) -> NonEmptyVector (Int, a)
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector (Int, a) -> NonEmptyVector (Int, a))
-> (NonEmptyVector a -> Vector (Int, a))
-> NonEmptyVector a
-> NonEmptyVector (Int, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> Vector (Int, a)
forall a. Vector a -> Vector (Int, a)
V.indexed (Vector a -> Vector (Int, a))
-> (NonEmptyVector a -> Vector a)
-> NonEmptyVector a
-> Vector (Int, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE indexed #-}

-- ---------------------------------------------------------------------- --
-- Mapping

-- | /O(n)/ Map a function over a non-empty vector.
--
-- >>> map (+1) $ unsafeFromList [1..3]
-- [2,3,4]
--
map :: (a -> b) -> NonEmptyVector a -> NonEmptyVector b
map :: (a -> b) -> NonEmptyVector a -> NonEmptyVector b
map a -> b
f = Vector b -> NonEmptyVector b
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector b -> NonEmptyVector b)
-> (NonEmptyVector a -> Vector b)
-> NonEmptyVector a
-> NonEmptyVector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Vector a -> Vector b
forall a b. (a -> b) -> Vector a -> Vector b
V.map a -> b
f (Vector a -> Vector b)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE map #-}

-- | /O(n)/ Apply a function to every element of a non-empty vector and
-- its index.
--
-- >>> imap (\i a -> if i == 2 then a+1 else a+0) $ unsafeFromList [1..3]
-- [1,2,4]
--
imap :: (Int -> a -> b) -> NonEmptyVector a -> NonEmptyVector b
imap :: (Int -> a -> b) -> NonEmptyVector a -> NonEmptyVector b
imap Int -> a -> b
f = Vector b -> NonEmptyVector b
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector b -> NonEmptyVector b)
-> (NonEmptyVector a -> Vector b)
-> NonEmptyVector a
-> NonEmptyVector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> b) -> Vector a -> Vector b
forall a b. (Int -> a -> b) -> Vector a -> Vector b
V.imap Int -> a -> b
f (Vector a -> Vector b)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE imap #-}

-- | Map a function over a vector and concatenate the results.
--
-- >>> concatMap (\a -> unsafeFromList [a,a]) (unsafeFromList [1,2,3])
-- [1,1,2,2,3,3]
--
concatMap
    :: (a -> NonEmptyVector b)
    -> NonEmptyVector a
    -> NonEmptyVector b
concatMap :: (a -> NonEmptyVector b) -> NonEmptyVector a -> NonEmptyVector b
concatMap a -> NonEmptyVector b
f = Vector b -> NonEmptyVector b
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector b -> NonEmptyVector b)
-> (NonEmptyVector a -> Vector b)
-> NonEmptyVector a
-> NonEmptyVector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Vector b) -> Vector a -> Vector b
forall a b. (a -> Vector b) -> Vector a -> Vector b
V.concatMap (NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec (NonEmptyVector b -> Vector b)
-> (a -> NonEmptyVector b) -> a -> Vector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NonEmptyVector b
f) (Vector a -> Vector b)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE concatMap #-}

-- ---------------------------------------------------------------------- --
-- Monadic Mapping

-- | /O(n)/ Apply the monadic action to all elements of the non-empty
-- vector, yielding non-empty vector of results.
--
-- >>> mapM Just (unsafeFromList [1..3])
-- Just [1,2,3]
--
-- >>> mapM (const Nothing) (unsafeFromList [1..3])
-- Nothing
--
mapM :: Monad m => (a -> m b) -> NonEmptyVector a -> m (NonEmptyVector b)
mapM :: (a -> m b) -> NonEmptyVector a -> m (NonEmptyVector b)
mapM a -> m b
f = (Vector b -> NonEmptyVector b)
-> m (Vector b) -> m (NonEmptyVector b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector b -> NonEmptyVector b
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (m (Vector b) -> m (NonEmptyVector b))
-> (NonEmptyVector a -> m (Vector b))
-> NonEmptyVector a
-> m (NonEmptyVector b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m b) -> Vector a -> m (Vector b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM a -> m b
f (Vector a -> m (Vector b))
-> (NonEmptyVector a -> Vector a)
-> NonEmptyVector a
-> m (Vector b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE mapM #-}

-- | /O(n)/ Apply the monadic action to every element of a non-empty
-- vector and its index, yielding a non-empty vector of results.
--
-- >>> imapM (\i a -> if i == 1 then Just a else Just 0) (unsafeFromList [1..3])
-- Just [0,2,0]
--
-- >>> imapM (\_ _ -> Nothing) (unsafeFromList [1..3])
-- Nothing
--
imapM
    :: Monad m
    => (Int -> a -> m b)
    -> NonEmptyVector a
    -> m (NonEmptyVector b)
imapM :: (Int -> a -> m b) -> NonEmptyVector a -> m (NonEmptyVector b)
imapM Int -> a -> m b
f = (Vector b -> NonEmptyVector b)
-> m (Vector b) -> m (NonEmptyVector b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector b -> NonEmptyVector b
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (m (Vector b) -> m (NonEmptyVector b))
-> (NonEmptyVector a -> m (Vector b))
-> NonEmptyVector a
-> m (NonEmptyVector b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> m b) -> Vector a -> m (Vector b)
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m (Vector b)
V.imapM Int -> a -> m b
f (Vector a -> m (Vector b))
-> (NonEmptyVector a -> Vector a)
-> NonEmptyVector a
-> m (Vector b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE imapM #-}

-- | /O(n)/ Apply the monadic action to all elements of a non-empty vector
-- and ignore the results.
--
-- >>> mapM_ (const $ Just ()) (unsafeFromList [1..3])
-- Just ()
--
-- >>> mapM_ (const Nothing) (unsafeFromList [1..3])
-- Nothing
--
mapM_ :: Monad m => (a -> m b) -> NonEmptyVector a -> m ()
mapM_ :: (a -> m b) -> NonEmptyVector a -> m ()
mapM_ a -> m b
f = (a -> m b) -> Vector a -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ a -> m b
f (Vector a -> m ())
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE mapM_ #-}

-- | /O(n)/ Apply the monadic action to every element of a non-emptpy
-- vector and its index, ignoring the results
--
-- >>> imapM_ (\i a -> if i == 1 then P.print a else P.putStrLn "0") (unsafeFromList [1..3])
-- 0
-- 2
-- 0
--
-- >>> imapM_ (\_ _ -> Nothing) (unsafeFromList [1..3])
-- Nothing
--
imapM_ :: Monad m => (Int -> a -> m b) -> NonEmptyVector a -> m ()
imapM_ :: (Int -> a -> m b) -> NonEmptyVector a -> m ()
imapM_ Int -> a -> m b
f = (Int -> a -> m b) -> Vector a -> m ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
V.imapM_ Int -> a -> m b
f (Vector a -> m ())
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE imapM_ #-}

-- | /O(n)/ Apply the monadic action to all elements of the non-empty
-- vector, yielding a  non0empty vector of results.
--
-- Equivalent to @flip 'mapM'@.
--
forM :: Monad m => NonEmptyVector a -> (a -> m b) -> m (NonEmptyVector b)
forM :: NonEmptyVector a -> (a -> m b) -> m (NonEmptyVector b)
forM (NonEmptyVector Vector a
v) a -> m b
f = (Vector b -> NonEmptyVector b)
-> m (Vector b) -> m (NonEmptyVector b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector b -> NonEmptyVector b
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> (a -> m b) -> m (Vector b)
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
V.forM Vector a
v a -> m b
f)
{-# INLINE forM #-}

-- | /O(n)/ Apply the monadic action to all elements of a non-empty
-- vector and ignore the results.
--
-- Equivalent to @flip 'mapM_'@.
--
forM_ :: Monad m => NonEmptyVector a -> (a -> m b) -> m ()
forM_ :: NonEmptyVector a -> (a -> m b) -> m ()
forM_ (NonEmptyVector Vector a
v) a -> m b
f = Vector a -> (a -> m b) -> m ()
forall (m :: * -> *) a b. Monad m => Vector a -> (a -> m b) -> m ()
V.forM_ Vector a
v a -> m b
f
{-# INLINE forM_ #-}

-- ---------------------------------------------------------------------- --
-- Zipping

-- | /O(min(m,n))/ Zip two non-empty vectors with the given function.
--
-- >>> zipWith (+) (unsafeFromList [1..3]) (unsafeFromList [1..3])
-- [2,4,6]
--
zipWith
    :: (a -> b -> c)
    -> NonEmptyVector a
    -> NonEmptyVector b
    -> NonEmptyVector c
zipWith :: (a -> b -> c)
-> NonEmptyVector a -> NonEmptyVector b -> NonEmptyVector c
zipWith a -> b -> c
f NonEmptyVector a
a NonEmptyVector b
b = Vector c -> NonEmptyVector c
forall a. Vector a -> NonEmptyVector a
NonEmptyVector ((a -> b -> c) -> Vector a -> Vector b -> Vector c
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
V.zipWith a -> b -> c
f Vector a
a' Vector b
b')
  where
    a' :: Vector a
a' = NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
{-# INLINE zipWith #-}

-- | Zip three non-empty vectors with the given function.
--
--
zipWith3
    :: (a -> b -> c -> d)
    -> NonEmptyVector a
    -> NonEmptyVector b
    -> NonEmptyVector c
    -> NonEmptyVector d
zipWith3 :: (a -> b -> c -> d)
-> NonEmptyVector a
-> NonEmptyVector b
-> NonEmptyVector c
-> NonEmptyVector d
zipWith3 a -> b -> c -> d
f NonEmptyVector a
a NonEmptyVector b
b NonEmptyVector c
c = Vector d -> NonEmptyVector d
forall a. Vector a -> NonEmptyVector a
NonEmptyVector ((a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d
forall a b c d.
(a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d
V.zipWith3 a -> b -> c -> d
f Vector a
a' Vector b
b' Vector c
c')
  where
    a' :: Vector a
a' = NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
c' = NonEmptyVector c -> Vector c
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector c
c
{-# INLINE zipWith3 #-}

-- | Zip four non-empty vectors with the given function.
--
zipWith4
    :: (a -> b -> c -> d -> e)
    -> NonEmptyVector a
    -> NonEmptyVector b
    -> NonEmptyVector c
    -> NonEmptyVector d
    -> NonEmptyVector e
zipWith4 :: (a -> b -> c -> d -> e)
-> NonEmptyVector a
-> NonEmptyVector b
-> NonEmptyVector c
-> NonEmptyVector d
-> NonEmptyVector e
zipWith4 a -> b -> c -> d -> e
f NonEmptyVector a
a NonEmptyVector b
b NonEmptyVector c
c NonEmptyVector d
d = Vector e -> NonEmptyVector e
forall a. Vector a -> NonEmptyVector a
NonEmptyVector ((a -> b -> c -> d -> e)
-> Vector a -> Vector b -> Vector c -> Vector d -> Vector e
forall a b c d e.
(a -> b -> c -> d -> e)
-> Vector a -> Vector b -> Vector c -> Vector d -> Vector e
V.zipWith4 a -> b -> c -> d -> e
f Vector a
a' Vector b
b' Vector c
c' Vector d
d')
  where
    a' :: Vector a
a' = NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
c' = NonEmptyVector c -> Vector c
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector c
c
    d' :: Vector d
d' = NonEmptyVector d -> Vector d
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector d
d
{-# INLINE zipWith4 #-}

-- | Zip five non-empty vectors with the given function.
--
zipWith5
    :: (a -> b -> c -> d -> e -> f)
    -> NonEmptyVector a
    -> NonEmptyVector b
    -> NonEmptyVector c
    -> NonEmptyVector d
    -> NonEmptyVector e
    -> NonEmptyVector f
zipWith5 :: (a -> b -> c -> d -> e -> f)
-> NonEmptyVector a
-> NonEmptyVector b
-> NonEmptyVector c
-> NonEmptyVector d
-> NonEmptyVector e
-> NonEmptyVector f
zipWith5 a -> b -> c -> d -> e -> f
f NonEmptyVector a
a NonEmptyVector b
b NonEmptyVector c
c NonEmptyVector d
d NonEmptyVector e
e = Vector f -> NonEmptyVector f
forall a. Vector a -> NonEmptyVector a
NonEmptyVector ((a -> b -> c -> d -> e -> f)
-> Vector a
-> Vector b
-> Vector c
-> Vector d
-> Vector e
-> Vector f
forall a b c d e f.
(a -> b -> c -> d -> e -> f)
-> Vector a
-> Vector b
-> Vector c
-> Vector d
-> Vector e
-> Vector f
V.zipWith5 a -> b -> c -> d -> e -> f
f Vector a
a' Vector b
b' Vector c
c' Vector d
d' Vector e
e')
  where
    a' :: Vector a
a' = NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
c' = NonEmptyVector c -> Vector c
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector c
c
    d' :: Vector d
d' = NonEmptyVector d -> Vector d
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector d
d
    e' :: Vector e
e' = NonEmptyVector e -> Vector e
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector e
e
{-# INLINE zipWith5 #-}

-- | Zip six non-empty vectors with the given function.
--
zipWith6
    :: (a -> b -> c -> d -> e -> f -> g)
    -> NonEmptyVector a
    -> NonEmptyVector b
    -> NonEmptyVector c
    -> NonEmptyVector d
    -> NonEmptyVector e
    -> NonEmptyVector f
    -> NonEmptyVector g
zipWith6 :: (a -> b -> c -> d -> e -> f -> g)
-> NonEmptyVector a
-> NonEmptyVector b
-> NonEmptyVector c
-> NonEmptyVector d
-> NonEmptyVector e
-> NonEmptyVector f
-> NonEmptyVector g
zipWith6 a -> b -> c -> d -> e -> f -> g
k NonEmptyVector a
a NonEmptyVector b
b NonEmptyVector c
c NonEmptyVector d
d NonEmptyVector e
e NonEmptyVector f
f = Vector g -> NonEmptyVector g
forall a. Vector a -> NonEmptyVector a
NonEmptyVector ((a -> b -> c -> d -> e -> f -> g)
-> Vector a
-> Vector b
-> Vector c
-> Vector d
-> Vector e
-> Vector f
-> Vector g
forall a b c d e f g.
(a -> b -> c -> d -> e -> f -> g)
-> Vector a
-> Vector b
-> Vector c
-> Vector d
-> Vector e
-> Vector f
-> Vector g
V.zipWith6 a -> b -> c -> d -> e -> f -> g
k Vector a
a' Vector b
b' Vector c
c' Vector d
d' Vector e
e' Vector f
f')
  where
    a' :: Vector a
a' = NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
c' = NonEmptyVector c -> Vector c
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector c
c
    d' :: Vector d
d' = NonEmptyVector d -> Vector d
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector d
d
    e' :: Vector e
e' = NonEmptyVector e -> Vector e
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector e
e
    f' :: Vector f
f' = NonEmptyVector f -> Vector f
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector f
f
{-# INLINE zipWith6 #-}


-- | /O(min(m,n))/ Zip two non-empty vectors with a function that also
-- takes the elements' indices.
--
izipWith
    :: (Int -> a -> b -> c)
    -> NonEmptyVector a
    -> NonEmptyVector b
    -> NonEmptyVector c
izipWith :: (Int -> a -> b -> c)
-> NonEmptyVector a -> NonEmptyVector b -> NonEmptyVector c
izipWith Int -> a -> b -> c
f NonEmptyVector a
a NonEmptyVector b
b = Vector c -> NonEmptyVector c
forall a. Vector a -> NonEmptyVector a
NonEmptyVector ((Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c
forall a b c.
(Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c
V.izipWith Int -> a -> b -> c
f Vector a
a' Vector b
b')
  where
    a' :: Vector a
a' = NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
{-# INLINE izipWith #-}

-- | Zip three non-empty vectors and their indices with the given function.
--
izipWith3
    :: (Int -> a -> b -> c -> d)
    -> NonEmptyVector a
    -> NonEmptyVector b
    -> NonEmptyVector c
    -> NonEmptyVector d
izipWith3 :: (Int -> a -> b -> c -> d)
-> NonEmptyVector a
-> NonEmptyVector b
-> NonEmptyVector c
-> NonEmptyVector d
izipWith3 Int -> a -> b -> c -> d
f NonEmptyVector a
a NonEmptyVector b
b NonEmptyVector c
c = Vector d -> NonEmptyVector d
forall a. Vector a -> NonEmptyVector a
NonEmptyVector ((Int -> a -> b -> c -> d)
-> Vector a -> Vector b -> Vector c -> Vector d
forall a b c d.
(Int -> a -> b -> c -> d)
-> Vector a -> Vector b -> Vector c -> Vector d
V.izipWith3 Int -> a -> b -> c -> d
f Vector a
a' Vector b
b' Vector c
c')
  where
    a' :: Vector a
a' = NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
c' = NonEmptyVector c -> Vector c
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector c
c
{-# INLINE izipWith3 #-}

-- | Zip four non-empty vectors and their indices with the given function.
--
izipWith4
    :: (Int -> a -> b -> c -> d -> e)
    -> NonEmptyVector a
    -> NonEmptyVector b
    -> NonEmptyVector c
    -> NonEmptyVector d
    -> NonEmptyVector e
izipWith4 :: (Int -> a -> b -> c -> d -> e)
-> NonEmptyVector a
-> NonEmptyVector b
-> NonEmptyVector c
-> NonEmptyVector d
-> NonEmptyVector e
izipWith4 Int -> a -> b -> c -> d -> e
f NonEmptyVector a
a NonEmptyVector b
b NonEmptyVector c
c NonEmptyVector d
d = Vector e -> NonEmptyVector e
forall a. Vector a -> NonEmptyVector a
NonEmptyVector ((Int -> a -> b -> c -> d -> e)
-> Vector a -> Vector b -> Vector c -> Vector d -> Vector e
forall a b c d e.
(Int -> a -> b -> c -> d -> e)
-> Vector a -> Vector b -> Vector c -> Vector d -> Vector e
V.izipWith4 Int -> a -> b -> c -> d -> e
f Vector a
a' Vector b
b' Vector c
c' Vector d
d')
  where
    a' :: Vector a
a' = NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
c' = NonEmptyVector c -> Vector c
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector c
c
    d' :: Vector d
d' = NonEmptyVector d -> Vector d
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector d
d
{-# INLINE izipWith4 #-}

-- | Zip five non-empty vectors and their indices with the given function.
--
izipWith5
    :: (Int -> a -> b -> c -> d -> e -> f)
    -> NonEmptyVector a
    -> NonEmptyVector b
    -> NonEmptyVector c
    -> NonEmptyVector d
    -> NonEmptyVector e
    -> NonEmptyVector f
izipWith5 :: (Int -> a -> b -> c -> d -> e -> f)
-> NonEmptyVector a
-> NonEmptyVector b
-> NonEmptyVector c
-> NonEmptyVector d
-> NonEmptyVector e
-> NonEmptyVector f
izipWith5 Int -> a -> b -> c -> d -> e -> f
f NonEmptyVector a
a NonEmptyVector b
b NonEmptyVector c
c NonEmptyVector d
d NonEmptyVector e
e = Vector f -> NonEmptyVector f
forall a. Vector a -> NonEmptyVector a
NonEmptyVector ((Int -> a -> b -> c -> d -> e -> f)
-> Vector a
-> Vector b
-> Vector c
-> Vector d
-> Vector e
-> Vector f
forall a b c d e f.
(Int -> a -> b -> c -> d -> e -> f)
-> Vector a
-> Vector b
-> Vector c
-> Vector d
-> Vector e
-> Vector f
V.izipWith5 Int -> a -> b -> c -> d -> e -> f
f Vector a
a' Vector b
b' Vector c
c' Vector d
d' Vector e
e')
  where
    a' :: Vector a
a' = NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
c' = NonEmptyVector c -> Vector c
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector c
c
    d' :: Vector d
d' = NonEmptyVector d -> Vector d
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector d
d
    e' :: Vector e
e' = NonEmptyVector e -> Vector e
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector e
e
{-# INLINE izipWith5 #-}

-- | Zip six non-empty vectors and their indices with the given function.
--
izipWith6
    :: (Int -> a -> b -> c -> d -> e -> f -> g)
    -> NonEmptyVector a
    -> NonEmptyVector b
    -> NonEmptyVector c
    -> NonEmptyVector d
    -> NonEmptyVector e
    -> NonEmptyVector f
    -> NonEmptyVector g
izipWith6 :: (Int -> a -> b -> c -> d -> e -> f -> g)
-> NonEmptyVector a
-> NonEmptyVector b
-> NonEmptyVector c
-> NonEmptyVector d
-> NonEmptyVector e
-> NonEmptyVector f
-> NonEmptyVector g
izipWith6 Int -> a -> b -> c -> d -> e -> f -> g
k NonEmptyVector a
a NonEmptyVector b
b NonEmptyVector c
c NonEmptyVector d
d NonEmptyVector e
e NonEmptyVector f
f = Vector g -> NonEmptyVector g
forall a. Vector a -> NonEmptyVector a
NonEmptyVector ((Int -> a -> b -> c -> d -> e -> f -> g)
-> Vector a
-> Vector b
-> Vector c
-> Vector d
-> Vector e
-> Vector f
-> Vector g
forall a b c d e f g.
(Int -> a -> b -> c -> d -> e -> f -> g)
-> Vector a
-> Vector b
-> Vector c
-> Vector d
-> Vector e
-> Vector f
-> Vector g
V.izipWith6 Int -> a -> b -> c -> d -> e -> f -> g
k Vector a
a' Vector b
b' Vector c
c' Vector d
d' Vector e
e' Vector f
f')
  where
    a' :: Vector a
a' = NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
c' = NonEmptyVector c -> Vector c
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector c
c
    d' :: Vector d
d' = NonEmptyVector d -> Vector d
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector d
d
    e' :: Vector e
e' = NonEmptyVector e -> Vector e
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector e
e
    f' :: Vector f
f' = NonEmptyVector f -> Vector f
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector f
f
{-# INLINE izipWith6 #-}

-- | /O(min(n,m))/ Elementwise pairing of non-empty vector elements. This is a special case
-- of 'zipWith' where the function argument is '(,)'
--
zip :: NonEmptyVector a -> NonEmptyVector b -> NonEmptyVector (a, b)
zip :: NonEmptyVector a -> NonEmptyVector b -> NonEmptyVector (a, b)
zip NonEmptyVector a
a NonEmptyVector b
b = Vector (a, b) -> NonEmptyVector (a, b)
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> Vector b -> Vector (a, b)
forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip Vector a
a' Vector b
b')
  where
    a' :: Vector a
a' = NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
{-# INLINE zip #-}

-- | Zip together three non-empty vectors.
--
zip3
    :: NonEmptyVector a
    -> NonEmptyVector b
    -> NonEmptyVector c
    -> NonEmptyVector (a, b, c)
zip3 :: NonEmptyVector a
-> NonEmptyVector b -> NonEmptyVector c -> NonEmptyVector (a, b, c)
zip3 NonEmptyVector a
a NonEmptyVector b
b NonEmptyVector c
c = Vector (a, b, c) -> NonEmptyVector (a, b, c)
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> Vector b -> Vector c -> Vector (a, b, c)
forall a b c. Vector a -> Vector b -> Vector c -> Vector (a, b, c)
V.zip3 Vector a
a' Vector b
b' Vector c
c')
  where
    a' :: Vector a
a' = NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
c' = NonEmptyVector c -> Vector c
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector c
c
{-# INLINE zip3 #-}

-- | Zip together four non-empty vectors.
--
zip4
    :: NonEmptyVector a
    -> NonEmptyVector b
    -> NonEmptyVector c
    -> NonEmptyVector d
    -> NonEmptyVector (a, b, c, d)
zip4 :: NonEmptyVector a
-> NonEmptyVector b
-> NonEmptyVector c
-> NonEmptyVector d
-> NonEmptyVector (a, b, c, d)
zip4 NonEmptyVector a
a NonEmptyVector b
b NonEmptyVector c
c NonEmptyVector d
d = Vector (a, b, c, d) -> NonEmptyVector (a, b, c, d)
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> Vector b -> Vector c -> Vector d -> Vector (a, b, c, d)
forall a b c d.
Vector a -> Vector b -> Vector c -> Vector d -> Vector (a, b, c, d)
V.zip4 Vector a
a' Vector b
b' Vector c
c' Vector d
d')
  where
    a' :: Vector a
a' = NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
c' = NonEmptyVector c -> Vector c
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector c
c
    d' :: Vector d
d' = NonEmptyVector d -> Vector d
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector d
d
{-# INLINE zip4 #-}

-- | Zip together five non-empty vectors.
--
zip5
    :: NonEmptyVector a
    -> NonEmptyVector b
    -> NonEmptyVector c
    -> NonEmptyVector d
    -> NonEmptyVector e
    -> NonEmptyVector (a, b, c, d, e)
zip5 :: NonEmptyVector a
-> NonEmptyVector b
-> NonEmptyVector c
-> NonEmptyVector d
-> NonEmptyVector e
-> NonEmptyVector (a, b, c, d, e)
zip5 NonEmptyVector a
a NonEmptyVector b
b NonEmptyVector c
c NonEmptyVector d
d NonEmptyVector e
e = Vector (a, b, c, d, e) -> NonEmptyVector (a, b, c, d, e)
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a
-> Vector b
-> Vector c
-> Vector d
-> Vector e
-> Vector (a, b, c, d, e)
forall a b c d e.
Vector a
-> Vector b
-> Vector c
-> Vector d
-> Vector e
-> Vector (a, b, c, d, e)
V.zip5 Vector a
a' Vector b
b' Vector c
c' Vector d
d' Vector e
e')
  where
    a' :: Vector a
a' = NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
c' = NonEmptyVector c -> Vector c
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector c
c
    d' :: Vector d
d' = NonEmptyVector d -> Vector d
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector d
d
    e' :: Vector e
e' = NonEmptyVector e -> Vector e
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector e
e
{-# INLINE zip5 #-}

-- | Zip together six non-empty vectors.
--
zip6
    :: NonEmptyVector a
    -> NonEmptyVector b
    -> NonEmptyVector c
    -> NonEmptyVector d
    -> NonEmptyVector e
    -> NonEmptyVector f
    -> NonEmptyVector (a, b, c, d, e, f)
zip6 :: NonEmptyVector a
-> NonEmptyVector b
-> NonEmptyVector c
-> NonEmptyVector d
-> NonEmptyVector e
-> NonEmptyVector f
-> NonEmptyVector (a, b, c, d, e, f)
zip6 NonEmptyVector a
a NonEmptyVector b
b NonEmptyVector c
c NonEmptyVector d
d NonEmptyVector e
e NonEmptyVector f
f = Vector (a, b, c, d, e, f) -> NonEmptyVector (a, b, c, d, e, f)
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a
-> Vector b
-> Vector c
-> Vector d
-> Vector e
-> Vector f
-> Vector (a, b, c, d, e, f)
forall a b c d e f.
Vector a
-> Vector b
-> Vector c
-> Vector d
-> Vector e
-> Vector f
-> Vector (a, b, c, d, e, f)
V.zip6 Vector a
a' Vector b
b' Vector c
c' Vector d
d' Vector e
e' Vector f
f')
  where
    a' :: Vector a
a' = NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
c' = NonEmptyVector c -> Vector c
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector c
c
    d' :: Vector d
d' = NonEmptyVector d -> Vector d
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector d
d
    e' :: Vector e
e' = NonEmptyVector e -> Vector e
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector e
e
    f' :: Vector f
f' = NonEmptyVector f -> Vector f
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector f
f
{-# INLINE zip6 #-}

-- ---------------------------------------------------------------------- --
-- Monadic Zipping

-- | /O(min(m,n))/ Zip the two non-empty vectors with the monadic action
-- and yield a non-empty vector of results.
--
zipWithM
    :: Monad m
    => (a -> b -> m c)
    -> NonEmptyVector a
    -> NonEmptyVector b
    -> m (NonEmptyVector c)
zipWithM :: (a -> b -> m c)
-> NonEmptyVector a -> NonEmptyVector b -> m (NonEmptyVector c)
zipWithM a -> b -> m c
f NonEmptyVector a
a NonEmptyVector b
b = (Vector c -> NonEmptyVector c)
-> m (Vector c) -> m (NonEmptyVector c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector c -> NonEmptyVector c
forall a. Vector a -> NonEmptyVector a
NonEmptyVector ((a -> b -> m c) -> Vector a -> Vector b -> m (Vector c)
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> Vector a -> Vector b -> m (Vector c)
V.zipWithM a -> b -> m c
f Vector a
a' Vector b
b')
  where
    a' :: Vector a
a' = NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
{-# INLINE zipWithM #-}

-- | /O(min(m,n))/ Zip the two non-empty vectors with a monadic action
-- that also takes the element index and yield a vector of results.
--
izipWithM
    :: Monad m
    => (Int -> a -> b -> m c)
    -> NonEmptyVector a
    -> NonEmptyVector b
    -> m (NonEmptyVector c)
izipWithM :: (Int -> a -> b -> m c)
-> NonEmptyVector a -> NonEmptyVector b -> m (NonEmptyVector c)
izipWithM Int -> a -> b -> m c
f NonEmptyVector a
a NonEmptyVector b
b = (Vector c -> NonEmptyVector c)
-> m (Vector c) -> m (NonEmptyVector c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector c -> NonEmptyVector c
forall a. Vector a -> NonEmptyVector a
NonEmptyVector ((Int -> a -> b -> m c) -> Vector a -> Vector b -> m (Vector c)
forall (m :: * -> *) a b c.
Monad m =>
(Int -> a -> b -> m c) -> Vector a -> Vector b -> m (Vector c)
V.izipWithM Int -> a -> b -> m c
f Vector a
a' Vector b
b')
  where
    a' :: Vector a
a' = NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
{-# INLINE izipWithM #-}

-- | /O(min(m,n))/ Zip the two non-empty vectors with the monadic action
-- and ignore the results.
--
zipWithM_
    :: Monad m
    => (a -> b -> m c)
    -> NonEmptyVector a
    -> NonEmptyVector b
    -> m ()
zipWithM_ :: (a -> b -> m c) -> NonEmptyVector a -> NonEmptyVector b -> m ()
zipWithM_ a -> b -> m c
f NonEmptyVector a
a NonEmptyVector b
b = (a -> b -> m c) -> Vector a -> Vector b -> m ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> Vector a -> Vector b -> m ()
V.zipWithM_ a -> b -> m c
f (NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a) (NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b)
{-# INLINE zipWithM_ #-}

-- | /O(min(m,n))/ Zip the two non-empty vectors with a monadic action
-- that also takes the element index and ignore the results.
--
izipWithM_
    :: Monad m
    => (Int -> a -> b -> m c)
    -> NonEmptyVector a
    -> NonEmptyVector b
    -> m ()
izipWithM_ :: (Int -> a -> b -> m c)
-> NonEmptyVector a -> NonEmptyVector b -> m ()
izipWithM_ Int -> a -> b -> m c
f NonEmptyVector a
a NonEmptyVector b
b = (Int -> a -> b -> m c) -> Vector a -> Vector b -> m ()
forall (m :: * -> *) a b c.
Monad m =>
(Int -> a -> b -> m c) -> Vector a -> Vector b -> m ()
V.izipWithM_ Int -> a -> b -> m c
f (NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a) (NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b)
{-# INLINE izipWithM_ #-}

-- ---------------------------------------------------------------------- --
-- Unzipping

-- | /O(min(m,n))/ Unzip a non-empty vector of pairs.
--
unzip :: NonEmptyVector (a, b) -> (NonEmptyVector a, NonEmptyVector b)
unzip :: NonEmptyVector (a, b) -> (NonEmptyVector a, NonEmptyVector b)
unzip (NonEmptyVector Vector (a, b)
v) = case Vector (a, b) -> (Vector a, Vector b)
forall a b. Vector (a, b) -> (Vector a, Vector b)
V.unzip Vector (a, b)
v of
    ~(Vector a
a,Vector b
b) -> (Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector a
a, Vector b -> NonEmptyVector b
forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector b
b)
{-# INLINE unzip #-}

-- | Unzip a non-empty vector of triples.
--
unzip3
    :: NonEmptyVector (a, b, c)
    -> (NonEmptyVector a, NonEmptyVector b, NonEmptyVector c)
unzip3 :: NonEmptyVector (a, b, c)
-> (NonEmptyVector a, NonEmptyVector b, NonEmptyVector c)
unzip3 (NonEmptyVector Vector (a, b, c)
v) = case Vector (a, b, c) -> (Vector a, Vector b, Vector c)
forall a b c. Vector (a, b, c) -> (Vector a, Vector b, Vector c)
V.unzip3 Vector (a, b, c)
v of
    ~(Vector a
a,Vector b
b,Vector c
c) ->
      ( Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector a
a
      , Vector b -> NonEmptyVector b
forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector b
b
      , Vector c -> NonEmptyVector c
forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector c
c
      )
{-# INLINE unzip3 #-}

-- | Unzip a non-empty vector of quadruples.
--
unzip4
    :: NonEmptyVector (a, b, c, d)
    -> ( NonEmptyVector a
       , NonEmptyVector b
       , NonEmptyVector c
       , NonEmptyVector d
       )
unzip4 :: NonEmptyVector (a, b, c, d)
-> (NonEmptyVector a, NonEmptyVector b, NonEmptyVector c,
    NonEmptyVector d)
unzip4 (NonEmptyVector Vector (a, b, c, d)
v) = case Vector (a, b, c, d) -> (Vector a, Vector b, Vector c, Vector d)
forall a b c d.
Vector (a, b, c, d) -> (Vector a, Vector b, Vector c, Vector d)
V.unzip4 Vector (a, b, c, d)
v of
    ~(Vector a
a,Vector b
b,Vector c
c,Vector d
d) ->
      ( Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector a
a
      , Vector b -> NonEmptyVector b
forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector b
b
      , Vector c -> NonEmptyVector c
forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector c
c
      , Vector d -> NonEmptyVector d
forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector d
d
      )
{-# INLINE unzip4 #-}

-- | Unzip a non-empty vector of quintuples.
--
unzip5
    :: NonEmptyVector (a, b, c, d, e)
    -> ( NonEmptyVector a
       , NonEmptyVector b
       , NonEmptyVector c
       , NonEmptyVector d
       , NonEmptyVector e
       )
unzip5 :: NonEmptyVector (a, b, c, d, e)
-> (NonEmptyVector a, NonEmptyVector b, NonEmptyVector c,
    NonEmptyVector d, NonEmptyVector e)
unzip5 (NonEmptyVector Vector (a, b, c, d, e)
v) = case Vector (a, b, c, d, e)
-> (Vector a, Vector b, Vector c, Vector d, Vector e)
forall a b c d e.
Vector (a, b, c, d, e)
-> (Vector a, Vector b, Vector c, Vector d, Vector e)
V.unzip5 Vector (a, b, c, d, e)
v of
    ~(Vector a
a,Vector b
b,Vector c
c,Vector d
d,Vector e
e) ->
      ( Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector a
a
      , Vector b -> NonEmptyVector b
forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector b
b
      , Vector c -> NonEmptyVector c
forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector c
c
      , Vector d -> NonEmptyVector d
forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector d
d
      , Vector e -> NonEmptyVector e
forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector e
e
      )
{-# INLINE unzip5 #-}

-- | Unzip a non-empty vector of sextuples.
--
unzip6
    :: NonEmptyVector (a, b, c, d, e, f)
    -> ( NonEmptyVector a
       , NonEmptyVector b
       , NonEmptyVector c
       , NonEmptyVector d
       , NonEmptyVector e
       , NonEmptyVector f
       )
unzip6 :: NonEmptyVector (a, b, c, d, e, f)
-> (NonEmptyVector a, NonEmptyVector b, NonEmptyVector c,
    NonEmptyVector d, NonEmptyVector e, NonEmptyVector f)
unzip6 (NonEmptyVector Vector (a, b, c, d, e, f)
v) = case Vector (a, b, c, d, e, f)
-> (Vector a, Vector b, Vector c, Vector d, Vector e, Vector f)
forall a b c d e f.
Vector (a, b, c, d, e, f)
-> (Vector a, Vector b, Vector c, Vector d, Vector e, Vector f)
V.unzip6 Vector (a, b, c, d, e, f)
v of
    ~(Vector a
a,Vector b
b,Vector c
c,Vector d
d,Vector e
e,Vector f
f) ->
      ( Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector a
a
      , Vector b -> NonEmptyVector b
forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector b
b
      , Vector c -> NonEmptyVector c
forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector c
c
      , Vector d -> NonEmptyVector d
forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector d
d
      , Vector e -> NonEmptyVector e
forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector e
e
      , Vector f -> NonEmptyVector f
forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector f
f
      )
{-# INLINE unzip6 #-}

-- ---------------------------------------------------------------------- --
-- Filtering

-- | /O(n)/ Drop elements that do not satisfy the predicate.
--
-- If no elements satisfy the predicate, the resulting vector may be empty.
--
-- >>> filter (\a -> if a == 2 then False else True) (unsafeFromList [1..3])
-- [1,3]
--
-- >>> filter (const False) (unsafeFromList [1..3])
-- []
--
filter :: (a -> Bool) -> NonEmptyVector a -> Vector a
filter :: (a -> Bool) -> NonEmptyVector a -> Vector a
filter a -> Bool
f = (a -> Bool) -> Vector a -> Vector a
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter a -> Bool
f (Vector a -> Vector a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE filter #-}

-- | /O(n)/ Drop elements that do not satisfy the predicate which is
-- applied to values and their indices.
--
-- If no elements satisfy the predicate, the resulting vector may be empty.
--
-- >>> ifilter (\i a -> if a == 2 || i == 0 then False else True) (unsafeFromList [1..3])
-- [3]
--
-- >>> ifilter (\_ _ -> False) (unsafeFromList [1..3])
-- []
--
ifilter
    :: (Int -> a -> Bool)
    -> NonEmptyVector a
    -> Vector a
ifilter :: (Int -> a -> Bool) -> NonEmptyVector a -> Vector a
ifilter Int -> a -> Bool
f = (Int -> a -> Bool) -> Vector a -> Vector a
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter Int -> a -> Bool
f (Vector a -> Vector a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE ifilter #-}

-- | /O(n)/ Drop elements that do not satisfy the monadic predicate.
--
-- If no elements satisfy the predicate, the resulting vector may be empty.
--
-- >>> filterM (\a -> if a == 2 then Just False else Just True) (unsafeFromList [1..3])
-- Just [1,3]
--
-- >>> filterM (\a -> if a == 2 then Nothing else Just True) (unsafeFromList [1..3])
-- Nothing
--
-- >>> filterM (const $ Just False) (unsafeFromList [1..3])
-- Just []
--
filterM
    :: Monad m
    => (a -> m Bool)
    -> NonEmptyVector a
    -> m (Vector a)
filterM :: (a -> m Bool) -> NonEmptyVector a -> m (Vector a)
filterM a -> m Bool
f = (a -> m Bool) -> Vector a -> m (Vector a)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Vector a -> m (Vector a)
V.filterM a -> m Bool
f (Vector a -> m (Vector a))
-> (NonEmptyVector a -> Vector a)
-> NonEmptyVector a
-> m (Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE filterM #-}

-- | /O(n)/ Drop elements that do not satisfy the monadic predicate that is
-- a function of index and value.
--
-- If no elements satisfy the predicate, the resulting vector may be empty.
--
-- TODO: this should be a more efficient function in `vector`.
--
-- >>> ifilterM (\i a -> if a == 2 || i == 0 then Just False else Just True) (unsafeFromList [1..3])
-- Just [3]
--
-- >>> ifilterM (\i a -> if a == 2 || i == 0 then Nothing else Just True) (unsafeFromList [1..3])
-- Nothing
--
-- >>> ifilterM (\_ _ -> Just False) (unsafeFromList [1..3])
-- Just []
--
ifilterM
    :: Monad m
    => (Int -> a -> m Bool)
    -> NonEmptyVector a
    -> m (Vector a)
ifilterM :: (Int -> a -> m Bool) -> NonEmptyVector a -> m (Vector a)
ifilterM Int -> a -> m Bool
f = (Vector (Int, a) -> Vector a)
-> m (Vector (Int, a)) -> m (Vector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Int, a) -> a) -> Vector (Int, a) -> Vector a
forall a b. (a -> b) -> Vector a -> Vector b
V.map (Int, a) -> a
forall a b. (a, b) -> b
snd)
    (m (Vector (Int, a)) -> m (Vector a))
-> (NonEmptyVector a -> m (Vector (Int, a)))
-> NonEmptyVector a
-> m (Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, a) -> m Bool) -> Vector (Int, a) -> m (Vector (Int, a))
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Vector a -> m (Vector a)
V.filterM ((Int -> a -> m Bool) -> (Int, a) -> m Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> a -> m Bool
f)
    (Vector (Int, a) -> m (Vector (Int, a)))
-> (NonEmptyVector a -> Vector (Int, a))
-> NonEmptyVector a
-> m (Vector (Int, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> Vector (Int, a)
forall a. Vector a -> Vector (Int, a)
V.indexed
    (Vector a -> Vector (Int, a))
-> (NonEmptyVector a -> Vector a)
-> NonEmptyVector a
-> Vector (Int, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE ifilterM #-}

-- | /O(n)/ Drop repeated adjacent elements.
--
-- >>> uniq $ unsafeFromList [1,1,2,2,3,3,1]
-- [1,2,3,1]
--
uniq :: Eq a => NonEmptyVector a -> NonEmptyVector a
uniq :: NonEmptyVector a -> NonEmptyVector a
uniq = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> NonEmptyVector a)
-> (NonEmptyVector a -> Vector a)
-> NonEmptyVector a
-> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> Vector a
forall a. Eq a => Vector a -> Vector a
V.uniq (Vector a -> Vector a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE uniq #-}

-- | /O(n)/ Drop elements when predicate returns Nothing
--
-- If no elements satisfy the predicate, the resulting vector may be empty.
--
-- >>> mapMaybe (\a -> if a == 2 then Nothing else Just a) (unsafeFromList [1..3])
-- [1,3]
--
mapMaybe
    :: (a -> Maybe b)
    -> NonEmptyVector a
    -> Vector b
mapMaybe :: (a -> Maybe b) -> NonEmptyVector a -> Vector b
mapMaybe a -> Maybe b
f = (a -> Maybe b) -> Vector a -> Vector b
forall a b. (a -> Maybe b) -> Vector a -> Vector b
V.mapMaybe a -> Maybe b
f (Vector a -> Vector b)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE mapMaybe #-}

-- | /O(n)/ Drop elements when predicate, applied to index and value, returns Nothing
--
-- If no elements satisfy the predicate, the resulting vector may be empty.
--
-- >>> imapMaybe (\i a -> if a == 2 || i == 2 then Nothing else Just a) (unsafeFromList [1..3])
-- [1]
--
imapMaybe
    :: (Int -> a -> Maybe b)
    -> NonEmptyVector a
    -> Vector b
imapMaybe :: (Int -> a -> Maybe b) -> NonEmptyVector a -> Vector b
imapMaybe Int -> a -> Maybe b
f = (Int -> a -> Maybe b) -> Vector a -> Vector b
forall a b. (Int -> a -> Maybe b) -> Vector a -> Vector b
V.imapMaybe Int -> a -> Maybe b
f (Vector a -> Vector b)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE imapMaybe #-}

-- | /O(n)/ Yield the longest prefix of elements satisfying the predicate
-- without copying.
--
-- If no elements satisfy the predicate, the resulting vector may be empty.
--
-- >>> takeWhile (/= 3) (unsafeFromList [1..3])
-- [1,2]
--
takeWhile :: (a -> Bool) -> NonEmptyVector a -> Vector a
takeWhile :: (a -> Bool) -> NonEmptyVector a -> Vector a
takeWhile a -> Bool
f = (a -> Bool) -> Vector a -> Vector a
forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile a -> Bool
f (Vector a -> Vector a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE takeWhile #-}

-- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate
-- without copying.
--
-- If all elements satisfy the predicate, the resulting vector may be empty.
--
-- >>> dropWhile (/= 3) (unsafeFromList [1..3])
-- [3]
--
dropWhile :: (a -> Bool) -> NonEmptyVector a -> Vector a
dropWhile :: (a -> Bool) -> NonEmptyVector a -> Vector a
dropWhile a -> Bool
f = (a -> Bool) -> Vector a -> Vector a
forall a. (a -> Bool) -> Vector a -> Vector a
V.dropWhile a -> Bool
f (Vector a -> Vector a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE dropWhile #-}

-- ---------------------------------------------------------------------- --
-- Partitioning

-- | /O(n)/ Split the non-empty vector in two parts, the first one
-- containing those elements that satisfy the predicate and the second
-- one those that don't. The relative order of the elements is preserved
-- at the cost of a sometimes reduced performance compared to
-- 'unstablePartition'.
--
-- If all or no elements satisfy the predicate, one of the resulting vectors
-- may be empty.
--
-- >>> partition (< 3) (unsafeFromList [1..5])
-- ([1,2],[3,4,5])
--
partition :: (a -> Bool) -> NonEmptyVector a -> (Vector a, Vector a)
partition :: (a -> Bool) -> NonEmptyVector a -> (Vector a, Vector a)
partition a -> Bool
f = (a -> Bool) -> Vector a -> (Vector a, Vector a)
forall a. (a -> Bool) -> Vector a -> (Vector a, Vector a)
V.partition a -> Bool
f (Vector a -> (Vector a, Vector a))
-> (NonEmptyVector a -> Vector a)
-> NonEmptyVector a
-> (Vector a, Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE partition #-}

-- | /O(n)/ Split the non-empty vector in two parts, the first one
-- containing those elements that satisfy the predicate and the second
-- one those that don't. The order of the elements is not preserved but
-- the operation is often faster than 'partition'.
--
-- If all or no elements satisfy the predicate, one of the resulting vectors
-- may be empty.
--
unstablePartition
    :: (a -> Bool)
    -> NonEmptyVector a
    -> (Vector a, Vector a)
unstablePartition :: (a -> Bool) -> NonEmptyVector a -> (Vector a, Vector a)
unstablePartition a -> Bool
f = (a -> Bool) -> Vector a -> (Vector a, Vector a)
forall a. (a -> Bool) -> Vector a -> (Vector a, Vector a)
V.unstablePartition a -> Bool
f (Vector a -> (Vector a, Vector a))
-> (NonEmptyVector a -> Vector a)
-> NonEmptyVector a
-> (Vector a, Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE unstablePartition #-}

-- | /O(n)/ Split the non-empty vector into the longest prefix of elements
-- that satisfy the predicate and the rest without copying.
--
-- If all or no elements satisfy the predicate, one of the resulting vectors
-- may be empty.
--
-- >>> span (== 1) (unsafeFromList [1,1,2,3,1])
-- ([1,1],[2,3,1])
--
span :: (a -> Bool) -> NonEmptyVector a -> (Vector a, Vector a)
span :: (a -> Bool) -> NonEmptyVector a -> (Vector a, Vector a)
span a -> Bool
f = (a -> Bool) -> Vector a -> (Vector a, Vector a)
forall a. (a -> Bool) -> Vector a -> (Vector a, Vector a)
V.span a -> Bool
f (Vector a -> (Vector a, Vector a))
-> (NonEmptyVector a -> Vector a)
-> NonEmptyVector a
-> (Vector a, Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE span #-}

-- | /O(n)/ Split the vector into the longest prefix of elements that do not
-- satisfy the predicate and the rest without copying.
--
-- If all or no elements satisfy the predicate, one of the resulting vectors
-- may be empty.
--
-- >>> break (== 2) (unsafeFromList [1,1,2,3,1])
-- ([1,1],[2,3,1])
--
break :: (a -> Bool) -> NonEmptyVector a -> (Vector a, Vector a)
break :: (a -> Bool) -> NonEmptyVector a -> (Vector a, Vector a)
break a -> Bool
f = (a -> Bool) -> Vector a -> (Vector a, Vector a)
forall a. (a -> Bool) -> Vector a -> (Vector a, Vector a)
V.break a -> Bool
f (Vector a -> (Vector a, Vector a))
-> (NonEmptyVector a -> Vector a)
-> NonEmptyVector a
-> (Vector a, Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE break #-}

-- ---------------------------------------------------------------------- --
-- Searching

-- | /O(n)/ Check if the non-empty vector contains an element
--
-- >>> elem 1 $ unsafeFromList [1..3]
-- True
-- >>> elem 4 $ unsafeFromList [1..3]
-- False
--
elem :: Eq a => a -> NonEmptyVector a -> Bool
elem :: a -> NonEmptyVector a -> Bool
elem a
a = a -> Vector a -> Bool
forall a. Eq a => a -> Vector a -> Bool
V.elem a
a (Vector a -> Bool)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE elem #-}

-- | /O(n)/ Check if the non-empty vector does not contain an element
-- (inverse of 'elem')
--
-- >>> notElem 1 $ unsafeFromList [1..3]
-- False
--
-- >>> notElem 4 $ unsafeFromList [1..3]
-- True
--
notElem :: Eq a => a -> NonEmptyVector a -> Bool
notElem :: a -> NonEmptyVector a -> Bool
notElem a
a = a -> Vector a -> Bool
forall a. Eq a => a -> Vector a -> Bool
V.notElem a
a (Vector a -> Bool)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE notElem #-}

-- | /O(n)/ Yield 'Just' the first element matching the predicate or
-- 'Nothing' if no such element exists.
--
-- >>> find (< 2) $ unsafeFromList [1..3]
-- Just 1
--
-- >>> find (< 0) $ unsafeFromList [1..3]
-- Nothing
--
find :: (a -> Bool) -> NonEmptyVector a -> Maybe a
find :: (a -> Bool) -> NonEmptyVector a -> Maybe a
find a -> Bool
f = (a -> Bool) -> Vector a -> Maybe a
forall a. (a -> Bool) -> Vector a -> Maybe a
V.find a -> Bool
f (Vector a -> Maybe a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE find #-}

-- | /O(n)/ Yield 'Just' the index of the first element matching the
-- predicate or 'Nothing' if no such element exists.
--
-- >>> findIndex (< 2) $ unsafeFromList [1..3]
-- Just 0
--
-- >>> findIndex (< 0) $ unsafeFromList [1..3]
-- Nothing
--
findIndex :: (a -> Bool) -> NonEmptyVector a -> Maybe Int
findIndex :: (a -> Bool) -> NonEmptyVector a -> Maybe Int
findIndex a -> Bool
f = (a -> Bool) -> Vector a -> Maybe Int
forall a. (a -> Bool) -> Vector a -> Maybe Int
V.findIndex a -> Bool
f (Vector a -> Maybe Int)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE findIndex #-}

-- | /O(n)/ Yield the indices of elements satisfying the predicate in
-- ascending order.
--
-- >>> findIndices (< 3) $ unsafeFromList [1..3]
-- [0,1]
--
-- >>> findIndices (< 0) $ unsafeFromList [1..3]
-- []
--
findIndices :: (a -> Bool) -> NonEmptyVector a -> Vector Int
findIndices :: (a -> Bool) -> NonEmptyVector a -> Vector Int
findIndices a -> Bool
f = (a -> Bool) -> Vector a -> Vector Int
forall a. (a -> Bool) -> Vector a -> Vector Int
V.findIndices a -> Bool
f (Vector a -> Vector Int)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE findIndices #-}

-- | /O(n)/ Yield 'Just' the index of the first occurence of the given
-- element or 'Nothing' if the non-empty vector does not contain the
-- element. This is a specialised version of 'findIndex'.
--
-- >>> elemIndex 1 $ unsafeFromList [1..3]
-- Just 0
--
-- >>> elemIndex 0 $ unsafeFromList [1..3]
-- Nothing
--
elemIndex :: Eq a => a -> NonEmptyVector a -> Maybe Int
elemIndex :: a -> NonEmptyVector a -> Maybe Int
elemIndex a
a = a -> Vector a -> Maybe Int
forall a. Eq a => a -> Vector a -> Maybe Int
V.elemIndex a
a (Vector a -> Maybe Int)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE elemIndex #-}

-- | /O(n)/ Yield the indices of all occurences of the given element in
-- ascending order. This is a specialised version of 'findIndices'.
--
-- >>> elemIndices 1 $ unsafeFromList [1,2,3,1]
-- [0,3]
--
-- >>> elemIndices 0 $ unsafeFromList [1..3]
-- []
--
elemIndices :: Eq a => a -> NonEmptyVector a -> Vector Int
elemIndices :: a -> NonEmptyVector a -> Vector Int
elemIndices a
a = a -> Vector a -> Vector Int
forall a. Eq a => a -> Vector a -> Vector Int
V.elemIndices a
a (Vector a -> Vector Int)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE elemIndices #-}

-- ---------------------------------------------------------------------- --
-- Folding

-- | /O(n)/ Left monoidal fold
--
foldl :: (a -> b -> a) -> a -> NonEmptyVector b -> a
foldl :: (a -> b -> a) -> a -> NonEmptyVector b -> a
foldl a -> b -> a
f a
a = (a -> b -> a) -> a -> Vector b -> a
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl a -> b -> a
f a
a (Vector b -> a)
-> (NonEmptyVector b -> Vector b) -> NonEmptyVector b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE foldl #-}

-- | /O(n)/ Left semigroupal fold
--
foldl1 :: (a -> a -> a) -> NonEmptyVector a -> a
foldl1 :: (a -> a -> a) -> NonEmptyVector a -> a
foldl1 a -> a -> a
f = (a -> a -> a) -> Vector a -> a
forall a. (a -> a -> a) -> Vector a -> a
V.foldl1 a -> a -> a
f (Vector a -> a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE foldl1 #-}

-- | /O(n)/ Strict Left monoidal fold
--
foldl' :: (a -> b -> a) -> a -> NonEmptyVector b -> a
foldl' :: (a -> b -> a) -> a -> NonEmptyVector b -> a
foldl' a -> b -> a
f a
a = (a -> b -> a) -> a -> Vector b -> a
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' a -> b -> a
f a
a (Vector b -> a)
-> (NonEmptyVector b -> Vector b) -> NonEmptyVector b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE foldl' #-}

-- | /O(n)/ Strict Left semigroupal fold
--
foldl1' :: (a -> a -> a) -> NonEmptyVector a -> a
foldl1' :: (a -> a -> a) -> NonEmptyVector a -> a
foldl1' a -> a -> a
f = (a -> a -> a) -> Vector a -> a
forall a. (a -> a -> a) -> Vector a -> a
V.foldl1' a -> a -> a
f (Vector a -> a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE foldl1' #-}

-- | /O(n)/ Right monoidal fold
--
foldr :: (a -> b -> b) -> b -> NonEmptyVector a -> b
foldr :: (a -> b -> b) -> b -> NonEmptyVector a -> b
foldr a -> b -> b
f b
b = (a -> b -> b) -> b -> Vector a -> b
forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr a -> b -> b
f b
b (Vector a -> b)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE foldr #-}

-- | /O(n)/ Right semigroupal fold
--
foldr1 :: (a -> a -> a) -> NonEmptyVector a -> a
foldr1 :: (a -> a -> a) -> NonEmptyVector a -> a
foldr1 a -> a -> a
f = (a -> a -> a) -> Vector a -> a
forall a. (a -> a -> a) -> Vector a -> a
V.foldr1 a -> a -> a
f (Vector a -> a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE foldr1 #-}

-- | /O(n)/ Strict right monoidal fold
--
foldr' :: (a -> b -> b) -> b -> NonEmptyVector a -> b
foldr' :: (a -> b -> b) -> b -> NonEmptyVector a -> b
foldr' a -> b -> b
f b
b = (a -> b -> b) -> b -> Vector a -> b
forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr' a -> b -> b
f b
b(Vector a -> b)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE foldr' #-}

-- | /O(n)/ Strict right semigroupal fold
--
foldr1' :: (a -> a -> a) -> NonEmptyVector a -> a
foldr1' :: (a -> a -> a) -> NonEmptyVector a -> a
foldr1' a -> a -> a
f = (a -> a -> a) -> Vector a -> a
forall a. (a -> a -> a) -> Vector a -> a
V.foldr1' a -> a -> a
f (Vector a -> a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE foldr1' #-}

-- | /O(n)/ Left monoidal fold with function applied to each element
-- and its index
--
ifoldl :: (a -> Int -> b -> a) -> a -> NonEmptyVector b -> a
ifoldl :: (a -> Int -> b -> a) -> a -> NonEmptyVector b -> a
ifoldl a -> Int -> b -> a
f a
a = (a -> Int -> b -> a) -> a -> Vector b -> a
forall a b. (a -> Int -> b -> a) -> a -> Vector b -> a
V.ifoldl a -> Int -> b -> a
f a
a (Vector b -> a)
-> (NonEmptyVector b -> Vector b) -> NonEmptyVector b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE ifoldl #-}

-- | /O(n)/ Strict left monoidal fold with function applied to each element
-- and its index
--
ifoldl' :: (a -> Int -> b -> a) -> a -> NonEmptyVector b -> a
ifoldl' :: (a -> Int -> b -> a) -> a -> NonEmptyVector b -> a
ifoldl' a -> Int -> b -> a
f a
a = (a -> Int -> b -> a) -> a -> Vector b -> a
forall a b. (a -> Int -> b -> a) -> a -> Vector b -> a
V.ifoldl' a -> Int -> b -> a
f a
a (Vector b -> a)
-> (NonEmptyVector b -> Vector b) -> NonEmptyVector b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE ifoldl' #-}

-- | /O(n)/ Right monoidal fold with function applied to each element
-- and its index
--
ifoldr :: (Int -> a -> b -> b) -> b -> NonEmptyVector a -> b
ifoldr :: (Int -> a -> b -> b) -> b -> NonEmptyVector a -> b
ifoldr Int -> a -> b -> b
f b
b = (Int -> a -> b -> b) -> b -> Vector a -> b
forall a b. (Int -> a -> b -> b) -> b -> Vector a -> b
V.ifoldr Int -> a -> b -> b
f b
b (Vector a -> b)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE ifoldr #-}

-- | /O(n)/ strict right monoidal fold with function applied to each element
-- and its index
--
ifoldr' :: (Int -> a -> b -> b) -> b -> NonEmptyVector a -> b
ifoldr' :: (Int -> a -> b -> b) -> b -> NonEmptyVector a -> b
ifoldr' Int -> a -> b -> b
f b
b = (Int -> a -> b -> b) -> b -> Vector a -> b
forall a b. (Int -> a -> b -> b) -> b -> Vector a -> b
V.ifoldr' Int -> a -> b -> b
f b
b (Vector a -> b)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE ifoldr' #-}

-- ---------------------------------------------------------------------- --
-- Specialised folds

-- | /O(n)/ Check if all elements satisfy the predicate.
--
all :: (a -> Bool) -> NonEmptyVector a -> Bool
all :: (a -> Bool) -> NonEmptyVector a -> Bool
all a -> Bool
f = (a -> Bool) -> Vector a -> Bool
forall a. (a -> Bool) -> Vector a -> Bool
V.all a -> Bool
f (Vector a -> Bool)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE all #-}

-- | /O(n)/ Check if any element satisfies the predicate.
--
any :: (a -> Bool) -> NonEmptyVector a -> Bool
any :: (a -> Bool) -> NonEmptyVector a -> Bool
any a -> Bool
f = (a -> Bool) -> Vector a -> Bool
forall a. (a -> Bool) -> Vector a -> Bool
V.any a -> Bool
f (Vector a -> Bool)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE any #-}

-- | /O(n)/ Check if all elements are @True@.
--
and :: NonEmptyVector Bool -> Bool
and :: NonEmptyVector Bool -> Bool
and = Vector Bool -> Bool
V.and (Vector Bool -> Bool)
-> (NonEmptyVector Bool -> Vector Bool)
-> NonEmptyVector Bool
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector Bool -> Vector Bool
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE and #-}

-- | /O(n)/ Check if any element is @True@
--
or :: NonEmptyVector Bool -> Bool
or :: NonEmptyVector Bool -> Bool
or = Vector Bool -> Bool
V.or (Vector Bool -> Bool)
-> (NonEmptyVector Bool -> Vector Bool)
-> NonEmptyVector Bool
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector Bool -> Vector Bool
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE or #-}

-- | /O(n)/ Compute the sum of the elements
--
sum :: Num a => NonEmptyVector a -> a
sum :: NonEmptyVector a -> a
sum = Vector a -> a
forall a. Num a => Vector a -> a
V.sum (Vector a -> a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE sum #-}

-- | /O(n)/ Compute the produce of the elements
--
product :: Num a => NonEmptyVector a -> a
product :: NonEmptyVector a -> a
product = Vector a -> a
forall a. Num a => Vector a -> a
V.product (Vector a -> a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE product #-}

-- | /O(n)/ Yield the maximum element of the non-empty vector.
--
maximum :: Ord a => NonEmptyVector a -> a
maximum :: NonEmptyVector a -> a
maximum = Vector a -> a
forall a. Ord a => Vector a -> a
V.maximum (Vector a -> a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE maximum #-}

-- | /O(n)/ Yield the maximum element of a non-empty vector
-- according to the given comparison function.
--
maximumBy :: (a -> a -> Ordering) -> NonEmptyVector a -> a
maximumBy :: (a -> a -> Ordering) -> NonEmptyVector a -> a
maximumBy a -> a -> Ordering
f = (a -> a -> Ordering) -> Vector a -> a
forall a. (a -> a -> Ordering) -> Vector a -> a
V.maximumBy a -> a -> Ordering
f (Vector a -> a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE maximumBy #-}

-- | /O(n)/ Yield the minimum element of the non-empty vector.
--
minimum :: Ord a => NonEmptyVector a -> a
minimum :: NonEmptyVector a -> a
minimum = Vector a -> a
forall a. Ord a => Vector a -> a
V.minimum (Vector a -> a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE minimum #-}

-- | /O(n)/ Yield the minimum element of the non-empty vector
-- according to the given comparison function.
--
minimumBy :: (a -> a -> Ordering) -> NonEmptyVector a -> a
minimumBy :: (a -> a -> Ordering) -> NonEmptyVector a -> a
minimumBy a -> a -> Ordering
f = (a -> a -> Ordering) -> Vector a -> a
forall a. (a -> a -> Ordering) -> Vector a -> a
V.minimumBy a -> a -> Ordering
f (Vector a -> a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE minimumBy #-}

-- | /O(n)/ Yield the index of the minimum element of the
-- non-empty vector.
--
minIndex :: Ord a => NonEmptyVector a -> Int
minIndex :: NonEmptyVector a -> Int
minIndex = Vector a -> Int
forall a. Ord a => Vector a -> Int
V.minIndex (Vector a -> Int)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE minIndex #-}

-- | /O(n)/ Yield the index of the minimum element of the vector
-- according to the given comparison function.
--
minIndexBy :: (a -> a -> Ordering) -> NonEmptyVector a -> Int
minIndexBy :: (a -> a -> Ordering) -> NonEmptyVector a -> Int
minIndexBy a -> a -> Ordering
f = (a -> a -> Ordering) -> Vector a -> Int
forall a. (a -> a -> Ordering) -> Vector a -> Int
V.minIndexBy a -> a -> Ordering
f (Vector a -> Int)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE minIndexBy #-}

-- | /O(n)/ Yield the index of the maximum element of the
-- non-empty vector.
--
maxIndex :: Ord a => NonEmptyVector a -> Int
maxIndex :: NonEmptyVector a -> Int
maxIndex = Vector a -> Int
forall a. Ord a => Vector a -> Int
V.maxIndex (Vector a -> Int)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE maxIndex #-}

-- | /O(n)/ Yield the index of the maximum element of the vector
-- according to the given comparison function.
--
maxIndexBy :: (a -> a -> Ordering) -> NonEmptyVector a -> Int
maxIndexBy :: (a -> a -> Ordering) -> NonEmptyVector a -> Int
maxIndexBy a -> a -> Ordering
f = (a -> a -> Ordering) -> Vector a -> Int
forall a. (a -> a -> Ordering) -> Vector a -> Int
V.maxIndexBy a -> a -> Ordering
f (Vector a -> Int)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE maxIndexBy #-}

-- ---------------------------------------------------------------------- --
-- Monadic folds

-- | /O(n)/ Monadic fold
--
foldM :: Monad m => (a -> b -> m a) -> a -> NonEmptyVector b -> m a
foldM :: (a -> b -> m a) -> a -> NonEmptyVector b -> m a
foldM a -> b -> m a
f a
a = (a -> b -> m a) -> a -> Vector b -> m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> a -> Vector b -> m a
V.foldM a -> b -> m a
f a
a (Vector b -> m a)
-> (NonEmptyVector b -> Vector b) -> NonEmptyVector b -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE foldM #-}

-- | /O(n)/ Monadic fold (action applied to each element and its index)
--
ifoldM :: Monad m => (a -> Int -> b -> m a) -> a -> NonEmptyVector b -> m a
ifoldM :: (a -> Int -> b -> m a) -> a -> NonEmptyVector b -> m a
ifoldM a -> Int -> b -> m a
f a
a = (a -> Int -> b -> m a) -> a -> Vector b -> m a
forall (m :: * -> *) a b.
Monad m =>
(a -> Int -> b -> m a) -> a -> Vector b -> m a
V.ifoldM a -> Int -> b -> m a
f a
a (Vector b -> m a)
-> (NonEmptyVector b -> Vector b) -> NonEmptyVector b -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE ifoldM #-}

-- | /O(n)/ Strict monadic fold
--
foldM' :: Monad m => (a -> b -> m a) -> a -> NonEmptyVector b -> m a
foldM' :: (a -> b -> m a) -> a -> NonEmptyVector b -> m a
foldM' a -> b -> m a
f a
a = (a -> b -> m a) -> a -> Vector b -> m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> a -> Vector b -> m a
V.foldM' a -> b -> m a
f a
a (Vector b -> m a)
-> (NonEmptyVector b -> Vector b) -> NonEmptyVector b -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE foldM' #-}

-- | /O(n)/ Strict monadic fold (action applied to each element and its index)
--
ifoldM' :: Monad m => (a -> Int -> b -> m a) -> a -> NonEmptyVector b -> m a
ifoldM' :: (a -> Int -> b -> m a) -> a -> NonEmptyVector b -> m a
ifoldM' a -> Int -> b -> m a
f a
a = (a -> Int -> b -> m a) -> a -> Vector b -> m a
forall (m :: * -> *) a b.
Monad m =>
(a -> Int -> b -> m a) -> a -> Vector b -> m a
V.ifoldM' a -> Int -> b -> m a
f a
a (Vector b -> m a)
-> (NonEmptyVector b -> Vector b) -> NonEmptyVector b -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE ifoldM' #-}

-- | /O(n)/ Monadic semigroupal fold
--
fold1M :: Monad m => (a -> a -> m a) -> NonEmptyVector a -> m a
fold1M :: (a -> a -> m a) -> NonEmptyVector a -> m a
fold1M a -> a -> m a
f = (a -> a -> m a) -> Vector a -> m a
forall (m :: * -> *) a.
Monad m =>
(a -> a -> m a) -> Vector a -> m a
V.fold1M a -> a -> m a
f (Vector a -> m a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE fold1M #-}

-- | /O(n)/ Strict monadic semigroupal fold
--
fold1M' :: Monad m => (a -> a -> m a) -> NonEmptyVector a -> m a
fold1M' :: (a -> a -> m a) -> NonEmptyVector a -> m a
fold1M' a -> a -> m a
f = (a -> a -> m a) -> Vector a -> m a
forall (m :: * -> *) a.
Monad m =>
(a -> a -> m a) -> Vector a -> m a
V.fold1M' a -> a -> m a
f (Vector a -> m a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE fold1M' #-}

-- | /O(n)/ Monadic fold that discards the result
--
foldM_ :: Monad m => (a -> b -> m a) -> a -> NonEmptyVector b -> m ()
foldM_ :: (a -> b -> m a) -> a -> NonEmptyVector b -> m ()
foldM_ a -> b -> m a
f a
a = (a -> b -> m a) -> a -> Vector b -> m ()
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> a -> Vector b -> m ()
V.foldM_ a -> b -> m a
f a
a (Vector b -> m ())
-> (NonEmptyVector b -> Vector b) -> NonEmptyVector b -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE foldM_ #-}

-- | /O(n)/ Monadic fold that discards the result (action applied to each
-- element and its index)
--
ifoldM_ :: Monad m => (a -> Int -> b -> m a) -> a -> NonEmptyVector b -> m ()
ifoldM_ :: (a -> Int -> b -> m a) -> a -> NonEmptyVector b -> m ()
ifoldM_ a -> Int -> b -> m a
f a
a = (a -> Int -> b -> m a) -> a -> Vector b -> m ()
forall (m :: * -> *) a b.
Monad m =>
(a -> Int -> b -> m a) -> a -> Vector b -> m ()
V.ifoldM_ a -> Int -> b -> m a
f a
a (Vector b -> m ())
-> (NonEmptyVector b -> Vector b) -> NonEmptyVector b -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE ifoldM_ #-}

-- | /O(n)/ Strict monadic fold that discards the result
--
foldM'_ :: Monad m => (a -> b -> m a) -> a -> NonEmptyVector b -> m ()
foldM'_ :: (a -> b -> m a) -> a -> NonEmptyVector b -> m ()
foldM'_ a -> b -> m a
f a
a = (a -> b -> m a) -> a -> Vector b -> m ()
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> a -> Vector b -> m ()
V.foldM'_ a -> b -> m a
f a
a (Vector b -> m ())
-> (NonEmptyVector b -> Vector b) -> NonEmptyVector b -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE foldM'_ #-}

-- | /O(n)/ Strict monadic fold that discards the result (action applied to each
-- element and its index)
--
ifoldM'_ :: Monad m => (a -> Int -> b -> m a) -> a -> NonEmptyVector b -> m ()
ifoldM'_ :: (a -> Int -> b -> m a) -> a -> NonEmptyVector b -> m ()
ifoldM'_ a -> Int -> b -> m a
f a
a = (a -> Int -> b -> m a) -> a -> Vector b -> m ()
forall (m :: * -> *) a b.
Monad m =>
(a -> Int -> b -> m a) -> a -> Vector b -> m ()
V.ifoldM'_ a -> Int -> b -> m a
f a
a (Vector b -> m ())
-> (NonEmptyVector b -> Vector b) -> NonEmptyVector b -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE ifoldM'_ #-}

-- | /O(n)/ Monadic semigroupal fold that discards the result
--
fold1M_ :: Monad m => (a -> a -> m a) -> NonEmptyVector a -> m ()
fold1M_ :: (a -> a -> m a) -> NonEmptyVector a -> m ()
fold1M_ a -> a -> m a
f = (a -> a -> m a) -> Vector a -> m ()
forall (m :: * -> *) a.
Monad m =>
(a -> a -> m a) -> Vector a -> m ()
V.fold1M_ a -> a -> m a
f (Vector a -> m ())
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE fold1M_ #-}

-- | /O(n)/ Strict monadic semigroupal fold that discards the result
--
fold1M'_ :: Monad m => (a -> a -> m a) -> NonEmptyVector a -> m ()
fold1M'_ :: (a -> a -> m a) -> NonEmptyVector a -> m ()
fold1M'_ a -> a -> m a
f = (a -> a -> m a) -> Vector a -> m ()
forall (m :: * -> *) a.
Monad m =>
(a -> a -> m a) -> Vector a -> m ()
V.fold1M'_ a -> a -> m a
f (Vector a -> m ())
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE fold1M'_ #-}

-- ---------------------------------------------------------------------- --
-- Monadic sequencing

-- | Evaluate each action and collect the results
--
sequence :: Monad m => NonEmptyVector (m a) -> m (NonEmptyVector a)
sequence :: NonEmptyVector (m a) -> m (NonEmptyVector a)
sequence = (Vector a -> NonEmptyVector a)
-> m (Vector a) -> m (NonEmptyVector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (m (Vector a) -> m (NonEmptyVector a))
-> (NonEmptyVector (m a) -> m (Vector a))
-> NonEmptyVector (m a)
-> m (NonEmptyVector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (m a) -> m (Vector a)
forall (m :: * -> *) a. Monad m => Vector (m a) -> m (Vector a)
V.sequence (Vector (m a) -> m (Vector a))
-> (NonEmptyVector (m a) -> Vector (m a))
-> NonEmptyVector (m a)
-> m (Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector (m a) -> Vector (m a)
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE sequence #-}

-- | Evaluate each action and discard the results
--
sequence_ :: Monad m => NonEmptyVector (m a) -> m ()
sequence_ :: NonEmptyVector (m a) -> m ()
sequence_ = Vector (m a) -> m ()
forall (m :: * -> *) a. Monad m => Vector (m a) -> m ()
V.sequence_ (Vector (m a) -> m ())
-> (NonEmptyVector (m a) -> Vector (m a))
-> NonEmptyVector (m a)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector (m a) -> Vector (m a)
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE sequence_ #-}

-- ---------------------------------------------------------------------- --
-- Prefix sums (scans)

-- | /O(n)/ Prescan
--
prescanl :: (a -> b -> a) -> a -> NonEmptyVector b -> NonEmptyVector a
prescanl :: (a -> b -> a) -> a -> NonEmptyVector b -> NonEmptyVector a
prescanl a -> b -> a
f a
a = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> NonEmptyVector a)
-> (NonEmptyVector b -> Vector a)
-> NonEmptyVector b
-> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> a) -> a -> Vector b -> Vector a
forall a b. (a -> b -> a) -> a -> Vector b -> Vector a
V.prescanl a -> b -> a
f a
a (Vector b -> Vector a)
-> (NonEmptyVector b -> Vector b) -> NonEmptyVector b -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE prescanl #-}

-- | /O(n)/ Prescan with strict accumulator
--
prescanl' :: (a -> b -> a) -> a -> NonEmptyVector b -> NonEmptyVector a
prescanl' :: (a -> b -> a) -> a -> NonEmptyVector b -> NonEmptyVector a
prescanl' a -> b -> a
f a
a = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> NonEmptyVector a)
-> (NonEmptyVector b -> Vector a)
-> NonEmptyVector b
-> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> a) -> a -> Vector b -> Vector a
forall a b. (a -> b -> a) -> a -> Vector b -> Vector a
V.prescanl' a -> b -> a
f a
a (Vector b -> Vector a)
-> (NonEmptyVector b -> Vector b) -> NonEmptyVector b -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE prescanl' #-}

-- | /O(n)/ Scan
--
postscanl :: (a -> b -> a) -> a -> NonEmptyVector b -> NonEmptyVector a
postscanl :: (a -> b -> a) -> a -> NonEmptyVector b -> NonEmptyVector a
postscanl a -> b -> a
f a
a = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> NonEmptyVector a)
-> (NonEmptyVector b -> Vector a)
-> NonEmptyVector b
-> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> a) -> a -> Vector b -> Vector a
forall a b. (a -> b -> a) -> a -> Vector b -> Vector a
V.postscanl a -> b -> a
f a
a (Vector b -> Vector a)
-> (NonEmptyVector b -> Vector b) -> NonEmptyVector b -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE postscanl #-}

-- | /O(n)/ Scan with a strict accumulator
--
postscanl' :: (a -> b -> a) -> a -> NonEmptyVector b -> NonEmptyVector a
postscanl' :: (a -> b -> a) -> a -> NonEmptyVector b -> NonEmptyVector a
postscanl' a -> b -> a
f a
a = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> NonEmptyVector a)
-> (NonEmptyVector b -> Vector a)
-> NonEmptyVector b
-> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> a) -> a -> Vector b -> Vector a
forall a b. (a -> b -> a) -> a -> Vector b -> Vector a
V.postscanl' a -> b -> a
f a
a (Vector b -> Vector a)
-> (NonEmptyVector b -> Vector b) -> NonEmptyVector b -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE postscanl' #-}

-- | /O(n)/ Haskell-style scan
--
scanl :: (a -> b -> a) -> a -> NonEmptyVector b -> NonEmptyVector a
scanl :: (a -> b -> a) -> a -> NonEmptyVector b -> NonEmptyVector a
scanl a -> b -> a
f a
a = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> NonEmptyVector a)
-> (NonEmptyVector b -> Vector a)
-> NonEmptyVector b
-> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> a) -> a -> Vector b -> Vector a
forall a b. (a -> b -> a) -> a -> Vector b -> Vector a
V.scanl a -> b -> a
f a
a (Vector b -> Vector a)
-> (NonEmptyVector b -> Vector b) -> NonEmptyVector b -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE scanl #-}

-- | /O(n)/ Haskell-style scan with strict accumulator
--
scanl' :: (a -> b -> a) -> a -> NonEmptyVector b -> NonEmptyVector a
scanl' :: (a -> b -> a) -> a -> NonEmptyVector b -> NonEmptyVector a
scanl' a -> b -> a
f a
a = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> NonEmptyVector a)
-> (NonEmptyVector b -> Vector a)
-> NonEmptyVector b
-> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> a) -> a -> Vector b -> Vector a
forall a b. (a -> b -> a) -> a -> Vector b -> Vector a
V.scanl' a -> b -> a
f a
a (Vector b -> Vector a)
-> (NonEmptyVector b -> Vector b) -> NonEmptyVector b -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE scanl' #-}

-- | /O(n)/ Semigroupal left scan
--
scanl1 :: (a -> a -> a) -> NonEmptyVector a -> NonEmptyVector a
scanl1 :: (a -> a -> a) -> NonEmptyVector a -> NonEmptyVector a
scanl1 a -> a -> a
f = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> NonEmptyVector a)
-> (NonEmptyVector a -> Vector a)
-> NonEmptyVector a
-> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a) -> Vector a -> Vector a
forall a. (a -> a -> a) -> Vector a -> Vector a
V.scanl1 a -> a -> a
f (Vector a -> Vector a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE scanl1 #-}

-- | /O(n)/ Strict semigroupal scan
--
scanl1' :: (a -> a -> a) -> NonEmptyVector a -> NonEmptyVector a
scanl1' :: (a -> a -> a) -> NonEmptyVector a -> NonEmptyVector a
scanl1' a -> a -> a
f = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> NonEmptyVector a)
-> (NonEmptyVector a -> Vector a)
-> NonEmptyVector a
-> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a) -> Vector a -> Vector a
forall a. (a -> a -> a) -> Vector a -> Vector a
V.scanl1' a -> a -> a
f (Vector a -> Vector a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE scanl1' #-}

-- | /O(n)/ Scan over a vector with its index
--
iscanl :: (Int -> a -> b -> a) -> a -> NonEmptyVector b -> NonEmptyVector a
iscanl :: (Int -> a -> b -> a) -> a -> NonEmptyVector b -> NonEmptyVector a
iscanl Int -> a -> b -> a
f a
a = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> NonEmptyVector a)
-> (NonEmptyVector b -> Vector a)
-> NonEmptyVector b
-> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> b -> a) -> a -> Vector b -> Vector a
forall a b. (Int -> a -> b -> a) -> a -> Vector b -> Vector a
V.iscanl Int -> a -> b -> a
f a
a (Vector b -> Vector a)
-> (NonEmptyVector b -> Vector b) -> NonEmptyVector b -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE iscanl #-}

-- | /O(n)/ Scan over a vector with its index with strict accumulator
--
iscanl' :: (Int -> a -> b -> a) -> a -> NonEmptyVector b -> NonEmptyVector a
iscanl' :: (Int -> a -> b -> a) -> a -> NonEmptyVector b -> NonEmptyVector a
iscanl' Int -> a -> b -> a
f a
a = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> NonEmptyVector a)
-> (NonEmptyVector b -> Vector a)
-> NonEmptyVector b
-> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> b -> a) -> a -> Vector b -> Vector a
forall a b. (Int -> a -> b -> a) -> a -> Vector b -> Vector a
V.iscanl' Int -> a -> b -> a
f a
a (Vector b -> Vector a)
-> (NonEmptyVector b -> Vector b) -> NonEmptyVector b -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector b -> Vector b
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE iscanl' #-}

-- | /O(n)/ Right-to-left prescan
--
prescanr :: (a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
prescanr :: (a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
prescanr a -> b -> b
f b
b = Vector b -> NonEmptyVector b
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector b -> NonEmptyVector b)
-> (NonEmptyVector a -> Vector b)
-> NonEmptyVector a
-> NonEmptyVector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> b) -> b -> Vector a -> Vector b
forall a b. (a -> b -> b) -> b -> Vector a -> Vector b
V.prescanr a -> b -> b
f b
b (Vector a -> Vector b)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE prescanr #-}

-- | /O(n)/ Right-to-left prescan with strict accumulator
--
prescanr' :: (a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
prescanr' :: (a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
prescanr' a -> b -> b
f b
b = Vector b -> NonEmptyVector b
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector b -> NonEmptyVector b)
-> (NonEmptyVector a -> Vector b)
-> NonEmptyVector a
-> NonEmptyVector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> b) -> b -> Vector a -> Vector b
forall a b. (a -> b -> b) -> b -> Vector a -> Vector b
V.prescanr' a -> b -> b
f b
b (Vector a -> Vector b)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE prescanr' #-}

-- | /O(n)/ Right-to-left scan
--
postscanr :: (a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
postscanr :: (a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
postscanr a -> b -> b
f b
b = Vector b -> NonEmptyVector b
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector b -> NonEmptyVector b)
-> (NonEmptyVector a -> Vector b)
-> NonEmptyVector a
-> NonEmptyVector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> b) -> b -> Vector a -> Vector b
forall a b. (a -> b -> b) -> b -> Vector a -> Vector b
V.postscanr a -> b -> b
f b
b (Vector a -> Vector b)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE postscanr #-}

-- | /O(n)/ Right-to-left scan with strict accumulator
--
postscanr' :: (a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
postscanr' :: (a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
postscanr' a -> b -> b
f b
b = Vector b -> NonEmptyVector b
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector b -> NonEmptyVector b)
-> (NonEmptyVector a -> Vector b)
-> NonEmptyVector a
-> NonEmptyVector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> b) -> b -> Vector a -> Vector b
forall a b. (a -> b -> b) -> b -> Vector a -> Vector b
V.postscanr' a -> b -> b
f b
b (Vector a -> Vector b)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE postscanr' #-}

-- | /O(n)/ Right-to-left Haskell-style scan
--
scanr :: (a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
scanr :: (a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
scanr a -> b -> b
f b
b = Vector b -> NonEmptyVector b
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector b -> NonEmptyVector b)
-> (NonEmptyVector a -> Vector b)
-> NonEmptyVector a
-> NonEmptyVector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> b) -> b -> Vector a -> Vector b
forall a b. (a -> b -> b) -> b -> Vector a -> Vector b
V.scanr a -> b -> b
f b
b (Vector a -> Vector b)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE scanr #-}

-- | /O(n)/ Right-to-left Haskell-style scan with strict accumulator
--
scanr' :: (a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
scanr' :: (a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
scanr' a -> b -> b
f b
b = Vector b -> NonEmptyVector b
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector b -> NonEmptyVector b)
-> (NonEmptyVector a -> Vector b)
-> NonEmptyVector a
-> NonEmptyVector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> b) -> b -> Vector a -> Vector b
forall a b. (a -> b -> b) -> b -> Vector a -> Vector b
V.scanr' a -> b -> b
f b
b (Vector a -> Vector b)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE scanr' #-}

-- | /O(n)/ Right-to-left Haskell-style semigroupal scan
--
scanr1 :: (a -> a -> a) -> NonEmptyVector a -> NonEmptyVector a
scanr1 :: (a -> a -> a) -> NonEmptyVector a -> NonEmptyVector a
scanr1 a -> a -> a
f = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> NonEmptyVector a)
-> (NonEmptyVector a -> Vector a)
-> NonEmptyVector a
-> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a) -> Vector a -> Vector a
forall a. (a -> a -> a) -> Vector a -> Vector a
V.scanr1 a -> a -> a
f (Vector a -> Vector a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE scanr1 #-}

-- | /O(n)/ Right-to-left Haskell-style semigroupal scan with strict accumulator
--
scanr1' :: (a -> a -> a) -> NonEmptyVector a -> NonEmptyVector a
scanr1' :: (a -> a -> a) -> NonEmptyVector a -> NonEmptyVector a
scanr1' a -> a -> a
f = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> NonEmptyVector a)
-> (NonEmptyVector a -> Vector a)
-> NonEmptyVector a
-> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a) -> Vector a -> Vector a
forall a. (a -> a -> a) -> Vector a -> Vector a
V.scanr1' a -> a -> a
f (Vector a -> Vector a)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE scanr1' #-}

-- | /O(n)/ Right-to-left scan over a vector with its index
--
iscanr :: (Int -> a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
iscanr :: (Int -> a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
iscanr Int -> a -> b -> b
f b
b = Vector b -> NonEmptyVector b
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector b -> NonEmptyVector b)
-> (NonEmptyVector a -> Vector b)
-> NonEmptyVector a
-> NonEmptyVector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> b -> b) -> b -> Vector a -> Vector b
forall a b. (Int -> a -> b -> b) -> b -> Vector a -> Vector b
V.iscanr Int -> a -> b -> b
f b
b (Vector a -> Vector b)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE iscanr #-}

-- | /O(n)/ Right-to-left scan over a vector with its index and a strict
-- accumulator
--
iscanr' :: (Int -> a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
iscanr' :: (Int -> a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
iscanr' Int -> a -> b -> b
f b
b = Vector b -> NonEmptyVector b
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector b -> NonEmptyVector b)
-> (NonEmptyVector a -> Vector b)
-> NonEmptyVector a
-> NonEmptyVector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> b -> b) -> b -> Vector a -> Vector b
forall a b. (Int -> a -> b -> b) -> b -> Vector a -> Vector b
V.iscanr' Int -> a -> b -> b
f b
b (Vector a -> Vector b)
-> (NonEmptyVector a -> Vector a) -> NonEmptyVector a -> Vector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector a -> Vector a
forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE iscanr' #-}