{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Data.Vessel.Class where
import Control.Arrow ((***))
import Control.Monad.Writer.Strict (Writer, execWriter, tell)
import Data.Align
import Data.Foldable
import Data.Functor.Compose
import Data.Witherable
import GHC.Generics
import Data.Semigroup
import Data.These
import Data.Maybe (fromMaybe)
import Data.Functor.Identity
import Reflex.Query.Class
import Data.Proxy
import Data.Map.Monoidal (MonoidalMap (..))
import Data.Dependent.Map.Monoidal (MonoidalDMap (..))
import Data.GADT.Compare
import qualified Data.Dependent.Map.Monoidal as DMap
import qualified Data.Dependent.Map as DMap'
import Data.Vessel.Internal
class View (v :: (* -> *) -> *) where
condenseV :: (Foldable t, Filterable t, Functor t) => t (v g) -> v (Compose t g)
default condenseV :: GCondenseView t g v => t (v g) -> v (Compose t g)
condenseV t (v g)
tvg = Rep (v (Compose t g)) Any -> v (Compose t g)
forall a x. Generic a => Rep a x -> a
to (Rep (v (Compose t g)) Any -> v (Compose t g))
-> Rep (v (Compose t g)) Any -> v (Compose t g)
forall a b. (a -> b) -> a -> b
$ t (Rep (v g) Any) -> Rep (v (Compose t g)) Any
forall k (t :: * -> *) (vf :: k -> *) (vtf :: k -> *) (p :: k).
CondenseView t vf vtf =>
t (vf p) -> vtf p
condenseView (t (Rep (v g) Any) -> Rep (v (Compose t g)) Any)
-> t (Rep (v g) Any) -> Rep (v (Compose t g)) Any
forall a b. (a -> b) -> a -> b
$ v g -> Rep (v g) Any
forall a x. Generic a => a -> Rep a x
from (v g -> Rep (v g) Any) -> t (v g) -> t (Rep (v g) Any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t (v g)
tvg
disperseV :: (Align t) => v (Compose t g) -> t (v g)
default disperseV :: GDisperseView t g v => v (Compose t g) -> t (v g)
disperseV v (Compose t g)
vtg = Rep (v g) Any -> v g
forall a x. Generic a => Rep a x -> a
to (Rep (v g) Any -> v g) -> t (Rep (v g) Any) -> t (v g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rep (v (Compose t g)) Any -> t (Rep (v g) Any)
forall k (t :: * -> *) (vf :: k -> *) (vtf :: k -> *) (p :: k).
DisperseView t vf vtf =>
vtf p -> t (vf p)
disperseView (v (Compose t g) -> Rep (v (Compose t g)) Any
forall a x. Generic a => a -> Rep a x
from v (Compose t g)
vtg)
cropV :: (forall a. s a -> i a -> r a) -> v s -> v i -> Maybe (v r)
default cropV :: forall s i r. GZipView s i r v => (forall a. s a -> i a -> r a) -> v s -> v i -> Maybe (v r)
cropV forall a. s a -> i a -> r a
f v s
vi v i
vs = v r -> Maybe (v r)
forall (v :: (* -> *) -> *) (f :: * -> *).
View v =>
v f -> Maybe (v f)
maybeEmptyView (v r -> Maybe (v r)) -> v r -> Maybe (v r)
forall a b. (a -> b) -> a -> b
$ Rep (v r) Any -> v r
forall a x. Generic a => Rep a x -> a
to (Rep (v r) Any -> v r) -> Rep (v r) Any -> v r
forall a b. (a -> b) -> a -> b
$ (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' s -> v' i -> v' r)
-> Rep (v s) Any -> Rep (v i) Any -> Rep (v r) Any
forall (f :: * -> *) (g :: * -> *) (h :: * -> *) (vf :: * -> *)
(vg :: * -> *) (vh :: * -> *) p.
ZipView f g h vf vg vh =>
(forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> v' h)
-> vf p -> vg p -> vh p
zipView forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' s -> v' i -> v' r
z (v s -> Rep (v s) Any
forall a x. Generic a => a -> Rep a x
from v s
vi) (v i -> Rep (v i) Any
forall a x. Generic a => a -> Rep a x
from v i
vs)
where z :: forall v'. (View v', EmptyView v') => v' s -> v' i -> v' r
z :: v' s -> v' i -> v' r
z v' s
v'i v' i
v's = v' r -> Maybe (v' r) -> v' r
forall a. a -> Maybe a -> a
fromMaybe v' r
forall (v :: (* -> *) -> *) (f :: * -> *). EmptyView v => v f
emptyV (Maybe (v' r) -> v' r) -> Maybe (v' r) -> v' r
forall a b. (a -> b) -> a -> b
$ (forall a. s a -> i a -> r a) -> v' s -> v' i -> Maybe (v' r)
forall (v :: (* -> *) -> *) (s :: * -> *) (i :: * -> *)
(r :: * -> *).
View v =>
(forall a. s a -> i a -> r a) -> v s -> v i -> Maybe (v r)
cropV forall a. s a -> i a -> r a
f v' s
v'i v' i
v's
nullV :: v i -> Bool
default nullV :: forall i. GMapView i i v => v i -> Bool
nullV v i
v = All -> Bool
getAll (All -> Bool) -> All -> Bool
forall a b. (a -> b) -> a -> b
$ Writer All (Rep (v i) Any) -> All
forall w a. Writer w a -> w
execWriter (Writer All (Rep (v i) Any) -> All)
-> Writer All (Rep (v i) Any) -> All
forall a b. (a -> b) -> a -> b
$
(forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' i -> WriterT All Identity (v' i))
-> Rep (v i) Any -> Writer All (Rep (v i) Any)
forall (f :: * -> *) (g :: * -> *) (vf :: * -> *) (vg :: * -> *)
(m :: * -> *) p.
(MapView f g vf vg, Applicative m) =>
(forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g))
-> vf p -> m (vg p)
mapViewM @i @i @(Rep (v i)) @(Rep (v i)) forall (v' :: (* -> *) -> *). View v' => v' i -> Writer All (v' i)
forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' i -> WriterT All Identity (v' i)
f (v i -> Rep (v i) Any
forall a x. Generic a => a -> Rep a x
from v i
v)
where f :: View v' => v' i -> Writer All (v' i)
f :: v' i -> Writer All (v' i)
f v' i
v' = All -> WriterT All Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Bool -> All
All (Bool -> All) -> Bool -> All
forall a b. (a -> b) -> a -> b
$ v' i -> Bool
forall (v :: (* -> *) -> *) (i :: * -> *). View v => v i -> Bool
nullV v' i
v') WriterT All Identity () -> Writer All (v' i) -> Writer All (v' i)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> v' i -> Writer All (v' i)
forall (f :: * -> *) a. Applicative f => a -> f a
pure v' i
v'
mapV :: (forall a. f a -> g a) -> v f -> v g
default mapV :: GMapView f g v => (forall a. f a -> g a) -> v f -> v g
mapV forall a. f a -> g a
f v f
vf = Rep (v g) Any -> v g
forall a x. Generic a => Rep a x -> a
to (Rep (v g) Any -> v g) -> Rep (v g) Any -> v g
forall a b. (a -> b) -> a -> b
$ (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g)
-> Rep (v f) Any -> Rep (v g) Any
forall (f :: * -> *) (g :: * -> *) (vf :: * -> *) (vg :: * -> *) p.
MapView f g vf vg =>
(forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g)
-> vf p -> vg p
mapView ((forall a. f a -> g a) -> v' f -> v' g
forall (v :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
View v =>
(forall a. f a -> g a) -> v f -> v g
mapV forall a. f a -> g a
f) (Rep (v f) Any -> Rep (v g) Any) -> Rep (v f) Any -> Rep (v g) Any
forall a b. (a -> b) -> a -> b
$ v f -> Rep (v f) Any
forall a x. Generic a => a -> Rep a x
from v f
vf
traverseV :: (Applicative m) => (forall a. f a -> m (g a)) -> v f -> m (v g)
default traverseV :: (GMapView f g v, Applicative m) => (forall a. f a -> m (g a)) -> v f -> m (v g)
traverseV forall a. f a -> m (g a)
f v f
vf = Rep (v g) Any -> v g
forall a x. Generic a => Rep a x -> a
to (Rep (v g) Any -> v g) -> m (Rep (v g) Any) -> m (v g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g))
-> Rep (v f) Any -> m (Rep (v g) Any)
forall (f :: * -> *) (g :: * -> *) (vf :: * -> *) (vg :: * -> *)
(m :: * -> *) p.
(MapView f g vf vg, Applicative m) =>
(forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g))
-> vf p -> m (vg p)
mapViewM ((forall a. f a -> m (g a)) -> v' f -> m (v' g)
forall (v :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
(g :: * -> *).
(View v, Applicative m) =>
(forall a. f a -> m (g a)) -> v f -> m (v g)
traverseV forall a. f a -> m (g a)
f) (v f -> Rep (v f) Any
forall a x. Generic a => a -> Rep a x
from v f
vf)
mapMaybeV :: (forall a. f a -> Maybe (g a)) -> v f -> Maybe (v g)
default mapMaybeV :: forall f g. GMapView f g v => (forall a. f a -> Maybe (g a)) -> v f -> Maybe (v g)
mapMaybeV forall a. f a -> Maybe (g a)
f v f
vf = v g -> Maybe (v g)
forall (v :: (* -> *) -> *) (f :: * -> *).
View v =>
v f -> Maybe (v f)
maybeEmptyView (v g -> Maybe (v g)) -> v g -> Maybe (v g)
forall a b. (a -> b) -> a -> b
$ Rep (v g) Any -> v g
forall a x. Generic a => Rep a x -> a
to (Rep (v g) Any -> v g) -> Rep (v g) Any -> v g
forall a b. (a -> b) -> a -> b
$ (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g)
-> Rep (v f) Any -> Rep (v g) Any
forall (f :: * -> *) (g :: * -> *) (vf :: * -> *) (vg :: * -> *) p.
MapView f g vf vg =>
(forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g)
-> vf p -> vg p
mapView forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g
z (Rep (v f) Any -> Rep (v g) Any) -> Rep (v f) Any -> Rep (v g) Any
forall a b. (a -> b) -> a -> b
$ v f -> Rep (v f) Any
forall a x. Generic a => a -> Rep a x
from v f
vf
where z :: forall v'. (View v', EmptyView v') => v' f -> v' g
z :: v' f -> v' g
z v' f
v'f = v' g -> Maybe (v' g) -> v' g
forall a. a -> Maybe a -> a
fromMaybe v' g
forall (v :: (* -> *) -> *) (f :: * -> *). EmptyView v => v f
emptyV (Maybe (v' g) -> v' g) -> Maybe (v' g) -> v' g
forall a b. (a -> b) -> a -> b
$ (forall a. f a -> Maybe (g a)) -> v' f -> Maybe (v' g)
forall (v :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
View v =>
(forall a. f a -> Maybe (g a)) -> v f -> Maybe (v g)
mapMaybeV forall a. f a -> Maybe (g a)
f v' f
v'f
alignWithMaybeV :: (forall a. These (f a) (g a) -> Maybe (h a)) -> v f -> v g -> Maybe (v h)
default alignWithMaybeV :: forall f g h. GZipView f g h v => (forall a. These (f a) (g a) -> Maybe (h a)) -> v f -> v g -> Maybe (v h)
alignWithMaybeV forall a. These (f a) (g a) -> Maybe (h a)
f v f
vf v g
vg = v h -> Maybe (v h)
forall (v :: (* -> *) -> *) (f :: * -> *).
View v =>
v f -> Maybe (v f)
maybeEmptyView (v h -> Maybe (v h)) -> v h -> Maybe (v h)
forall a b. (a -> b) -> a -> b
$ Rep (v h) Any -> v h
forall a x. Generic a => Rep a x -> a
to (Rep (v h) Any -> v h) -> Rep (v h) Any -> v h
forall a b. (a -> b) -> a -> b
$ (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> v' h)
-> Rep (v f) Any -> Rep (v g) Any -> Rep (v h) Any
forall (f :: * -> *) (g :: * -> *) (h :: * -> *) (vf :: * -> *)
(vg :: * -> *) (vh :: * -> *) p.
ZipView f g h vf vg vh =>
(forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> v' h)
-> vf p -> vg p -> vh p
zipView forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> v' h
z (v f -> Rep (v f) Any
forall a x. Generic a => a -> Rep a x
from v f
vf) (v g -> Rep (v g) Any
forall a x. Generic a => a -> Rep a x
from v g
vg)
where z :: forall v'. (View v', EmptyView v') => v' f -> v' g -> v' h
z :: v' f -> v' g -> v' h
z v' f
v'f v' g
v'g = v' h -> Maybe (v' h) -> v' h
forall a. a -> Maybe a -> a
fromMaybe v' h
forall (v :: (* -> *) -> *) (f :: * -> *). EmptyView v => v f
emptyV (Maybe (v' h) -> v' h) -> Maybe (v' h) -> v' h
forall a b. (a -> b) -> a -> b
$ (forall a. These (f a) (g a) -> Maybe (h a))
-> v' f -> v' g -> Maybe (v' h)
forall (v :: (* -> *) -> *) (f :: * -> *) (g :: * -> *)
(h :: * -> *).
View v =>
(forall a. These (f a) (g a) -> Maybe (h a))
-> v f -> v g -> Maybe (v h)
alignWithMaybeV forall a. These (f a) (g a) -> Maybe (h a)
f v' f
v'f v' g
v'g
alignWithV :: (forall a. These (f a) (g a) -> h a) -> v f -> v g -> v h
default alignWithV :: GZipView f g h v => (forall a. These (f a) (g a) -> h a) -> v f -> v g -> v h
alignWithV forall a. These (f a) (g a) -> h a
f v f
vf v g
vg = Rep (v h) Any -> v h
forall a x. Generic a => Rep a x -> a
to (Rep (v h) Any -> v h) -> Rep (v h) Any -> v h
forall a b. (a -> b) -> a -> b
$ (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> v' h)
-> Rep (v f) Any -> Rep (v g) Any -> Rep (v h) Any
forall (f :: * -> *) (g :: * -> *) (h :: * -> *) (vf :: * -> *)
(vg :: * -> *) (vh :: * -> *) p.
ZipView f g h vf vg vh =>
(forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> v' h)
-> vf p -> vg p -> vh p
zipView ((forall a. These (f a) (g a) -> h a) -> v' f -> v' g -> v' h
forall (v :: (* -> *) -> *) (f :: * -> *) (g :: * -> *)
(h :: * -> *).
View v =>
(forall a. These (f a) (g a) -> h a) -> v f -> v g -> v h
alignWithV forall a. These (f a) (g a) -> h a
f) (v f -> Rep (v f) Any
forall a x. Generic a => a -> Rep a x
from v f
vf) (v g -> Rep (v g) Any
forall a x. Generic a => a -> Rep a x
from v g
vg)
class View v => EmptyView v where
emptyV :: v f
maybeEmptyView :: View v => v f -> Maybe (v f)
maybeEmptyView :: v f -> Maybe (v f)
maybeEmptyView v f
v = if v f -> Bool
forall (v :: (* -> *) -> *) (i :: * -> *). View v => v i -> Bool
nullV v f
v then Maybe (v f)
forall a. Maybe a
Nothing else v f -> Maybe (v f)
forall a. a -> Maybe a
Just v f
v
class Empty1 a where
empty :: a p
instance Empty1 U1 where
empty :: U1 p
empty = U1 p
forall k (p :: k). U1 p
U1
instance EmptyView v => Empty1 (K1 i (v f)) where
empty :: K1 i (v f) p
empty = v f -> K1 i (v f) p
forall k i c (p :: k). c -> K1 i c p
K1 v f
forall (v :: (* -> *) -> *) (f :: * -> *). EmptyView v => v f
emptyV
instance Empty1 a => Empty1 (M1 i t a) where
empty :: M1 i t a p
empty = a p -> M1 i t a p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 a p
forall k (a :: k -> *) (p :: k). Empty1 a => a p
empty
instance (Empty1 a, Empty1 b) => Empty1 (a :*: b) where
empty :: (:*:) a b p
empty = a p
forall k (a :: k -> *) (p :: k). Empty1 a => a p
empty a p -> b p -> (:*:) a b p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b p
forall k (a :: k -> *) (p :: k). Empty1 a => a p
empty
type GCondenseView t f v =
( Generic (v f)
, Generic (v (Compose t f))
, CondenseView t (Rep (v f)) (Rep (v (Compose t f)))
)
class (Foldable t, Filterable t, Functor t) => CondenseView t vf vtf where
condenseView :: t (vf p) -> vtf p
instance (Foldable t, Filterable t, Functor t) => CondenseView t U1 U1 where
condenseView :: t (U1 p) -> U1 p
condenseView t (U1 p)
_ = U1 p
forall k (p :: k). U1 p
U1
instance (View v, Foldable t, Filterable t, Functor t) => CondenseView t (K1 i (v f)) (K1 i (v (Compose t f))) where
condenseView :: t (K1 i (v f) p) -> K1 i (v (Compose t f)) p
condenseView t (K1 i (v f) p)
tvf = v (Compose t f) -> K1 i (v (Compose t f)) p
forall k i c (p :: k). c -> K1 i c p
K1 (v (Compose t f) -> K1 i (v (Compose t f)) p)
-> v (Compose t f) -> K1 i (v (Compose t f)) p
forall a b. (a -> b) -> a -> b
$ t (v f) -> v (Compose t f)
forall (v :: (* -> *) -> *) (t :: * -> *) (g :: * -> *).
(View v, Foldable t, Filterable t, Functor t) =>
t (v g) -> v (Compose t g)
condenseV (t (v f) -> v (Compose t f)) -> t (v f) -> v (Compose t f)
forall a b. (a -> b) -> a -> b
$ K1 i (v f) p -> v f
forall i c k (p :: k). K1 i c p -> c
unK1 (K1 i (v f) p -> v f) -> t (K1 i (v f) p) -> t (v f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t (K1 i (v f) p)
tvf
instance CondenseView t vf vtf => CondenseView t (M1 i t' vf) (M1 i t' vtf) where
condenseView :: t (M1 i t' vf p) -> M1 i t' vtf p
condenseView t (M1 i t' vf p)
tvf = vtf p -> M1 i t' vtf p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (vtf p -> M1 i t' vtf p) -> vtf p -> M1 i t' vtf p
forall a b. (a -> b) -> a -> b
$ t (vf p) -> vtf p
forall k (t :: * -> *) (vf :: k -> *) (vtf :: k -> *) (p :: k).
CondenseView t vf vtf =>
t (vf p) -> vtf p
condenseView (t (vf p) -> vtf p) -> t (vf p) -> vtf p
forall a b. (a -> b) -> a -> b
$ M1 i t' vf p -> vf p
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (M1 i t' vf p -> vf p) -> t (M1 i t' vf p) -> t (vf p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t (M1 i t' vf p)
tvf
instance (CondenseView t avf avtf, CondenseView t bvf bvtf, Empty1 avf, Empty1 bvf) => CondenseView t (avf :*: bvf) (avtf :*: bvtf) where
condenseView :: t ((:*:) avf bvf p) -> (:*:) avtf bvtf p
condenseView t ((:*:) avf bvf p)
tvf = t (avf p) -> avtf p
forall k (t :: * -> *) (vf :: k -> *) (vtf :: k -> *) (p :: k).
CondenseView t vf vtf =>
t (vf p) -> vtf p
condenseView ((:*:) avf bvf p -> avf p
forall k (f :: k -> *) (g :: k -> *) (p :: k). (:*:) f g p -> f p
getA ((:*:) avf bvf p -> avf p) -> t ((:*:) avf bvf p) -> t (avf p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t ((:*:) avf bvf p)
tvf) avtf p -> bvtf p -> (:*:) avtf bvtf p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: t (bvf p) -> bvtf p
forall k (t :: * -> *) (vf :: k -> *) (vtf :: k -> *) (p :: k).
CondenseView t vf vtf =>
t (vf p) -> vtf p
condenseView ((:*:) avf bvf p -> bvf p
forall k (f :: k -> *) (g :: k -> *) (p :: k). (:*:) f g p -> g p
getB ((:*:) avf bvf p -> bvf p) -> t ((:*:) avf bvf p) -> t (bvf p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t ((:*:) avf bvf p)
tvf)
where getA :: (:*:) f g p -> f p
getA (f p
a :*: g p
_) = f p
a
getB :: (:*:) f g p -> g p
getB (f p
_ :*: g p
b) = g p
b
type GDisperseView t f v =
( Generic (v f)
, Generic (v (Compose t f))
, DisperseView t (Rep (v f)) (Rep (v (Compose t f)))
)
class Align t => DisperseView t vf vtf where
disperseView :: vtf p -> t (vf p)
instance Align t => DisperseView t U1 U1 where
disperseView :: U1 p -> t (U1 p)
disperseView U1 p
_ = t (U1 p)
forall (f :: * -> *) a. Align f => f a
nil
instance (View v, Align t) => DisperseView t (K1 i (v f)) (K1 i (v (Compose t f))) where
disperseView :: K1 i (v (Compose t f)) p -> t (K1 i (v f) p)
disperseView (K1 v (Compose t f)
vtf) = v f -> K1 i (v f) p
forall k i c (p :: k). c -> K1 i c p
K1 (v f -> K1 i (v f) p) -> t (v f) -> t (K1 i (v f) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v (Compose t f) -> t (v f)
forall (v :: (* -> *) -> *) (t :: * -> *) (g :: * -> *).
(View v, Align t) =>
v (Compose t g) -> t (v g)
disperseV v (Compose t f)
vtf
instance DisperseView t vf vtf => DisperseView t (M1 i t' vf) (M1 i t' vtf) where
disperseView :: M1 i t' vtf p -> t (M1 i t' vf p)
disperseView (M1 vtf p
vf) = vf p -> M1 i t' vf p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (vf p -> M1 i t' vf p) -> t (vf p) -> t (M1 i t' vf p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> vtf p -> t (vf p)
forall k (t :: * -> *) (vf :: k -> *) (vtf :: k -> *) (p :: k).
DisperseView t vf vtf =>
vtf p -> t (vf p)
disperseView vtf p
vf
instance (DisperseView t avf avtf, DisperseView t bvf bvtf, Empty1 avf, Empty1 bvf) => DisperseView t (avf :*: bvf) (avtf :*: bvtf) where
disperseView :: (:*:) avtf bvtf p -> t ((:*:) avf bvf p)
disperseView (avtf p
avtf :*: bvtf p
bvtf) = (These (avf p) (bvf p) -> (:*:) avf bvf p)
-> t (avf p) -> t (bvf p) -> t ((:*:) avf bvf p)
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith These (avf p) (bvf p) -> (:*:) avf bvf p
forall (p :: k). These (avf p) (bvf p) -> (:*:) avf bvf p
f (avtf p -> t (avf p)
forall k (t :: * -> *) (vf :: k -> *) (vtf :: k -> *) (p :: k).
DisperseView t vf vtf =>
vtf p -> t (vf p)
disperseView avtf p
avtf) (bvtf p -> t (bvf p)
forall k (t :: * -> *) (vf :: k -> *) (vtf :: k -> *) (p :: k).
DisperseView t vf vtf =>
vtf p -> t (vf p)
disperseView bvtf p
bvtf)
where f :: These (avf p) (bvf p) -> (avf :*: bvf) p
f :: These (avf p) (bvf p) -> (:*:) avf bvf p
f = \case
This avf p
a -> avf p
a avf p -> bvf p -> (:*:) avf bvf p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: bvf p
forall k (a :: k -> *) (p :: k). Empty1 a => a p
empty
That bvf p
b -> avf p
forall k (a :: k -> *) (p :: k). Empty1 a => a p
empty avf p -> bvf p -> (:*:) avf bvf p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: bvf p
b
These avf p
a bvf p
b -> avf p
a avf p -> bvf p -> (:*:) avf bvf p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: bvf p
b
type GMapView f g v =
( Generic (v f)
, Generic (v g)
, MapView f g (Rep (v f)) (Rep (v g))
)
class MapView f g vf vg where
mapViewM
:: Applicative m
=> (forall v'. (View v', EmptyView v') => v' f -> m (v' g))
-> vf p
-> m (vg p)
instance MapView f g V1 V1 where
mapViewM :: (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g))
-> V1 p -> m (V1 p)
mapViewM forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g)
_ = V1 p -> m (V1 p)
\case
instance MapView f g U1 U1 where
mapViewM :: (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g))
-> U1 p -> m (U1 p)
mapViewM forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g)
_ U1 p
U1 = U1 p -> m (U1 p)
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 p
forall k (p :: k). U1 p
U1
instance (View v, EmptyView v) => MapView f g (K1 i (v f)) (K1 i (v g)) where
mapViewM :: (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g))
-> K1 i (v f) p -> m (K1 i (v g) p)
mapViewM forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g)
f (K1 v f
vf) = v g -> K1 i (v g) p
forall k i c (p :: k). c -> K1 i c p
K1 (v g -> K1 i (v g) p) -> m (v g) -> m (K1 i (v g) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v f -> m (v g)
forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g)
f v f
vf
instance MapView f g vf vg => MapView f g (M1 i t vf) (M1 i t vg) where
mapViewM :: (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g))
-> M1 i t vf p -> m (M1 i t vg p)
mapViewM forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g)
f (M1 vf p
vf) = vg p -> M1 i t vg p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (vg p -> M1 i t vg p) -> m (vg p) -> m (M1 i t vg p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g))
-> vf p -> m (vg p)
forall (f :: * -> *) (g :: * -> *) (vf :: * -> *) (vg :: * -> *)
(m :: * -> *) p.
(MapView f g vf vg, Applicative m) =>
(forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g))
-> vf p -> m (vg p)
mapViewM forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g)
f vf p
vf
instance (MapView f g avf avg, MapView f g bvf bvg) => MapView f g (avf :*: bvf) (avg :*: bvg) where
mapViewM :: (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g))
-> (:*:) avf bvf p -> m ((:*:) avg bvg p)
mapViewM forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g)
f (avf p
avf :*: bvf p
bvf) = avg p -> bvg p -> (:*:) avg bvg p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:)
(avg p -> bvg p -> (:*:) avg bvg p)
-> m (avg p) -> m (bvg p -> (:*:) avg bvg p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g))
-> avf p -> m (avg p)
forall (f :: * -> *) (g :: * -> *) (vf :: * -> *) (vg :: * -> *)
(m :: * -> *) p.
(MapView f g vf vg, Applicative m) =>
(forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g))
-> vf p -> m (vg p)
mapViewM forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g)
f avf p
avf
m (bvg p -> (:*:) avg bvg p) -> m (bvg p) -> m ((:*:) avg bvg p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g))
-> bvf p -> m (bvg p)
forall (f :: * -> *) (g :: * -> *) (vf :: * -> *) (vg :: * -> *)
(m :: * -> *) p.
(MapView f g vf vg, Applicative m) =>
(forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g))
-> vf p -> m (vg p)
mapViewM forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g)
f bvf p
bvf
mapView
:: MapView f g vf vg
=> (forall v'. (View v', EmptyView v') => v' f -> v' g)
-> vf p
-> vg p
mapView :: (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g)
-> vf p -> vg p
mapView forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g
f vf p
vf = Identity (vg p) -> vg p
forall a. Identity a -> a
runIdentity (Identity (vg p) -> vg p) -> Identity (vg p) -> vg p
forall a b. (a -> b) -> a -> b
$ (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> Identity (v' g))
-> vf p -> Identity (vg p)
forall (f :: * -> *) (g :: * -> *) (vf :: * -> *) (vg :: * -> *)
(m :: * -> *) p.
(MapView f g vf vg, Applicative m) =>
(forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> m (v' g))
-> vf p -> m (vg p)
mapViewM (\v' f
v'f -> v' g -> Identity (v' g)
forall a. a -> Identity a
Identity (v' g -> Identity (v' g)) -> v' g -> Identity (v' g)
forall a b. (a -> b) -> a -> b
$ v' f -> v' g
forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g
f v' f
v'f) vf p
vf
type GZipView f g h v =
( Generic (v f)
, Generic (v g)
, Generic (v h)
, ZipView f g h (Rep (v f)) (Rep (v g)) (Rep (v h))
)
class ZipView f g h vf vg vh where
zipViewM
:: Applicative m
=> (forall v'. (View v', EmptyView v') => v' f -> v' g -> m (v' h))
-> vf p
-> vg p
-> m (vh p)
instance ZipView f g h V1 V1 V1 where
zipViewM :: (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> m (v' h))
-> V1 p -> V1 p -> m (V1 p)
zipViewM forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> m (v' h)
_ = V1 p -> V1 p -> m (V1 p)
\case
instance ZipView f g h U1 U1 U1 where
zipViewM :: (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> m (v' h))
-> U1 p -> U1 p -> m (U1 p)
zipViewM forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> m (v' h)
_ U1 p
U1 U1 p
U1 = U1 p -> m (U1 p)
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 p
forall k (p :: k). U1 p
U1
instance (View v, EmptyView v) => ZipView f g h (K1 i (v f)) (K1 i (v g)) (K1 i (v h)) where
zipViewM :: (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> m (v' h))
-> K1 i (v f) p -> K1 i (v g) p -> m (K1 i (v h) p)
zipViewM forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> m (v' h)
f (K1 v f
vf) (K1 v g
vg) = v h -> K1 i (v h) p
forall k i c (p :: k). c -> K1 i c p
K1 (v h -> K1 i (v h) p) -> m (v h) -> m (K1 i (v h) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v f -> v g -> m (v h)
forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> m (v' h)
f v f
vf v g
vg
instance ZipView f g h vf vg vh => ZipView f g h (M1 i t vf) (M1 i t vg) (M1 i t vh) where
zipViewM :: (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> m (v' h))
-> M1 i t vf p -> M1 i t vg p -> m (M1 i t vh p)
zipViewM forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> m (v' h)
f (M1 vf p
vf) (M1 vg p
vg) = vh p -> M1 i t vh p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (vh p -> M1 i t vh p) -> m (vh p) -> m (M1 i t vh p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> m (v' h))
-> vf p -> vg p -> m (vh p)
forall (f :: * -> *) (g :: * -> *) (h :: * -> *) (vf :: * -> *)
(vg :: * -> *) (vh :: * -> *) (m :: * -> *) p.
(ZipView f g h vf vg vh, Applicative m) =>
(forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> m (v' h))
-> vf p -> vg p -> m (vh p)
zipViewM forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> m (v' h)
f vf p
vf vg p
vg
instance (ZipView f g h avf avg avh, ZipView f g h bvf bvg bvh) => ZipView f g h (avf :*: bvf) (avg :*: bvg) (avh :*: bvh) where
zipViewM :: (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> m (v' h))
-> (:*:) avf bvf p -> (:*:) avg bvg p -> m ((:*:) avh bvh p)
zipViewM forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> m (v' h)
f (avf p
avf :*: bvf p
bvf) (avg p
avg :*: bvg p
bvg) = avh p -> bvh p -> (:*:) avh bvh p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:)
(avh p -> bvh p -> (:*:) avh bvh p)
-> m (avh p) -> m (bvh p -> (:*:) avh bvh p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> m (v' h))
-> avf p -> avg p -> m (avh p)
forall (f :: * -> *) (g :: * -> *) (h :: * -> *) (vf :: * -> *)
(vg :: * -> *) (vh :: * -> *) (m :: * -> *) p.
(ZipView f g h vf vg vh, Applicative m) =>
(forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> m (v' h))
-> vf p -> vg p -> m (vh p)
zipViewM forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> m (v' h)
f avf p
avf avg p
avg
m (bvh p -> (:*:) avh bvh p) -> m (bvh p) -> m ((:*:) avh bvh p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> m (v' h))
-> bvf p -> bvg p -> m (bvh p)
forall (f :: * -> *) (g :: * -> *) (h :: * -> *) (vf :: * -> *)
(vg :: * -> *) (vh :: * -> *) (m :: * -> *) p.
(ZipView f g h vf vg vh, Applicative m) =>
(forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> m (v' h))
-> vf p -> vg p -> m (vh p)
zipViewM forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> m (v' h)
f bvf p
bvf bvg p
bvg
zipView
:: ZipView f g h vf vg vh
=> (forall v'. (View v', EmptyView v') => v' f -> v' g -> v' h)
-> vf p
-> vg p
-> vh p
zipView :: (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> v' h)
-> vf p -> vg p -> vh p
zipView forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> v' h
f vf p
vf vg p
vg = Identity (vh p) -> vh p
forall a. Identity a -> a
runIdentity (Identity (vh p) -> vh p) -> Identity (vh p) -> vh p
forall a b. (a -> b) -> a -> b
$ (forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> Identity (v' h))
-> vf p -> vg p -> Identity (vh p)
forall (f :: * -> *) (g :: * -> *) (h :: * -> *) (vf :: * -> *)
(vg :: * -> *) (vh :: * -> *) (m :: * -> *) p.
(ZipView f g h vf vg vh, Applicative m) =>
(forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> m (v' h))
-> vf p -> vg p -> m (vh p)
zipViewM (\v' f
v'f v' g
v'g -> v' h -> Identity (v' h)
forall a. a -> Identity a
Identity (v' h -> Identity (v' h)) -> v' h -> Identity (v' h)
forall a b. (a -> b) -> a -> b
$ v' f -> v' g -> v' h
forall (v' :: (* -> *) -> *).
(View v', EmptyView v') =>
v' f -> v' g -> v' h
f v' f
v'f v' g
v'g) vf p
vf vg p
vg
collapseNullV :: View v => v f -> Maybe (v f)
collapseNullV :: v f -> Maybe (v f)
collapseNullV v f
v = if v f -> Bool
forall (v :: (* -> *) -> *) (i :: * -> *). View v => v i -> Bool
nullV v f
v
then Maybe (v f)
forall a. Maybe a
Nothing
else v f -> Maybe (v f)
forall a. a -> Maybe a
Just v f
v
subtractV :: View v => v f -> v g -> Maybe (v f)
subtractV :: v f -> v g -> Maybe (v f)
subtractV = (forall a. These (f a) (g a) -> Maybe (f a))
-> v f -> v g -> Maybe (v f)
forall (v :: (* -> *) -> *) (f :: * -> *) (g :: * -> *)
(h :: * -> *).
View v =>
(forall a. These (f a) (g a) -> Maybe (h a))
-> v f -> v g -> Maybe (v h)
alignWithMaybeV (\case This f a
x -> f a -> Maybe (f a)
forall a. a -> Maybe a
Just f a
x; These (f a) (g a)
_ -> Maybe (f a)
forall a. Maybe a
Nothing)
alignWithMV
:: forall m v f g h
. (View v, Applicative m)
=> (forall a. These (f a) (g a) -> m (h a))
-> v f
-> v g
-> m (Maybe (v h))
alignWithMV :: (forall a. These (f a) (g a) -> m (h a))
-> v f -> v g -> m (Maybe (v h))
alignWithMV forall a. These (f a) (g a) -> m (h a)
f v f
a v g
b = (v (Compose m h) -> m (v h))
-> Maybe (v (Compose m h)) -> m (Maybe (v h))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((forall a. Compose m h a -> m (h a)) -> v (Compose m h) -> m (v h)
forall (v :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
(g :: * -> *).
(View v, Applicative m) =>
(forall a. f a -> m (g a)) -> v f -> m (v g)
traverseV forall a. Compose m h a -> m (h a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) (Maybe (v (Compose m h)) -> m (Maybe (v h)))
-> Maybe (v (Compose m h)) -> m (Maybe (v h))
forall a b. (a -> b) -> a -> b
$ (forall a. These (f a) (g a) -> Maybe (Compose m h a))
-> v f -> v g -> Maybe (v (Compose m h))
forall (v :: (* -> *) -> *) (f :: * -> *) (g :: * -> *)
(h :: * -> *).
View v =>
(forall a. These (f a) (g a) -> Maybe (h a))
-> v f -> v g -> Maybe (v h)
alignWithMaybeV forall a. These (f a) (g a) -> Maybe (Compose m h a)
g v f
a v g
b
where g :: forall a. These (f a) (g a) -> Maybe (Compose m h a)
g :: These (f a) (g a) -> Maybe (Compose m h a)
g = Compose m h a -> Maybe (Compose m h a)
forall a. a -> Maybe a
Just (Compose m h a -> Maybe (Compose m h a))
-> (These (f a) (g a) -> Compose m h a)
-> These (f a) (g a)
-> Maybe (Compose m h a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (h a) -> Compose m h a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (m (h a) -> Compose m h a)
-> (These (f a) (g a) -> m (h a))
-> These (f a) (g a)
-> Compose m h a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. These (f a) (g a) -> m (h a)
forall a. These (f a) (g a) -> m (h a)
f
transposeView
:: ( View v
, Foldable t
, Filterable t
, Functor t
, Align t
, QueryResult (t (v g)) ~ (t (v g'))
, QueryResult (v (Compose t g)) ~ v (Compose t g')
, Monoid (v g)
, Monoid (v (Compose t g))
)
=> QueryMorphism (t (v g)) (v (Compose t g))
transposeView :: QueryMorphism (t (v g)) (v (Compose t g))
transposeView = QueryMorphism :: forall q q'.
(q -> q')
-> (QueryResult q' -> QueryResult q) -> QueryMorphism q q'
QueryMorphism
{ _queryMorphism_mapQuery :: t (v g) -> v (Compose t g)
_queryMorphism_mapQuery = t (v g) -> v (Compose t g)
forall (v :: (* -> *) -> *) (t :: * -> *) (g :: * -> *).
(View v, Foldable t, Filterable t, Functor t) =>
t (v g) -> v (Compose t g)
condenseV
, _queryMorphism_mapQueryResult :: QueryResult (v (Compose t g)) -> QueryResult (t (v g))
_queryMorphism_mapQueryResult = QueryResult (v (Compose t g)) -> QueryResult (t (v g))
forall (v :: (* -> *) -> *) (t :: * -> *) (g :: * -> *).
(View v, Align t) =>
v (Compose t g) -> t (v g)
disperseV
}
mapDecomposedV
:: (Functor m, View v)
=> (v Proxy -> m (v Identity))
-> v (Compose (MonoidalMap c) g)
-> m (Maybe (v (Compose (MonoidalMap c) Identity)))
mapDecomposedV :: (v Proxy -> m (v Identity))
-> v (Compose (MonoidalMap c) g)
-> m (Maybe (v (Compose (MonoidalMap c) Identity)))
mapDecomposedV v Proxy -> m (v Identity)
f v (Compose (MonoidalMap c) g)
v = (forall a.
Compose (MonoidalMap c) g a
-> Identity a -> Compose (MonoidalMap c) Identity a)
-> v (Compose (MonoidalMap c) g)
-> v Identity
-> Maybe (v (Compose (MonoidalMap c) Identity))
forall (v :: (* -> *) -> *) (s :: * -> *) (i :: * -> *)
(r :: * -> *).
View v =>
(forall a. s a -> i a -> r a) -> v s -> v i -> Maybe (v r)
cropV forall a.
Compose (MonoidalMap c) g a
-> Identity a -> Compose (MonoidalMap c) Identity a
forall c (g :: * -> *) a.
Compose (MonoidalMap c) g a
-> Identity a -> Compose (MonoidalMap c) Identity a
recompose v (Compose (MonoidalMap c) g)
v (v Identity -> Maybe (v (Compose (MonoidalMap c) Identity)))
-> m (v Identity)
-> m (Maybe (v (Compose (MonoidalMap c) Identity)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (v Proxy -> m (v Identity)
f (v Proxy -> m (v Identity)) -> v Proxy -> m (v Identity)
forall a b. (a -> b) -> a -> b
$ (forall a. Compose (MonoidalMap c) g a -> Proxy a)
-> v (Compose (MonoidalMap c) g) -> v Proxy
forall (v :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
View v =>
(forall a. f a -> g a) -> v f -> v g
mapV (\Compose (MonoidalMap c) g a
_ -> Proxy a
forall k (t :: k). Proxy t
Proxy) v (Compose (MonoidalMap c) g)
v)
where
recompose :: Compose (MonoidalMap c) g a -> Identity a -> Compose (MonoidalMap c) Identity a
recompose :: Compose (MonoidalMap c) g a
-> Identity a -> Compose (MonoidalMap c) Identity a
recompose (Compose MonoidalMap c (g a)
s) Identity a
i = MonoidalMap c (Identity a) -> Compose (MonoidalMap c) Identity a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (MonoidalMap c (Identity a) -> Compose (MonoidalMap c) Identity a)
-> MonoidalMap c (Identity a) -> Compose (MonoidalMap c) Identity a
forall a b. (a -> b) -> a -> b
$ Identity a
i Identity a -> MonoidalMap c (g a) -> MonoidalMap c (Identity a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MonoidalMap c (g a)
s
instance (GCompare k) => View (MonoidalDMap k) where
cropV :: (forall a. s a -> i a -> r a) -> MonoidalDMap k s -> MonoidalDMap k i -> Maybe (MonoidalDMap k r)
cropV :: (forall a. s a -> i a -> r a)
-> MonoidalDMap k s -> MonoidalDMap k i -> Maybe (MonoidalDMap k r)
cropV forall a. s a -> i a -> r a
f MonoidalDMap k s
a MonoidalDMap k i
b = MonoidalDMap k r -> Maybe (MonoidalDMap k r)
forall (v :: (* -> *) -> *) (f :: * -> *).
View v =>
v f -> Maybe (v f)
collapseNullV (MonoidalDMap k r -> Maybe (MonoidalDMap k r))
-> MonoidalDMap k r -> Maybe (MonoidalDMap k r)
forall a b. (a -> b) -> a -> b
$ (forall v. k v -> s v -> i v -> r v)
-> MonoidalDMap k s -> MonoidalDMap k i -> MonoidalDMap k r
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (g :: k1 -> *)
(h :: k1 -> *).
GCompare k2 =>
(forall (v :: k1). k2 v -> f v -> g v -> h v)
-> MonoidalDMap k2 f -> MonoidalDMap k2 g -> MonoidalDMap k2 h
DMap.intersectionWithKey (\k v
_ s v
s i v
i -> s v -> i v -> r v
forall a. s a -> i a -> r a
f s v
s i v
i) MonoidalDMap k s
a MonoidalDMap k i
b
nullV :: MonoidalDMap k s -> Bool
nullV :: MonoidalDMap k s -> Bool
nullV MonoidalDMap k s
m = MonoidalDMap k s -> Bool
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). MonoidalDMap k2 f -> Bool
DMap.null MonoidalDMap k s
m
condenseV :: forall col g. ( Foldable col, Filterable col, Functor col )
=> col (MonoidalDMap k g)
-> MonoidalDMap k (Compose col g)
condenseV :: col (MonoidalDMap k g) -> MonoidalDMap k (Compose col g)
condenseV col (MonoidalDMap k g)
col = DMap k g
-> col (MonoidalDMap k g) -> MonoidalDMap k (Compose col g)
forall k1 (k :: k1 -> *) (t :: * -> *) (g :: k1 -> *).
(GCompare k, Foldable t, Filterable t) =>
DMap k g -> t (MonoidalDMap k g) -> MonoidalDMap k (Compose t g)
condenseD' (col (DMap k g) -> DMap k g
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ((MonoidalDMap k g -> DMap k g)
-> col (MonoidalDMap k g) -> col (DMap k g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MonoidalDMap k g -> DMap k g
forall k (f :: k -> *) (g :: k -> *). MonoidalDMap f g -> DMap f g
unMonoidalDMap col (MonoidalDMap k g)
col)) col (MonoidalDMap k g)
col
disperseV :: forall col g. (Align col)
=> MonoidalDMap k (Compose col g)
-> col (MonoidalDMap k g)
disperseV :: MonoidalDMap k (Compose col g) -> col (MonoidalDMap k g)
disperseV MonoidalDMap k (Compose col g)
row = case DMap k (Compose col g) -> PivotD k (Compose col g)
forall l (k :: l -> *) (g :: l -> *).
GCompare k =>
DMap k g -> PivotD k g
findPivotD (MonoidalDMap k (Compose col g) -> DMap k (Compose col g)
forall k (f :: k -> *) (g :: k -> *). MonoidalDMap f g -> DMap f g
unMonoidalDMap MonoidalDMap k (Compose col g)
row) of
PivotD k (Compose col g)
NoneD -> col (MonoidalDMap k g)
forall (f :: * -> *) a. Align f => f a
nil
OneD k v
k (Compose col (g v)
v) -> (g v -> MonoidalDMap k g) -> col (g v) -> col (MonoidalDMap k g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (k v -> g v -> MonoidalDMap k g
forall k1 (k2 :: k1 -> *) (v :: k1) (f :: k1 -> *).
k2 v -> f v -> MonoidalDMap k2 f
DMap.singleton k v
k) col (g v)
v
SplitD k v
pivot DMap k (Compose col g)
_l DMap k (Compose col g)
_r -> (col (MonoidalDMap k g)
-> col (MonoidalDMap k g) -> col (MonoidalDMap k g))
-> (col (MonoidalDMap k g), col (MonoidalDMap k g))
-> col (MonoidalDMap k g)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((These (MonoidalDMap k g) (MonoidalDMap k g) -> MonoidalDMap k g)
-> col (MonoidalDMap k g)
-> col (MonoidalDMap k g)
-> col (MonoidalDMap k g)
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith ((MonoidalDMap k g -> MonoidalDMap k g -> MonoidalDMap k g)
-> These (MonoidalDMap k g) (MonoidalDMap k g) -> MonoidalDMap k g
forall a. (a -> a -> a) -> These a a -> a
mergeThese MonoidalDMap k g -> MonoidalDMap k g -> MonoidalDMap k g
forall k1 (k2 :: k1 -> *) (g :: k1 -> *).
GCompare k2 =>
MonoidalDMap k2 g -> MonoidalDMap k2 g -> MonoidalDMap k2 g
unionDistinctAscD)) ((col (MonoidalDMap k g), col (MonoidalDMap k g))
-> col (MonoidalDMap k g))
-> (col (MonoidalDMap k g), col (MonoidalDMap k g))
-> col (MonoidalDMap k g)
forall a b. (a -> b) -> a -> b
$
MonoidalDMap k (Compose col g) -> col (MonoidalDMap k g)
forall (v :: (* -> *) -> *) (t :: * -> *) (g :: * -> *).
(View v, Align t) =>
v (Compose t g) -> t (v g)
disperseV (MonoidalDMap k (Compose col g) -> col (MonoidalDMap k g))
-> (MonoidalDMap k (Compose col g) -> col (MonoidalDMap k g))
-> (MonoidalDMap k (Compose col g), MonoidalDMap k (Compose col g))
-> (col (MonoidalDMap k g), col (MonoidalDMap k g))
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** MonoidalDMap k (Compose col g) -> col (MonoidalDMap k g)
forall (v :: (* -> *) -> *) (t :: * -> *) (g :: * -> *).
(View v, Align t) =>
v (Compose t g) -> t (v g)
disperseV ((MonoidalDMap k (Compose col g), MonoidalDMap k (Compose col g))
-> (col (MonoidalDMap k g), col (MonoidalDMap k g)))
-> (MonoidalDMap k (Compose col g), MonoidalDMap k (Compose col g))
-> (col (MonoidalDMap k g), col (MonoidalDMap k g))
forall a b. (a -> b) -> a -> b
$ k v
-> MonoidalDMap k (Compose col g)
-> (MonoidalDMap k (Compose col g), MonoidalDMap k (Compose col g))
forall k1 (k2 :: k1 -> *) (v :: k1) (g :: k1 -> *).
GCompare k2 =>
k2 v -> MonoidalDMap k2 g -> (MonoidalDMap k2 g, MonoidalDMap k2 g)
splitLTD k v
pivot MonoidalDMap k (Compose col g)
row
mapV :: (forall a. f a -> g a) -> MonoidalDMap k f -> MonoidalDMap k g
mapV :: (forall a. f a -> g a) -> MonoidalDMap k f -> MonoidalDMap k g
mapV forall a. f a -> g a
f MonoidalDMap k f
m = (forall a. f a -> g a) -> MonoidalDMap k f -> MonoidalDMap k g
forall k1 (f :: k1 -> *) (g :: k1 -> *) (k2 :: k1 -> *).
(forall (v :: k1). f v -> g v)
-> MonoidalDMap k2 f -> MonoidalDMap k2 g
DMap.map forall a. f a -> g a
f MonoidalDMap k f
m
traverseV :: (Applicative m) => (forall a. f a -> m (g a)) -> MonoidalDMap k f -> m (MonoidalDMap k g)
traverseV :: (forall a. f a -> m (g a))
-> MonoidalDMap k f -> m (MonoidalDMap k g)
traverseV forall a. f a -> m (g a)
f MonoidalDMap k f
m = (forall v. k v -> f v -> m (g v))
-> MonoidalDMap k f -> m (MonoidalDMap k g)
forall k1 (t :: * -> *) (k2 :: k1 -> *) (f :: k1 -> *)
(g :: k1 -> *).
Applicative t =>
(forall (v :: k1). k2 v -> f v -> t (g v))
-> MonoidalDMap k2 f -> t (MonoidalDMap k2 g)
DMap.traverseWithKey (\k v
_ f v
v -> f v -> m (g v)
forall a. f a -> m (g a)
f f v
v) MonoidalDMap k f
m
mapMaybeV :: (forall a. f a -> Maybe (g a))
-> MonoidalDMap k f -> Maybe (MonoidalDMap k g)
mapMaybeV forall a. f a -> Maybe (g a)
f (MonoidalDMap DMap k f
m) = MonoidalDMap k g -> Maybe (MonoidalDMap k g)
forall (v :: (* -> *) -> *) (f :: * -> *).
View v =>
v f -> Maybe (v f)
collapseNullV (MonoidalDMap k g -> Maybe (MonoidalDMap k g))
-> MonoidalDMap k g -> Maybe (MonoidalDMap k g)
forall a b. (a -> b) -> a -> b
$ DMap k g -> MonoidalDMap k g
forall k (f :: k -> *) (g :: k -> *). DMap f g -> MonoidalDMap f g
MonoidalDMap (DMap k g -> MonoidalDMap k g) -> DMap k g -> MonoidalDMap k g
forall a b. (a -> b) -> a -> b
$
(forall a. f a -> Maybe (g a)) -> DMap k f -> DMap k g
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (g :: k1 -> *).
GCompare k2 =>
(forall (v :: k1). f v -> Maybe (g v)) -> DMap k2 f -> DMap k2 g
DMap'.mapMaybe forall a. f a -> Maybe (g a)
f DMap k f
m
alignWithV :: (forall a. These (f a) (g a) -> h a)
-> MonoidalDMap k f -> MonoidalDMap k g -> MonoidalDMap k h
alignWithV forall a. These (f a) (g a) -> h a
f MonoidalDMap k f
a MonoidalDMap k g
b = (forall a. k a -> These (f a) (g a) -> h a)
-> MonoidalDMap k f -> MonoidalDMap k g -> MonoidalDMap k h
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (g :: k1 -> *)
(h :: k1 -> *).
GCompare k2 =>
(forall (a :: k1). k2 a -> These (f a) (g a) -> h a)
-> MonoidalDMap k2 f -> MonoidalDMap k2 g -> MonoidalDMap k2 h
alignWithKeyMonoidalDMap (\k a
_ These (f a) (g a)
x -> These (f a) (g a) -> h a
forall a. These (f a) (g a) -> h a
f These (f a) (g a)
x) MonoidalDMap k f
a MonoidalDMap k g
b
alignWithMaybeV :: (forall a. These (f a) (g a) -> Maybe (h a))
-> MonoidalDMap k f -> MonoidalDMap k g -> Maybe (MonoidalDMap k h)
alignWithMaybeV forall a. These (f a) (g a) -> Maybe (h a)
f MonoidalDMap k f
a MonoidalDMap k g
b = MonoidalDMap k h -> Maybe (MonoidalDMap k h)
forall (v :: (* -> *) -> *) (f :: * -> *).
View v =>
v f -> Maybe (v f)
collapseNullV (MonoidalDMap k h -> Maybe (MonoidalDMap k h))
-> MonoidalDMap k h -> Maybe (MonoidalDMap k h)
forall a b. (a -> b) -> a -> b
$ (forall a. k a -> These (f a) (g a) -> Maybe (h a))
-> MonoidalDMap k f -> MonoidalDMap k g -> MonoidalDMap k h
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (g :: k1 -> *)
(h :: k1 -> *).
GCompare k2 =>
(forall (a :: k1). k2 a -> These (f a) (g a) -> Maybe (h a))
-> MonoidalDMap k2 f -> MonoidalDMap k2 g -> MonoidalDMap k2 h
alignWithKeyMaybeMonoidalDMap (\k a
_ These (f a) (g a)
x -> These (f a) (g a) -> Maybe (h a)
forall a. These (f a) (g a) -> Maybe (h a)
f These (f a) (g a)
x) MonoidalDMap k f
a MonoidalDMap k g
b
instance (GCompare k) => EmptyView (MonoidalDMap k) where
emptyV :: MonoidalDMap k f
emptyV = MonoidalDMap k f
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). MonoidalDMap k2 f
DMap.empty
filterV :: View v => (forall a. f a -> Bool) -> v f -> Maybe (v f)
filterV :: (forall a. f a -> Bool) -> v f -> Maybe (v f)
filterV forall a. f a -> Bool
f = (forall a. f a -> Maybe (f a)) -> v f -> Maybe (v f)
forall (v :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
View v =>
(forall a. f a -> Maybe (g a)) -> v f -> Maybe (v g)
mapMaybeV (\f a
x -> if f a -> Bool
forall a. f a -> Bool
f f a
x then f a -> Maybe (f a)
forall a. a -> Maybe a
Just f a
x else Maybe (f a)
forall a. Maybe a
Nothing)
instance View Proxy