--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Lens.Util
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Some helper utils for Lens
--
--------------------------------------------------------------------------------
module HGeometry.Lens.Util
  ( folding1
  , ifolding1
  , itoNonEmptyOf

  , toVectorOf
  , toNonEmptyVectorOf
  ) where

import           Control.Lens
import           Control.Lens.Internal.Fold (NonEmptyDList(..))
import           Data.Foldable1
import           Data.Functor.Apply (Apply)
import           Data.Functor.Contravariant (phantom)
import           Data.List.NonEmpty (NonEmpty(..))
import           Data.Semigroup.Foldable
import qualified VectorBuilder.Builder as Builder
import qualified VectorBuilder.Vector as Builder
import           Data.Vector.NonEmpty (NonEmptyVector)
import           Data.Vector (Vector)
import qualified Data.Vector.NonEmpty as NonEmptyV

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

-- TODO: upstream these to lens
-- taken and modified directly from lens

-- | construct a Fold1 from a function that produces a Foldable1
folding1         :: Foldable1 f => (s -> f a) -> Fold1 s a
folding1 :: forall (f :: * -> *) s a. Foldable1 f => (s -> f a) -> Fold1 s a
folding1 s -> f a
sfa a -> f a
agb = f () -> f s
forall (f :: * -> *) a b.
(Functor f, Contravariant f) =>
f a -> f b
phantom (f () -> f s) -> (s -> f ()) -> s -> f s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> f a -> f ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable1 t, Apply f) =>
(a -> f b) -> t a -> f ()
traverse1_ a -> f a
agb (f a -> f ()) -> (s -> f a) -> s -> f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> f a
sfa
{-# INLINE folding1 #-}

-- | Version of ifolding to build an 'IndexedFold1'
ifolding1       :: (Foldable1 f, Indexable i p, Contravariant g, Apply g)
                => (s -> f (i, a)) -> Over p g s t a b
ifolding1 :: forall (f :: * -> *) i (p :: * -> * -> *) (g :: * -> *) s a t b.
(Foldable1 f, Indexable i p, Contravariant g, Apply g) =>
(s -> f (i, a)) -> Over p g s t a b
ifolding1 s -> f (i, a)
sfa p a (g b)
f = g () -> g t
forall (f :: * -> *) a b.
(Functor f, Contravariant f) =>
f a -> f b
phantom (g () -> g t) -> (s -> g ()) -> s -> g t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((i, a) -> g (ZonkAny 0)) -> f (i, a) -> g ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable1 t, Apply f) =>
(a -> f b) -> t a -> f ()
traverse1_ (g b -> g (ZonkAny 0)
forall (f :: * -> *) a b.
(Functor f, Contravariant f) =>
f a -> f b
phantom (g b -> g (ZonkAny 0))
-> ((i, a) -> g b) -> (i, a) -> g (ZonkAny 0)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> a -> g b) -> (i, a) -> g b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (p a (g b) -> i -> a -> g b
forall a b. p a b -> i -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p a (g b)
f)) (f (i, a) -> g ()) -> (s -> f (i, a)) -> s -> g ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> f (i, a)
sfa
{-# INLINE ifolding1 #-}

-- | indexed version of 'toNonEmptyOf'
itoNonEmptyOf   :: IndexedGetting i (NonEmptyDList (i,a)) s a -> s -> NonEmpty (i,a)
itoNonEmptyOf :: forall i a s.
IndexedGetting i (NonEmptyDList (i, a)) s a -> s -> NonEmpty (i, a)
itoNonEmptyOf IndexedGetting i (NonEmptyDList (i, a)) s a
l = (NonEmptyDList (i, a) -> [(i, a)] -> NonEmpty (i, a))
-> [(i, a)] -> NonEmptyDList (i, a) -> NonEmpty (i, a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip NonEmptyDList (i, a) -> [(i, a)] -> NonEmpty (i, a)
forall a. NonEmptyDList a -> [a] -> NonEmpty a
getNonEmptyDList [] (NonEmptyDList (i, a) -> NonEmpty (i, a))
-> (s -> NonEmptyDList (i, a)) -> s -> NonEmpty (i, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexedGetting i (NonEmptyDList (i, a)) s a
-> (i -> a -> NonEmptyDList (i, a)) -> s -> NonEmptyDList (i, a)
forall i m s a. IndexedGetting i m s a -> (i -> a -> m) -> s -> m
ifoldMapOf IndexedGetting i (NonEmptyDList (i, a)) s a
l (\i
i a
a -> ([(i, a)] -> NonEmpty (i, a)) -> NonEmptyDList (i, a)
forall a. ([a] -> NonEmpty a) -> NonEmptyDList a
NonEmptyDList ((i
i,a
a) (i, a) -> [(i, a)] -> NonEmpty (i, a)
forall a. a -> [a] -> NonEmpty a
:|))
{-# INLINE itoNonEmptyOf #-}

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

-- | Given a fold, construct a non-emptyVector out of it
toNonEmptyVectorOf   :: Getting (Builder.Builder a) s a -> s -> NonEmptyVector a
toNonEmptyVectorOf :: forall a s. Getting (Builder a) s a -> s -> NonEmptyVector a
toNonEmptyVectorOf Getting (Builder a) s a
l = Vector a -> NonEmptyVector a
forall a. Vector a -> NonEmptyVector a
NonEmptyV.unsafeFromVector (Vector a -> NonEmptyVector a)
-> (s -> Vector a) -> s -> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Builder a) s a -> s -> Vector a
forall a s. Getting (Builder a) s a -> s -> Vector a
toVectorOf Getting (Builder a) s a
l

-- | Given a fold, construct a non-emptyVector out of it
toVectorOf     :: Getting (Builder.Builder a) s a -> s -> Vector a
toVectorOf :: forall a s. Getting (Builder a) s a -> s -> Vector a
toVectorOf Getting (Builder a) s a
l s
s = Builder a -> Vector a
forall (vector :: * -> *) element.
Vector vector element =>
Builder element -> vector element
Builder.build (Builder a -> Vector a) -> Builder a -> Vector a
forall a b. (a -> b) -> a -> b
$ Getting (Builder a) s a -> (a -> Builder a) -> s -> Builder a
forall r s a. Getting r s a -> (a -> r) -> s -> r
foldMapOf Getting (Builder a) s a
l a -> Builder a
forall element. element -> Builder element
Builder.singleton s
s