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
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 #-}
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 #-}
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 #-}
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
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