--------------------------------------------------------------------------------
-- |
-- 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
  ) 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

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

-- 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 Any) -> f (i, a) -> g ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable1 t, Apply f) =>
(a -> f b) -> t a -> f ()
traverse1_ (g b -> g Any
forall (f :: * -> *) a b.
(Functor f, Contravariant f) =>
f a -> f b
phantom (g b -> g Any) -> ((i, a) -> g b) -> (i, a) -> g Any
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 #-}