{-# 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 #-}
{-# LANGUAGE UndecidableInstances #-}

module Data.Vessel.SubVessel where

import Control.Applicative
import Data.Aeson
import Data.Constraint
import Data.Constraint.Extras
import Data.Dependent.Map.Monoidal (MonoidalDMap(..))
import Data.Dependent.Sum (DSum(..))
import Data.Foldable
import Data.Functor.Compose
import Data.Functor.Identity
import Data.GADT.Compare
import Data.GADT.Show
import Data.Map.Monoidal (MonoidalMap(..))
import Data.Proxy
import Data.Set (Set)
import Data.Some (Some(Some))
import Data.Type.Equality
import GHC.Generics
import Data.Patch (Group(..), Additive)
import Reflex.Query.Class
import qualified Data.Dependent.Map as DMap'
import qualified Data.Dependent.Map.Monoidal as DMap
import qualified Data.Map.Monoidal as Map

import Data.Vessel.Class hiding (empty)
import Data.Vessel.Vessel
import Data.Vessel.Internal
import Data.Vessel.ViewMorphism

data SubVesselKey k (f :: (* -> *) -> *) (g :: (* -> *) -> *) where
  SubVesselKey :: k -> SubVesselKey k f f
deriving instance Show k => Show (SubVesselKey k f g)
instance Show k => GShow (SubVesselKey k f) where gshowsPrec :: Int -> SubVesselKey k f a -> ShowS
gshowsPrec = Int -> SubVesselKey k f a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec

instance FromJSON k => FromJSON (Some (SubVesselKey k v)) where parseJSON :: Value -> Parser (Some (SubVesselKey k v))
parseJSON Value
v = SubVesselKey k v v -> Some (SubVesselKey k v)
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some (SubVesselKey k v v -> Some (SubVesselKey k v))
-> (k -> SubVesselKey k v v) -> k -> Some (SubVesselKey k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> SubVesselKey k v v
forall k (f :: (* -> *) -> *). k -> SubVesselKey k f f
SubVesselKey (k -> Some (SubVesselKey k v))
-> Parser k -> Parser (Some (SubVesselKey k v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser k
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
instance ToJSON k => ToJSON (SubVesselKey k f g) where toJSON :: SubVesselKey k f g -> Value
toJSON (SubVesselKey k
k) = k -> Value
forall a. ToJSON a => a -> Value
toJSON k
k

instance ArgDict c (SubVesselKey k f) where
  type ConstraintsFor (SubVesselKey k f) c = c f
  argDict :: SubVesselKey k f a -> Dict (c a)
argDict (SubVesselKey k
_) = Dict (c a)
forall (a :: Constraint). a => Dict a
Dict

instance Eq k => GEq (SubVesselKey k v) where
  geq :: SubVesselKey k v a -> SubVesselKey k v b -> Maybe (a :~: b)
geq (SubVesselKey k
x) (SubVesselKey k
y) = case k
x k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
y of
    Bool
True -> (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
    Bool
False -> Maybe (a :~: b)
forall a. Maybe a
Nothing

instance Ord k => GCompare (SubVesselKey k v) where
  gcompare :: SubVesselKey k v a -> SubVesselKey k v b -> GOrdering a b
gcompare (SubVesselKey k
x) (SubVesselKey k
y) = case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
x k
y of
    Ordering
LT -> GOrdering a b
forall k (a :: k) (b :: k). GOrdering a b
GLT
    Ordering
EQ -> GOrdering a b
forall k (a :: k). GOrdering a a
GEQ
    Ordering
GT -> GOrdering a b
forall k (a :: k) (b :: k). GOrdering a b
GGT

-- | Something between MapV and Vessel, where the keys are simple values, but the values are full views.
--
-- TODO: this representation has the advantage that all of it's instances come "free", but the mostly "right" representation is probably
-- ... Vessel v (Compose (MonoidalMap k) f)
newtype SubVessel (k :: *)  (v :: (* -> *) -> *) (f :: * -> *) = SubVessel { SubVessel k v f -> Vessel (SubVesselKey k v) f
unSubVessel :: Vessel (SubVesselKey k v) f }
  deriving (Value -> Parser [SubVessel k v f]
Value -> Parser (SubVessel k v f)
(Value -> Parser (SubVessel k v f))
-> (Value -> Parser [SubVessel k v f])
-> FromJSON (SubVessel k v f)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, FromJSON k, FromJSON (v f), View v) =>
Value -> Parser [SubVessel k v f]
forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, FromJSON k, FromJSON (v f), View v) =>
Value -> Parser (SubVessel k v f)
parseJSONList :: Value -> Parser [SubVessel k v f]
$cparseJSONList :: forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, FromJSON k, FromJSON (v f), View v) =>
Value -> Parser [SubVessel k v f]
parseJSON :: Value -> Parser (SubVessel k v f)
$cparseJSON :: forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, FromJSON k, FromJSON (v f), View v) =>
Value -> Parser (SubVessel k v f)
FromJSON, [SubVessel k v f] -> Encoding
[SubVessel k v f] -> Value
SubVessel k v f -> Encoding
SubVessel k v f -> Value
(SubVessel k v f -> Value)
-> (SubVessel k v f -> Encoding)
-> ([SubVessel k v f] -> Value)
-> ([SubVessel k v f] -> Encoding)
-> ToJSON (SubVessel k v f)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, ToJSON k, ToJSON (v f)) =>
[SubVessel k v f] -> Encoding
forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, ToJSON k, ToJSON (v f)) =>
[SubVessel k v f] -> Value
forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, ToJSON k, ToJSON (v f)) =>
SubVessel k v f -> Encoding
forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, ToJSON k, ToJSON (v f)) =>
SubVessel k v f -> Value
toEncodingList :: [SubVessel k v f] -> Encoding
$ctoEncodingList :: forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, ToJSON k, ToJSON (v f)) =>
[SubVessel k v f] -> Encoding
toJSONList :: [SubVessel k v f] -> Value
$ctoJSONList :: forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, ToJSON k, ToJSON (v f)) =>
[SubVessel k v f] -> Value
toEncoding :: SubVessel k v f -> Encoding
$ctoEncoding :: forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, ToJSON k, ToJSON (v f)) =>
SubVessel k v f -> Encoding
toJSON :: SubVessel k v f -> Value
$ctoJSON :: forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, ToJSON k, ToJSON (v f)) =>
SubVessel k v f -> Value
ToJSON, b -> SubVessel k v f -> SubVessel k v f
NonEmpty (SubVessel k v f) -> SubVessel k v f
SubVessel k v f -> SubVessel k v f -> SubVessel k v f
(SubVessel k v f -> SubVessel k v f -> SubVessel k v f)
-> (NonEmpty (SubVessel k v f) -> SubVessel k v f)
-> (forall b.
    Integral b =>
    b -> SubVessel k v f -> SubVessel k v f)
