module Resource.Collection
  ( enumerate
  , size
  , toVector
  , toVectorStorable
  ) where

import RIO

import RIO.Vector qualified as Vector
import RIO.Vector.Storable qualified as VectorStorable
import Data.List qualified as List
import Data.Traversable (mapAccumL)

{-# INLINE size #-}
size :: (Foldable t, Num size) => t a -> size
size :: t a -> size
size = [a] -> size
forall i a. Num i => [a] -> i
List.genericLength ([a] -> size) -> (t a -> [a]) -> t a -> size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

enumerate :: (Traversable t, Num ix) => t a -> t (ix, a)
enumerate :: t a -> t (ix, a)
enumerate = (ix, t (ix, a)) -> t (ix, a)
forall a b. (a, b) -> b
snd ((ix, t (ix, a)) -> t (ix, a))
-> (t a -> (ix, t (ix, a))) -> t a -> t (ix, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ix -> a -> (ix, (ix, a))) -> ix -> t a -> (ix, t (ix, a))
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL ix -> a -> (ix, (ix, a))
forall a b. Num a => a -> b -> (a, (a, b))
f ix
0
  where
    f :: a -> b -> (a, (a, b))
f a
a b
b = (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, (a
a, b
b))

{-# INLINE toVector #-}
toVector :: Foldable collection => collection a -> Vector a
toVector :: collection a -> Vector a
toVector = [a] -> Vector a
forall (v :: * -> *) a. Vector v a => [a] -> v a
Vector.fromList ([a] -> Vector a)
-> (collection a -> [a]) -> collection a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. collection a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

{-# INLINE toVectorStorable #-}
toVectorStorable
  :: (Foldable collection, Storable a)
  => collection a
  -> VectorStorable.Vector a
toVectorStorable :: collection a -> Vector a
toVectorStorable = [a] -> Vector a
forall a. Storable a => [a] -> Vector a
VectorStorable.fromList ([a] -> Vector a)
-> (collection a -> [a]) -> collection a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. collection a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList