{-# 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.Map where

import Control.Applicative
import Data.Aeson
import Data.Align
import Data.Foldable
import Data.Functor.Identity
import Data.Functor.Compose
import Data.Map.Monoidal (MonoidalMap (..))
import Data.Patch (Group(..), Additive)
import GHC.Generics
import qualified Data.Map.Monoidal as Map
import qualified Data.Map as Map'
import qualified Data.Map.Merge.Strict as Map'
import Data.Set (Set)

import Data.Vessel.Class hiding (empty)
import Data.Vessel.Selectable
import Data.Vessel.Disperse
import Data.Vessel.ViewMorphism

-- | A functor-indexed container corresponding to Map k v.
newtype MapV k v g = MapV { MapV k v g -> MonoidalMap k (g v)
unMapV :: MonoidalMap k (g v) }
  deriving (MapV k v g -> MapV k v g -> Bool
(MapV k v g -> MapV k v g -> Bool)
-> (MapV k v g -> MapV k v g -> Bool) -> Eq (MapV k v g)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k k (v :: k) (g :: k -> *).
(Eq k, Eq (g v)) =>
MapV k v g -> MapV k v g -> Bool
/= :: MapV k v g -> MapV k v g -> Bool
$c/= :: forall k k (v :: k) (g :: k -> *).
(Eq k, Eq (g v)) =>
MapV k v g -> MapV k v g -> Bool
== :: MapV k v g -> MapV k v g -> Bool
$c== :: forall k k (v :: k) (g :: k -> *).
(Eq k, Eq (g v)) =>
MapV k v g -> MapV k v g -> Bool
Eq, Eq (MapV k v g)
Eq (MapV k v g)
-> (MapV k v g -> MapV k v g -> Ordering)
-> (MapV k v g -> MapV k v g -> Bool)
-> (MapV k v g -> MapV k v g -> Bool)
-> (MapV k v g -> MapV k v g -> Bool)
-> (MapV k v g -> MapV k v g -> Bool)
-> (MapV k v g -> MapV k v g -> MapV k v g)
-> (MapV k v g -> MapV k v g -> MapV k v g)
-> Ord (MapV k v g)
MapV k v g -> MapV k v g -> Bool
MapV k v g -> MapV k v g -> Ordering
MapV k v g -> MapV k v g -> MapV k v g
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k k (v :: k) (g :: k -> *).
(Ord k, Ord (g v)) =>
Eq (MapV k v g)
forall k k (v :: k) (g :: k -> *).
(Ord k, Ord (g v)) =>
MapV k v g -> MapV k v g -> Bool
forall k k (v :: k) (g :: k -> *).
(Ord k, Ord (g v)) =>
MapV k v g -> MapV k v g -> Ordering
forall k k (v :: k) (g :: k -> *).
(Ord k, Ord (g v)) =>
MapV k v g -> MapV k v g -> MapV k v g
min :: MapV k v g -> MapV k v g -> MapV k v g
$cmin :: forall k k (v :: k) (g :: k -> *).
(Ord k, Ord (g v)) =>
MapV k v g -> MapV k v g -> MapV k v g
max :: MapV k v g -> MapV k v g -> MapV k v g
$cmax :: forall k k (v :: k) (g :: k -> *).
(Ord k, Ord (g v)) =>
MapV k v g -> MapV k v g -> MapV k v g
>= :: MapV k v g -> MapV k v g -> Bool
$c>= :: forall k k (v :: k) (g :: k -> *).
(Ord k, Ord (g v)) =>
MapV k v g -> MapV k v g -> Bool
> :: MapV k v g -> MapV k v g -> Bool
$c> :: forall k k (v :: k) (g :: k -> *).
(Ord k, Ord (g v)) =>
MapV k v g -> MapV k v g -> Bool
<= :: MapV k v g -> MapV k v g -> Bool
$c<= :: forall k k (v :: k) (g :: k -> *).
(Ord k, Ord (g v)) =>
MapV k v g -> MapV k v g -> Bool
< :: MapV k v g -> MapV k v g -> Bool
$c< :: forall k k (v :: k) (g :: k -> *).
(Ord k, Ord (g v)) =>
MapV k v g -> MapV k v g -> Bool
compare :: MapV k v g -> MapV k v g -> Ordering
$ccompare :: forall k k (v :: k) (g :: k -> *).
(Ord k, Ord (g v)) =>
MapV k v g -> MapV k v g -> Ordering
$cp1Ord :: forall k k (v :: k) (g :: k -> *).
(Ord k, Ord (g v)) =>
Eq (MapV k v g)
Ord, Int -> MapV k v g -> ShowS
[MapV k v g] -> ShowS
MapV k v g -> String
(Int -> MapV k v g -> ShowS)
-> (MapV k v g -> String)
-> ([MapV k v g] -> ShowS)
-> Show (MapV k v g)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k k (v :: k) (g :: k -> *).
(Show k, Show (g v)) =>
Int -> MapV k v g -> ShowS
forall k k (v :: k) (g :: k -> *).
(Show k, Show (g v)) =>
[MapV k v g] -> ShowS
forall k k (v :: k) (g :: k -> *).
(Show k, Show (g v)) =>
MapV k v g -> String
showList :: [MapV k v g] -> ShowS
$cshowList :: forall k k (v :: k) (g :: k -> *).
(Show k, Show (g v)) =>
[MapV k v g] -> ShowS
show :: MapV k v g -> String
$cshow :: forall k k (v :: k) (g :: k -> *).
(Show k, Show (g v)) =>
MapV k v g -> String
showsPrec :: Int -> MapV k v g -> ShowS
$cshowsPrec :: forall k k (v :: k) (g :: k -> *).
(Show k, Show (g v)) =>
Int -> MapV k v g -> ShowS
Show, ReadPrec [MapV k v g]
ReadPrec (MapV k v g)
Int -> ReadS (MapV k v g)
ReadS [MapV k v g]
(Int -> ReadS (MapV k v g))
-> ReadS [MapV k v g]
-> ReadPrec (MapV k v g)
-> ReadPrec [MapV k v g]
-> Read (MapV k v g)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall k k (v :: k) (g :: k -> *).
(Ord k, Read k, Read (g v)) =>
ReadPrec [MapV k v g]
forall k k (v :: k) (g :: k -> *).
(Ord k, Read k, Read (g v)) =>
ReadPrec (MapV k v g)
forall k k (v :: k) (g :: k -> *).
(Ord k, Read k, Read (g v)) =>
Int -> ReadS (MapV k v g)
forall k k (v :: k) (g :: k -> *).
(Ord k, Read k, Read (g v)) =>
ReadS [MapV k v g]
readListPrec :: ReadPrec [MapV k v g]
$creadListPrec :: forall k k (v :: k) (g :: k -> *).
(Ord k, Read k, Read (g v)) =>
ReadPrec [MapV k v g]
readPrec :: ReadPrec (MapV k v g)
$creadPrec :: forall k k (v :: k) (g :: k -> *).
(Ord k, Read k, Read (g v)) =>
ReadPrec (MapV k v g)
readList :: ReadS [MapV k v g]
$creadList :: forall k k (v :: k) (g :: k -> *).
(Ord k, Read k, Read (g v)) =>
ReadS [MapV k v g]
readsPrec :: Int -> ReadS (MapV k v g)
$creadsPrec :: forall k k (v :: k) (g :: k -> *).
(Ord k, Read k, Read (g v)) =>
Int -> ReadS (MapV k v g)
Read, (forall x. MapV k v g -> Rep (MapV k v g) x)
-> (forall x. Rep (MapV k v g) x -> MapV k v g)
-> Generic (MapV k v g)
forall x. Rep (MapV k v g) x -> MapV k v g
forall x. MapV k v g -> Rep (MapV k v g) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k k (v :: k) (g :: k -> *) x.
Rep (MapV k v g) x -> MapV k v g
forall k k (v :: k) (g :: k -> *) x.
MapV k v g -> Rep (MapV k v g) x
$cto :: forall k k (v :: k) (g :: k -> *) x.
Rep (MapV k v g) x -> MapV k v g
$cfrom :: forall k k (v :: k) (g :: k -> *) x.
MapV k v g -> Rep (MapV k v g) x
Generic)

deriving instance (Semigroup v, Ord k) => Semigroup (MapV k v Identity)
deriving instance (Semigroup v, Ord k) => Monoid (MapV k v Identity)
deriving instance (Ord k1, Ord k2, Semigroup v) => Semigroup (MapV k1 v (Compose (MonoidalMap k2) Identity))

instance (Ord k, Eq g, Monoid g) => Semigroup (MapV k v (Const g)) where
  MapV (MonoidalMap Map k (Const g v)
xs) <> :: MapV k v (Const g) -> MapV k v (Const g) -> MapV k v (Const g)
<> MapV (MonoidalMap Map k (Const g v)
ys) = MonoidalMap k (Const g v) -> MapV k v (Const g)
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV (MonoidalMap k (Const g v) -> MapV k v (Const g))
-> MonoidalMap k (Const g v) -> MapV k v (Const g)
forall a b. (a -> b) -> a -> b
$ Map k (Const g v) -> MonoidalMap k (Const g v)
forall k a. Map k a -> MonoidalMap k a
MonoidalMap (Map k (Const g v) -> MonoidalMap k (Const g v))
-> Map k (Const g v) -> MonoidalMap k (Const g v)
forall a b. (a -> b) -> a -> b
$ SimpleWhenMissing k (Const g v) (Const g v)
-> SimpleWhenMissing k (Const g v) (Const g v)
-> SimpleWhenMatched k (Const g v) (Const g v) (Const g v)
-> Map k (Const g v)
-> Map k (Const g v)
-> Map k (Const g v)
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Map'.merge SimpleWhenMissing k (Const g v) (Const g v)
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map'.preserveMissing SimpleWhenMissing k (Const g v) (Const g v)
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map'.preserveMissing ((k -> Const g v -> Const g v -> Maybe (Const g v))
-> SimpleWhenMatched k (Const g v) (Const g v) (Const g v)
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
Map'.zipWithMaybeMatched ((k -> Const g v -> Const g v -> Maybe (Const g v))
 -> SimpleWhenMatched k (Const g v) (Const g v) (Const g v))