-> Semigroup (SubVessel k v f)
forall b. Integral b => b -> SubVessel k v f -> SubVessel k v f
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall k (v :: (* -> *) -> *) (f :: * -> *).
(Semigroup (v f), Ord k, View v) =>
NonEmpty (SubVessel k v f) -> SubVessel k v f
forall k (v :: (* -> *) -> *) (f :: * -> *).
(Semigroup (v f), Ord k, View v) =>
SubVessel k v f -> SubVessel k v f -> SubVessel k v f
forall k (v :: (* -> *) -> *) (f :: * -> *) b.
(Semigroup (v f), Ord k, View v, Integral b) =>
b -> SubVessel k v f -> SubVessel k v f
stimes :: b -> SubVessel k v f -> SubVessel k v f
$cstimes :: forall k (v :: (* -> *) -> *) (f :: * -> *) b.
(Semigroup (v f), Ord k, View v, Integral b) =>
b -> SubVessel k v f -> SubVessel k v f
sconcat :: NonEmpty (SubVessel k v f) -> SubVessel k v f
$csconcat :: forall k (v :: (* -> *) -> *) (f :: * -> *).
(Semigroup (v f), Ord k, View v) =>
NonEmpty (SubVessel k v f) -> SubVessel k v f
<> :: SubVessel k v f -> SubVessel k v f -> SubVessel k v f
$c<> :: forall k (v :: (* -> *) -> *) (f :: * -> *).
(Semigroup (v f), Ord k, View v) =>
SubVessel k v f -> SubVessel k v f -> SubVessel k v f
Semigroup, Semigroup (SubVessel k v f)
SubVessel k v f
Semigroup (SubVessel k v f)
-> SubVessel k v f
-> (SubVessel k v f -> SubVessel k v f -> SubVessel k v f)
-> ([SubVessel k v f] -> SubVessel k v f)
-> Monoid (SubVessel k v f)
[SubVessel k v f] -> SubVessel k v f
SubVessel k v f -> SubVessel k v f -> SubVessel k v f
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall k (v :: (* -> *) -> *) (f :: * -> *).
(Semigroup (v f), Ord k, View v) =>
Semigroup (SubVessel k v f)
forall k (v :: (* -> *) -> *) (f :: * -> *).
(Semigroup (v f), Ord k, View v) =>
SubVessel k v f
forall k (v :: (* -> *) -> *) (f :: * -> *).
(Semigroup (v f), Ord k, View v) =>
[SubVessel k v f] -> SubVessel k v f
forall k (v :: (* -> *) -> *) (f :: * -> *).
(Semigroup (v f), Ord k, View v) =>
SubVessel k v f -> SubVessel k v f -> SubVessel k v f
mconcat :: [SubVessel k v f] -> SubVessel k v f
$cmconcat :: forall k (v :: (* -> *) -> *) (f :: * -> *).
(Semigroup (v f), Ord k, View v) =>
[SubVessel k v f] -> SubVessel k v f
mappend :: SubVessel k v f -> SubVessel k v f -> SubVessel k v f
$cmappend :: forall k (v :: (* -> *) -> *) (f :: * -> *).
(Semigroup (v f), Ord k, View v) =>
SubVessel k v f -> SubVessel k v f -> SubVessel k v f
mempty :: SubVessel k v f
$cmempty :: forall k (v :: (* -> *) -> *) (f :: * -> *).
(Semigroup (v f), Ord k, View v) =>
SubVessel k v f
$cp1Monoid :: forall k (v :: (* -> *) -> *) (f :: * -> *).
(Semigroup (v f), Ord k, View v) =>
Semigroup (SubVessel k v f)
Monoid, (forall x. SubVessel k v f -> Rep (SubVessel k v f) x)
-> (forall x. Rep (SubVessel k v f) x -> SubVessel k v f)
-> Generic (SubVessel k v f)
forall x. Rep (SubVessel k v f) x -> SubVessel k v f
forall x. SubVessel k v f -> Rep (SubVessel k v f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (v :: (* -> *) -> *) (f :: * -> *) x.
Rep (SubVessel k v f) x -> SubVessel k v f
forall k (v :: (* -> *) -> *) (f :: * -> *) x.
SubVessel k v f -> Rep (SubVessel k v f) x
$cto :: forall k (v :: (* -> *) -> *) (f :: * -> *) x.
Rep (SubVessel k v f) x -> SubVessel k v f
$cfrom :: forall k (v :: (* -> *) -> *) (f :: * -> *) x.
SubVessel k v f -> Rep (SubVessel k v f) x
Generic, Semigroup (SubVessel k v f)
Monoid (SubVessel k v f)
Semigroup (SubVessel k v f)
-> Monoid (SubVessel k v f)
-> (SubVessel k v f -> SubVessel k v f)
-> (SubVessel k v f -> SubVessel k v f -> SubVessel k v f)
-> Group (SubVessel k v f)
SubVessel k v f -> SubVessel k v f
SubVessel k v f -> SubVessel k v f -> SubVessel k v f
forall q.
Semigroup q -> Monoid q -> (q -> q) -> (q -> q -> q) -> Group q
forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, View v, Group (v f)) =>
Semigroup (SubVessel k v f)
forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, View v, Group (v f)) =>
Monoid (SubVessel k v f)
forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, View v, Group (v f)) =>
SubVessel k v f -> SubVessel k v f
forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, View v, Group (v f)) =>
SubVessel k v f -> SubVessel k v f -> SubVessel k v f
~~ :: SubVessel k v f -> SubVessel k v f -> SubVessel k v f
$c~~ :: forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, View v, Group (v f)) =>
SubVessel k v f -> SubVessel k v f -> SubVessel k v f
negateG :: SubVessel k v f -> SubVessel k v f
$cnegateG :: forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, View v, Group (v f)) =>
SubVessel k v f -> SubVessel k v f
$cp2Group :: forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, View v, Group (v f)) =>
Monoid (SubVessel k v f)
$cp1Group :: forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, View v, Group (v f)) =>
Semigroup (SubVessel k v f)
Group, Semigroup (SubVessel k v f)
Semigroup (SubVessel k v f) -> Additive (SubVessel k v f)
forall q. Semigroup q -> Additive q
forall k (v :: (* -> *) -> *) (f :: * -> *).
(Semigroup (v f), Ord k, View v) =>
Semigroup (SubVessel k v f)
Additive, SubVessel k v f -> SubVessel k v f -> Bool
(SubVessel k v f -> SubVessel k v f -> Bool)
-> (SubVessel k v f -> SubVessel k v f -> Bool)
-> Eq (SubVessel k v f)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, Eq (v f)) =>
SubVessel k v f -> SubVessel k v f -> Bool
/= :: SubVessel k v f -> SubVessel k v f -> Bool
$c/= :: forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, Eq (v f)) =>
SubVessel k v f -> SubVessel k v f -> Bool
== :: SubVessel k v f -> SubVessel k v f -> Bool
$c== :: forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, Eq (v f)) =>
SubVessel k v f -> SubVessel k v f -> Bool
Eq)

deriving instance (Show k, Show (v f)) => Show (SubVessel k v f)

-- slightly nicer unwrapper compared to unSubVessel
getSubVessel :: Ord k => SubVessel k v f -> MonoidalMap k (v f)
getSubVessel :: SubVessel k v f -> MonoidalMap k (v f)
getSubVessel = (v f -> v f -> v f) -> [(k, v f)] -> MonoidalMap k (v f)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> MonoidalMap k a
Map.fromListWith (String -> v f -> v f -> v f
forall a. HasCallStack => String -> a
error String
"getSubVessel:collision") ([(k, v f)] -> MonoidalMap k (v f))
-> (SubVessel k v f -> [(k, v f)])
-> SubVessel k v f
-> MonoidalMap k (v f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VSum (SubVesselKey k v) f -> (k, v f))
-> [VSum (SubVesselKey k v) f] -> [(k, v f)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(SubVesselKey k :~> v f
v) -> (k
k, v f
v)) ([VSum (SubVesselKey k v) f] -> [(k, v f)])
-> (SubVessel k v f -> [VSum (SubVesselKey k v) f])
-> SubVessel k v f
-> [(k, v f)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vessel (SubVesselKey k v) f -> [VSum (SubVesselKey k v) f]
forall (k :: ((* -> *) -> *) -> *) (g :: * -> *).
Vessel k g -> [VSum k g]
toListV (Vessel (SubVesselKey k v) f -> [VSum (SubVesselKey k v) f])
-> (SubVessel k v f -> Vessel (SubVesselKey k v) f)
-> SubVessel k v f
-> [VSum (SubVesselKey k v) f]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubVessel k v f -> Vessel (SubVesselKey k v) f
forall k (v :: (* -> *) -> *) (f :: * -> *).
SubVessel k v f -> Vessel (SubVesselKey k v) f
unSubVessel

mkSubVessel :: Ord k => MonoidalMap k (v f) -> SubVessel k v f
mkSubVessel :: MonoidalMap k (v f) -> SubVessel k v f
mkSubVessel = Vessel (SubVesselKey k v) f -> SubVessel k v f
forall k (v :: (* -> *) -> *) (f :: * -> *).
Vessel (SubVesselKey k v) f -> SubVessel k v f
SubVessel (Vessel (SubVesselKey k v) f -> SubVessel k v f)
-> (MonoidalMap k (v f) -> Vessel (SubVesselKey k v) f)
-> MonoidalMap k (v f)
-> SubVessel k v f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonoidalDMap (SubVesselKey k v) (FlipAp f)
-> Vessel (SubVesselKey k v) f
forall (k :: ((* -> *) -> *) -> *) (g :: * -> *).
MonoidalDMap k (FlipAp g) -> Vessel k g
Vessel (MonoidalDMap (SubVesselKey k v) (FlipAp f)
 -> Vessel (SubVesselKey k v) f)
-> (MonoidalMap k (v f)
    -> MonoidalDMap (SubVesselKey k v) (FlipAp f))
-> MonoidalMap k (v f)
-> Vessel (SubVesselKey k v) f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DMap (SubVesselKey k v) (FlipAp f)
-> MonoidalDMap (SubVesselKey k v) (FlipAp f)
forall k (f :: k -> *) (g :: k -> *). DMap f g -> MonoidalDMap f g
MonoidalDMap (DMap (SubVesselKey k v) (FlipAp f)
 -> MonoidalDMap (SubVesselKey k v) (FlipAp f))
-> (MonoidalMap k (v f) -> DMap (SubVesselKey k v) (FlipAp f))
-> MonoidalMap k (v f)
-> MonoidalDMap (SubVesselKey k v) (FlipAp f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DSum (SubVesselKey k v) (FlipAp f)]
-> DMap (SubVesselKey k v) (FlipAp f)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *).
GCompare k2 =>
[DSum k2 f] -> DMap k2 f
DMap'.fromList ([DSum (SubVesselKey k v) (FlipAp f)]
 -> DMap (SubVesselKey k v) (FlipAp f))
