{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Data.Vessel.Internal where
import Control.Arrow ((***))
import Data.Aeson
import Data.Constraint.Extras
import Data.Constraint.Forall
import Data.Dependent.Map.Internal (DMap (..))
import qualified Data.Dependent.Map as DMap'
import Data.Dependent.Map.Monoidal (MonoidalDMap(..))
import Data.Functor.Compose
import Data.Functor.Const
import Data.GADT.Compare
import Data.Some (Some(Some))
import Data.Map.Monoidal (MonoidalMap (..))
import qualified Data.Map.Monoidal as Map
import Data.These
import Data.Patch (Group(..), Additive)
import Data.Coerce
import Data.Set (Set)
import Data.Witherable
import qualified Data.Map as Map'
import qualified Data.Map.Merge.Strict as Map'
import qualified Data.Dependent.Map.Monoidal as DMap
newtype FlipAp (g :: k) (v :: k -> *) = FlipAp { FlipAp g v -> v g
unFlipAp :: v g }
deriving (FlipAp g v -> FlipAp g v -> Bool
(FlipAp g v -> FlipAp g v -> Bool)
-> (FlipAp g v -> FlipAp g v -> Bool) -> Eq (FlipAp g v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (g :: k) (v :: k -> *).
Eq (v g) =>
FlipAp g v -> FlipAp g v -> Bool
/= :: FlipAp g v -> FlipAp g v -> Bool
$c/= :: forall k (g :: k) (v :: k -> *).
Eq (v g) =>
FlipAp g v -> FlipAp g v -> Bool
== :: FlipAp g v -> FlipAp g v -> Bool
$c== :: forall k (g :: k) (v :: k -> *).
Eq (v g) =>
FlipAp g v -> FlipAp g v -> Bool
Eq, Eq (FlipAp g v)
Eq (FlipAp g v)
-> (FlipAp g v -> FlipAp g v -> Ordering)
-> (FlipAp g v -> FlipAp g v -> Bool)
-> (FlipAp g v -> FlipAp g v -> Bool)
-> (FlipAp g v -> FlipAp g v -> Bool)
-> (FlipAp g v -> FlipAp g v -> Bool)
-> (FlipAp g v -> FlipAp g v -> FlipAp g v)
-> (FlipAp g v -> FlipAp g v -> FlipAp g v)
-> Ord (FlipAp g v)
FlipAp g v -> FlipAp g v -> Bool
FlipAp g v -> FlipAp g v -> Ordering
FlipAp g v -> FlipAp g v -> FlipAp g v
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 (g :: k) (v :: k -> *). Ord (v g) => Eq (FlipAp g v)
forall k (g :: k) (v :: k -> *).
Ord (v g) =>
FlipAp g v -> FlipAp g v -> Bool
forall k (g :: k) (v :: k -> *).
Ord (v g) =>
FlipAp g v -> FlipAp g v -> Ordering
forall k (g :: k) (v :: k -> *).
Ord (v g) =>
FlipAp g v -> FlipAp g v -> FlipAp g v
min :: FlipAp g v -> FlipAp g v -> FlipAp g v
$cmin :: forall k (g :: k) (v :: k -> *).
Ord (v g) =>
FlipAp g v -> FlipAp g v -> FlipAp g v
max :: FlipAp g v -> FlipAp g v -> FlipAp g v
$cmax :: forall k (g :: k) (v :: k -> *).
Ord (v g) =>
FlipAp g v -> FlipAp g v -> FlipAp g v
>= :: FlipAp g v -> FlipAp g v -> Bool
$c>= :: forall k (g :: k) (v :: k -> *).
Ord (v g) =>
FlipAp g v -> FlipAp g v -> Bool
> :: FlipAp g v -> FlipAp g v -> Bool
$c> :: forall k (g :: k) (v :: k -> *).
Ord (v g) =>
FlipAp g v -> FlipAp g v -> Bool
<= :: FlipAp g v -> FlipAp g v -> Bool
$c<= :: forall k (g :: k) (v :: k -> *).
Ord (v g) =>
FlipAp g v -> FlipAp g v -> Bool
< :: FlipAp g v -> FlipAp g v -> Bool
$c< :: forall k (g :: k) (v :: k -> *).
Ord (v g) =>
FlipAp g v -> FlipAp g v -> Bool
compare :: FlipAp g v -> FlipAp g v -> Ordering
$ccompare :: forall k (g :: k) (v :: k -> *).
Ord (v g) =>
FlipAp g v -> FlipAp g v -> Ordering
$cp1Ord :: forall k (g :: k) (v :: k -> *). Ord (v g) => Eq (FlipAp g v)
Ord, Int -> FlipAp g v -> ShowS
[FlipAp g v] -> ShowS
FlipAp g v -> String
(Int -> FlipAp g v -> ShowS)
-> (FlipAp g v -> String)
-> ([FlipAp g v] -> ShowS)
-> Show (FlipAp g v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (g :: k) (v :: k -> *).
Show (v g) =>
Int -> FlipAp g v -> ShowS
forall k (g :: k) (v :: k -> *).
Show (v g) =>
[FlipAp g v] -> ShowS
forall k (g :: k) (v :: k -> *). Show (v g) => FlipAp g v -> String
showList :: [FlipAp g v] -> ShowS
$cshowList :: forall k (g :: k) (v :: k -> *).
Show (v g) =>
[FlipAp g v] -> ShowS
show :: FlipAp g v -> String
$cshow :: forall k (g :: k) (v :: k -> *). Show (v g) => FlipAp g v -> String
showsPrec :: Int -> FlipAp g v -> ShowS
$cshowsPrec :: forall k (g :: k) (v :: k -> *).
Show (v g) =>
Int -> FlipAp g v -> ShowS
Show)
instance Semigroup (v g) => Semigroup (FlipAp g v) where
FlipAp v g
x <> :: FlipAp g v -> FlipAp g v -> FlipAp g v
<> FlipAp v g
y = v g -> FlipAp g v
forall k (g :: k) (v :: k -> *). v g -> FlipAp g v
FlipAp (v g
x v g -> v g -> v g
forall a. Semigroup a => a -> a -> a
<> v g
y)
instance Monoid (v g) => Monoid (FlipAp g v) where
mempty :: FlipAp g v
mempty = v g -> FlipAp g v
forall k (g :: k) (v :: k -> *). v g -> FlipAp g v
FlipAp v g
forall a. Monoid a => a
mempty
mappend :: FlipAp g v -> FlipAp g v -> FlipAp g v
mappend (FlipAp v g
x) (FlipAp v g
y) = v g -> FlipAp g v
forall k (g :: k) (v :: k -> *). v g -> FlipAp g v
FlipAp (v g -> v g -> v g
forall a. Monoid a => a -> a -> a
mappend v g
x v g
y)
instance Group (v g) => Group (FlipAp g v) where
negateG :: FlipAp g v -> FlipAp g v
negateG (FlipAp v g
x) = v g -> FlipAp g v
forall k (g :: k) (v :: k -> *). v g -> FlipAp g v
FlipAp (v g -> v g
forall q. Group q => q -> q
negateG v g
x)
instance Additive (v g) => Additive (FlipAp g v)
data VSum (k :: ((* -> *) -> *) -> *) (g :: * -> *) = forall v. k v :~> v g
instance (ForallF ToJSON k, HasV ToJSON k g) => ToJSON (VSum k g) where
toJSON :: VSum k g -> Value
toJSON ((k v
k :: k v) :~> (v g
v :: v g)) =
(Value, Value) -> Value
forall a. ToJSON a => a -> Value
toJSON ( (ToJSON (k v) => Value) -> Value
forall k2 k1 (c :: k2 -> Constraint) (t :: k1 -> k2) (a :: k1) r.
ForallF c t =>
(c (t a) => r) -> r
whichever @ToJSON @k @v (k v -> Value
forall a. ToJSON a => a -> Value
toJSON k v
k)
, k v -> (ToJSON (v g) => Value) -> Value
forall k' k (c :: k' -> Constraint) (g :: k) (f :: (k -> k') -> *)
(v :: k -> k') r.
HasV c f g =>
f v -> (c (v g) => r) -> r
hasV @ToJSON @g k v
k (v g -> Value
forall a. ToJSON a => a -> Value
toJSON v g
v))
instance forall k g. (FromJSON (Some k), HasV FromJSON k g) => FromJSON (VSum k g) where
parseJSON :: Value -> Parser (VSum k g)
parseJSON Value
x = do
(Value
jk, Value
jv) <- Value -> Parser (Value, Value)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x
(Some k a
k) <- Value -> Parser (Some k)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
jk
a g
v <- k a -> (FromJSON (a g) => Parser (a g)) -> Parser (a g)
forall k' k (c :: k' -> Constraint) (g :: k) (f :: (k -> k') -> *)
(v :: k -> k') r.
HasV c f g =>
f v -> (c (v g) => r) -> r
hasV @FromJSON @g k a
k (Value -> Parser (a g)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
jv)
VSum k g -> Parser (VSum k g)
forall (m :: * -> *) a. Monad m => a -> m a
return (k a
k k a -> a g -> VSum k g
forall (k :: ((* -> *) -> *) -> *) (g :: * -> *)
(v :: (* -> *) -> *).
k v -> v g -> VSum k g
:~> a g
v)
instance (Has' Group f g, Has' Semigroup f g, GCompare f) => Group (MonoidalDMap f g) where
negateG :: MonoidalDMap f g -> MonoidalDMap f g
negateG (MonoidalDMap DMap f g
m) = DMap f g -> MonoidalDMap f g
forall k (f :: k -> *) (g :: k -> *). DMap f g -> MonoidalDMap f g
MonoidalDMap ((forall (v :: k). f v -> g v -> g v) -> DMap f g -> DMap f g
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (g :: k1 -> *).
(forall (v :: k1). k2 v -> f v -> g v) -> DMap k2 f -> DMap k2 g
DMap'.mapWithKey (\f v
k g v
v -> f v -> (Group (g v) => g v) -> g v
forall k k' (c :: k -> Constraint) (g :: k' -> k) (f :: k' -> *)
(a :: k') r.
Has' c f g =>
f a -> (c (g a) => r) -> r
has' @Group @g f v
k (g v -> g v
forall q. Group q => q -> q
negateG g v
v)) DMap f g
m)
instance (Has' Group f g, Has' Semigroup f g, GCompare f) => Additive (MonoidalDMap f g)
instance (Semigroup (f (g a))) => Semigroup (Compose f g a) where
(Compose f (g a)
x) <> :: Compose f g a -> Compose f g a -> Compose f g a
<> (Compose f (g a)
y) = f (g a) -> Compose f g a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g a)
x f (g a) -> f (g a) -> f (g a)
forall a. Semigroup a => a -> a -> a
<> f (g a)
y)
instance (Monoid (f (g a))) => Monoid (Compose f g a) where
mempty :: Compose f g a
mempty = f (g a) -> Compose f g a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose f (g a)
forall a. Monoid a => a
mempty
mappend :: Compose f g a -> Compose f g a -> Compose f g a
mappend (Compose f (g a)
x) (Compose f (g a)
y) = f (g a) -> Compose f g a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g a) -> f (g a) -> f (g a)
forall a. Monoid a => a -> a -> a
mappend f (g a)
x f (g a)
y)
assocLCompose :: (Functor f) => Compose f (Compose g h) x -> Compose (Compose f g) h x
assocLCompose :: Compose f (Compose g h) x -> Compose (Compose f g) h x
assocLCompose (Compose f (Compose g h x)
x) = Compose f g (h x) -> Compose (Compose f g) h x
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g (h x)) -> Compose f g (h x)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((Compose g h x -> g (h x)) -> f (Compose g h x) -> f (g (h x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Compose g h x -> g (h x)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose f (Compose g h x)
x))
assocRCompose :: (Functor f) => Compose (Compose f g) h x -> Compose f (Compose g h) x
assocRCompose :: Compose (Compose f g) h x -> Compose f (Compose g h) x
assocRCompose (Compose (Compose f (g (h x))
x)) = f (Compose g h x) -> Compose f (Compose g h) x
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((g (h x) -> Compose g h x) -> f (g (h x)) -> f (Compose g h x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g (h x) -> Compose g h x
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose f (g (h x))
x)
alignWithKeyMaybeDMap :: GCompare k => (forall a. k a -> These (f a) (g a) -> Maybe (h a)) -> DMap k f -> DMap k g -> DMap k h
alignWithKeyMaybeDMap :: (forall (a :: k). k a -> These (f a) (g a) -> Maybe (h a))
-> DMap k f -> DMap k g -> DMap k h
alignWithKeyMaybeDMap forall (a :: k). k a -> These (f a) (g a) -> Maybe (h a)
f DMap k f
a DMap k g
b = (forall (v :: k). k v -> DThese f g v -> Maybe (h v))
-> DMap k (DThese f g) -> DMap k h
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (g :: k1 -> *).
GCompare k2 =>
(forall (v :: k1). k2 v -> f v -> Maybe (g v))
-> DMap k2 f -> DMap k2 g
DMap'.mapMaybeWithKey (\k v
k DThese f g v
t -> k v -> These (f v) (g v) -> Maybe (h v)
forall (a :: k). k a -> These (f a) (g a) -> Maybe (h a)
f k v
k (These (f v) (g v) -> Maybe (h v))
-> These (f v) (g v) -> Maybe (h v)
forall a b. (a -> b) -> a -> b
$ DThese f g v -> These (f v) (g v)
forall k (f :: k -> *) (g :: k -> *) (a :: k).
DThese f g a -> These (f a) (g a)
dtheseToThese DThese f g v
t) (DMap k (DThese f g) -> DMap k h)
-> DMap k (DThese f g) -> DMap k h
forall a b. (a -> b) -> a -> b
$ (forall (v :: k).
k v -> DThese f g v -> DThese f g v -> DThese f g v)
-> DMap k (DThese f g)
-> DMap k (DThese f g)
-> DMap k (DThese f g)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *).
GCompare k2 =>
(forall (v :: k1). k2 v -> f v -> f v -> f v)
-> DMap k2 f -> DMap k2 f -> DMap k2 f
DMap'.unionWithKey (\k v
_ (DThis x) (DThat y) -> f v -> g v -> DThese f g v
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> DThese f g a
DThese f v
x g v
y) ((forall (v :: k). f v -> DThese f g v)
-> DMap k f -> DMap k (DThese f g)
forall k1 (f :: k1 -> *) (g :: k1 -> *) (k2 :: k1 -> *).
(forall (v :: k1). f v -> g v) -> DMap k2 f -> DMap k2 g
DMap'.map forall (v :: k). f v -> DThese f g v
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> DThese f g a
DThis DMap k f
a) ((forall (v :: k). g v -> DThese f g v)
-> DMap k g -> DMap k (DThese f g)
forall k1 (f :: k1 -> *) (g :: k1 -> *) (k2 :: k1 -> *).
(forall (v :: k1). f v -> g v) -> DMap k2 f -> DMap k2 g
DMap'.map forall (v :: k). g v -> DThese f g v
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> DThese f g a
DThat DMap k g
b)
alignWithKeyDMap :: GCompare k => (forall a. k a -> These (f a) (g a) -> h a) -> DMap k f -> DMap k g -> DMap k h
alignWithKeyDMap :: (forall (a :: k). k a -> These (f a) (g a) -> h a)
-> DMap k f -> DMap k g -> DMap k h
alignWithKeyDMap forall (a :: k). k a -> These (f a) (g a) -> h a
f DMap k f
a DMap k g
b = (forall (v :: k). k v -> DThese f g v -> h v)
-> DMap k (DThese f g) -> DMap k h
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (g :: k1 -> *).
(forall (v :: k1). k2 v -> f v -> g v) -> DMap k2 f -> DMap k2 g
DMap'.mapWithKey (\k v
k DThese f g v
t -> k v -> These (f v) (g v) -> h v
forall (a :: k). k a -> These (f a) (g a) -> h a
f k v
k (These (f v) (g v) -> h v) -> These (f v) (g v) -> h v
forall a b. (a -> b) -> a -> b
$ DThese f g v -> These (f v) (g v)
forall k (f :: k -> *) (g :: k -> *) (a :: k).
DThese f g a -> These (f a) (g a)
dtheseToThese DThese f g v
t) (DMap k (DThese f g) -> DMap k h)
-> DMap k (DThese f g) -> DMap k h
forall a b. (a -> b) -> a -> b
$ (forall (v :: k).
k v -> DThese f g v -> DThese f g v -> DThese f g v)
-> DMap k (DThese f g)
-> DMap k (DThese f g)
-> DMap k (DThese f g)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *).
GCompare k2 =>
(forall (v :: k1). k2 v -> f v -> f v -> f v)
-> DMap k2 f -> DMap k2 f -> DMap k2 f
DMap'.unionWithKey (\k v
_ (DThis x) (DThat y) -> f v -> g v -> DThese f g v
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> DThese f g a
DThese f v
x g v
y) ((forall (v :: k). f v -> DThese f g v)
-> DMap k f -> DMap k (DThese f g)
forall k1 (f :: k1 -> *) (g :: k1 -> *) (k2 :: k1 -> *).
(forall (v :: k1). f v -> g v) -> DMap k2 f -> DMap k2 g
DMap'.map forall (v :: k). f v -> DThese f g v
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> DThese f g a
DThis DMap k f
a) ((forall (v :: k). g v -> DThese f g v)
-> DMap k g -> DMap k (DThese f g)
forall k1 (f :: k1 -> *) (g :: k1 -> *) (k2 :: k1 -> *).
(forall (v :: k1). f v -> g v) -> DMap k2 f -> DMap k2 g
DMap'.map forall (v :: k). g v -> DThese f g v
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> DThese f g a
DThat DMap k g
b)
data DThese f g a = DThis (f a) | DThat (g a) | DThese (f a) (g a)
dtheseToThese :: DThese f g a -> These (f a) (g a)
dtheseToThese :: DThese f g a -> These (f a) (g a)
dtheseToThese = \case
DThis f a
a -> f a -> These (f a) (g a)
forall a b. a -> These a b
This f a
a
DThat g a
b -> g a -> These (f a) (g a)
forall a b. b -> These a b
That g a
b
DThese f a
a g a
b -> f a -> g a -> These (f a) (g a)
forall a b. a -> b -> These a b
These f a
a g a
b
theseToDThese :: These (f a) (g a) -> DThese f g a
theseToDThese :: These (f a) (g a) -> DThese f g a
theseToDThese = \case
This f a
a -> f a -> DThese f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> DThese f g a
DThis f a
a
That g a
b -> g a -> DThese f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> DThese f g a
DThat g a
b
These f a
a g a
b -> f a -> g a -> DThese f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> DThese f g a
DThese f a
a g a
b
unalignProperly :: (Filterable f) => f (These a b) -> (f a, f b)
unalignProperly :: f (These a b) -> (f a, f b)
unalignProperly f (These a b)
f = ((These a b -> Maybe a) -> f (These a b) -> f a
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe These a b -> Maybe a
forall a b. These a b -> Maybe a
leftThese f (These a b)
f, (These a b -> Maybe b) -> f (These a b) -> f b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe These a b -> Maybe b
forall a b. These a b -> Maybe b
rightThese f (These a b)
f)
where
leftThese :: These a b -> Maybe a
leftThese :: These a b -> Maybe a
leftThese = (a -> Maybe a)
-> (b -> Maybe a) -> (a -> b -> Maybe a) -> These a b -> Maybe a
forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these (\a
x -> a -> Maybe a
forall a. a -> Maybe a
Just a
x) (\b
_ -> Maybe a
forall a. Maybe a
Nothing) (\a
x b
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
x)
rightThese :: These a b -> Maybe b
rightThese :: These a b -> Maybe b
rightThese = (a -> Maybe b)
-> (b -> Maybe b) -> (a -> b -> Maybe b) -> These a b -> Maybe b
forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these (\a
_ -> Maybe b
forall a. Maybe a
Nothing) (\b
y -> b -> Maybe b
forall a. a -> Maybe a
Just b
y) (\a
_ b
y -> b -> Maybe b
forall a. a -> Maybe a
Just b
y)
data Pivot k a = None | One k a | Split k (MonoidalMap k a) (MonoidalMap k a)
deriving (Pivot k a -> Pivot k a -> Bool
(Pivot k a -> Pivot k a -> Bool)
-> (Pivot k a -> Pivot k a -> Bool) -> Eq (Pivot k a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k a. (Eq k, Eq a) => Pivot k a -> Pivot k a -> Bool
/= :: Pivot k a -> Pivot k a -> Bool
$c/= :: forall k a. (Eq k, Eq a) => Pivot k a -> Pivot k a -> Bool
== :: Pivot k a -> Pivot k a -> Bool
$c== :: forall k a. (Eq k, Eq a) => Pivot k a -> Pivot k a -> Bool
Eq, Eq (Pivot k a)
Eq (Pivot k a)
-> (Pivot k a -> Pivot k a -> Ordering)
-> (Pivot k a -> Pivot k a -> Bool)
-> (Pivot k a -> Pivot k a -> Bool)
-> (Pivot k a -> Pivot k a -> Bool)
-> (Pivot k a -> Pivot k a -> Bool)
-> (Pivot k a -> Pivot k a -> Pivot k a)
-> (Pivot k a -> Pivot k a -> Pivot k a)
-> Ord (Pivot k a)
Pivot k a -> Pivot k a -> Bool
Pivot k a -> Pivot k a -> Ordering
Pivot k a -> Pivot k a -> Pivot k a
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 a. (Ord k, Ord a) => Eq (Pivot k a)
forall k a. (Ord k, Ord a) => Pivot k a -> Pivot k a -> Bool
forall k a. (Ord k, Ord a) => Pivot k a -> Pivot k a -> Ordering
forall k a. (Ord k, Ord a) => Pivot k a -> Pivot k a -> Pivot k a
min :: Pivot k a -> Pivot k a -> Pivot k a
$cmin :: forall k a. (Ord k, Ord a) => Pivot k a -> Pivot k a -> Pivot k a
max :: Pivot k a -> Pivot k a -> Pivot k a
$cmax :: forall k a. (Ord k, Ord a) => Pivot k a -> Pivot k a -> Pivot k a
>= :: Pivot k a -> Pivot k a -> Bool
$c>= :: forall k a. (Ord k, Ord a) => Pivot k a -> Pivot k a -> Bool
> :: Pivot k a -> Pivot k a -> Bool
$c> :: forall k a. (Ord k, Ord a) => Pivot k a -> Pivot k a -> Bool
<= :: Pivot k a -> Pivot k a -> Bool
$c<= :: forall k a. (Ord k, Ord a) => Pivot k a -> Pivot k a -> Bool
< :: Pivot k a -> Pivot k a -> Bool
$c< :: forall k a. (Ord k, Ord a) => Pivot k a -> Pivot k a -> Bool
compare :: Pivot k a -> Pivot k a -> Ordering
$ccompare :: forall k a. (Ord k, Ord a) => Pivot k a -> Pivot k a -> Ordering
$cp1Ord :: forall k a. (Ord k, Ord a) => Eq (Pivot k a)
Ord, Int -> Pivot k a -> ShowS
[Pivot k a] -> ShowS
Pivot k a -> String
(Int -> Pivot k a -> ShowS)
-> (Pivot k a -> String)
-> ([Pivot k a] -> ShowS)
-> Show (Pivot k a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k a. (Show k, Show a) => Int -> Pivot k a -> ShowS
forall k a. (Show k, Show a) => [Pivot k a] -> ShowS
forall k a. (Show k, Show a) => Pivot k a -> String
showList :: [Pivot k a] -> ShowS
$cshowList :: forall k a. (Show k, Show a) => [Pivot k a] -> ShowS
show :: Pivot k a -> String
$cshow :: forall k a. (Show k, Show a) => Pivot k a -> String
showsPrec :: Int -> Pivot k a -> ShowS
$cshowsPrec :: forall k a. (Show k, Show a) => Int -> Pivot k a -> ShowS
Show)
findPivot :: Ord k => MonoidalMap k a -> Pivot k a
findPivot :: MonoidalMap k a -> Pivot k a
findPivot MonoidalMap k a
m = case MonoidalMap k a -> [MonoidalMap k a]
forall k a. MonoidalMap k a -> [MonoidalMap k a]
Map.splitRoot MonoidalMap k a
m of
[] -> Pivot k a
forall k a. Pivot k a
None
[MonoidalMap k a
l,MonoidalMap k a
xm,MonoidalMap k a
r] -> case MonoidalMap k a -> [(k, a)]
forall k a. MonoidalMap k a -> [(k, a)]
Map.toList MonoidalMap k a
xm of
[(k
k,a
v)] | MonoidalMap k a -> Bool
forall k a. MonoidalMap k a -> Bool
Map.null MonoidalMap k a
l Bool -> Bool -> Bool
&& MonoidalMap k a -> Bool
forall k a. MonoidalMap k a -> Bool
Map.null MonoidalMap k a
r -> k -> a -> Pivot k a
forall k a. k -> a -> Pivot k a
One k
k a
v
| Bool
otherwise -> k -> MonoidalMap k a -> MonoidalMap k a -> Pivot k a
forall k a. k -> MonoidalMap k a -> MonoidalMap k a -> Pivot k a
Split k
k (k -> a -> MonoidalMap k a -> MonoidalMap k a
forall k a. Ord k => k -> a -> MonoidalMap k a -> MonoidalMap k a
Map.insert k
k a
v MonoidalMap k a
l) MonoidalMap k a
r
[(k, a)]
_ -> Pivot k a
forall a. a
errorMsg
[MonoidalMap k a]
_ -> Pivot k a
forall a. a
errorMsg
where errorMsg :: a
errorMsg = String -> a
forall a. HasCallStack => String -> a
error String
"Data.Vessel.findPivot: unexpected result from Data.MonoidalMap.splitRoot (wrong version of monoidal-containers?)"
unionDistinctAsc :: (Ord k) => MonoidalMap k a -> MonoidalMap k a -> MonoidalMap k a
unionDistinctAsc :: MonoidalMap k a -> MonoidalMap k a -> MonoidalMap k a
unionDistinctAsc = (a -> a -> a)
-> MonoidalMap k a -> MonoidalMap k a -> MonoidalMap k a
forall k a.
Ord k =>
(a -> a -> a)
-> MonoidalMap k a -> MonoidalMap k a -> MonoidalMap k a
Map.unionWith (\a
x a
_ -> a
x)
splitLT :: Ord k => k -> MonoidalMap k a -> (MonoidalMap k a, MonoidalMap k a)
splitLT :: k -> MonoidalMap k a -> (MonoidalMap k a, MonoidalMap k a)
splitLT k
k MonoidalMap k a
m = case k -> MonoidalMap k a -> (MonoidalMap k a, Maybe a, MonoidalMap k a)
forall k a.
Ord k =>
k -> MonoidalMap k a -> (MonoidalMap k a, Maybe a, MonoidalMap k a)
Map.splitLookup k
k MonoidalMap k a
m of
(MonoidalMap k a
l, Just a
v, MonoidalMap k a
r) -> (k -> a -> MonoidalMap k a -> MonoidalMap k a
forall k a. Ord k => k -> a -> MonoidalMap k a -> MonoidalMap k a
Map.insert k
k a
v MonoidalMap k a
l, MonoidalMap k a
r)
(MonoidalMap k a
l, Maybe a
Nothing, MonoidalMap k a
r) -> (MonoidalMap k a
l, MonoidalMap k a
r)
data PivotD (k :: l -> *) (g :: l -> *) = NoneD | forall v. OneD (k v) (g v) | forall v. SplitD (k v) (DMap k g) (DMap k g)
condenseD' :: (GCompare k, Foldable t, Filterable t)
=> DMap k g
-> t (MonoidalDMap k g)
-> MonoidalDMap k (Compose t g)
condenseD' :: DMap k g -> t (MonoidalDMap k g) -> MonoidalDMap k (Compose t g)
condenseD' DMap k g
folded t (MonoidalDMap k g)
col = case DMap k g -> PivotD k g
forall l (k :: l -> *) (g :: l -> *).
GCompare k =>
DMap k g -> PivotD k g
findPivotD DMap k g
folded of
PivotD k g
NoneD -> MonoidalDMap k (Compose t g)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). MonoidalDMap k2 f
DMap.empty
OneD k v
k g v
_ -> k v -> Compose t g v -> MonoidalDMap k (Compose t g)
forall k1 (k2 :: k1 -> *) (v :: k1) (f :: k1 -> *).
k2 v -> f v -> MonoidalDMap k2 f
DMap.singleton k v
k (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 (t (g v) -> Compose t g v) -> t (g v) -> Compose t g v
forall a b. (a -> b) -> a -> b
$ (MonoidalDMap k g -> Maybe (g v))
-> t (MonoidalDMap k g) -> t (g v)
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (k v -> MonoidalDMap k g -> Maybe (g v)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> MonoidalDMap k2 f -> Maybe (f v)
DMap.lookup k v
k) t (MonoidalDMap k g)
col)
SplitD k v
pivot DMap k g
l DMap k g
r -> (MonoidalDMap k (Compose t g)
-> MonoidalDMap k (Compose t g) -> MonoidalDMap k (Compose t g))
-> (MonoidalDMap k (Compose t g), MonoidalDMap k (Compose t g))
-> MonoidalDMap k (Compose t g)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry MonoidalDMap k (Compose t g)
-> MonoidalDMap k (Compose t g) -> MonoidalDMap k (Compose t g)
forall k (k :: k -> *) (g :: k -> *).
GCompare k =>
MonoidalDMap k g -> MonoidalDMap k g -> MonoidalDMap k g
unionDistinctAscD ((MonoidalDMap k (Compose t g), MonoidalDMap k (Compose t g))
-> MonoidalDMap k (Compose t g))
-> (MonoidalDMap k (Compose t g), MonoidalDMap k (Compose t g))
-> MonoidalDMap k (Compose t g)
forall a b. (a -> b) -> a -> b
$ (DMap k g -> t (MonoidalDMap k g) -> MonoidalDMap k (Compose t g)
forall k1 (k :: k1 -> *) (t :: * -> *) (g :: k1 -> *).
(GCompare k, Foldable t, Filterable t) =>
DMap k g -> t (MonoidalDMap k g) -> MonoidalDMap k (Compose t g)
condenseD' DMap k g
l (t (MonoidalDMap k g) -> MonoidalDMap k (Compose t g))
-> (t (MonoidalDMap k g) -> MonoidalDMap k (Compose t g))
-> (t (MonoidalDMap k g), t (MonoidalDMap k g))
-> (MonoidalDMap k (Compose t g), MonoidalDMap k (Compose t g))
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** DMap k g -> t (MonoidalDMap k g) -> MonoidalDMap k (Compose t g)
forall k1 (k :: k1 -> *) (t :: * -> *) (g :: k1 -> *).
(GCompare k, Foldable t, Filterable t) =>
DMap k g -> t (MonoidalDMap k g) -> MonoidalDMap k (Compose t g)
condenseD' DMap k g
r) ((t (MonoidalDMap k g), t (MonoidalDMap k g))
-> (MonoidalDMap k (Compose t g), MonoidalDMap k (Compose t g)))
-> (t (MonoidalDMap k g), t (MonoidalDMap k g))
-> (MonoidalDMap k (Compose t g), MonoidalDMap k (Compose t g))
forall a b. (a -> b) -> a -> b
$ k v
-> t (MonoidalDMap k g)
-> (t (MonoidalDMap k g), t (MonoidalDMap k g))
forall k (k :: k -> *) (t :: * -> *) (x :: k) (g :: k -> *).
(GCompare k, Filterable t) =>
k x
-> t (MonoidalDMap k g)
-> (t (MonoidalDMap k g), t (MonoidalDMap k g))
splitD k v
pivot t (MonoidalDMap k g)
col
findPivotD :: (GCompare k) => DMap k g -> PivotD k g
findPivotD :: DMap k g -> PivotD k g
findPivotD DMap k g
m = case DMap k g
m of
DMap k g
Tip -> PivotD k g
forall l (k :: l -> *) (g :: l -> *). PivotD k g
NoneD
Bin Int
_ k v
k g v
v DMap k g
l DMap k g
r
| DMap k g -> Bool
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Bool
DMap'.null DMap k g
l Bool -> Bool -> Bool
&& DMap k g -> Bool
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Bool
DMap'.null DMap k g
r -> k v -> g v -> PivotD k g
forall l (k :: l -> *) (g :: l -> *) (v :: l).
k v -> g v -> PivotD k g
OneD k v
k g v
v
| Bool
otherwise -> k v -> DMap k g -> DMap k g -> PivotD k g
forall l (k :: l -> *) (g :: l -> *) (v :: l).
k v -> DMap k g -> DMap k g -> PivotD k g
SplitD k v
k (k v -> g v -> DMap k g -> DMap k g
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> f v -> DMap k2 f -> DMap k2 f
DMap'.insert k v
k g v
v DMap k g
l) DMap k g
r
unionDistinctAscD :: (GCompare k) => MonoidalDMap k g -> MonoidalDMap k g -> MonoidalDMap k g
unionDistinctAscD :: MonoidalDMap k g -> MonoidalDMap k g -> MonoidalDMap k g
unionDistinctAscD = (forall (v :: k). k v -> g v -> g v -> g v)
-> MonoidalDMap k g -> MonoidalDMap k g -> MonoidalDMap k g
forall k1 (k2 :: k1 -> *) (f :: k1 -> *).
GCompare k2 =>
(forall (v :: k1). k2 v -> f v -> f v -> f v)
-> MonoidalDMap k2 f -> MonoidalDMap k2 f -> MonoidalDMap k2 f
DMap.unionWithKey (\k v
_ g v
x g v
_ -> g v
x)
splitLTD :: GCompare k => k v -> MonoidalDMap k g -> (MonoidalDMap k g, MonoidalDMap k g)
splitLTD :: k v -> MonoidalDMap k g -> (MonoidalDMap k g, MonoidalDMap k g)
splitLTD k v
k MonoidalDMap k g
m = case k v
-> MonoidalDMap k g
-> (MonoidalDMap k g, Maybe (g v), MonoidalDMap k g)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v
-> MonoidalDMap k2 f
-> (MonoidalDMap k2 f, Maybe (f v), MonoidalDMap k2 f)
DMap.splitLookup k v
k MonoidalDMap k g
m of
(MonoidalDMap k g
l, Just g v
v, MonoidalDMap k g
r) -> (k v -> g v -> MonoidalDMap k g -> MonoidalDMap k g
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> f v -> MonoidalDMap k2 f -> MonoidalDMap k2 f
DMap.insert k v
k g v
v MonoidalDMap k g
l, MonoidalDMap k g
r)
(MonoidalDMap k g
l, Maybe (g v)
Nothing, MonoidalDMap k g
r) -> (MonoidalDMap k g
l, MonoidalDMap k g
r)
alignWithKeyMonoidalDMap :: GCompare k => (forall a. k a -> These (f a) (g a) -> h a) -> MonoidalDMap k f -> MonoidalDMap k g -> MonoidalDMap k h
alignWithKeyMonoidalDMap :: (forall (a :: k). k a -> These (f a) (g a) -> h a)
-> MonoidalDMap k f -> MonoidalDMap k g -> MonoidalDMap k h
alignWithKeyMonoidalDMap forall (a :: k). k a -> These (f a) (g a) -> h a
f (MonoidalDMap DMap k f
a) (MonoidalDMap DMap k g
b) = DMap k h -> MonoidalDMap k h
forall k (f :: k -> *) (g :: k -> *). DMap f g -> MonoidalDMap f g
MonoidalDMap (DMap k h -> MonoidalDMap k h) -> DMap k h -> MonoidalDMap k h
forall a b. (a -> b) -> a -> b
$ (forall (a :: k). k a -> These (f a) (g a) -> h a)
-> DMap k f -> DMap k g -> DMap k h
forall k (k :: k -> *) (f :: k -> *) (g :: k -> *) (h :: k -> *).
GCompare k =>
(forall (a :: k). k a -> These (f a) (g a) -> h a)
-> DMap k f -> DMap k g -> DMap k h
alignWithKeyDMap forall (a :: k). k a -> These (f a) (g a) -> h a
f DMap k f
a DMap k g
b
alignWithKeyMaybeMonoidalDMap :: GCompare k => (forall a. k a -> These (f a) (g a) -> Maybe (h a)) -> MonoidalDMap k f -> MonoidalDMap k g -> MonoidalDMap k h
alignWithKeyMaybeMonoidalDMap :: (forall (a :: k). k a -> These (f a) (g a) -> Maybe (h a))
-> MonoidalDMap k f -> MonoidalDMap k g -> MonoidalDMap k h
alignWithKeyMaybeMonoidalDMap forall (a :: k). k a -> These (f a) (g a) -> Maybe (h a)
f (MonoidalDMap DMap k f
a) (MonoidalDMap DMap k g
b) = DMap k h -> MonoidalDMap k h
forall k (f :: k -> *) (g :: k -> *). DMap f g -> MonoidalDMap f g
MonoidalDMap (DMap k h -> MonoidalDMap k h) -> DMap k h -> MonoidalDMap k h
forall a b. (a -> b) -> a -> b
$ (forall (a :: k). k a -> These (f a) (g a) -> Maybe (h a))
-> DMap k f -> DMap k g -> DMap k h
forall k (k :: k -> *) (f :: k -> *) (g :: k -> *) (h :: k -> *).
GCompare k =>
(forall (a :: k). k a -> These (f a) (g a) -> Maybe (h a))
-> DMap k f -> DMap k g -> DMap k h
alignWithKeyMaybeDMap forall (a :: k). k a -> These (f a) (g a) -> Maybe (h a)
f DMap k f
a DMap k g
b
splitD :: (GCompare k, Filterable t)
=> k x -> t (MonoidalDMap k g) -> (t (MonoidalDMap k g), t (MonoidalDMap k g))
splitD :: k x
-> t (MonoidalDMap k g)
-> (t (MonoidalDMap k g), t (MonoidalDMap k g))
splitD k x
pivot t (MonoidalDMap k g)
col = t (These (MonoidalDMap k g) (MonoidalDMap k g))
-> (t (MonoidalDMap k g), t (MonoidalDMap k g))
forall (f :: * -> *) a b.
Filterable f =>
f (These a b) -> (f a, f b)
unalignProperly (t (These (MonoidalDMap k g) (MonoidalDMap k g))
-> (t (MonoidalDMap k g), t (MonoidalDMap k g)))
-> t (These (MonoidalDMap k g) (MonoidalDMap k g))
-> (t (MonoidalDMap k g), t (MonoidalDMap k g))
forall a b. (a -> b) -> a -> b
$ (MonoidalDMap k g
-> Maybe (These (MonoidalDMap k g) (MonoidalDMap k g)))
-> t (MonoidalDMap k g)
-> t (These (MonoidalDMap k g) (MonoidalDMap k g))
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (k x
-> MonoidalDMap k g
-> Maybe (These (MonoidalDMap k g) (MonoidalDMap k g))
forall k (k :: k -> *) (v :: k) (g :: k -> *).
GCompare k =>
k v
-> MonoidalDMap k g
-> Maybe (These (MonoidalDMap k g) (MonoidalDMap k g))
splitOneD k x
pivot) t (MonoidalDMap k g)
col
splitOneD :: (GCompare k) => k v -> MonoidalDMap k g -> Maybe (These (MonoidalDMap k g) (MonoidalDMap k g))
splitOneD :: k v
-> MonoidalDMap k g
-> Maybe (These (MonoidalDMap k g) (MonoidalDMap k g))
splitOneD k v
pivot MonoidalDMap k g
m =
let (MonoidalDMap k g
l, MonoidalDMap k g
r) = k v -> MonoidalDMap k g -> (MonoidalDMap k g, MonoidalDMap k g)
forall k (k :: k -> *) (v :: k) (g :: k -> *).
GCompare k =>
k v -> MonoidalDMap k g -> (MonoidalDMap k g, MonoidalDMap k g)
splitLTD k v
pivot MonoidalDMap k g
m
in case (MonoidalDMap k g -> Bool
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). MonoidalDMap k2 f -> Bool
DMap.null MonoidalDMap k g
l, MonoidalDMap k g -> Bool
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). MonoidalDMap k2 f -> Bool
DMap.null MonoidalDMap k g
r) of
(Bool
True, Bool
True) -> Maybe (These (MonoidalDMap k g) (MonoidalDMap k g))
forall a. Maybe a
Nothing
(Bool
False, Bool
True) -> These (MonoidalDMap k g) (MonoidalDMap k g)
-> Maybe (These (MonoidalDMap k g) (MonoidalDMap k g))
forall a. a -> Maybe a
Just (These (MonoidalDMap k g) (MonoidalDMap k g)
-> Maybe (These (MonoidalDMap k g) (MonoidalDMap k g)))
-> These (MonoidalDMap k g) (MonoidalDMap k g)
-> Maybe (These (MonoidalDMap k g) (MonoidalDMap k g))
forall a b. (a -> b) -> a -> b
$ MonoidalDMap k g -> These (MonoidalDMap k g) (MonoidalDMap k g)
forall a b. a -> These a b
This MonoidalDMap k g
l
(Bool
True, Bool
False) -> These (MonoidalDMap k g) (MonoidalDMap k g)
-> Maybe (These (MonoidalDMap k g) (MonoidalDMap k g))
forall a. a -> Maybe a
Just (These (MonoidalDMap k g) (MonoidalDMap k g)
-> Maybe (These (MonoidalDMap k g) (MonoidalDMap k g)))
-> These (MonoidalDMap k g) (MonoidalDMap k g)
-> Maybe (These (MonoidalDMap k g) (MonoidalDMap k g))
forall a b. (a -> b) -> a -> b
$ MonoidalDMap k g -> These (MonoidalDMap k g) (MonoidalDMap k g)
forall a b. b -> These a b
That MonoidalDMap k g
r
(Bool
False, Bool
False) -> These (MonoidalDMap k g) (MonoidalDMap k g)
-> Maybe (These (MonoidalDMap k g) (MonoidalDMap k g))
forall a. a -> Maybe a
Just (These (MonoidalDMap k g) (MonoidalDMap k g)
-> Maybe (These (MonoidalDMap k g) (MonoidalDMap k g)))
-> These (MonoidalDMap k g) (MonoidalDMap k g)
-> Maybe (These (MonoidalDMap k g) (MonoidalDMap k g))
forall a b. (a -> b) -> a -> b
$ MonoidalDMap k g
-> MonoidalDMap k g -> These (MonoidalDMap k g) (MonoidalDMap k g)
forall a b. a -> b -> These a b
These MonoidalDMap k g
l MonoidalDMap k g
r
instance Group (f (g x)) => Group (Compose f g x) where
negateG :: Compose f g x -> Compose f g x
negateG (Compose f (g x)
fgx) = f (g x) -> Compose f g x
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g x) -> f (g x)
forall q. Group q => q -> q
negateG f (g x)
fgx)
Compose f (g x)
fgx ~~ :: Compose f g x -> Compose f g x -> Compose f g x
~~ Compose f (g x)
fgy = f (g x) -> Compose f g x
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g x)
fgx f (g x) -> f (g x) -> f (g x)
forall q. Group q => q -> q -> q
~~ f (g x)
fgy)
curryMMap :: (Ord a, Ord b) => MonoidalMap (a,b) c -> MonoidalMap a (MonoidalMap b c)
curryMMap :: MonoidalMap (a, b) c -> MonoidalMap a (MonoidalMap b c)
curryMMap MonoidalMap (a, b) c
m = (MonoidalMap b c -> MonoidalMap b c -> MonoidalMap b c)
-> [(a, MonoidalMap b c)] -> MonoidalMap a (MonoidalMap b c)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> MonoidalMap k a
Map.fromListWith ((c -> c -> c)
-> MonoidalMap b c -> MonoidalMap b c -> MonoidalMap b c
forall k a.
Ord k =>
(a -> a -> a)
-> MonoidalMap k a -> MonoidalMap k a -> MonoidalMap k a
Map.unionWith (String -> c -> c -> c
forall a. HasCallStack => String -> a
error String
"overlap")) ([(a, MonoidalMap b c)] -> MonoidalMap a (MonoidalMap b c))
-> [(a, MonoidalMap b c)] -> MonoidalMap a (MonoidalMap b c)
forall a b. (a -> b) -> a -> b
$
[ (a
a, (b -> c -> MonoidalMap b c
forall k a. k -> a -> MonoidalMap k a
Map.singleton b
b c
c))
| ((a
a,b
b), c
c) <- MonoidalMap (a, b) c -> [((a, b), c)]
forall k a. MonoidalMap k a -> [(k, a)]
Map.toList MonoidalMap (a, b) c
m
]
uncurryMMap :: (Ord a, Ord b) => MonoidalMap a (MonoidalMap b c) -> MonoidalMap (a,b) c
uncurryMMap :: MonoidalMap a (MonoidalMap b c) -> MonoidalMap (a, b) c
uncurryMMap MonoidalMap a (MonoidalMap b c)
m = (c -> c -> c) -> [((a, b), c)] -> MonoidalMap (a, b) c
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> MonoidalMap k a
Map.fromListWith (String -> c -> c -> c
forall a. HasCallStack => String -> a
error String
"overlap") ([((a, b), c)] -> MonoidalMap (a, b) c)
-> [((a, b), c)] -> MonoidalMap (a, b) c
forall a b. (a -> b) -> a -> b
$
[ ((a
a, b
b), c
c)
| (a
a, MonoidalMap b c
bc) <- MonoidalMap a (MonoidalMap b c) -> [(a, MonoidalMap b c)]
forall k a. MonoidalMap k a -> [(k, a)]
Map.toList MonoidalMap a (MonoidalMap b c)
m
, (b
b, c
c) <- MonoidalMap b c -> [(b, c)]
forall k a. MonoidalMap k a -> [(k, a)]
Map.toList MonoidalMap b c
bc
]
leftOuterJoin :: Ord k => (a -> c) -> (a -> b -> c) -> MonoidalMap k a -> MonoidalMap k b -> MonoidalMap k c
leftOuterJoin :: (a -> c)
-> (a -> b -> c)
-> MonoidalMap k a
-> MonoidalMap k b
-> MonoidalMap k c
leftOuterJoin =
(forall a c b k.
((a -> c) -> (a -> b -> c) -> Map k a -> Map k b -> Map k c)
-> (a -> c)
-> (a -> b -> c)
-> MonoidalMap k a
-> MonoidalMap k b
-> MonoidalMap k c
coerce :: ((a -> c) -> (a -> b -> c) -> Map'.Map k a -> Map'.Map k b -> Map'.Map k c)
-> ((a -> c) -> (a -> b -> c) -> MonoidalMap k a -> MonoidalMap k b -> MonoidalMap k c)
) (a -> c) -> (a -> b -> c) -> Map k a -> Map k b -> Map k c
forall k a c b.
Ord k =>
(a -> c) -> (a -> b -> c) -> Map k a -> Map k b -> Map k c
leftOuterJoin'
leftOuterJoin' :: Ord k => (a -> c) -> (a -> b -> c) -> Map'.Map k a -> Map'.Map k b -> Map'.Map k c
leftOuterJoin' :: (a -> c) -> (a -> b -> c) -> Map k a -> Map k b -> Map k c
leftOuterJoin' a -> c
a2c a -> b -> c
ab2c = SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
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
((k -> a -> c) -> SimpleWhenMissing k a c
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map'.mapMissing ((k -> a -> c) -> SimpleWhenMissing k a c)
-> (k -> a -> c) -> SimpleWhenMissing k a c
forall a b. (a -> b) -> a -> b
$ \k
_ -> a -> c
a2c)
SimpleWhenMissing k b c
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
Map'.dropMissing
((k -> a -> b -> c) -> SimpleWhenMatched k a b c
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
Map'.zipWithMatched ((k -> a -> b -> c) -> SimpleWhenMatched k a b c)
-> (k -> a -> b -> c) -> SimpleWhenMatched k a b c
forall a b. (a -> b) -> a -> b
$ \k
_ -> a -> b -> c
ab2c)
leftOuterJoin_ :: Ord k => a -> Set k -> MonoidalMap k a -> MonoidalMap k a
leftOuterJoin_ :: a -> Set k -> MonoidalMap k a -> MonoidalMap k a
leftOuterJoin_ a
x = (a -> a)
-> (a -> a -> a)
-> MonoidalMap k a
-> MonoidalMap k a
-> MonoidalMap k a
forall k a c b.
Ord k =>
(a -> c)
-> (a -> b -> c)
-> MonoidalMap k a
-> MonoidalMap k b
-> MonoidalMap k c
leftOuterJoin a -> a
forall a. a -> a
id a -> a -> a
forall a b. a -> b -> a
const (MonoidalMap k a -> MonoidalMap k a -> MonoidalMap k a)
-> (Set k -> MonoidalMap k a)
-> Set k
-> MonoidalMap k a
-> MonoidalMap k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> a) -> Set k -> MonoidalMap k a
forall k a. (k -> a) -> Set k -> MonoidalMap k a
Map.fromSet (a -> k -> a
forall a b. a -> b -> a
const a
x)