-> (k -> Const g v -> Const g v -> Maybe (Const g v))
-> SimpleWhenMatched k (Const g v) (Const g v) (Const g v)
forall a b. (a -> b) -> a -> b
$ \k
_ (Const g
x) (Const g
y) -> g -> g -> Maybe (Const g v)
f g
x g
y) Map k (Const g v)
xs Map k (Const g v)
ys
    where
      f :: g -> g -> Maybe (Const g v)
      f :: g -> g -> Maybe (Const g v)
f g
x g
y = if g
xy g -> g -> Bool
forall a. Eq a => a -> a -> Bool
== g
forall a. Monoid a => a
mempty then Maybe (Const g v)
forall a. Maybe a
Nothing else Const g v -> Maybe (Const g v)
forall a. a -> Maybe a
Just (g -> Const g v
forall k a (b :: k). a -> Const a b
Const g
xy)
        where
          xy :: g
xy = g
x g -> g -> g
forall a. Semigroup a => a -> a -> a
<> g
y

instance (Ord k, Eq g, Monoid g) => Monoid (MapV k v (Const g)) where
  mappend :: MapV k v (Const g) -> MapV k v (Const g) -> MapV k v (Const g)
mappend = MapV k v (Const g) -> MapV k v (Const g) -> MapV k v (Const g)
forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: MapV k v (Const g)
mempty = MonoidalMap k (Const g v) -> MapV k v (Const g)
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV MonoidalMap k (Const g v)
forall k a. MonoidalMap k a
Map.empty

instance (Ord k, Eq g, Group g) => Group (MapV k v (Const g)) where
  negateG :: MapV k v (Const g) -> MapV k v (Const g)
negateG (MapV (MonoidalMap Map k (Const g v)
xs)) = MonoidalMap k (Const g v) -> MapV k v (Const g)
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV (MonoidalMap k (Const g v) -> MapV k v (Const g))
-> MonoidalMap k (Const g v) -> MapV k v (Const g)
forall a b. (a -> b) -> a -> b
$ Map k (Const g v) -> MonoidalMap k (Const g v)
forall k a. Map k a -> MonoidalMap k a
MonoidalMap (Map k (Const g v) -> MonoidalMap k (Const g v))
-> Map k (Const g v) -> MonoidalMap k (Const g v)
forall a b. (a -> b) -> a -> b
$ (Const g v -> Const g v) -> Map k (Const g v) -> Map k (Const g v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Const g v -> Const g v
forall q. Group q => q -> q
negateG Map k (Const g v)
xs
instance (Ord k, Eq g, Group g, Additive g) => Additive (MapV k v (Const g))

instance (Ord k1, Ord k2, Monoid g, Eq g) => Semigroup (MapV k1 v (Compose (MonoidalMap k2) (Const g))) where
  MapV (MonoidalMap Map k1 (Compose (MonoidalMap k2) (Const g) v)
xs) <> :: MapV k1 v (Compose (MonoidalMap k2) (Const g))
-> MapV k1 v (Compose (MonoidalMap k2) (Const g))
-> MapV k1 v (Compose (MonoidalMap k2) (Const g))
<> MapV (MonoidalMap Map k1 (Compose (MonoidalMap k2) (Const g) v)
ys) = MonoidalMap k1 (Compose (MonoidalMap k2) (Const g) v)
-> MapV k1 v (Compose (MonoidalMap k2) (Const g))
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV (MonoidalMap k1 (Compose (MonoidalMap k2) (Const g) v)
 -> MapV k1 v (Compose (MonoidalMap k2) (Const g)))
-> MonoidalMap k1 (Compose (MonoidalMap k2) (Const g) v)
-> MapV k1 v (Compose (MonoidalMap k2) (Const g))
forall a b. (a -> b) -> a -> b
$ Map k1 (Compose (MonoidalMap k2) (Const g) v)
-> MonoidalMap k1 (Compose (MonoidalMap k2) (Const g) v)
forall k a. Map k a -> MonoidalMap k a
MonoidalMap (Map k1 (Compose (MonoidalMap k2) (Const g) v)
 -> MonoidalMap k1 (Compose (MonoidalMap k2) (Const g) v))
-> Map k1 (Compose (MonoidalMap k2) (Const g) v)
-> MonoidalMap k1 (Compose (MonoidalMap k2) (Const g) v)
forall a b. (a -> b) -> a -> b
$ SimpleWhenMissing
  k1
  (Compose (MonoidalMap k2) (Const g) v)
  (Compose (MonoidalMap k2) (Const g) v)
-> SimpleWhenMissing
     k1
     (Compose (MonoidalMap k2) (Const g) v)
     (Compose (MonoidalMap k2) (Const g) v)
-> SimpleWhenMatched
     k1
     (Compose (MonoidalMap k2) (Const g) v)
     (Compose (MonoidalMap k2) (Const g) v)
     (Compose (MonoidalMap k2) (Const g) v)
-> Map k1 (Compose (MonoidalMap k2) (Const g) v)
-> Map k1 (Compose (MonoidalMap k2) (Const g) v)
-> Map k1 (Compose (MonoidalMap k2) (Const g) v)
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Map'.merge SimpleWhenMissing
  k1
  (Compose (MonoidalMap k2) (Const g) v)
  (Compose (MonoidalMap k2) (Const g) v)
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map'.preserveMissing SimpleWhenMissing
  k1
  (Compose (MonoidalMap k2) (Const g) v)
  (Compose (MonoidalMap k2) (Const g) v)
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map'.preserveMissing ((k1
 -> Compose (MonoidalMap k2) (Const g) v
 -> Compose (MonoidalMap k2) (Const g) v
 -> Maybe (Compose (MonoidalMap k2) (Const g) v))