-> (MonoidalMap k (v f) -> [DSum (SubVesselKey k v) (FlipAp f)])
-> MonoidalMap k (v f)
-> DMap (SubVesselKey k v) (FlipAp f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v f) -> DSum (SubVesselKey k v) (FlipAp f))
-> [(k, v f)] -> [DSum (SubVesselKey k v) (FlipAp f)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(k
k, v f
v) -> (k -> SubVesselKey k v v
forall k (f :: (* -> *) -> *). k -> SubVesselKey k f f
SubVesselKey k
k SubVesselKey k v v
-> FlipAp f v -> DSum (SubVesselKey k v) (FlipAp f)
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> v f -> FlipAp f v
forall k (g :: k) (v :: k -> *). v g -> FlipAp g v
FlipAp v f
v)) ([(k, v f)] -> [DSum (SubVesselKey k v) (FlipAp f)])
-> (MonoidalMap k (v f) -> [(k, v f)])
-> MonoidalMap k (v f)
-> [DSum (SubVesselKey k v) (FlipAp f)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonoidalMap k (v f) -> [(k, v f)]
forall k a. MonoidalMap k a -> [(k, a)]
Map.toList


instance (Ord k, View v) => View (SubVessel k v)

instance (Ord k, Semigroup (v Identity), View v) => Query (SubVessel k v (Const x)) where
  type QueryResult (SubVessel k v (Const x)) = SubVessel k v Identity
  crop :: SubVessel k v (Const x)
-> QueryResult (SubVessel k v (Const x))
-> QueryResult (SubVessel k v (Const x))
crop (SubVessel Vessel (SubVesselKey k v) (Const x)
q) (SubVessel r) = Vessel (SubVesselKey k v) Identity -> SubVessel k v Identity
forall k (v :: (* -> *) -> *) (f :: * -> *).
Vessel (SubVesselKey k v) f -> SubVessel k v f
SubVessel (Vessel (SubVesselKey k v) (Const x)
-> QueryResult (Vessel (SubVesselKey k v) (Const x))
-> QueryResult (Vessel (SubVesselKey k v) (Const x))
forall a. Query a => a -> QueryResult a -> QueryResult a
crop Vessel (SubVesselKey k v) (Const x)
q QueryResult (Vessel (SubVesselKey k v) (Const x))
Vessel (SubVesselKey k v) Identity
r)

instance (Ord k, Semigroup (v Identity), View v ) => Query (SubVessel k v Proxy) where
  type QueryResult (SubVessel k v Proxy) = SubVessel k v Identity
  crop :: SubVessel k v Proxy
-> QueryResult (SubVessel k v Proxy)
-> QueryResult (SubVessel k v Proxy)
crop (SubVessel Vessel (SubVesselKey k v) Proxy
q) (SubVessel r) = Vessel (SubVesselKey k v) Identity -> SubVessel k v Identity
forall k (v :: (* -> *) -> *) (f :: * -> *).
Vessel (SubVesselKey k v) f -> SubVessel k v f
SubVessel (Vessel (SubVesselKey k v) Proxy
-> QueryResult (Vessel (SubVesselKey k v) Proxy)
-> QueryResult (Vessel (SubVesselKey k v) Proxy)
forall a. Query a => a -> QueryResult a -> QueryResult a
crop Vessel (SubVesselKey k v) Proxy
q QueryResult (Vessel (SubVesselKey k v) Proxy)
Vessel (SubVesselKey k v) Identity
r)

instance
    ( Ord k
    , View v
    , Query (Vessel (SubVesselKey k v) g)
    , Semigroup (v (Compose c (VesselLeafWrapper (QueryResult (Vessel (SubVesselKey k v) g)))))
    )
    => Query (SubVessel k v (Compose c (g :: * -> *))) where
  type QueryResult (SubVessel k v (Compose c g)) = SubVessel k v
    (Compose c (VesselLeafWrapper (QueryResult (Vessel (SubVesselKey k v) g))))
  crop :: SubVessel k v (Compose c g)
-> QueryResult (SubVessel k v (Compose c g))
-> QueryResult (SubVessel k v (Compose c g))
crop (SubVessel Vessel (SubVesselKey k v) (Compose c g)
q) (SubVessel r) = Vessel
  (SubVesselKey k v)
  (Compose
     c (VesselLeafWrapper (QueryResult (Vessel (SubVesselKey k v) g))))
-> SubVessel
     k
     v
     (Compose
        c (VesselLeafWrapper (QueryResult (Vessel (SubVesselKey k v) g))))
forall k (v :: (* -> *) -> *) (f :: * -> *).
Vessel (SubVesselKey k v) f -> SubVessel k v f
SubVessel (Vessel (SubVesselKey k v) (Compose c g)
-> QueryResult (Vessel (SubVesselKey k v) (Compose c g))
-> QueryResult (Vessel (SubVesselKey k v) (Compose c g))
forall a. Query a => a -> QueryResult a -> QueryResult a
crop Vessel (SubVesselKey k v) (Compose c g)
q QueryResult (Vessel (SubVesselKey k v) (Compose c g))
Vessel
  (SubVesselKey k v)
  (Compose
     c (VesselLeafWrapper (QueryResult (Vessel (SubVesselKey k v) g))))
r)


traverseSubVessel :: (Ord k, View v, Applicative m) => (k -> v g -> m (v h)) -> SubVessel k v g -> m (SubVessel k v h)
traverseSubVessel :: (k -> v g -> m (v h)) -> SubVessel k v g -> m (SubVessel k v h)
traverseSubVessel k -> v g -> m (v h)
f (SubVessel Vessel (SubVesselKey k v) g
x) = Vessel (SubVesselKey k v) h -> SubVessel k v h
forall k (v :: (* -> *) -> *) (f :: * -> *).
Vessel (SubVesselKey k v) f -> SubVessel k v f
SubVessel (Vessel (SubVesselKey k v) h -> SubVessel k v h)
-> m (Vessel (SubVesselKey k v) h) -> m (SubVessel k v h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (v :: (* -> *) -> *).
 View v =>
 SubVesselKey k v v -> v g -> m (v h))
-> Vessel (SubVesselKey k v) g -> m (Vessel (SubVesselKey k v) h)
forall (k :: ((* -> *) -> *) -> *) (m :: * -> *) (g :: * -> *)
       (h :: * -> *).
(GCompare k, Has View k, Applicative m) =>
(forall (v :: (* -> *) -> *). View v => k v -> v g -> m (v h))
-> Vessel k g -> m (Vessel k h)
traverseWithKeyV (\(SubVesselKey k) -> k -> v g -> m (v h)
f k
k) Vessel (SubVesselKey k v) g
x

singletonSubVessel :: forall k f v . View v => k -> v f -> SubVessel k v f
singletonSubVessel :: k -> v f -> SubVessel k v f
singletonSubVessel k
k v f
f = Vessel (SubVesselKey k v) f -> SubVessel k v f
forall k (v :: (* -> *) -> *) (f :: * -> *).
Vessel (SubVesselKey k v) f -> SubVessel k v f
SubVessel (Vessel (SubVesselKey k v) f -> SubVessel k v f)
-> Vessel (SubVesselKey k v) f -> SubVessel k v f
forall a b. (a -> b) -> a -> b
$ SubVesselKey k v v -> v f -> Vessel (SubVesselKey k v) f
forall (v :: (* -> *) -> *) (k :: ((* -> *) -> *) -> *)
       (g :: * -> *).
View v =>
k v -> v g -> Vessel k g
singletonV @v @(SubVesselKey k v) (k -> SubVesselKey k v v
forall k (f :: (* -> *) -> *). k -> SubVesselKey k f f
SubVesselKey k
k :: SubVesselKey k v v ) v f
f

lookupSubVessel :: (Ord k) => k -> SubVessel k v f -> Maybe (v f)
lookupSubVessel :: k -> SubVessel k v f -> Maybe (v f)
lookupSubVessel k
k = SubVesselKey k v v -> Vessel (SubVesselKey k v) f -> Maybe (v f)
forall (k :: ((* -> *) -> *) -> *) (v :: (* -> *) -> *)
       (g :: * -> *).
GCompare k =>
k v -> Vessel k g -> Maybe (v g)
lookupV (k -> SubVesselKey k v v
forall k (f :: (* -> *) -> *). k -> SubVesselKey k f f
SubVesselKey k
k) (Vessel (SubVesselKey k v) f -> Maybe (v f))
-> (SubVessel k v f -> Vessel (SubVesselKey k v) f)
-> SubVessel k v f
-> Maybe (v f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubVessel k v f -> Vessel (SubVesselKey k v) f
forall k (v :: (* -> *) -> *) (f :: * -> *).
SubVessel k v f -> Vessel (SubVesselKey k v) f
unSubVessel

subVesselFromKeys :: (Ord k, View v) => (k -> v f) -> Set k -> SubVessel k v f
subVesselFromKeys :: (k -> v f) -> Set k -> SubVessel k v f
subVesselFromKeys k -> v f
f Set k
ks = Vessel (SubVesselKey k v) f -> SubVessel k v f
forall k (v :: (* -> *) -> *) (f :: * -> *).
Vessel (SubVesselKey k v) f -> SubVessel k v f
SubVessel (Vessel (SubVesselKey k v) f -> SubVessel k v f)
-> Vessel (SubVesselKey k v) f -> SubVessel k v f
forall a b. (a -> b) -> a -> b
$ [VSum (SubVesselKey k v) f] -> Vessel (SubVesselKey k v) f
forall (k :: ((* -> *) -> *) -> *) (g :: * -> *).
(GCompare k, Has View k) =>
[VSum k g] -> Vessel k g
fromListV ([VSum (SubVesselKey k v) f] -> Vessel (SubVesselKey k v) f)
-> [VSum (SubVesselKey k v) f] -> Vessel (SubVesselKey k v) f
forall a b. (a -> b) -> a -> b
$ (k -> VSum (SubVesselKey k v) f)
-> [k] -> [VSum (SubVesselKey k v) f]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\k
k -> k -> SubVesselKey k v v
forall k (f :: (* -> *) -> *). k -> SubVesselKey k f f
SubVesselKey k
k SubVesselKey k v v -> v f -> VSum (SubVesselKey k v) f
forall (k :: ((* -> *) -> *) -> *) (g :: * -> *)
       (v :: (* -> *) -> *).
k v -> v g -> VSum k g
:~> k -> v f
f k
k) ([k] -> [VSum (SubVesselKey k v) f])
-> [k] -> [VSum (SubVesselKey k v) f]
forall a b. (a -> b) -> a -> b
$ Set k -> [k]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set k
ks

type instance ViewQueryResult (SubVessel k v g) = SubVessel k v (ViewQueryResult g)

subVessel :: (Ord k, View v, ViewQueryResult (v g) ~ v (ViewQueryResult g), Alternative n, Applicative m) => k -> ViewMorphism m n (v g) (SubVessel k v g)
subVessel :: k -> ViewMorphism m n (v g) (SubVessel k v g)
subVessel k
k = ViewHalfMorphism m n (v g) (SubVessel k v g)
-> ViewHalfMorphism n m (SubVessel k v g) (v g)
-> ViewMorphism m n (v g) (SubVessel k v g)
forall (m :: * -> *) (n :: * -> *) p q.
ViewHalfMorphism m n p q
-> ViewHalfMorphism n m q p -> ViewMorphism m n p q
ViewMorphism (k -> ViewHalfMorphism m n (v g) (SubVessel k v g)
forall k (m :: * -> *) (n :: * -> *) (v :: (* -> *) -> *)
       (g :: * -> *).
(Ord k, Applicative m, Alternative n, View v,
 ViewQueryResult (v g) ~ v (ViewQueryResult g)) =>
k -> ViewHalfMorphism m n (v g) (SubVessel k v g)
toSubVessel k
k) (k -> ViewHalfMorphism n m (SubVessel k v g) (v g)
forall k (m :: * -> *) (n :: * -> *) (v :: (* -> *) -> *)
       (g :: * -> *).
(Ord k, Alternative m, Applicative n, View v,
 ViewQueryResult (v g) ~ v (ViewQueryResult g)) =>
k -> ViewHalfMorphism m n (SubVessel k v g) (v g)
fromSubVessel k
k)

toSubVessel :: (Ord k, Applicative m, Alternative n, View v, ViewQueryResult (v g) ~ v (ViewQueryResult g)) => k -> ViewHalfMorphism m n (v g) (SubVessel k v g)
toSubVessel :: k -> ViewHalfMorphism m n (v g) (SubVessel k v g)
toSubVessel k
k = ViewHalfMorphism :: forall (m :: * -> *) (n :: * -> *) p q.
(p -> m q)
-> (ViewQueryResult q -> n (ViewQueryResult p))
-> ViewHalfMorphism m n p q
ViewHalfMorphism
  { _viewMorphism_mapQuery :: v g -> m (SubVessel k v g)
_viewMorphism_mapQuery = SubVessel k v g -> m (SubVessel k v g)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubVessel k v g -> m (SubVessel k v g))
-> (v g -> SubVessel k v g) -> v g -> m (SubVessel k v g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> v g -> SubVessel k v g
forall k (f :: * -> *) (v :: (* -> *) -> *).
View v =>
k -> v f -> SubVessel k v f
singletonSubVessel k
k
  , _viewMorphism_mapQueryResult :: ViewQueryResult (SubVessel k v g) -> n (ViewQueryResult (v g))
_viewMorphism_mapQueryResult = n (v (ViewQueryResult g))
-> (v (ViewQueryResult g) -> n (v (ViewQueryResult g)))
-> Maybe (v (ViewQueryResult g))
-> n (v (ViewQueryResult g))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe n (v (ViewQueryResult g))
forall (f :: * -> *) a. Alternative f => f a
empty v (ViewQueryResult g) -> n (v (ViewQueryResult g))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (v (ViewQueryResult g)) -> n (v (ViewQueryResult g)))
-> (SubVessel k v (ViewQueryResult g)
    -> Maybe (v (ViewQueryResult g)))
-> SubVessel k v (ViewQueryResult g)
-> n (v (ViewQueryResult g))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k
-> SubVessel k v (ViewQueryResult g)
-> Maybe (v (ViewQueryResult g))
forall k (v :: (* -> *) -> *) (f :: * -> *).
Ord k =>
k -> SubVessel k v f -> Maybe (v f)
lookupSubVessel k
k
  }

