{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# OPTIONS_GHC -Wno-orphans #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Vector.NonEmpty.Util
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Instances for non-empty vectors
--
--------------------------------------------------------------------------------
module HGeometry.Vector.NonEmpty.Util
  (
  ) where

import           Control.Lens
import qualified Data.Foldable as F
import           Data.Foldable1
import           Data.Foldable1.WithIndex
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Vector as Vector
import qualified Data.Vector.NonEmpty as NonEmptyV
import           Data.Vector.NonEmpty.Internal (NonEmptyVector(..))

--------------------------------------------------------------------------------


type instance Index   (NonEmptyVector a) = Int
type instance IxValue (NonEmptyVector a) = a

instance Ixed (NonEmptyVector a) where
  ix :: Index (NonEmptyVector a)
-> Traversal' (NonEmptyVector a) (IxValue (NonEmptyVector a))
ix Index (NonEmptyVector a)
i IxValue (NonEmptyVector a) -> f (IxValue (NonEmptyVector a))
f (NonEmptyVector Vector a
v) = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector a -> NonEmptyVector a)
-> f (Vector a) -> f (NonEmptyVector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index (Vector a) -> Traversal' (Vector a) (IxValue (Vector a))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Vector a)
Index (NonEmptyVector a)
i IxValue (Vector a) -> f (IxValue (Vector a))
IxValue (NonEmptyVector a) -> f (IxValue (NonEmptyVector a))
f Vector a
v
  {-# INLINE ix #-}


instance Foldable1WithIndex Int NonEmptyVector where
  ifoldMap1 :: forall m a. Semigroup m => (Int -> a -> m) -> NonEmptyVector a -> m
ifoldMap1 Int -> a -> m
f = NonEmptyVector m -> m
forall m. Semigroup m => NonEmptyVector m -> m
forall (t :: * -> *) m. (Foldable1 t, Semigroup m) => t m -> m
fold1 (NonEmptyVector m -> m)
-> (NonEmptyVector a -> NonEmptyVector m) -> NonEmptyVector a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> m) -> NonEmptyVector a -> NonEmptyVector m
forall a b. (Int -> a -> b) -> NonEmptyVector a -> NonEmptyVector b
NonEmptyV.imap Int -> a -> m
f
  {-# INLINE ifoldMap1 #-}
-- -- | ifoldMap1. This will appear in indexedtraversal as of next release
-- ifoldMap1   :: Semigroup m => (Int -> a -> m) -> NonEmptyV.NonEmptyVector a -> m



-- instance Foldable1 NonEmptyVector where
--   foldMap1 f v = let (v',x) = NV.unsnoc v
--                  in Vector.foldr (\x' a -> f x' <> a) (f x) v'
--   {-# INLINE foldMap1 #-}

instance Traversable1 NonEmptyVector where
  traverse1 :: forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> NonEmptyVector a -> f (NonEmptyVector b)
traverse1 a -> f b
f (NonEmptyVector Vector a
v) =
      -- Get the length of the vector in /O(1)/ time
      let !n :: Int
n = Vector a -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length Vector a
v
      -- Use fromListN to be more efficient in construction of resulting vector
      -- Also behaves better with compact regions, preventing runtime exceptions
      in Vector b -> NonEmptyVector b
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector b -> NonEmptyVector b)
-> (NonEmpty b -> Vector b) -> NonEmpty b -> NonEmptyVector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [b] -> Vector b
forall a. Int -> [a] -> Vector a
Vector.fromListN Int
n ([b] -> Vector b) -> (NonEmpty b -> [b]) -> NonEmpty b -> Vector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty b -> [b]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
         (NonEmpty b -> NonEmptyVector b)
-> f (NonEmpty b) -> f (NonEmptyVector b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> NonEmpty a -> f (NonEmpty b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse1 a -> f b
f ([a] -> NonEmpty a
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList ([a] -> NonEmpty a) -> [a] -> NonEmpty a
forall a b. (a -> b) -> a -> b
$ Vector a -> [a]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Vector a
v)
         -- notice that NonEmpty.fromList is suposedly safe since the vector is NonEmpty...
  {-# INLINE traverse1 #-}

instance FunctorWithIndex Int NonEmptyVector where
  imap :: forall a b. (Int -> a -> b) -> NonEmptyVector a -> NonEmptyVector b
imap Int -> a -> b
f (NonEmptyVector Vector a
v) = Vector b -> NonEmptyVector b
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector b -> NonEmptyVector b) -> Vector b -> NonEmptyVector b
forall a b. (a -> b) -> a -> b
$ (Int -> a -> b) -> Vector a -> Vector b
forall a b. (Int -> a -> b) -> Vector a -> Vector b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap Int -> a -> b
f Vector a
v
  {-# INLINE imap #-}
instance FoldableWithIndex Int NonEmptyVector where
  ifoldMap :: forall m a. Monoid m => (Int -> a -> m) -> NonEmptyVector a -> m
ifoldMap Int -> a -> m
f (NonEmptyVector Vector a
v) = (Int -> a -> m) -> Vector a -> m
forall m a. Monoid m => (Int -> a -> m) -> Vector a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap Int -> a -> m
f Vector a
v
  {-# INLINE ifoldMap #-}
instance TraversableWithIndex Int NonEmptyVector where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> NonEmptyVector a -> f (NonEmptyVector b)
itraverse Int -> a -> f b
f (NonEmptyVector Vector a
v) = Vector b -> NonEmptyVector b
forall a. Vector a -> NonEmptyVector a
NonEmptyVector (Vector b -> NonEmptyVector b)
-> f (Vector b) -> f (NonEmptyVector b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> a -> f b) -> Vector a -> f (Vector b)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> Vector a -> f (Vector b)
itraverse Int -> a -> f b
f Vector a
v
  {-# INLINE itraverse #-}