-> SimpleWhenMatched
     k1
     (Compose (MonoidalMap k2) (Const g) v)
     (Compose (MonoidalMap k2) (Const g) v)
     (Compose (MonoidalMap k2) (Const g) v)
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
Map'.zipWithMaybeMatched ((k1
  -> Compose (MonoidalMap k2) (Const g) v
  -> Compose (MonoidalMap k2) (Const g) v
  -> Maybe (Compose (MonoidalMap k2) (Const g) v))
 -> SimpleWhenMatched
      k1
      (Compose (MonoidalMap k2) (Const g) v)
      (Compose (MonoidalMap k2) (Const g) v)
      (Compose (MonoidalMap k2) (Const g) v))
-> (k1
    -> Compose (MonoidalMap k2) (Const g) v
    -> Compose (MonoidalMap k2) (Const g) v
    -> Maybe (Compose (MonoidalMap k2) (Const g) v))
-> SimpleWhenMatched
     k1
     (Compose (MonoidalMap k2) (Const g) v)
     (Compose (MonoidalMap k2) (Const g) v)
     (Compose (MonoidalMap k2) (Const g) v)
forall a b. (a -> b) -> a -> b
$ \k1
_ (Compose (MonoidalMap Map k2 (Const g v)
x)) (Compose (MonoidalMap Map k2 (Const g v)
y)) -> (MonoidalMap k2 (Const g v)
 -> Compose (MonoidalMap k2) (Const g) v)
-> Maybe (MonoidalMap k2 (Const g v))
-> Maybe (Compose (MonoidalMap k2) (Const g) v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MonoidalMap k2 (Const g v) -> Compose (MonoidalMap k2) (Const g) v
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Maybe (MonoidalMap k2 (Const g v))
 -> Maybe (Compose (MonoidalMap k2) (Const g) v))
-> Maybe (MonoidalMap k2 (Const g v))
-> Maybe (Compose (MonoidalMap k2) (Const g) v)
forall a b. (a -> b) -> a -> b
$ MonoidalMap k2 (Const g v) -> Maybe (MonoidalMap k2 (Const g v))
forall (f :: * -> *) a. Foldable f => f a -> Maybe (f a)
nothingOnNull (MonoidalMap k2 (Const g v) -> Maybe (MonoidalMap k2 (Const g v)))
-> MonoidalMap k2 (Const g v) -> Maybe (MonoidalMap k2 (Const g v))
forall a b. (a -> b) -> a -> b
$ Map k2 (Const g v) -> MonoidalMap k2 (Const g v)
forall k a. Map k a -> MonoidalMap k a
MonoidalMap (Map k2 (Const g v) -> MonoidalMap k2 (Const g v))
-> Map k2 (Const g v) -> MonoidalMap k2 (Const g v)
forall a b. (a -> b) -> a -> b
$ Map k2 (Const g v) -> Map k2 (Const g v) -> Map k2 (Const g v)
forall k g.
(Ord k, Monoid g, Eq g) =>
Map k g -> Map k g -> Map k g
mergeMapSemigroup Map k2 (Const g v)
x Map k2 (Const g v)
y) Map k1 (Compose (MonoidalMap k2) (Const g) v)
xs Map k1 (Compose (MonoidalMap k2) (Const g) v)
ys
    where
      nothingOnNull :: Foldable f => f a -> Maybe (f a)
      nothingOnNull :: f a -> Maybe (f a)
nothingOnNull f a
f = if f a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null f a
f then Maybe (f a)
forall a. Maybe a
Nothing else f a -> Maybe (f a)
forall a. a -> Maybe a
Just f a
f

      mergeMapSemigroup :: forall k g. (Ord k, Monoid g, Eq g) => Map'.Map k g -> Map'.Map k g -> Map'.Map k g
      mergeMapSemigroup :: Map k g -> Map k g -> Map k g
mergeMapSemigroup = SimpleWhenMissing k g g
-> SimpleWhenMissing k g g
-> SimpleWhenMatched k g g g
-> Map k g
-> Map k g
-> Map k g
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Map'.merge SimpleWhenMissing k g g
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map'.preserveMissing SimpleWhenMissing k g g
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map'.preserveMissing ((k -> g -> g -> Maybe g) -> SimpleWhenMatched k g g g
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
Map'.zipWithMaybeMatched ((k -> g -> g -> Maybe g) -> SimpleWhenMatched k g g g)
-> (k -> g -> g -> Maybe g) -> SimpleWhenMatched k g g g
forall a b. (a -> b) -> a -> b
$ (g -> g -> Maybe g) -> k -> g -> g -> Maybe g
forall a b. a -> b -> a
const g -> g -> Maybe g
f)
          where
            f :: g -> g -> Maybe g
            f :: g -> g -> Maybe g
f g
x g
y = if g
xy g -> g -> Bool
forall a. Eq a => a -> a -> Bool
== g
forall a. Monoid a => a
mempty then Maybe g
forall a. Maybe a
Nothing else g -> Maybe g
forall a. a -> Maybe a
Just g
xy
              where
                xy :: g
xy = g
x g -> g -> g
forall a. Semigroup a => a -> a -> a
<> g
y

instance (Ord k1, Ord k2, Monoid g, Eq g) => Monoid (MapV k1 v (Compose (MonoidalMap k2) (Const g))) where
  mappend :: MapV k1 v (Compose (MonoidalMap k2) (Const g))
-> MapV k1 v (Compose (MonoidalMap k2) (Const g))
-> MapV k1 v (Compose (MonoidalMap k2) (Const g))
mappend = MapV k1 v (Compose (MonoidalMap k2) (Const g))
-> MapV k1 v (Compose (MonoidalMap k2) (Const g))
-> MapV k1 v (Compose (MonoidalMap k2) (Const g))
forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: MapV k1 v (Compose (MonoidalMap k2) (Const g))
mempty = MonoidalMap k1 (Compose (MonoidalMap k2) (Const g) v)
-> MapV k1 v (Compose (MonoidalMap k2) (Const g))
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV MonoidalMap k1 (Compose (MonoidalMap k2) (Const g) v)
forall k a. MonoidalMap k a
Map.empty

instance (Ord k1, Ord k2, Group g, Eq g) => Group (MapV k1 v (Compose (MonoidalMap k2) (Const g))) where
  negateG :: MapV k1 v (Compose (MonoidalMap k2) (Const g))