fromSubVessel :: (Ord k, Alternative m, Applicative n, View v, ViewQueryResult (v g) ~ v (ViewQueryResult g)) => k -> ViewHalfMorphism m n (SubVessel k v g) (v g)
fromSubVessel :: k -> ViewHalfMorphism m n (SubVessel k v g) (v g)
fromSubVessel k
k = ViewHalfMorphism :: forall (m :: * -> *) (n :: * -> *) p q.
(p -> m q)
-> (ViewQueryResult q -> n (ViewQueryResult p))
-> ViewHalfMorphism m n p q
ViewHalfMorphism
  { _viewMorphism_mapQuery :: SubVessel k v g -> m (v g)
_viewMorphism_mapQuery = m (v g) -> (v g -> m (v g)) -> Maybe (v g) -> m (v g)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m (v g)
forall (f :: * -> *) a. Alternative f => f a
empty v g -> m (v g)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (v g) -> m (v g))
-> (SubVessel k v g -> Maybe (v g)) -> SubVessel k v g -> m (v g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> SubVessel k v g -> Maybe (v g)
forall k (v :: (* -> *) -> *) (f :: * -> *).
Ord k =>
k -> SubVessel k v f -> Maybe (v f)
lookupSubVessel k
k
  , _viewMorphism_mapQueryResult :: ViewQueryResult (v g) -> n (ViewQueryResult (SubVessel k v g))
_viewMorphism_mapQueryResult = SubVessel k v (ViewQueryResult g)
-> n (SubVessel k v (ViewQueryResult g))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubVessel k v (ViewQueryResult g)
 -> n (SubVessel k v (ViewQueryResult g)))
-> (v (ViewQueryResult g) -> SubVessel k v (ViewQueryResult g))
-> v (ViewQueryResult g)
-> n (SubVessel k v (ViewQueryResult g))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> v (ViewQueryResult g) -> SubVessel k v (ViewQueryResult g)
forall k (f :: * -> *) (v :: (* -> *) -> *).
View v =>
k -> v f -> SubVessel k v f
singletonSubVessel k
k
  }


subVesselWildcard
  ::
  ( Ord k
  , View v, ViewQueryResult (v g) ~ v (ViewQueryResult g)
  , Semigroup (v g), Semigroup (v (ViewQueryResult g))
  , Alternative n
  , Applicative m
  ) => ViewMorphism m n (v g) (SubVessel k v g)
subVesselWildcard :: ViewMorphism m n (v g) (SubVessel k v g)
subVesselWildcard = ViewHalfMorphism m n (v g) (SubVessel k v g)
-> ViewHalfMorphism n m (SubVessel k v g) (v g)
-> ViewMorphism m n (v g) (SubVessel k v g)
forall (m :: * -> *) (n :: * -> *) p q.
ViewHalfMorphism m n p q
-> ViewHalfMorphism n m q p -> ViewMorphism m n p q
ViewMorphism ViewHalfMorphism m n (v g) (SubVessel k v g)
forall k (m :: * -> *) (n :: * -> *) (v :: (* -> *) -> *)
       (g :: * -> *).
