{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
-- |
-- Module       : Data.Vector.NonEmpty
-- Copyright 	: (c) 2019-2023 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, partitionWith, 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.Either (Either(..))
import Data.Functor hiding (unzip)
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, Maybe(..), Either(..))
-- >>> 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 :: forall a. NonEmptyVector a -> Int
length = forall a. Vector a -> Int
V.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. NonEmptyVector a -> a
head = forall a. Vector a -> a
V.unsafeHead forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. NonEmptyVector a -> a
last = forall a. Vector a -> a
V.unsafeLast forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE last #-}

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

-- | /O(1)/ Unsafe indexing without bounds checking
--
unsafeIndex :: NonEmptyVector a -> Int -> a
unsafeIndex :: forall a. NonEmptyVector a -> Int -> a
unsafeIndex (NonEmptyVector Vector a
as) Int
n = 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 :: forall (m :: * -> *) a. Monad m => NonEmptyVector a -> Int -> m a
indexM (NonEmptyVector Vector a
v) Int
n = 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 :: forall (m :: * -> *) a. Monad m => NonEmptyVector a -> m a
headM (NonEmptyVector Vector a
v) = 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 :: forall (m :: * -> *) a. Monad m => NonEmptyVector a -> m a
lastM (NonEmptyVector Vector a
v) = 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 :: forall (m :: * -> *) a. Monad m => NonEmptyVector a -> Int -> m a
unsafeIndexM (NonEmptyVector Vector a
v) Int
n = 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 :: forall a. NonEmptyVector a -> Vector a
tail = forall a. Vector a -> Vector a
V.unsafeTail forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. NonEmptyVector a -> (a, Vector a)
uncons NonEmptyVector a
v = (forall a. NonEmptyVector a -> a
head NonEmptyVector a
v, 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 :: forall a. NonEmptyVector a -> (Vector a, a)
unsnoc NonEmptyVector a
v = (forall a. NonEmptyVector a -> Vector a
init NonEmptyVector a
v, 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 :: forall a. Int -> Int -> NonEmptyVector a -> Vector a
slice Int
i Int
n = forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
i Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. NonEmptyVector a -> Vector a
init = forall a. Vector a -> Vector a
V.unsafeInit forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Int -> NonEmptyVector a -> Vector a
take Int
n = forall a. Int -> Vector a -> Vector a
V.take Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Int -> NonEmptyVector a -> Vector a
drop Int
n = forall a. Int -> Vector a -> Vector a
V.drop Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Int -> NonEmptyVector a -> (Vector a, Vector a)
splitAt Int
n = forall a. Int -> Vector a -> (Vector a, Vector a)
V.splitAt Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Int -> Int -> NonEmptyVector a -> Vector a
unsafeSlice Int
i Int
n = forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
i Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Int -> NonEmptyVector a -> Vector a
unsafeTake Int
n = forall a. Int -> Vector a -> Vector a
V.unsafeTake Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Int -> NonEmptyVector a -> Vector a
unsafeDrop Int
n = forall a. Int -> Vector a -> Vector a
V.unsafeDrop Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. a -> NonEmptyVector a
singleton = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Int -> a -> Maybe (NonEmptyVector a)
replicate Int
n a
a = forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (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 :: forall a. Int -> a -> NonEmptyVector a
replicate1 Int
n a
a = forall a. Vector a -> NonEmptyVector a
unsafeFromVector (forall a. Int -> a -> Vector a
V.replicate (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 :: forall a. Int -> (Int -> a) -> Maybe (NonEmptyVector a)
generate Int
n Int -> a
f = forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (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 :: forall a. Int -> (Int -> a) -> NonEmptyVector a
generate1 Int
n Int -> a
f = forall a. Vector a -> NonEmptyVector a
unsafeFromVector (forall a. Int -> (Int -> a) -> Vector a
V.generate (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 :: forall a. Int -> (a -> a) -> a -> Maybe (NonEmptyVector a)
iterateN Int
n a -> a
f a
a = forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (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 :: forall a. Int -> (a -> a) -> a -> NonEmptyVector a
iterateN1 Int
n a -> a
f a
a = forall a. Vector a -> NonEmptyVector a
unsafeFromVector (forall a. Int -> (a -> a) -> a -> Vector a
V.iterateN (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 :: forall (m :: * -> *) a.
Monad m =>
Int -> m a -> m (Maybe (NonEmptyVector a))
replicateM Int
n m a
a = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (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 :: forall (m :: * -> *) a.
Monad m =>
Int -> m a -> m (NonEmptyVector a)
replicate1M Int
n m a
a = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Vector a -> NonEmptyVector a
unsafeFromVector (forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM (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 :: forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Maybe (NonEmptyVector a))
generateM Int
n Int -> m a
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (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 :: forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (NonEmptyVector a)
generate1M Int
n Int -> m a
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Vector a -> NonEmptyVector a
unsafeFromVector (forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
V.generateM (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 :: forall (m :: * -> *) a.
Monad m =>
Int -> (a -> m a) -> a -> m (Maybe (NonEmptyVector a))
iterateNM Int
n a -> m a
f a
a = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (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 :: forall (m :: * -> *) a.
Monad m =>
Int -> (a -> m a) -> a -> m (NonEmptyVector a)
iterateN1M Int
n a -> m a
f a
a = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Vector a -> NonEmptyVector a
unsafeFromVector (forall (m :: * -> *) a.
Monad m =>
Int -> (a -> m a) -> a -> m (Vector a)
V.iterateNM (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 a.
(forall s. ST s (MVector s a)) -> Maybe (NonEmptyVector a)
create forall s. ST s (MVector s a)
p = forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (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)
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 a. (forall s. ST s (MVector s a)) -> NonEmptyVector a
unsafeCreate forall s. ST s (MVector s a)
p = forall a. Vector a -> NonEmptyVector a
unsafeFromVector (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)
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 (t :: * -> *) a.
Traversable t =>
(forall s. ST s (t (MVector s a))) -> t (Maybe (NonEmptyVector a))
createT forall s. ST s (t (MVector s a))
p = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (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))
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 (t :: * -> *) a.
Traversable t =>
(forall s. ST s (t (MVector s a))) -> t (NonEmptyVector a)
unsafeCreateT forall s. ST s (t (MVector s a))
p = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Vector a -> NonEmptyVector a
unsafeFromVector (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))
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 :: forall b a. (b -> Maybe (a, b)) -> b -> Maybe (NonEmptyVector a)
unfoldr b -> Maybe (a, b)
f b
b = forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (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 :: forall b a. (b -> Maybe (a, b)) -> a -> b -> NonEmptyVector a
unfoldr1 b -> Maybe (a, b)
f a
a b
b = forall a. a -> NonEmptyVector a -> NonEmptyVector a
cons a
a (forall a. Vector a -> NonEmptyVector a
unsafeFromVector (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 :: forall b a.
Int -> (b -> Maybe (a, b)) -> b -> Maybe (NonEmptyVector a)
unfoldrN Int
n b -> Maybe (a, b)
f b
b = forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (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 :: forall b a.
Int -> (b -> Maybe (a, b)) -> a -> b -> NonEmptyVector a
unfoldr1N Int
n b -> Maybe (a, b)
f a
a b
b = forall a. a -> NonEmptyVector a -> NonEmptyVector a
cons a
a (forall a. Vector a -> NonEmptyVector a
unsafeFromVector (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 :: forall (m :: * -> *) b a.
Monad m =>
(b -> m (Maybe (a, b))) -> b -> m (Maybe (NonEmptyVector a))
unfoldrM b -> m (Maybe (a, b))
f b
b = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (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 :: forall (m :: * -> *) b a.
Monad m =>
(b -> m (Maybe (a, b))) -> a -> b -> m (NonEmptyVector a)
unfoldr1M b -> m (Maybe (a, b))
f a
a b
b = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> NonEmptyVector a -> NonEmptyVector a
cons a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> NonEmptyVector a
unsafeFromVector) (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 :: forall (m :: * -> *) b a.
Monad m =>
Int -> (b -> m (Maybe (a, b))) -> b -> m (Maybe (NonEmptyVector a))
unfoldrNM Int
n b -> m (Maybe (a, b))
f b
b = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (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 :: forall (m :: * -> *) b a.
Monad m =>
Int -> (b -> m (Maybe (a, b))) -> a -> b -> m (NonEmptyVector a)
unfoldr1NM Int
n b -> m (Maybe (a, b))
f a
a b
b = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> NonEmptyVector a -> NonEmptyVector a
cons a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> NonEmptyVector a
unsafeFromVector) (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 :: forall a. Int -> (Vector a -> a) -> Maybe (NonEmptyVector a)
constructN Int
n Vector a -> a
f = forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (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 :: forall a. Int -> (Vector a -> a) -> Maybe (NonEmptyVector a)
constructrN Int
n Vector a -> a
f = forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (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 :: forall a. Num a => a -> Int -> Maybe (NonEmptyVector a)
enumFromN a
a Int
n = forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (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 :: forall a. Num a => a -> Int -> NonEmptyVector a
enumFromN1 a
a Int
n = forall a. Vector a -> NonEmptyVector a
unsafeFromVector (forall a. Num a => a -> Int -> Vector a
V.enumFromN a
a (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 :: forall a. Num a => a -> a -> Int -> Maybe (NonEmptyVector a)
enumFromStepN a
a0 a
a1 Int
n = forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (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 :: forall a. Num a => a -> a -> Int -> NonEmptyVector a
enumFromStepN1 a
a0 a
a1 Int
n = forall a. Vector a -> NonEmptyVector a
unsafeFromVector (forall a. Num a => a -> a -> Int -> Vector a
V.enumFromStepN a
a0 a
a1 (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 :: forall a. Enum a => a -> a -> Maybe (NonEmptyVector a)
enumFromTo a
a0 a
a1 = forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (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 :: forall a. Enum a => a -> a -> a -> Maybe (NonEmptyVector a)
enumFromThenTo a
a0 a
a1 a
a2 = forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (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 :: forall a. a -> NonEmptyVector a -> NonEmptyVector a
cons a
a (NonEmptyVector Vector a
as) = 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 :: forall a. a -> Vector a -> NonEmptyVector a
consV a
a = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. NonEmptyVector a -> a -> NonEmptyVector a
snoc (NonEmptyVector Vector a
as) = 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 :: forall a. Vector a -> a -> NonEmptyVector a
snocV Vector a
as = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 ++ :: forall a. NonEmptyVector a -> NonEmptyVector a -> NonEmptyVector a
++ NonEmptyVector Vector a
v' = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a
v 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 :: forall a. [NonEmptyVector a] -> Maybe (NonEmptyVector a)
concat [] = forall a. Maybe a
Nothing
concat (NonEmptyVector a
a:[NonEmptyVector a]
as) = forall a. a -> Maybe a
Just (forall a. NonEmpty (NonEmptyVector a) -> NonEmptyVector a
concat1 (NonEmptyVector a
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 :: forall a. NonEmpty (NonEmptyVector a) -> NonEmptyVector a
concat1 = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' forall {a}. Vector a -> NonEmptyVector a -> Vector a
go 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 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 :: forall a. NonEmptyVector a -> NonEmpty a
toNonEmpty = forall a. [a] -> NonEmpty a
NonEmpty.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [a]
V.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. NonEmpty a -> NonEmptyVector a
fromNonEmpty = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Int -> NonEmpty a -> Maybe (NonEmptyVector a)
fromNonEmptyN Int
n NonEmpty a
a = forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (forall a. Int -> [a] -> Vector a
V.fromListN Int
n (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 :: forall a. Int -> NonEmpty a -> NonEmptyVector a
fromNonEmptyN1 Int
n = forall a. Vector a -> NonEmptyVector a
unsafeFromVector
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> Vector a
V.fromListN (forall a. Ord a => a -> a -> a
max Int
n Int
1)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. NonEmptyVector a -> Vector a
toVector = 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 :: forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector Vector a
v = if forall a. Vector a -> Bool
V.null Vector a
v then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (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 :: forall a. Vector a -> NonEmptyVector a
unsafeFromVector = 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 :: forall a. NonEmptyVector a -> [a]
toList = forall a. Vector a -> [a]
V.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. [a] -> Maybe (NonEmptyVector a)
fromList = forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. [a] -> NonEmptyVector a
unsafeFromList = forall a. Vector a -> NonEmptyVector a
unsafeFromVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Int -> [a] -> Maybe (NonEmptyVector a)
fromListN Int
n [a]
as = forall a. Vector a -> Maybe (NonEmptyVector a)
fromVector (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 :: forall a. NonEmptyVector a -> NonEmptyVector a
force (NonEmptyVector Vector a
a) = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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 // :: forall a. NonEmptyVector a -> [(Int, a)] -> NonEmptyVector a
// [(Int, a)]
us = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a
v 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 :: forall a. NonEmptyVector a -> Vector (Int, a) -> NonEmptyVector a
update (NonEmptyVector Vector a
v) Vector (Int, a)
v' = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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_ :: forall a.
NonEmptyVector a -> Vector Int -> Vector a -> NonEmptyVector a
update_ (NonEmptyVector Vector a
v) Vector Int
is Vector a
as = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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 :: forall a. NonEmptyVector a -> [(Int, a)] -> NonEmptyVector a
unsafeUpd (NonEmptyVector Vector a
v) [(Int, a)]
us = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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 :: forall a. NonEmptyVector a -> Vector (Int, a) -> NonEmptyVector a
unsafeUpdate (NonEmptyVector Vector a
v) Vector (Int, a)
us = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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_ :: forall a.
NonEmptyVector a -> Vector Int -> Vector a -> NonEmptyVector a
unsafeUpdate_ (NonEmptyVector Vector a
v) Vector Int
is Vector a
as = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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 :: forall a b.
(a -> b -> a) -> NonEmptyVector a -> [(Int, b)] -> NonEmptyVector a
accum a -> b -> a
f (NonEmptyVector Vector a
v) [(Int, b)]
u = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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 :: forall a b.
(a -> b -> a)
-> NonEmptyVector a -> Vector (Int, b) -> NonEmptyVector a
accumulate a -> b -> a
f (NonEmptyVector Vector a
v) Vector (Int, b)
u = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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_ :: forall a b.
(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 = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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 :: forall a b.
(a -> b -> a) -> NonEmptyVector a -> [(Int, b)] -> NonEmptyVector a
unsafeAccum a -> b -> a
f (NonEmptyVector Vector a
v) [(Int, b)]
u = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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 :: forall a b.
(a -> b -> a)
-> NonEmptyVector a -> Vector (Int, b) -> NonEmptyVector a
unsafeAccumulate a -> b -> a
f NonEmptyVector a
v Vector (Int, b)
u = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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' = 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_ :: forall a b.
(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 = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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' = 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 :: forall a. NonEmptyVector a -> NonEmptyVector a
reverse = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> Vector a
V.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a.
NonEmptyVector a -> NonEmptyVector Int -> NonEmptyVector a
backpermute (NonEmptyVector Vector a
v) (NonEmptyVector Vector Int
i)
    = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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 :: forall a.
NonEmptyVector a -> NonEmptyVector Int -> NonEmptyVector a
unsafeBackpermute (NonEmptyVector Vector a
v) (NonEmptyVector Vector Int
i)
    = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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 a.
(forall s. MVector s a -> ST s ())
-> NonEmptyVector a -> NonEmptyVector a
modify forall s. MVector s a -> ST s ()
p (NonEmptyVector Vector a
v) = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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 :: forall a. NonEmptyVector a -> NonEmptyVector (Int, a)
indexed = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> Vector (Int, a)
V.indexed forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a b. (a -> b) -> NonEmptyVector a -> NonEmptyVector b
map a -> b
f = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> Vector a -> Vector b
V.map a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a b. (Int -> a -> b) -> NonEmptyVector a -> NonEmptyVector b
imap Int -> a -> b
f = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Int -> a -> b) -> Vector a -> Vector b
V.imap Int -> a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a b.
(a -> NonEmptyVector b) -> NonEmptyVector a -> NonEmptyVector b
concatMap a -> NonEmptyVector b
f = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Vector b) -> Vector a -> Vector b
V.concatMap (forall a. NonEmptyVector a -> Vector a
_neVec forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NonEmptyVector b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmptyVector a -> m (NonEmptyVector b)
mapM a -> m b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM a -> m b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> NonEmptyVector a -> m (NonEmptyVector b)
imapM Int -> a -> m b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m (Vector b)
V.imapM Int -> a -> m b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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_ :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmptyVector a -> m ()
mapM_ a -> m b
f = forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ a -> m b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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_ :: forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> NonEmptyVector a -> m ()
imapM_ Int -> a -> m b
f = forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
V.imapM_ Int -> a -> m b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *) a b.
Monad m =>
NonEmptyVector a -> (a -> m b) -> m (NonEmptyVector b)
forM (NonEmptyVector Vector a
v) a -> m b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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_ :: forall (m :: * -> *) a b.
Monad m =>
NonEmptyVector a -> (a -> m b) -> m ()
forM_ (NonEmptyVector Vector a
v) a -> m b
f = 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 :: forall a b c.
(a -> b -> c)
-> NonEmptyVector a -> NonEmptyVector b -> NonEmptyVector c
zipWith a -> b -> c
f NonEmptyVector a
a NonEmptyVector b
b = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
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 :: forall a b c d.
(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 = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
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 :: forall a b c d e.
(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 = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
c' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector c
c
    d' :: Vector d
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 :: forall a b c d e f.
(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 = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
c' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector c
c
    d' :: Vector d
d' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector d
d
    e' :: Vector e
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 :: forall a b c d e f g.
(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 = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
c' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector c
c
    d' :: Vector d
d' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector d
d
    e' :: Vector e
e' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector e
e
    f' :: Vector f
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 :: forall a b c.
(Int -> a -> b -> c)
-> NonEmptyVector a -> NonEmptyVector b -> NonEmptyVector c
izipWith Int -> a -> b -> c
f NonEmptyVector a
a NonEmptyVector b
b = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
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 :: forall a b c d.
(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 = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
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 :: forall a b c d e.
(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 = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
c' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector c
c
    d' :: Vector d
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 :: forall a b c d e f.
(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 = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
c' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector c
c
    d' :: Vector d
d' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector d
d
    e' :: Vector e
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 :: forall a b c d e f g.
(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 = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
c' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector c
c
    d' :: Vector d
d' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector d
d
    e' :: Vector e
e' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector e
e
    f' :: Vector f
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 :: forall a b.
NonEmptyVector a -> NonEmptyVector b -> NonEmptyVector (a, b)
zip NonEmptyVector a
a NonEmptyVector b
b = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip Vector a
a' Vector b
b')
  where
    a' :: Vector a
a' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
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 :: forall a b c.
NonEmptyVector a
-> NonEmptyVector b -> NonEmptyVector c -> NonEmptyVector (a, b, c)
zip3 NonEmptyVector a
a NonEmptyVector b
b NonEmptyVector c
c = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
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 :: forall a b c d.
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 = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
c' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector c
c
    d' :: Vector d
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 :: forall a b c d e.
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 = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
c' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector c
c
    d' :: Vector d
d' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector d
d
    e' :: Vector e
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 :: forall a b c d e f.
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 = forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
b' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector b
b
    c' :: Vector c
c' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector c
c
    d' :: Vector d
d' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector d
d
    e' :: Vector e
e' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector e
e
    f' :: Vector f
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 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c)
-> NonEmptyVector a -> NonEmptyVector b -> m (NonEmptyVector c)
zipWithM a -> b -> m c
f NonEmptyVector a
a NonEmptyVector b
b = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
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 :: forall (m :: * -> *) a b c.
Monad m =>
(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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Vector a -> NonEmptyVector a
NonEmptyVector (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' = forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a
    b' :: Vector b
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_ :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> NonEmptyVector a -> NonEmptyVector b -> m ()
zipWithM_ a -> b -> m c
f NonEmptyVector a
a NonEmptyVector b
b = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> Vector a -> Vector b -> m ()
V.zipWithM_ a -> b -> m c
f (forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a) (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_ :: forall (m :: * -> *) a b c.
Monad m =>
(Int -> a -> b -> m c)
-> NonEmptyVector a -> NonEmptyVector b -> m ()
izipWithM_ Int -> a -> b -> m c
f NonEmptyVector a
a NonEmptyVector b
b = 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 (forall a. NonEmptyVector a -> Vector a
_neVec NonEmptyVector a
a) (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 :: forall a b.
NonEmptyVector (a, b) -> (NonEmptyVector a, NonEmptyVector b)
unzip (NonEmptyVector Vector (a, b)
v) = case forall a b. Vector (a, b) -> (Vector a, Vector b)
V.unzip Vector (a, b)
v of
    ~(Vector a
a,Vector b
b) -> (forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector a
a, 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 :: forall a b c.
NonEmptyVector (a, b, c)
-> (NonEmptyVector a, NonEmptyVector b, NonEmptyVector c)
unzip3 (NonEmptyVector Vector (a, b, c)
v) = case 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) ->
      ( forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector a
a
      , forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector b
b
      , 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 :: forall a b c d.
NonEmptyVector (a, b, c, d)
-> (NonEmptyVector a, NonEmptyVector b, NonEmptyVector c,
    NonEmptyVector d)
unzip4 (NonEmptyVector Vector (a, b, c, d)
v) = case 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) ->
      ( forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector a
a
      , forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector b
b
      , forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector c
c
      , 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 :: forall a b c d e.
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 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) ->
      ( forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector a
a
      , forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector b
b
      , forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector c
c
      , forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector d
d
      , 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 :: forall a b c d e f.
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 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) ->
      ( forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector a
a
      , forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector b
b
      , forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector c
c
      , forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector d
d
      , forall a. Vector a -> NonEmptyVector a
NonEmptyVector Vector e
e
      , 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 :: forall a. (a -> Bool) -> NonEmptyVector a -> Vector a
filter a -> Bool
f = forall a. (a -> Bool) -> Vector a -> Vector a
V.filter a -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (Int -> a -> Bool) -> NonEmptyVector a -> Vector a
ifilter Int -> a -> Bool
f = forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter Int -> a -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> NonEmptyVector a -> m (Vector a)
filterM a -> m Bool
f = forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Vector a -> m (Vector a)
V.filterM a -> m Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *) a.
Monad m =>
(Int -> a -> m Bool) -> NonEmptyVector a -> m (Vector a)
ifilterM Int -> a -> m Bool
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> Vector a -> Vector b
V.map forall a b. (a, b) -> b
snd)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Vector a -> m (Vector a)
V.filterM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> a -> m Bool
f)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> Vector (Int, a)
V.indexed
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Eq a => NonEmptyVector a -> NonEmptyVector a
uniq = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => Vector a -> Vector a
V.uniq forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a b. (a -> Maybe b) -> NonEmptyVector a -> Vector b
mapMaybe a -> Maybe b
f = forall a b. (a -> Maybe b) -> Vector a -> Vector b
V.mapMaybe a -> Maybe b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a b. (Int -> a -> Maybe b) -> NonEmptyVector a -> Vector b
imapMaybe Int -> a -> Maybe b
f = forall a b. (Int -> a -> Maybe b) -> Vector a -> Vector b
V.imapMaybe Int -> a -> Maybe b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (a -> Bool) -> NonEmptyVector a -> Vector a
takeWhile a -> Bool
f = forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile a -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (a -> Bool) -> NonEmptyVector a -> Vector a
dropWhile a -> Bool
f = forall a. (a -> Bool) -> Vector a -> Vector a
V.dropWhile a -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (a -> Bool) -> NonEmptyVector a -> (Vector a, Vector a)
partition a -> Bool
f = forall a. (a -> Bool) -> Vector a -> (Vector a, Vector a)
V.partition a -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE partition #-}

-- | /O(n)/ Split the non-empty vector in two parts, the first one
-- containing the Left elements and the second containing the
-- Right elements. The relative order of the elements is preserved.
--
-- If all elements produce a Left (or Right), one of the
-- resulting vectors may be empty.
--
-- >>> partitionWith (\a -> if a < 3 then Left a else Right (P.show a)) (unsafeFromList [1..5])
-- ([1,2],["3","4","5"])
--
partitionWith :: (a -> Either b c) -> NonEmptyVector a -> (Vector b, Vector c)
partitionWith :: forall a b c.
(a -> Either b c) -> NonEmptyVector a -> (Vector b, Vector c)
partitionWith a -> Either b c
f = forall a b c. (a -> Either b c) -> Vector a -> (Vector b, Vector c)
V.partitionWith a -> Either b c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE partitionWith #-}

-- | /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 :: forall a. (a -> Bool) -> NonEmptyVector a -> (Vector a, Vector a)
unstablePartition a -> Bool
f = forall a. (a -> Bool) -> Vector a -> (Vector a, Vector a)
V.unstablePartition a -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (a -> Bool) -> NonEmptyVector a -> (Vector a, Vector a)
span a -> Bool
f = forall a. (a -> Bool) -> Vector a -> (Vector a, Vector a)
V.span a -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (a -> Bool) -> NonEmptyVector a -> (Vector a, Vector a)
break a -> Bool
f = forall a. (a -> Bool) -> Vector a -> (Vector a, Vector a)
V.break a -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Eq a => a -> NonEmptyVector a -> Bool
elem a
a = forall a. Eq a => a -> Vector a -> Bool
V.elem a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Eq a => a -> NonEmptyVector a -> Bool
notElem a
a = forall a. Eq a => a -> Vector a -> Bool
V.notElem a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (a -> Bool) -> NonEmptyVector a -> Maybe a
find a -> Bool
f = forall a. (a -> Bool) -> Vector a -> Maybe a
V.find a -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (a -> Bool) -> NonEmptyVector a -> Maybe Int
findIndex a -> Bool
f = forall a. (a -> Bool) -> Vector a -> Maybe Int
V.findIndex a -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (a -> Bool) -> NonEmptyVector a -> Vector Int
findIndices a -> Bool
f = forall a. (a -> Bool) -> Vector a -> Vector Int
V.findIndices a -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Eq a => a -> NonEmptyVector a -> Maybe Int
elemIndex a
a = forall a. Eq a => a -> Vector a -> Maybe Int
V.elemIndex a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Eq a => a -> NonEmptyVector a -> Vector Int
elemIndices a
a = forall a. Eq a => a -> Vector a -> Vector Int
V.elemIndices a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE elemIndices #-}

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

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

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

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

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

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

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

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

-- | /O(n)/ Strict right semigroupal fold
--
foldr1' :: (a -> a -> a) -> NonEmptyVector a -> a
foldr1' :: forall a. (a -> a -> a) -> NonEmptyVector a -> a
foldr1' a -> a -> a
f = forall a. (a -> a -> a) -> Vector a -> a
V.foldr1' a -> a -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a b. (a -> Int -> b -> a) -> a -> NonEmptyVector b -> a
ifoldl a -> Int -> b -> a
f a
a = forall a b. (a -> Int -> b -> a) -> a -> Vector b -> a
V.ifoldl a -> Int -> b -> a
f a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' :: forall a b. (a -> Int -> b -> a) -> a -> NonEmptyVector b -> a
ifoldl' a -> Int -> b -> a
f a
a = forall a b. (a -> Int -> b -> a) -> a -> Vector b -> a
V.ifoldl' a -> Int -> b -> a
f a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a b. (Int -> a -> b -> b) -> b -> NonEmptyVector a -> b
ifoldr Int -> a -> b -> b
f b
b = forall a b. (Int -> a -> b -> b) -> b -> Vector a -> b
V.ifoldr Int -> a -> b -> b
f b
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' :: forall a b. (Int -> a -> b -> b) -> b -> NonEmptyVector a -> b
ifoldr' Int -> a -> b -> b
f b
b = forall a b. (Int -> a -> b -> b) -> b -> Vector a -> b
V.ifoldr' Int -> a -> b -> b
f b
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (a -> Bool) -> NonEmptyVector a -> Bool
all a -> Bool
f = forall a. (a -> Bool) -> Vector a -> Bool
V.all a -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (a -> Bool) -> NonEmptyVector a -> Bool
any a -> Bool
f = forall a. (a -> Bool) -> Vector a -> Bool
V.any a -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE or #-}

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

-- | /O(n)/ Compute the produce of the elements
--
product :: Num a => NonEmptyVector a -> a
product :: forall a. Num a => NonEmptyVector a -> a
product = forall a. Num a => Vector a -> a
V.product forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Ord a => NonEmptyVector a -> a
maximum = forall a. Ord a => Vector a -> a
V.maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (a -> a -> Ordering) -> NonEmptyVector a -> a
maximumBy a -> a -> Ordering
f = forall a. (a -> a -> Ordering) -> Vector a -> a
V.maximumBy a -> a -> Ordering
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Ord a => NonEmptyVector a -> a
minimum = forall a. Ord a => Vector a -> a
V.minimum forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (a -> a -> Ordering) -> NonEmptyVector a -> a
minimumBy a -> a -> Ordering
f = forall a. (a -> a -> Ordering) -> Vector a -> a
V.minimumBy a -> a -> Ordering
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Ord a => NonEmptyVector a -> Int
minIndex = forall a. Ord a => Vector a -> Int
V.minIndex forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (a -> a -> Ordering) -> NonEmptyVector a -> Int
minIndexBy a -> a -> Ordering
f = forall a. (a -> a -> Ordering) -> Vector a -> Int
V.minIndexBy a -> a -> Ordering
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Ord a => NonEmptyVector a -> Int
maxIndex = forall a. Ord a => Vector a -> Int
V.maxIndex forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (a -> a -> Ordering) -> NonEmptyVector a -> Int
maxIndexBy a -> a -> Ordering
f = forall a. (a -> a -> Ordering) -> Vector a -> Int
V.maxIndexBy a -> a -> Ordering
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> a -> NonEmptyVector b -> m a
foldM a -> b -> m a
f a
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *) a b.
Monad m =>
(a -> Int -> b -> m a) -> a -> NonEmptyVector b -> m a
ifoldM a -> Int -> b -> m a
f a
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' :: forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> a -> NonEmptyVector b -> m a
foldM' a -> b -> m a
f a
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' :: forall (m :: * -> *) a b.
Monad m =>
(a -> Int -> b -> m a) -> a -> NonEmptyVector b -> m a
ifoldM' a -> Int -> b -> m a
f a
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *) a.
Monad m =>
(a -> a -> m a) -> NonEmptyVector a -> m a
fold1M a -> a -> m a
f = forall (m :: * -> *) a.
Monad m =>
(a -> a -> m a) -> Vector a -> m a
V.fold1M a -> a -> m a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' :: forall (m :: * -> *) a.
Monad m =>
(a -> a -> m a) -> NonEmptyVector a -> m a
fold1M' a -> a -> m a
f = forall (m :: * -> *) a.
Monad m =>
(a -> a -> m a) -> Vector a -> m a
V.fold1M' a -> a -> m a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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_ :: forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> a -> NonEmptyVector b -> m ()
foldM_ a -> b -> m a
f a
a = forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> a -> Vector b -> m ()
V.foldM_ a -> b -> m a
f a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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_ :: forall (m :: * -> *) a b.
Monad m =>
(a -> Int -> b -> m a) -> a -> NonEmptyVector b -> m ()
ifoldM_ a -> Int -> b -> m a
f a
a = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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'_ :: forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> a -> NonEmptyVector b -> m ()
foldM'_ a -> b -> m a
f a
a = forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> a -> Vector b -> m ()
V.foldM'_ a -> b -> m a
f a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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'_ :: forall (m :: * -> *) a b.
Monad m =>
(a -> Int -> b -> m a) -> a -> NonEmptyVector b -> m ()
ifoldM'_ a -> Int -> b -> m a
f a
a = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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_ :: forall (m :: * -> *) a.
Monad m =>
(a -> a -> m a) -> NonEmptyVector a -> m ()
fold1M_ a -> a -> m a
f = forall (m :: * -> *) a.
Monad m =>
(a -> a -> m a) -> Vector a -> m ()
V.fold1M_ a -> a -> m a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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'_ :: forall (m :: * -> *) a.
Monad m =>
(a -> a -> m a) -> NonEmptyVector a -> m ()
fold1M'_ a -> a -> m a
f = forall (m :: * -> *) a.
Monad m =>
(a -> a -> m a) -> Vector a -> m ()
V.fold1M'_ a -> a -> m a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *) a.
Monad m =>
NonEmptyVector (m a) -> m (NonEmptyVector a)
sequence = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => Vector (m a) -> m (Vector a)
V.sequence forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE sequence #-}

-- | Evaluate each action and discard the results
--
sequence_ :: Monad m => NonEmptyVector (m a) -> m ()
sequence_ :: forall (m :: * -> *) a. Monad m => NonEmptyVector (m a) -> m ()
sequence_ = forall (m :: * -> *) a. Monad m => Vector (m a) -> m ()
V.sequence_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a b.
(a -> b -> a) -> a -> NonEmptyVector b -> NonEmptyVector a
prescanl a -> b -> a
f a
a = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b -> a) -> a -> Vector b -> Vector a
V.prescanl a -> b -> a
f a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' :: forall a b.
(a -> b -> a) -> a -> NonEmptyVector b -> NonEmptyVector a
prescanl' a -> b -> a
f a
a = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b -> a) -> a -> Vector b -> Vector a
V.prescanl' a -> b -> a
f a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE prescanl' #-}

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

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

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

-- | /O(n)/ Strict semigroupal scan
--
scanl1' :: (a -> a -> a) -> NonEmptyVector a -> NonEmptyVector a
scanl1' :: forall a. (a -> a -> a) -> NonEmptyVector a -> NonEmptyVector a
scanl1' a -> a -> a
f = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> a) -> Vector a -> Vector a
V.scanl1' a -> a -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a b.
(Int -> a -> b -> a) -> a -> NonEmptyVector b -> NonEmptyVector a
iscanl Int -> a -> b -> a
f a
a = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Int -> a -> b -> a) -> a -> Vector b -> Vector a
V.iscanl Int -> a -> b -> a
f a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' :: forall a b.
(Int -> a -> b -> a) -> a -> NonEmptyVector b -> NonEmptyVector a
iscanl' Int -> a -> b -> a
f a
a = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Int -> a -> b -> a) -> a -> Vector b -> Vector a
V.iscanl' Int -> a -> b -> a
f a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a b.
(a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
prescanr a -> b -> b
f b
b = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b -> b) -> b -> Vector a -> Vector b
V.prescanr a -> b -> b
f b
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' :: forall a b.
(a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
prescanr' a -> b -> b
f b
b = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b -> b) -> b -> Vector a -> Vector b
V.prescanr' a -> b -> b
f b
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a b.
(a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
postscanr a -> b -> b
f b
b = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b -> b) -> b -> Vector a -> Vector b
V.postscanr a -> b -> b
f b
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' :: forall a b.
(a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
postscanr' a -> b -> b
f b
b = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b -> b) -> b -> Vector a -> Vector b
V.postscanr' a -> b -> b
f b
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a b.
(a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
scanr a -> b -> b
f b
b = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b -> b) -> b -> Vector a -> Vector b
V.scanr a -> b -> b
f b
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' :: forall a b.
(a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
scanr' a -> b -> b
f b
b = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b -> b) -> b -> Vector a -> Vector b
V.scanr' a -> b -> b
f b
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (a -> a -> a) -> NonEmptyVector a -> NonEmptyVector a
scanr1 a -> a -> a
f = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> a) -> Vector a -> Vector a
V.scanr1 a -> a -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' :: forall a. (a -> a -> a) -> NonEmptyVector a -> NonEmptyVector a
scanr1' a -> a -> a
f = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> a) -> Vector a -> Vector a
V.scanr1' a -> a -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a b.
(Int -> a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
iscanr Int -> a -> b -> b
f b
b = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Int -> a -> b -> b) -> b -> Vector a -> Vector b
V.iscanr Int -> a -> b -> b
f b
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' :: forall a b.
(Int -> a -> b -> b) -> b -> NonEmptyVector a -> NonEmptyVector b
iscanr' Int -> a -> b -> b
f b
b = forall a. Vector a -> NonEmptyVector a
NonEmptyVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Int -> a -> b -> b) -> b -> Vector a -> Vector b
V.iscanr' Int -> a -> b -> b
f b
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmptyVector a -> Vector a
_neVec
{-# INLINE iscanr' #-}