-> MapV k1 v (Compose (MonoidalMap k2) (Const g))
negateG (MapV MonoidalMap k1 (Compose (MonoidalMap k2) (Const g) v)
xs) = MonoidalMap k1 (Compose (MonoidalMap k2) (Const g) v)
-> MapV k1 v (Compose (MonoidalMap k2) (Const g))
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV (MonoidalMap k1 (Compose (MonoidalMap k2) (Const g) v)
 -> MapV k1 v (Compose (MonoidalMap k2) (Const g)))
-> MonoidalMap k1 (Compose (MonoidalMap k2) (Const g) v)
-> MapV k1 v (Compose (MonoidalMap k2) (Const g))
forall a b. (a -> b) -> a -> b
$ (Compose (MonoidalMap k2) (Const g) v
 -> Compose (MonoidalMap k2) (Const g) v)
-> MonoidalMap k1 (Compose (MonoidalMap k2) (Const g) v)
-> MonoidalMap k1 (Compose (MonoidalMap k2) (Const g) v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Compose (MonoidalMap k2) (Const g) v
-> Compose (MonoidalMap k2) (Const g) v
forall q. Group q => q -> q
negateG MonoidalMap k1 (Compose (MonoidalMap k2) (Const g) v)
xs
instance (Ord k1, Ord k2, Additive g, Group g, Eq g) => Additive (MapV k1 v (Compose (MonoidalMap k2) (Const g)))

instance (Ord k) => View (MapV k v) where
  cropV :: (forall a. s a -> i a -> r a)
-> MapV k v s -> MapV k v i -> Maybe (MapV k v r)
cropV forall a. s a -> i a -> r a
f (MapV MonoidalMap k (s v)
s) (MapV MonoidalMap k (i v)
i) = MapV k v r -> Maybe (MapV k v r)
forall (v :: (* -> *) -> *) (f :: * -> *).
View v =>
v f -> Maybe (v f)
collapseNullV (MapV k v r -> Maybe (MapV k v r))
-> MapV k v r -> Maybe (MapV k v r)
forall a b. (a -> b) -> a -> b
$ MonoidalMap k (r v) -> MapV k v r
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV ((k -> s v -> i v -> r v)
-> MonoidalMap k (s v)
-> MonoidalMap k (i v)
-> MonoidalMap k (r v)
forall k a b c.
Ord k =>
(k -> a -> b -> c)
-> MonoidalMap k a -> MonoidalMap k b -> MonoidalMap k c
Map.intersectionWithKey (\k
_ s v
x i v
y -> s v -> i v -> r v
forall a. s a -> i a -> r a
f s v
x i v
y) MonoidalMap k (s v)
s MonoidalMap k (i v)
i)
  nullV :: MapV k v i -> Bool
nullV (MapV MonoidalMap k (i v)
m) = MonoidalMap k (i v) -> Bool
forall k a. MonoidalMap k a -> Bool
Map.null MonoidalMap k (i v)
m
  condenseV :: t (MapV k v g) -> MapV k v (Compose t g)
condenseV t (MapV k v g)
m = MonoidalMap k (Compose t g v) -> MapV k v (Compose t g)
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV (MonoidalMap k (Compose t g v) -> MapV k v (Compose t g))
-> (t (MapV k v g) -> MonoidalMap k (Compose t g v))
-> t (MapV k v g)
-> MapV k v (Compose t g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t (g v) -> Compose t g v)
-> MonoidalMap k (t (g v)) -> MonoidalMap k (Compose t g v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t (g v) -> Compose t g v
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (MonoidalMap k (t (g v)) -> MonoidalMap k (Compose t g v))
-> (t (MapV k v g) -> MonoidalMap k (t (g v)))
-> t (MapV k v g)
-> MonoidalMap k (Compose t g v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (MonoidalMap k (g v)) -> MonoidalMap k (t (g v))
forall (row :: * -> *) (col :: * -> *) a.
(Disperse row, Foldable col, Filterable col, Functor col) =>
col (row a) -> row (col a)
disperse (t (MonoidalMap k (g v)) -> MonoidalMap k (t (g v)))
-> (t (MapV k v g) -> t (MonoidalMap k (g v)))
-> t (MapV k v g)
-> MonoidalMap k (t (g v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MapV k v g -> MonoidalMap k (g v))
-> t (MapV k v g) -> t (MonoidalMap k (g v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MapV k v g -> MonoidalMap k (g v)
forall k k (v :: k) (g :: k -> *).
MapV k v g -> MonoidalMap k (g v)
unMapV (t (MapV k v g) -> MapV k v (Compose t g))
-> t (MapV k v g) -> MapV k v (Compose t g)
forall a b. (a -> b) -> a -> b
$ t (MapV k v g)
m
  disperseV :: MapV k v (Compose t g) -> t (MapV k v g)
disperseV (MapV MonoidalMap k (Compose t g v)
m) = (MonoidalMap k (g v) -> MapV k v g)
-> t (MonoidalMap k (g v)) -> t (MapV k v g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MonoidalMap k (g v) -> MapV k v g
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV (t (MonoidalMap k (g v)) -> t (MapV k v g))
-> (MonoidalMap k (Compose t g v) -> t (MonoidalMap k (g v)))
-> MonoidalMap k (Compose t g v)
-> t (MapV k v g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonoidalMap k (t (g v)) -> t (MonoidalMap k (g v))
forall (row :: * -> *) (col :: * -> *) a.
(Disperse row, Align col) =>
row (col a) -> col (row a)
condense (MonoidalMap k (t (g v)) -> t (MonoidalMap k (g v)))
-> (MonoidalMap k (Compose t g v) -> MonoidalMap k (t (g v)))
-> MonoidalMap k (Compose t g v)
-> t (MonoidalMap k (g v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Compose t g v -> t (g v))
-> MonoidalMap k (Compose t g v) -> MonoidalMap k (t (g v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Compose t g v -> t (g v)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (MonoidalMap k (Compose t g v) -> t (MapV k v g))
-> MonoidalMap k (Compose t g v) -> t (MapV k v g)
forall a b. (a -> b) -> a -> b
$ MonoidalMap k (Compose t g v)
m
  mapV :: (forall a. f a -> g a) -> MapV k v f -> MapV k v g
mapV forall a. f a -> g a
f (MapV MonoidalMap k (f v)
m) = MonoidalMap k (g v) -> MapV k v g
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV (MonoidalMap k (g v) -> MapV k v g)
-> MonoidalMap k (g v) -> MapV k v g
forall a b. (a -> b) -> a -> b
$ (f v -> g v) -> MonoidalMap k (f v) -> MonoidalMap k (g v)
forall a b k. (a -> b) -> MonoidalMap k a -> MonoidalMap k b
Map.map f v -> g v
forall a. f a -> g a
f MonoidalMap k (f v)
m
  traverseV :: (forall a. f a -> m (g a)) -> MapV k v f -> m (MapV k v g)
traverseV forall a. f a -> m (g a)
f (MapV MonoidalMap k (f v)
m) = MonoidalMap k (g v) -> MapV k v g
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV (MonoidalMap k (g v) -> MapV k v g)
-> m (MonoidalMap k (g v)) -> m (MapV k v g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (f v -> m (g v)) -> MonoidalMap k (f v) -> m (MonoidalMap k (g v))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse f v -> m (g v)
forall a. f a -> m (g a)
f MonoidalMap k (f v)
m
  mapMaybeV :: (forall a. f a -> Maybe (g a)) -> MapV k v f -> Maybe (MapV k v g)
mapMaybeV forall a. f a -> Maybe (g a)
f (MapV MonoidalMap k (f v)
m) = MapV k v g -> Maybe (MapV k v g)
forall (v :: (* -> *) -> *) (f :: * -> *).
View v =>
v f -> Maybe (v f)
collapseNullV (MapV k v g -> Maybe (MapV k v g))
-> MapV k v g -> Maybe (MapV k v g)
forall a b. (a -> b) -> a -> b
$ MonoidalMap k (g v) -> MapV k v g
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV (MonoidalMap k (g v) -> MapV k v g)
-> MonoidalMap k (g v) -> MapV k v g
forall a b. (a -> b) -> a -> b
$ (f v -> Maybe (g v)) -> MonoidalMap k (f v) -> MonoidalMap k (g v)
forall k a b. (a -> Maybe b) -> MonoidalMap k a -> MonoidalMap k b
Map.mapMaybe f v -> Maybe (g v)
forall a. f a -> Maybe (g a)
f MonoidalMap k (f v)
m
  alignWithMaybeV :: (forall a. These (f a) (g a) -> Maybe (h a))
-> MapV k v f -> MapV k v g -> Maybe (MapV k v h)
alignWithMaybeV forall a. These (f a) (g a) -> Maybe (h a)
f (MapV (MonoidalMap Map k (f v)
a)) (MapV (MonoidalMap Map k (g v)
b)) = MapV k v h -> Maybe (MapV k v h)
forall (v :: (* -> *) -> *) (f :: * -> *).
View v =>
v f -> Maybe (v f)
collapseNullV (MapV k v h -> Maybe (MapV k v h))
-> MapV k v h -> Maybe (MapV k v h)
forall a b. (a -> b) -> a -> b
$ MonoidalMap k (h v) -> MapV k v h
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV (MonoidalMap k (h v) -> MapV k v h)
-> MonoidalMap k (h v) -> MapV k v h
forall a b. (a -> b) -> a -> b
$ Map k (h v) -> MonoidalMap k (h v)
forall k a. Map k a -> MonoidalMap k a
MonoidalMap (Map k (h v) -> MonoidalMap k (h v))
-> Map k (h v) -> MonoidalMap k (h v)
forall a b. (a -> b) -> a -> b
$ (Maybe (h v) -> Maybe (h v)) -> Map k (Maybe (h v)) -> Map k (h v)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map'.mapMaybe Maybe (h v) -> Maybe (h v)
forall a. a -> a
id (Map k (Maybe (h v)) -> Map k (h v))
-> Map k (Maybe (h v)) -> Map k (h v)
forall a b. (a -> b) -> a -> b
$ (These (f v) (g v) -> Maybe (h v))
-> Map k (f v) -> Map k (g v) -> Map k (Maybe (h v))
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith These (f v) (g v) -> Maybe (h v)
forall a. These (f a) (g a) -> Maybe (h a)
f Map k (f v)
a Map k (g v)
b
  alignWithV :: (forall a. These (f a) (g a) -> h a)
-> MapV k v f -> MapV k v g -> MapV k v h
alignWithV forall a. These (f a) (g a) -> h a
f (MapV (MonoidalMap Map k (f v)
a)) (MapV (MonoidalMap Map k (g v)
b)) = MonoidalMap k (h v) -> MapV k v h
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV (MonoidalMap k (h v) -> MapV k v h)
-> MonoidalMap k (h v) -> MapV k v h
forall a b. (a -> b) -> a -> b
$ Map k (h v) -> MonoidalMap k (h v)
forall k a. Map k a -> MonoidalMap k a
MonoidalMap (Map k (h v) -> MonoidalMap k (h v))
-> Map k (h v) -> MonoidalMap k (h v)
forall a b. (a -> b) -> a -> b
$ (These (f v) (g v) -> h v)
-> Map k (f v) -> Map k (g v) -> Map k (h v)
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith These (f v) (g v) -> h v
forall a. These (f a) (g a) -> h a
f Map k (f v)
a Map k (g v)
b

instance (Ord k) => EmptyView (MapV k v) where
  emptyV :: MapV k v f
emptyV = MonoidalMap k (f v) -> MapV k v f
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV MonoidalMap k (f v)
forall k a. MonoidalMap k a
Map.empty

deriving instance (ToJSONKey k, ToJSON (g v), Ord k) => ToJSON (MapV k v g)
deriving instance (FromJSONKey k, FromJSON (g v), Ord k) => FromJSON (MapV k v g)

instance (Ord k) => Selectable (MapV k v) (Set k) where
  type Selection (MapV k v) (Set k) = MonoidalMap k v
  selector :: (forall a. p a) -> Set k -> MapV k v p
selector forall a. p a
p Set k
s = MonoidalMap k (p v) -> MapV k v p
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV ((k -> p v) -> Set k -> MonoidalMap k (p v)
forall k a. (k -> a) -> Set k -> MonoidalMap k a
Map.fromSet (p v -> k -> p v
forall a b. a -> b -> a
const p v
forall a. p a
p) Set k
s)
  selection :: Set k -> MapV k v Identity -> Selection (MapV k v) (Set k)
selection Set k
_ (MapV MonoidalMap k (Identity v)
m) = (Identity v -> v) -> MonoidalMap k (Identity v) -> MonoidalMap k v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Identity v
a) -> v
a) MonoidalMap k (Identity v)
m

instance Ord k => Selectable (MapV k v) (Identity k) where
  type Selection (MapV k v) (Identity k) = Maybe v
  selector :: (forall a. p a) -> Identity k -> MapV k v p
selector forall a. p a
p (Identity k
k) = MonoidalMap k (p v) -> MapV k v p
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV (k -> p v -> MonoidalMap k (p v)
forall k a. k -> a -> MonoidalMap k a
Map.singleton k
k p v
forall a. p a
p)
  selection :: Identity k
-> MapV k v Identity -> Selection (MapV k v) (Identity k)
selection (Identity k
k) (MapV MonoidalMap k (Identity v)
m) = k -> MonoidalMap k v -> Maybe v
forall k a. Ord k => k -> MonoidalMap k a -> Maybe a
Map.lookup k
k (MonoidalMap k v -> Maybe v) -> MonoidalMap k v -> Maybe v
forall a b. (a -> b) -> a -> b
$ (Identity v -> v) -> MonoidalMap k (Identity v) -> MonoidalMap k v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Identity v
a) -> v
a) MonoidalMap k (Identity v)
m

singletonMapV :: k -> g v -> MapV k v g
singletonMapV :: k -> g v -> MapV k v g
singletonMapV k
k g v
v = MonoidalMap k (g v) -> MapV k v g
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV (MonoidalMap k (g v) -> MapV k v g)
-> MonoidalMap k (g v) -> MapV k v g
forall a b. (a -> b) -> a -> b
$ k -> g v -> MonoidalMap k (g v)
forall k a. k -> a -> MonoidalMap k a
Map.singleton k
k g v
v

lookupMapV :: Ord k => k -> MapV k v g -> Maybe (g v)
lookupMapV :: k -> MapV k v g -> Maybe (g v)
lookupMapV k
k (MapV MonoidalMap k (g v)
xs) = k -> MonoidalMap k (g v) -> Maybe (g v)
forall k a. Ord k => k -> MonoidalMap k a -> Maybe a
Map.lookup k
k MonoidalMap k (g v)
xs

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

mapVMorphism
  :: ( Ord k , ViewQueryResult (g v) ~ ViewQueryResult g v, Alternative n, Applicative m)
  => k -> ViewMorphism m n (g v) (MapV k v g)
mapVMorphism :: k -> ViewMorphism m n (g v) (MapV k v g)
mapVMorphism k
k = ViewHalfMorphism m n (g v) (MapV k v g)
-> ViewHalfMorphism n m (MapV k v g) (g v)
-> ViewMorphism m n (g v) (MapV 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 (g v) (MapV k v g)
forall k k (g :: k -> *) (v :: k) (n :: * -> *) (m :: * -> *).
(Ord k, ViewQueryResult (g v) ~ ViewQueryResult g v, Alternative n,
 Applicative m) =>
k -> ViewHalfMorphism m n (g v) (MapV k v g)
toMapVMorphism k
k) (k -> ViewHalfMorphism n m (MapV k v g) (g v)
forall k (m :: * -> *) (n :: * -> *) k (g :: k -> *) (v :: k).
(Alternative m, Applicative n, Ord k,
 ViewQueryResult (g v) ~ ViewQueryResult g v) =>
k -> ViewHalfMorphism m n (MapV k v g) (g v)
fromMapVMorphism k
k)

toMapVMorphism
  :: ( Ord k , ViewQueryResult (g v) ~ ViewQueryResult g v, Alternative n, Applicative m)
  => k -> ViewHalfMorphism m n (g v) (MapV k v g)
toMapVMorphism :: k -> ViewHalfMorphism m n (g v) (MapV k v g)
toMapVMorphism k
k = ViewHalfMorphism :: forall (m :: * -> *) (n :: * -> *) p q.
(p -> m q)
-> (ViewQueryResult q -> n (ViewQueryResult p))
-> ViewHalfMorphism m n p q
ViewHalfMorphism
  { _viewMorphism_mapQuery :: g v -> m (MapV k v g)
_viewMorphism_mapQuery = MapV k v g -> m (MapV k v g)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MapV k v g -> m (MapV k v g))
-> (g v -> MapV k v g) -> g v -> m (MapV k v g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> g v -> MapV k v g
forall k k (g :: k -> *) (v :: k). k -> g v -> MapV k v g
singletonMapV k
k
  , _viewMorphism_mapQueryResult :: ViewQueryResult (MapV k v g) -> n (ViewQueryResult (g v))
_viewMorphism_mapQueryResult = n (ViewQueryResult g v)
-> (ViewQueryResult g v -> n (ViewQueryResult g v))
-> Maybe (ViewQueryResult g v)
-> n (ViewQueryResult g v)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe n (ViewQueryResult g v)
forall (f :: * -> *) a. Alternative f => f a
empty ViewQueryResult g v -> n (ViewQueryResult g v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ViewQueryResult g v) -> n (ViewQueryResult g v))
-> (MapV k v (ViewQueryResult g) -> Maybe (ViewQueryResult g v))
-> MapV k v (ViewQueryResult g)
-> n (ViewQueryResult g v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> MapV k v (ViewQueryResult g) -> Maybe (ViewQueryResult g v)
forall k k (v :: k) (g :: k -> *).
Ord k =>
k -> MapV k v g -> Maybe (g v)
lookupMapV k
k
  }
fromMapVMorphism
  :: ( Alternative m, Applicative n, Ord k , ViewQueryResult (g v) ~ ViewQueryResult g v)
  => k -> ViewHalfMorphism m n (MapV k v g) (g v)
fromMapVMorphism :: k -> ViewHalfMorphism m n (MapV k v g) (g v)
fromMapVMorphism k
k = ViewHalfMorphism :: forall (m :: * -> *) (n :: * -> *) p q.
(p -> m q)
-> (ViewQueryResult q -> n (ViewQueryResult p))
-> ViewHalfMorphism m n p q
ViewHalfMorphism
  { _viewMorphism_mapQuery :: MapV k v g -> m (g v)
_viewMorphism_mapQuery = m (g v) -> (g v -> m (g v)) -> Maybe (g v) -> m (g v)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m (g v)
forall (f :: * -> *) a. Alternative f => f a
empty g v -> m (g v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (g v) -> m (g v))
-> (MapV k v g -> Maybe (g v)) -> MapV k v g -> m (g v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> MapV k v g -> Maybe (g v)
forall k k (v :: k) (g :: k -> *).
Ord k =>
k -> MapV k v g -> Maybe (g v)
lookupMapV k
k
  , _viewMorphism_mapQueryResult :: ViewQueryResult (g v) -> n (ViewQueryResult (MapV k v g))
_viewMorphism_mapQueryResult = MapV k v (ViewQueryResult g) -> n (MapV k v (ViewQueryResult g))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MapV k v (ViewQueryResult g) -> n (MapV k v (ViewQueryResult g)))
-> (ViewQueryResult g v -> MapV k v (ViewQueryResult g))
-> ViewQueryResult g v
-> n (MapV k v (ViewQueryResult g))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> ViewQueryResult g v -> MapV k v (ViewQueryResult g)
forall k k (g :: k -> *) (v :: k). k -> g v -> MapV k v g
singletonMapV k
k
  }

mapVSetMorphism
  :: ( Ord k , ViewQueryResult (g v) ~ ViewQueryResult g v, Monoid (ViewQueryResult g v), Monoid (g v), Alternative n, Applicative m)
  => Set k -> ViewMorphism m n (g v) (MapV k v g)
mapVSetMorphism :: Set k -> ViewMorphism m n (g v) (MapV k v g)
mapVSetMorphism Set k
k = ViewHalfMorphism m n (g v) (MapV k v g)
-> ViewHalfMorphism n m (MapV k v g) (g v)
-> ViewMorphism m n (g v) (MapV 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 (g v) (MapV k v g)
forall k k (g :: k -> *) (v :: k) (n :: * -> *) (m :: * -> *).
(Ord k, ViewQueryResult (g v) ~ ViewQueryResult g v, Applicative n,
 Applicative m, Monoid (ViewQueryResult g v)) =>
Set k -> ViewHalfMorphism m n (g v) (MapV k v g)
toMapVSetMorphism Set k
k) (Set k -> ViewHalfMorphism n m (MapV k v g) (g v)
forall k (m :: * -> *) (n :: * -> *) k (g :: k -> *) (v :: k).
(Alternative m, Applicative n, Ord k,
 ViewQueryResult (g v) ~ ViewQueryResult g v, Monoid (g v)) =>
Set k -> ViewHalfMorphism m n (MapV k v g) (g v)
fromMapVSetMorphism Set k
k)

toMapVSetMorphism
  :: ( Ord k , ViewQueryResult (g v) ~ ViewQueryResult g v, Applicative n, Applicative m, Monoid (ViewQueryResult g v))
  => Set k -> ViewHalfMorphism m n (g v) (MapV k v g)
toMapVSetMorphism :: Set k -> ViewHalfMorphism m n (g v) (MapV k v g)
toMapVSetMorphism 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 :: g v -> m (MapV k v g)
_viewMorphism_mapQuery = MapV k v g -> m (MapV k v g)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MapV k v g -> m (MapV k v g))
-> (g v -> MapV k v g) -> g v -> m (MapV k v g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonoidalMap k (g v) -> MapV k v g
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV (MonoidalMap k (g v) -> MapV k v g)
-> (g v -> MonoidalMap k (g v)) -> g v -> MapV k v g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k -> g v) -> Set k -> MonoidalMap k (g v))
-> Set k -> (k -> g v) -> MonoidalMap k (g v)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (k -> g v) -> Set k -> MonoidalMap k (g v)
forall k a. (k -> a) -> Set k -> MonoidalMap k a
Map.fromSet Set k
k ((k -> g v) -> MonoidalMap k (g v))
-> (g v -> k -> g v) -> g v -> MonoidalMap k (g v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g v -> k -> g v
forall a b. a -> b -> a
const
  , _viewMorphism_mapQueryResult :: ViewQueryResult (MapV k v g) -> n (ViewQueryResult (g v))
_viewMorphism_mapQueryResult = ViewQueryResult g v -> n (ViewQueryResult g v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ViewQueryResult g v -> n (ViewQueryResult g v))
-> (MapV k v (ViewQueryResult g) -> ViewQueryResult g v)
-> MapV k v (ViewQueryResult g)
-> n (ViewQueryResult g v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k (ViewQueryResult g v) -> ViewQueryResult g v
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map k (ViewQueryResult g v) -> ViewQueryResult g v)
-> (MapV k v (ViewQueryResult g) -> Map k (ViewQueryResult g v))
-> MapV k v (ViewQueryResult g)
-> ViewQueryResult g v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map k (ViewQueryResult g v)
 -> Set k -> Map k (ViewQueryResult g v))
-> Set k
-> Map k (ViewQueryResult g v)
-> Map k (ViewQueryResult g v)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Map k (ViewQueryResult g v) -> Set k -> Map k (ViewQueryResult g v)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map'.restrictKeys Set k
k (Map k (ViewQueryResult g v) -> Map k (ViewQueryResult g v))
-> (MapV k v (ViewQueryResult g) -> Map k (ViewQueryResult g v))
-> MapV k v (ViewQueryResult g)
-> Map k (ViewQueryResult g v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonoidalMap k (ViewQueryResult g v) -> Map k (ViewQueryResult g v)
forall k a. MonoidalMap k a -> Map k a
getMonoidalMap (MonoidalMap k (ViewQueryResult g v)
 -> Map k (ViewQueryResult g v))
-> (MapV k v (ViewQueryResult g)
    -> MonoidalMap k (ViewQueryResult g v))
-> MapV k v (ViewQueryResult g)
-> Map k (ViewQueryResult g v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MapV k v (ViewQueryResult g) -> MonoidalMap k (ViewQueryResult g v)
forall k k (v :: k) (g :: k -> *).
MapV k v g -> MonoidalMap k (g v)
unMapV
  }
fromMapVSetMorphism
  :: ( Alternative m, Applicative n, Ord k , ViewQueryResult (g v) ~ ViewQueryResult g v, Monoid (g v))
  => Set k -> ViewHalfMorphism m n (MapV k v g) (g v)
fromMapVSetMorphism :: Set k -> ViewHalfMorphism m n (MapV k v g) (g v)
fromMapVSetMorphism 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 :: MapV k v g -> m (g v)
_viewMorphism_mapQuery = g v -> m (g v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (g v -> m (g v)) -> (MapV k v g -> g v) -> MapV k v g -> m (g v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k (g v) -> g v
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map k (g v) -> g v)
-> (MapV k v g -> Map k (g v)) -> MapV k v g -> g v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map k (g v) -> Set k -> Map k (g v))
-> Set k -> Map k (g v) -> Map k (g v)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Map k (g v) -> Set k -> Map k (g v)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map'.restrictKeys Set k
k (Map k (g v) -> Map k (g v))
-> (MapV k v g -> Map k (g v)) -> MapV k v g -> Map k (g v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonoidalMap k (g v) -> Map k (g v)
forall k a. MonoidalMap k a -> Map k a
getMonoidalMap (MonoidalMap k (g v) -> Map k (g v))
-> (MapV k v g -> MonoidalMap k (g v)) -> MapV k v g -> Map k (g v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MapV k v g -> MonoidalMap k (g v)
forall k k (v :: k) (g :: k -> *).
MapV k v g -> MonoidalMap k (g v)
unMapV
  , _viewMorphism_mapQueryResult :: ViewQueryResult (g v) -> n (ViewQueryResult (MapV k v g))
_viewMorphism_mapQueryResult = MapV k v (ViewQueryResult g) -> n (MapV k v (ViewQueryResult g))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MapV k v (ViewQueryResult g) -> n (MapV k v (ViewQueryResult g)))
-> (ViewQueryResult g v -> MapV k v (ViewQueryResult g))
-> ViewQueryResult g v
-> n (MapV k v (ViewQueryResult g))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonoidalMap k (ViewQueryResult g v) -> MapV k v (ViewQueryResult g)
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV (MonoidalMap k (ViewQueryResult g v)
 -> MapV k v (ViewQueryResult g))
-> (ViewQueryResult g v -> MonoidalMap k (ViewQueryResult g v))
-> ViewQueryResult g v
-> MapV k v (ViewQueryResult g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k -> ViewQueryResult g v)
 -> Set k -> MonoidalMap k (ViewQueryResult g v))
-> Set k
-> (k -> ViewQueryResult g v)
-> MonoidalMap k (ViewQueryResult g v)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (k -> ViewQueryResult g v)
-> Set k -> MonoidalMap k (ViewQueryResult g v)
forall k a. (k -> a) -> Set k -> MonoidalMap k a
Map.fromSet Set k
k ((k -> ViewQueryResult g v) -> MonoidalMap k (ViewQueryResult g v))
-> (ViewQueryResult g v -> k -> ViewQueryResult g v)
-> ViewQueryResult g v
-> MonoidalMap k (ViewQueryResult g v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ViewQueryResult g v -> k -> ViewQueryResult g v
forall a b. a -> b -> a
const
  }

-- | Match whatever's present in the View, insert nothing.
mapVWildcardMorphism
  :: (Semigroup (g v), Semigroup (ViewQueryResult g v), ViewQueryResult (g v) ~ ViewQueryResult g v, Alternative n, Applicative m)
  => ViewMorphism m n (g v) (MapV k v g)
mapVWildcardMorphism :: ViewMorphism m n (g v) (MapV k v g)
mapVWildcardMorphism = ViewHalfMorphism m n (g v) (MapV k v g)
-> ViewHalfMorphism n m (MapV k v g) (g v)
-> ViewMorphism m n (g v) (MapV 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 (g v) (MapV k v g)
forall k (m :: * -> *) (n :: * -> *) (g :: k -> *) (v :: k) k.
(Applicative m, Alternative n, Semigroup (ViewQueryResult g v),
 ViewQueryResult (g v) ~ ViewQueryResult g v) =>
ViewHalfMorphism m n (g v) (MapV k v g)
toMapVWildcardMorphism ViewHalfMorphism n m (MapV k v g) (g v)
forall k (m :: * -> *) (n :: * -> *) (g :: k -> *) (v :: k) k.
(Alternative m, Applicative n, Semigroup (g v)) =>
ViewHalfMorphism m n (MapV k v g) (g v)
fromMapVWildcardMorphism

toMapVWildcardMorphism
  :: (Applicative m, Alternative n, Semigroup (ViewQueryResult g v), ViewQueryResult (g v) ~ ViewQueryResult g v)
  => ViewHalfMorphism m n (g v) (MapV k v g)
toMapVWildcardMorphism :: ViewHalfMorphism m n (g v) (MapV k v g)
toMapVWildcardMorphism = ViewHalfMorphism :: forall (m :: * -> *) (n :: * -> *) p q.
(p -> m q)
-> (ViewQueryResult q -> n (ViewQueryResult p))
-> ViewHalfMorphism m n p q
ViewHalfMorphism
  { _viewMorphism_mapQuery :: g v -> m (MapV k v g)
_viewMorphism_mapQuery = m (MapV k v g) -> g v -> m (MapV k v g)
forall a b. a -> b -> a
const (m (MapV k v g) -> g v -> m (MapV k v g))
-> m (MapV k v g) -> g v -> m (MapV k v g)
forall a b. (a -> b) -> a -> b
$ MapV k v g -> m (MapV k v g)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MapV k v g -> m (MapV k v g)) -> MapV k v g -> m (MapV k v g)
forall a b. (a -> b) -> a -> b
$ MonoidalMap k (g v) -> MapV k v g
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV MonoidalMap k (g v)
forall k a. MonoidalMap k a
Map.empty
  , _viewMorphism_mapQueryResult :: ViewQueryResult (MapV k v g) -> n (ViewQueryResult (g v))
_viewMorphism_mapQueryResult = n (ViewQueryResult g v)
-> (ViewQueryResult g v -> n (ViewQueryResult g v))
-> Maybe (ViewQueryResult g v)
-> n (ViewQueryResult g v)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe n (ViewQueryResult g v)
forall (f :: * -> *) a. Alternative f => f a
empty ViewQueryResult g v -> n (ViewQueryResult g v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ViewQueryResult g v) -> n (ViewQueryResult g v))
-> (MapV k v (ViewQueryResult g) -> Maybe (ViewQueryResult g v))
-> MapV k v (ViewQueryResult g)
-> n (ViewQueryResult g v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ViewQueryResult g v -> Maybe (ViewQueryResult g v))
-> MonoidalMap k (ViewQueryResult g v)
-> Maybe (ViewQueryResult g v)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ViewQueryResult g v -> Maybe (ViewQueryResult g v)
forall a. a -> Maybe a
Just (MonoidalMap k (ViewQueryResult g v)
 -> Maybe (ViewQueryResult g v))
-> (MapV k v (ViewQueryResult g)
    -> MonoidalMap k (ViewQueryResult g v))
-> MapV k v (ViewQueryResult g)
-> Maybe (ViewQueryResult g v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MapV k v (ViewQueryResult g) -> MonoidalMap k (ViewQueryResult g v)
forall k k (v :: k) (g :: k -> *).
MapV k v g -> MonoidalMap k (g v)
unMapV
  }

fromMapVWildcardMorphism
  :: (Alternative m, Applicative n, Semigroup (g v))
  => ViewHalfMorphism m n (MapV k v g) (g v)
fromMapVWildcardMorphism :: ViewHalfMorphism m n (MapV k v g) (g v)
fromMapVWildcardMorphism = ViewHalfMorphism :: forall (m :: * -> *) (n :: * -> *) p q.
(p -> m q)
-> (ViewQueryResult q -> n (ViewQueryResult p))
-> ViewHalfMorphism m n p q
ViewHalfMorphism
  { _viewMorphism_mapQuery :: MapV k v g -> m (g v)
_viewMorphism_mapQuery = m (g v) -> (g v -> m (g v)) -> Maybe (g v) -> m (g v)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m (g v)
forall (f :: * -> *) a. Alternative f => f a
empty g v -> m (g v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (g v) -> m (g v))
-> (MapV k v g -> Maybe (g v)) -> MapV k v g -> m (g v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (g v -> Maybe (g v)) -> MonoidalMap k (g v) -> Maybe (g v)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap g v -> Maybe (g v)
forall a. a -> Maybe a
Just (MonoidalMap k (g v) -> Maybe (g v))
-> (MapV k v g -> MonoidalMap k (g v)) -> MapV k v g -> Maybe (g v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MapV k v g -> MonoidalMap k (g v)
forall k k (v :: k) (g :: k -> *).
MapV k v g -> MonoidalMap k (g v)
unMapV
  , _viewMorphism_mapQueryResult :: ViewQueryResult (g v) -> n (ViewQueryResult (MapV k v g))
_viewMorphism_mapQueryResult = n (MapV k v (ViewQueryResult g))
-> ViewQueryResult (g v) -> n (MapV k v (ViewQueryResult g))
forall a b. a -> b -> a
const (n (MapV k v (ViewQueryResult g))
 -> ViewQueryResult (g v) -> n (MapV k v (ViewQueryResult g)))
-> n (MapV k v (ViewQueryResult g))
-> ViewQueryResult (g v)
-> n (MapV k v (ViewQueryResult g))
forall a b. (a -> b) -> a -> b
$ MapV k v (ViewQueryResult g) -> n (MapV k v (ViewQueryResult g))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MapV k v (ViewQueryResult g) -> n (MapV k v (ViewQueryResult g)))
-> MapV k v (ViewQueryResult g) -> n (MapV k v (ViewQueryResult g))
forall a b. (a -> b) -> a -> b
$ MonoidalMap k (ViewQueryResult g v) -> MapV k v (ViewQueryResult g)
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV MonoidalMap k (ViewQueryResult g v)
forall k a. MonoidalMap k a
Map.empty
  }

-- | A gadget to "traverse" over all of the keys in a MapV in one step
handleMapVSelector
  :: forall a f g k m.
  ( Ord k, Functor m )
  => (forall x. x -> f x -> g x)
  -> (Set k -> m (MonoidalMap k a))
  ->    MapV k a f
  -> m (MapV k a g)
handleMapVSelector :: (forall x. x -> f x -> g x)
-> (Set k -> m (MonoidalMap k a)) -> MapV k a f -> m (MapV k a g)
handleMapVSelector forall x. x -> f x -> g x
k Set k -> m (MonoidalMap k a)
f (MapV MonoidalMap k (f a)
xs) = (\MonoidalMap k a
ys -> MonoidalMap k (g a) -> MapV k a g
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV (MonoidalMap k (g a) -> MapV k a g)
-> MonoidalMap k (g a) -> MapV k a g
forall a b. (a -> b) -> a -> b
$ (a -> f a -> g a)
-> MonoidalMap k a -> MonoidalMap k (f a) -> MonoidalMap k (g a)
forall k a b c.
Ord k =>
(a -> b -> c)
-> MonoidalMap k a -> MonoidalMap k b -> MonoidalMap k c
Map.intersectionWith a -> f a -> g a
forall x. x -> f x -> g x
k MonoidalMap k a
ys MonoidalMap k (f a)
xs) (MonoidalMap k a -> MapV k a g)
-> m (MonoidalMap k a) -> m (MapV k a g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set k -> m (MonoidalMap k a)
f (MonoidalMap k (f a) -> Set k
forall k a. MonoidalMap k a -> Set k
Map.keysSet MonoidalMap k (f a)
xs)

-- | Non-existentialized mapV; since the contained value is known
mapMapWithKeyV :: (k -> f a -> g a) -> MapV k a f -> MapV k a g
mapMapWithKeyV :: (k -> f a -> g a) -> MapV k a f -> MapV k a g
mapMapWithKeyV k -> f a -> g a
f (MapV MonoidalMap k (f a)
xs) = MonoidalMap k (g a) -> MapV k a g
forall k k (v :: k) (g :: k -> *).
MonoidalMap k (g v) -> MapV k v g
MapV ((k -> f a -> g a) -> MonoidalMap k (f a) -> MonoidalMap k (g a)
forall k a b. (k -> a -> b) -> MonoidalMap k a -> MonoidalMap k b
Map.mapWithKey k -> f a -> g a
f MonoidalMap k (f a)
xs)