(Ord k, Applicative m, Alternative n, View v,
 ViewQueryResult (v g) ~ v (ViewQueryResult g),
 Semigroup (v (ViewQueryResult g))) =>
ViewHalfMorphism m n (v g) (SubVessel k v g)
toSubVesselWildcard ViewHalfMorphism n m (SubVessel k v g) (v g)
forall k (m :: * -> *) (n :: * -> *) (v :: (* -> *) -> *)
       (g :: * -> *).
(Ord k, Alternative m, Applicative n, Semigroup (v g)) =>
ViewHalfMorphism m n (SubVessel k v g) (v g)
fromSubVesselWildcard

toSubVesselWildcard
  ::
  ( Ord k
  , Applicative m, Alternative n
  , View v, ViewQueryResult (v g) ~ v (ViewQueryResult g)
  , Semigroup (v (ViewQueryResult g))
  ) => ViewHalfMorphism m n (v g) (SubVessel k v g)
toSubVesselWildcard :: ViewHalfMorphism m n (v g) (SubVessel k v g)
toSubVesselWildcard = ViewHalfMorphism :: forall (m :: * -> *) (n :: * -> *) p q.
(p -> m q)
-> (ViewQueryResult q -> n (ViewQueryResult p))
-> ViewHalfMorphism m n p q
ViewHalfMorphism
  { _viewMorphism_mapQuery :: v g -> m (SubVessel k v g)
_viewMorphism_mapQuery = m (SubVessel k v g) -> v g -> m (SubVessel k v g)
forall a b. a -> b -> a
const (m (SubVessel k v g) -> v g -> m (SubVessel k v g))
-> m (SubVessel k v g) -> v g -> m (SubVessel k v g)
forall a b. (a -> b) -> a -> b
$ SubVessel k v g -> m (SubVessel k v g)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubVessel k v g -> m (SubVessel k v g))
-> SubVessel k v g -> m (SubVessel k v g)
forall a b. (a -> b) -> a -> b
$ Vessel (SubVesselKey k v) g -> SubVessel k v g
forall k (v :: (* -> *) -> *) (f :: * -> *).
Vessel (SubVesselKey k v) f -> SubVessel k v f
SubVessel (Vessel (SubVesselKey k v) g -> SubVessel k v g)
-> Vessel (SubVesselKey k v) g -> SubVessel k v g
forall a b. (a -> b) -> a -> b
$ MonoidalDMap (SubVesselKey k v) (FlipAp g)
-> Vessel (SubVesselKey k v) g
forall (k :: ((* -> *) -> *) -> *) (g :: * -> *).
MonoidalDMap k (FlipAp g) -> Vessel k g
Vessel (MonoidalDMap (SubVesselKey k v) (FlipAp g)
 -> Vessel (SubVesselKey k v) g)
-> MonoidalDMap (SubVesselKey k v) (FlipAp g)
-> Vessel (SubVesselKey k v) g
forall a b. (a -> b) -> a -> b
$ MonoidalDMap (SubVesselKey k v) (FlipAp g)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). MonoidalDMap k2 f
DMap.empty
  , _viewMorphism_mapQueryResult :: ViewQueryResult (SubVessel k v g) -> n (ViewQueryResult (v g))
_viewMorphism_mapQueryResult = n (v (ViewQueryResult g))
-> (v (ViewQueryResult g) -> n (v (ViewQueryResult g)))
-> Maybe (v (ViewQueryResult g))
-> n (v (ViewQueryResult g))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe n (v (ViewQueryResult g))
forall (f :: * -> *) a. Alternative f => f a
empty v (ViewQueryResult g) -> n (v (ViewQueryResult g))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (v (ViewQueryResult g)) -> n (v (ViewQueryResult g)))
-> (SubVessel k v (ViewQueryResult g)
    -> Maybe (v (ViewQueryResult g)))
-> SubVessel k v (ViewQueryResult g)
-> n (v (ViewQueryResult g))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v (ViewQueryResult g) -> Maybe (v (ViewQueryResult g)))
-> MonoidalMap k (v (ViewQueryResult g))
-> Maybe (v (ViewQueryResult g))
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap v (ViewQueryResult g) -> Maybe (v (ViewQueryResult g))
forall a. a -> Maybe a
Just (MonoidalMap k (v (ViewQueryResult g))
 -> Maybe (v (ViewQueryResult g)))
-> (SubVessel k v (ViewQueryResult g)
    -> MonoidalMap k (v (ViewQueryResult g)))
-> SubVessel k v (ViewQueryResult g)
-> Maybe (v (ViewQueryResult g))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubVessel k v (ViewQueryResult g)
-> MonoidalMap k (v (ViewQueryResult g))
forall k (v :: (* -> *) -> *) (f :: * -> *).
Ord k =>
SubVessel k v f -> MonoidalMap k (v f)
getSubVessel
  }

fromSubVesselWildcard
  ::
  ( Ord k
  , Alternative m, Applicative n
  , Semigroup (v g)
  ) => ViewHalfMorphism m n (SubVessel k v g) (v g)
fromSubVesselWildcard :: ViewHalfMorphism m n (SubVessel k v g) (v g)
fromSubVesselWildcard = ViewHalfMorphism :: forall (m :: * -> *) (n :: * -> *) p q.
(p -> m q)
-> (ViewQueryResult q -> n (ViewQueryResult p))
-> ViewHalfMorphism m n p q
ViewHalfMorphism
  { _viewMorphism_mapQuery :: SubVessel k v g -> m (v g)
_viewMorphism_mapQuery = m (v g) -> (v g -> m (v g)) -> Maybe (v g) -> m (v g)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m (v g)
forall (f :: * -> *) a. Alternative f => f a
empty v g -> m (v g)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (v g) -> m (v g))
-> (SubVessel k v g -> Maybe (v g)) -> SubVessel k v g -> m (v g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v g -> Maybe (v g)) -> MonoidalMap k (v g) -> Maybe (v g)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap v g -> Maybe (v g)
forall a. a -> Maybe a
Just (MonoidalMap k (v g) -> Maybe (v g))
-> (SubVessel k v g -> MonoidalMap k (v g))
-> SubVessel k v g
-> Maybe (v g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubVessel k v g -> MonoidalMap k (v g)
forall k (v :: (* -> *) -> *) (f :: * -> *).
Ord k =>
SubVessel k v f -> MonoidalMap k (v f)
getSubVessel
  , _viewMorphism_mapQueryResult :: ViewQueryResult (v g) -> n (ViewQueryResult (SubVessel k v g))
_viewMorphism_mapQueryResult = n (SubVessel k v (ViewQueryResult g))
-> ViewQueryResult (v g) -> n (SubVessel k v (ViewQueryResult g))
forall a b. a -> b -> a
const (n (SubVessel k v (ViewQueryResult g))
 -> ViewQueryResult (v g) -> n (SubVessel k v (ViewQueryResult g)))
-> n (SubVessel k v (ViewQueryResult g))
-> ViewQueryResult (v g)
-> n (SubVessel k v (ViewQueryResult g))
forall a b. (a -> b) -> a -> b
$ SubVessel k v (ViewQueryResult g)
-> n (SubVessel k v (ViewQueryResult g))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubVessel k v (ViewQueryResult g)
 -> n (SubVessel k v (ViewQueryResult g)))
-> SubVessel k v (ViewQueryResult g)
-> n (SubVessel k v (ViewQueryResult g))
forall a b. (a -> b) -> a -> b
$ Vessel (SubVesselKey k v) (ViewQueryResult g)
-> SubVessel k v (ViewQueryResult g)
forall k (v :: (* -> *) -> *) (f :: * -> *).
Vessel (SubVesselKey k v) f -> SubVessel k v f
SubVessel (Vessel (SubVesselKey k v) (ViewQueryResult g)
 -> SubVessel k v (ViewQueryResult g))
-> Vessel (SubVesselKey k v) (ViewQueryResult g)
-> SubVessel k v (ViewQueryResult g)
forall a b. (a -> b) -> a -> b
$ MonoidalDMap (SubVesselKey k v) (FlipAp (ViewQueryResult g))
-> Vessel (SubVesselKey k v) (ViewQueryResult g)
forall (k :: ((* -> *) -> *) -> *) (g :: * -> *).
MonoidalDMap k (FlipAp g) -> Vessel k g
Vessel (MonoidalDMap (SubVesselKey k v) (FlipAp (ViewQueryResult g))
 -> Vessel (SubVesselKey k v) (ViewQueryResult g))
-> MonoidalDMap (SubVesselKey k v) (FlipAp (ViewQueryResult g))
-> Vessel (SubVesselKey k v) (ViewQueryResult g)
forall a b. (a -> b) -> a -> b
$ MonoidalDMap (SubVesselKey k v) (FlipAp (ViewQueryResult g))
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). MonoidalDMap k2 f
DMap.empty
  }

subVessels ::
  ( Ord k, Applicative m, View v , Alternative n
  , ViewQueryResult (v g) ~ v (ViewQueryResult g)
  , Monoid (n (v g)) , Monoid (n (v (ViewQueryResult g)))
  ) => Set k -> ViewMorphism m n (v g) (SubVessel k v g)
subVessels :: Set k -> ViewMorphism m n (v g) (SubVessel k v g)
subVessels Set k
k = ViewHalfMorphism m n (v g) (SubVessel k v g)
-> ViewHalfMorphism n m (SubVessel k v g) (v g)
-> ViewMorphism m n (v g) (SubVessel k v g)
forall (m :: * -> *) (n :: * -> *) p q.
ViewHalfMorphism m n p q
-> ViewHalfMorphism n m q p -> ViewMorphism m n p q
ViewMorphism (Set k -> ViewHalfMorphism m n (v g) (SubVessel k v g)
forall k (m :: * -> *) (v :: (* -> *) -> *) (n :: * -> *)
       (g :: * -> *).
(Ord k, Applicative m, View v, Alternative n,
 ViewQueryResult (v g) ~ v (ViewQueryResult g),
 Monoid (n (v (ViewQueryResult g)))) =>
Set k -> ViewHalfMorphism m n (v g) (SubVessel k v g)
toSubVessels Set k
k) (Set k -> ViewHalfMorphism n m (SubVessel k v g) (v g)
forall k (m :: * -> *) (v :: (* -> *) -> *) (n :: * -> *)
       (g :: * -> *).
(Ord k, Applicative m, View v, Alternative n,
 ViewQueryResult (v g) ~ v (ViewQueryResult g), Monoid (n (v g))) =>
Set k -> ViewHalfMorphism n m (SubVessel k v g) (v g)
fromSubVessels Set k
k)

toSubVessels ::
  ( Ord k, Applicative m, View v , Alternative n
  , ViewQueryResult (v g) ~ v (ViewQueryResult g)
  , Monoid (n (v (ViewQueryResult g)))
  ) => Set k -> ViewHalfMorphism m n (v g) (SubVessel k v g)
toSubVessels :: Set k -> ViewHalfMorphism m n (v g) (SubVessel k v g)
toSubVessels Set k
k = ViewHalfMorphism :: forall (m :: * -> *) (n :: * -> *) p q.
(p -> m q)
-> (ViewQueryResult q -> n (ViewQueryResult p))
-> ViewHalfMorphism m n p q
ViewHalfMorphism
  { _viewMorphism_mapQuery :: v g -> m (SubVessel k v g)
_viewMorphism_mapQuery = SubVessel k v g -> m (SubVessel k v g)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubVessel k v g -> m (SubVessel k v g))
-> (v g -> SubVessel k v g) -> v g -> m (SubVessel k v g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k -> v g) -> Set k -> SubVessel k v g)
-> Set k -> (k -> v g) -> SubVessel k v g
forall a b c. (a -> b -> c) -> b -> a -> c
flip (k -> v g) -> Set k -> SubVessel k v g
forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, View v) =>
(k -> v f) -> Set k -> SubVessel k v f
subVesselFromKeys Set k
k ((k -> v g) -> SubVessel k v g)
-> (v g -> k -> v g) -> v g -> SubVessel k v g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v g -> k -> v g
forall a b. a -> b -> a
const
  , _viewMorphism_mapQueryResult :: ViewQueryResult (SubVessel k v g) -> n (ViewQueryResult (v g))
_viewMorphism_mapQueryResult = MonoidalMap k (n (v (ViewQueryResult g)))
-> n (v (ViewQueryResult g))
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (MonoidalMap k (n (v (ViewQueryResult g)))
 -> n (v (ViewQueryResult g)))
-> (SubVessel k v (ViewQueryResult g)
    -> MonoidalMap k (n (v (ViewQueryResult g))))
-> SubVessel k v (ViewQueryResult g)
-> n (v (ViewQueryResult g))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n (v (ViewQueryResult g))
-> Set k
-> MonoidalMap k (n (v (ViewQueryResult g)))
-> MonoidalMap k (n (v (ViewQueryResult g)))
forall k a.
Ord k =>
a -> Set k -> MonoidalMap k a -> MonoidalMap k a
leftOuterJoin_ n (v (ViewQueryResult g))
forall (f :: * -> *) a. Alternative f => f a
empty Set k
k (MonoidalMap k (n (v (ViewQueryResult g)))
 -> MonoidalMap k (n (v (ViewQueryResult g))))
-> (SubVessel k v (ViewQueryResult g)
    -> MonoidalMap k (n (v (ViewQueryResult g))))
-> SubVessel k v (ViewQueryResult g)
-> MonoidalMap k (n (v (ViewQueryResult g)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v (ViewQueryResult g) -> n (v (ViewQueryResult g)))
-> MonoidalMap k (v (ViewQueryResult g))
-> MonoidalMap k (n (v (ViewQueryResult g)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v (ViewQueryResult g) -> n (v (ViewQueryResult g))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MonoidalMap k (v (ViewQueryResult g))
 -> MonoidalMap k (n (v (ViewQueryResult g))))
-> (SubVessel k v (ViewQueryResult g)
    -> MonoidalMap k (v (ViewQueryResult g)))
-> SubVessel k v (ViewQueryResult g)
-> MonoidalMap k (n (v (ViewQueryResult g)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubVessel k v (ViewQueryResult g)
-> MonoidalMap k (v (ViewQueryResult g))
forall k (v :: (* -> *) -> *) (f :: * -> *).
Ord k =>
SubVessel k v f -> MonoidalMap k (v f)
getSubVessel
  }

fromSubVessels ::
  ( Ord k, Applicative m, View v , Alternative n
  , ViewQueryResult (v g) ~ v (ViewQueryResult g)
  , Monoid (n (v g))
  ) => Set k -> ViewHalfMorphism n m (SubVessel k v g) (v g)
fromSubVessels :: Set k -> ViewHalfMorphism n m (SubVessel k v g) (v g)
fromSubVessels Set k
k = ViewHalfMorphism :: forall (m :: * -> *) (n :: * -> *) p q.
(p -> m q)
-> (ViewQueryResult q -> n (ViewQueryResult p))
-> ViewHalfMorphism m n p q
ViewHalfMorphism
  { _viewMorphism_mapQuery :: SubVessel k v g -> n (v g)
_viewMorphism_mapQuery = MonoidalMap k (n (v g)) -> n (v g)
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (MonoidalMap k (n (v g)) -> n (v g))
-> (SubVessel k v g -> MonoidalMap k (n (v g)))
-> SubVessel k v g
-> n (v g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n (v g)
-> Set k -> MonoidalMap k (n (v g)) -> MonoidalMap k (n (v g))
forall k a.
Ord k =>
a -> Set k -> MonoidalMap k a -> MonoidalMap k a
leftOuterJoin_ n (v g)
forall (f :: * -> *) a. Alternative f => f a
empty Set k
k (MonoidalMap k (n (v g)) -> MonoidalMap k (n (v g)))
-> (SubVessel k v g -> MonoidalMap k (n (v g)))
-> SubVessel k v g
-> MonoidalMap k (n (v g))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v g -> n (v g)) -> MonoidalMap k (v g) -> MonoidalMap k (n (v g))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v g -> n (v g)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MonoidalMap k (v g) -> MonoidalMap k (n (v g)))
-> (SubVessel k v g -> MonoidalMap k (v g))
-> SubVessel k v g
-> MonoidalMap k (n (v g))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubVessel k v g -> MonoidalMap k (v g)
forall k (v :: (* -> *) -> *) (f :: * -> *).
Ord k =>
SubVessel k v f -> MonoidalMap k (v f)
getSubVessel
  , _viewMorphism_mapQueryResult :: ViewQueryResult (v g) -> m (ViewQueryResult (SubVessel k v g))
_viewMorphism_mapQueryResult = SubVessel k v (ViewQueryResult g)
-> m (SubVessel k v (ViewQueryResult g))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubVessel k v (ViewQueryResult g)
 -> m (SubVessel k v (ViewQueryResult g)))
-> (v (ViewQueryResult g) -> SubVessel k v (ViewQueryResult g))
-> v (ViewQueryResult g)
-> m (SubVessel k v (ViewQueryResult g))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k -> v (ViewQueryResult g))
 -> Set k -> SubVessel k v (ViewQueryResult g))
-> Set k
-> (k -> v (ViewQueryResult g))
-> SubVessel k v (ViewQueryResult g)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (k -> v (ViewQueryResult g))
-> Set k -> SubVessel k v (ViewQueryResult g)
forall k (v :: (* -> *) -> *) (f :: * -> *).
(Ord k, View v) =>
(k -> v f) -> Set k -> SubVessel k v f
subVesselFromKeys Set k
k ((k -> v (ViewQueryResult g)) -> SubVessel k v (ViewQueryResult g))
-> (v (ViewQueryResult g) -> k -> v (ViewQueryResult g))
-> v (ViewQueryResult g)
-> SubVessel k v (ViewQueryResult g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v (ViewQueryResult g) -> k -> v (ViewQueryResult g)
forall a b. a -> b -> a
const
  }


mapMaybeWithKeySubVessel :: forall k v (g :: * -> *) (g' :: * -> *) . (View v, Ord k) => (k -> v g -> Maybe (v g')) -> SubVessel k v g -> SubVessel k v g'
mapMaybeWithKeySubVessel :: (k -> v g -> Maybe (v g')) -> SubVessel k v g -> SubVessel k v g'
mapMaybeWithKeySubVessel k -> v g -> Maybe (v g')
f (SubVessel Vessel (SubVesselKey k v) g
xs) = Vessel (SubVesselKey k v) g' -> SubVessel k v g'
forall k (v :: (* -> *) -> *) (f :: * -> *).
Vessel (SubVesselKey k v) f -> SubVessel k v f
SubVessel ((forall (v :: (* -> *) -> *).
 View v =>
 SubVesselKey k v v -> v g -> Maybe (v g'))
-> Vessel (SubVesselKey k v) g -> Vessel (SubVesselKey k v) g'
forall (k :: ((* -> *) -> *) -> *) (g :: * -> *) (g' :: * -> *).
(GCompare k, Has View k) =>
(forall (v :: (* -> *) -> *). View v => k v -> v g -> Maybe (v g'))
-> Vessel k g -> Vessel k g'
mapMaybeWithKeyV @(SubVesselKey k v) forall (v :: (* -> *) -> *).
View v =>
SubVesselKey k v v -> v g -> Maybe (v g')
forall (x :: (* -> *) -> *).
SubVesselKey k v x -> x g -> Maybe (x g')
f' Vessel (SubVesselKey k v) g
xs)
  where
    f' :: forall x . SubVesselKey k v x -> x g -> Maybe (x g')
    f' :: SubVesselKey k v x -> x g -> Maybe (x g')
f' (SubVesselKey k
k) = k -> v g -> Maybe (v g')
f k
k


uncurrySubVessel :: (Ord k1, Ord k2) => MonoidalMap k1 (SubVessel k2 v f) -> SubVessel (k1, k2) v f
uncurrySubVessel :: MonoidalMap k1 (SubVessel k2 v f) -> SubVessel (k1, k2) v f
uncurrySubVessel MonoidalMap k1 (SubVessel k2 v f)
xs = MonoidalMap (k1, k2) (v f) -> SubVessel (k1, k2) v f
forall k (v :: (* -> *) -> *) (f :: * -> *).
Ord k =>
MonoidalMap k (v f) -> SubVessel k v f
mkSubVessel (MonoidalMap (k1, k2) (v f) -> SubVessel (k1, k2) v f)
-> MonoidalMap (k1, k2) (v f) -> SubVessel (k1, k2) v f
forall a b. (a -> b) -> a -> b
$ MonoidalMap k1 (MonoidalMap k2 (v f)) -> MonoidalMap (k1, k2) (v f)
forall a b c.
(Ord a, Ord b) =>
MonoidalMap a (MonoidalMap b c) -> MonoidalMap (a, b) c
uncurryMMap (MonoidalMap k1 (MonoidalMap k2 (v f))
 -> MonoidalMap (k1, k2) (v f))
-> MonoidalMap k1 (MonoidalMap k2 (v f))
-> MonoidalMap (k1, k2) (v f)
forall a b. (a -> b) -> a -> b
$ (SubVessel k2 v f -> MonoidalMap k2 (v f))
-> MonoidalMap k1 (SubVessel k2 v f)
-> MonoidalMap k1 (MonoidalMap k2 (v f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SubVessel k2 v f -> MonoidalMap k2 (v f)
forall k (v :: (* -> *) -> *) (f :: * -> *).
Ord k =>
SubVessel k v f -> MonoidalMap k (v f)
getSubVessel MonoidalMap k1 (SubVessel k2 v f)
xs

currySubVessel :: (Ord k1, Ord k2) => SubVessel (k1, k2) v f -> MonoidalMap k1 (SubVessel k2 v f)
currySubVessel :: SubVessel (k1, k2) v f -> MonoidalMap k1 (SubVessel k2 v f)
currySubVessel SubVessel (k1, k2) v f
xs = (MonoidalMap k2 (v f) -> SubVessel k2 v f)
-> MonoidalMap k1 (MonoidalMap k2 (v f))
-> MonoidalMap k1 (SubVessel k2 v f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MonoidalMap k2 (v f) -> SubVessel k2 v f
forall k (v :: (* -> *) -> *) (f :: * -> *).
Ord k =>
MonoidalMap k (v f) -> SubVessel k v f
mkSubVessel (MonoidalMap k1 (MonoidalMap k2 (v f))
 -> MonoidalMap k1 (SubVessel k2 v f))
-> MonoidalMap k1 (MonoidalMap k2 (v f))
-> MonoidalMap k1 (SubVessel k2 v f)
forall a b. (a -> b) -> a -> b
$ MonoidalMap (k1, k2) (v f) -> MonoidalMap k1 (MonoidalMap k2 (v f))
forall a b c.
(Ord a, Ord b) =>
MonoidalMap (a, b) c -> MonoidalMap a (MonoidalMap b c)
curryMMap (MonoidalMap (k1, k2) (v f)
 -> MonoidalMap k1 (MonoidalMap k2 (v f)))
-> MonoidalMap (k1, k2) (v f)
-> MonoidalMap k1 (MonoidalMap k2 (v f))
forall a b. (a -> b) -> a -> b
$ SubVessel (k1, k2) v f -> MonoidalMap (k1, k2) (v f)
forall k (v :: (* -> *) -> *) (f :: * -> *).
Ord k =>
SubVessel k v f -> MonoidalMap k (v f)
getSubVessel SubVessel (k1, k2) v f
xs

-- | the instance for Filterable (MonoidalMap k) is not defined anyplace conveninent, this sidesteps it for this particular case.
condenseVMMap :: forall k v g. View v => MonoidalMap k (v g) -> v (Compose (MonoidalMap k) g)
condenseVMMap :: MonoidalMap k (v g) -> v (Compose (MonoidalMap k) g)
condenseVMMap = (forall a. Compose (Map k) g a -> Compose (MonoidalMap k) g a)
-> v (Compose (Map k) g) -> v (Compose (MonoidalMap k) g)
forall (v :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
View v =>
(forall a. f a -> g a) -> v f -> v g
mapV (MonoidalMap k (g a) -> Compose (MonoidalMap k) g a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (MonoidalMap k (g a) -> Compose (MonoidalMap k) g a)
-> (Compose (Map k) g a -> MonoidalMap k (g a))
-> Compose (Map k) g a
-> Compose (MonoidalMap k) g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k (g a) -> MonoidalMap k (g a)
forall k a. Map k a -> MonoidalMap k a
MonoidalMap (Map k (g a) -> MonoidalMap k (g a))
-> (Compose (Map k) g a -> Map k (g a))
-> Compose (Map k) g a
-> MonoidalMap k (g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (Map k) g a -> Map k (g a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) (v (Compose (Map k) g) -> v (Compose (MonoidalMap k) g))
-> (MonoidalMap k (v g) -> v (Compose (Map k) g))
-> MonoidalMap k (v g)
-> v (Compose (MonoidalMap k) g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k (v g) -> v (Compose (Map k) g)
forall (v :: (* -> *) -> *) (t :: * -> *) (g :: * -> *).
(View v, Foldable t, Filterable t, Functor t) =>
t (v g) -> v (Compose t g)
condenseV (Map k (v g) -> v (Compose (Map k) g))
-> (MonoidalMap k (v g) -> Map k (v g))
-> MonoidalMap k (v g)
-> v (Compose (Map k) g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonoidalMap k (v g) -> Map k (v g)
forall k a. MonoidalMap k a -> Map k a
getMonoidalMap

-- | A gadget to "traverse" over all of the keys in a SubVessel in one step
handleSubVesselSelector
  ::  forall k m tag (f :: * -> *) (g :: * -> *).
  ( Ord k, Applicative m, Has View tag, GCompare tag )
  => (forall v.  tag v
             ->    MonoidalMap k (v f)
             -> m (MonoidalMap k (v g)))
  ->    SubVessel k (Vessel tag) f
  -> m (SubVessel k (Vessel tag) g)
handleSubVesselSelector :: (forall (v :: (* -> *) -> *).
 tag v -> MonoidalMap k (v f) -> m (MonoidalMap k (v g)))
-> SubVessel k (Vessel tag) f -> m (SubVessel k (Vessel tag) g)
handleSubVesselSelector forall (v :: (* -> *) -> *).
tag v -> MonoidalMap k (v f) -> m (MonoidalMap k (v g))
f SubVessel k (Vessel tag) f
xs = (\Vessel tag (Compose (MonoidalMap k) g)
y -> MonoidalMap k (Vessel tag g) -> SubVessel k (Vessel tag) g
forall k (v :: (* -> *) -> *) (f :: * -> *).
Ord k =>
MonoidalMap k (v f) -> SubVessel k v f
mkSubVessel (MonoidalMap k (Vessel tag g) -> SubVessel k (Vessel tag) g)
-> MonoidalMap k (Vessel tag g) -> SubVessel k (Vessel tag) g
forall a b. (a -> b) -> a -> b
$ Vessel tag (Compose (MonoidalMap k) g)
-> MonoidalMap k (Vessel tag g)
forall (v :: (* -> *) -> *) (t :: * -> *) (g :: * -> *).
(View v, Align t) =>
v (Compose t g) -> t (v g)
disperseV Vessel tag (Compose (MonoidalMap k) g)
y) (Vessel tag (Compose (MonoidalMap k) g)
 -> SubVessel k (Vessel tag) g)
-> m (Vessel tag (Compose (MonoidalMap k) g))
-> m (SubVessel k (Vessel tag) g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (v :: (* -> *) -> *).
 View v =>
 tag v
 -> v (Compose (MonoidalMap k) f)
 -> m (v (Compose (MonoidalMap k) g)))
-> Vessel tag (Compose (MonoidalMap k) f)
-> m (Vessel tag (Compose (MonoidalMap k) g))
forall (k :: ((* -> *) -> *) -> *) (m :: * -> *) (g :: * -> *)
       (h :: * -> *).
(GCompare k, Has View k, Applicative m) =>
(forall (v :: (* -> *) -> *). View v => k v -> v g -> m (v h))
-> Vessel k g -> m (Vessel k h)
traverseWithKeyV forall (v :: (* -> *) -> *).
tag v
-> v (Compose (MonoidalMap k) f)
-> m (v (Compose (MonoidalMap k) g))
forall (v :: (* -> *) -> *).
View v =>
tag v
-> v (Compose (MonoidalMap k) f)
-> m (v (Compose (MonoidalMap k) g))
f' (MonoidalMap k (Vessel tag f)
-> Vessel tag (Compose (MonoidalMap k) f)
forall k (v :: (* -> *) -> *) (g :: * -> *).
View v =>
MonoidalMap k (v g) -> v (Compose (MonoidalMap k) g)
condenseVMMap (MonoidalMap k (Vessel tag f)
 -> Vessel tag (Compose (MonoidalMap k) f))
-> MonoidalMap k (Vessel tag f)
-> Vessel tag (Compose (MonoidalMap k) f)
forall a b. (a -> b) -> a -> b
$ SubVessel k (Vessel tag) f -> MonoidalMap k (Vessel tag f)
forall k (v :: (* -> *) -> *) (f :: * -> *).
Ord k =>
SubVessel k v f -> MonoidalMap k (v f)
getSubVessel SubVessel k (Vessel tag) f
xs)
  where
    f' :: forall v.  tag v
       ->    v (Compose (MonoidalMap k) f)
       -> m (v (Compose (MonoidalMap k) g))
    f' :: tag v
-> v (Compose (MonoidalMap k) f)
-> m (v (Compose (MonoidalMap k) g))
f' tag v
tag v (Compose (MonoidalMap k) f)
xs' = tag v
-> (View v => m (v (Compose (MonoidalMap k) g)))
-> m (v (Compose (MonoidalMap k) g))
forall k (c :: k -> Constraint) (f :: k -> *) (a :: k) r.
Has c f =>
f a -> (c a => r) -> r
has @View tag v
tag ((View v => m (v (Compose (MonoidalMap k) g)))
 -> m (v (Compose (MonoidalMap k) g)))
-> (View v => m (v (Compose (MonoidalMap k) g)))
-> m (v (Compose (MonoidalMap k) g))
forall a b. (a -> b) -> a -> b
$ MonoidalMap k (v g) -> v (Compose (MonoidalMap k) g)
forall k (v :: (* -> *) -> *) (g :: * -> *).
View v =>
MonoidalMap k (v g) -> v (Compose (MonoidalMap k) g)
condenseVMMap (MonoidalMap k (v g) -> v (Compose (MonoidalMap k) g))
-> m (MonoidalMap k (v g)) -> m (v (Compose (MonoidalMap k) g))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> tag v -> MonoidalMap k (v f) -> m (MonoidalMap k (v g))
forall (v :: (* -> *) -> *).
tag v -> MonoidalMap k (v f) -> m (MonoidalMap k (v g))
f tag v
tag (v (Compose (MonoidalMap k) f) -> MonoidalMap k (v f)
forall (v :: (* -> *) -> *) (t :: * -> *) (g :: * -> *).
(View v, Align t) =>
v (Compose t g) -> t (v g)
disperseV v (Compose (MonoidalMap k) f)
xs')

-- | A gadget to "traverse" over all of the keys in a SubVessel, aligned to the keys nested inside a deeper Map, in one step
handleSubSubVesselSelector
  :: (Ord k1, Ord k2, Applicative m, Has View tag, GCompare tag)
  => (forall v. tag v -> MonoidalMap (k1, k2) (v f) -> m (MonoidalMap (k1, k2) (v g)))
  ->    MonoidalMap k1 (SubVessel k2 (Vessel tag) f)
  -> m (MonoidalMap k1 (SubVessel k2 (Vessel tag) g))
handleSubSubVesselSelector :: (forall (v :: (* -> *) -> *).
 tag v
 -> MonoidalMap (k1, k2) (v f) -> m (MonoidalMap (k1, k2) (v g)))
-> MonoidalMap k1 (SubVessel k2 (Vessel tag) f)
-> m (MonoidalMap k1 (SubVessel k2 (Vessel tag) g))
handleSubSubVesselSelector forall (v :: (* -> *) -> *).
tag v
-> MonoidalMap (k1, k2) (v f) -> m (MonoidalMap (k1, k2) (v g))
f MonoidalMap k1 (SubVessel k2 (Vessel tag) f)
xs = SubVessel (k1, k2) (Vessel tag) g
-> MonoidalMap k1 (SubVessel k2 (Vessel tag) g)
forall k1 k2 (v :: (* -> *) -> *) (f :: * -> *).
(Ord k1, Ord k2) =>
SubVessel (k1, k2) v f -> MonoidalMap k1 (SubVessel k2 v f)
currySubVessel (SubVessel (k1, k2) (Vessel tag) g
 -> MonoidalMap k1 (SubVessel k2 (Vessel tag) g))
-> m (SubVessel (k1, k2) (Vessel tag) g)
-> m (MonoidalMap k1 (SubVessel k2 (Vessel tag) g))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (v :: (* -> *) -> *).
 tag v
 -> MonoidalMap (k1, k2) (v f) -> m (MonoidalMap (k1, k2) (v g)))
-> SubVessel (k1, k2) (Vessel tag) f
-> m (SubVessel (k1, k2) (Vessel tag) g)
forall k (m :: * -> *) (tag :: ((* -> *) -> *) -> *) (f :: * -> *)
       (g :: * -> *).
(Ord k, Applicative m, Has View tag, GCompare tag) =>
(forall (v :: (* -> *) -> *).
 tag v -> MonoidalMap k (v f) -> m (MonoidalMap k (v g)))
-> SubVessel k (Vessel tag) f -> m (SubVessel k (Vessel tag) g)
handleSubVesselSelector forall (v :: (* -> *) -> *).
tag v
-> MonoidalMap (k1, k2) (v f) -> m (MonoidalMap (k1, k2) (v g))
f (MonoidalMap k1 (SubVessel k2 (Vessel tag) f)
-> SubVessel (k1, k2) (Vessel tag) f
forall k1 k2 (v :: (* -> *) -> *) (f :: * -> *).
(Ord k1, Ord k2) =>
MonoidalMap k1 (SubVessel k2 v f) -> SubVessel (k1, k2) v f
uncurrySubVessel MonoidalMap k1 (SubVessel k2 (Vessel tag) f)
xs)

instance (Ord k, View v) => EmptyView (SubVessel k v) where
  emptyV :: SubVessel k v f
emptyV = Vessel (SubVesselKey k v) f -> SubVessel k v f
forall k (v :: (* -> *) -> *) (f :: * -> *).
Vessel (SubVesselKey k v) f -> SubVessel k v f
SubVessel Vessel (SubVesselKey k v) f
forall (v :: (* -> *) -> *) (f :: * -> *). EmptyView v => v f
emptyV