{-# 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
-- import qualified Data.Dependent.Map 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)

------- Instances for FlipAp -------

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)


-- A single Vessel key/value pair, essentially a choice of container type, together with a corresponding container.
data VSum (k :: ((* -> *) -> *) -> *) (g :: * -> *) = forall v. k v :~> v g

------- Serialisation -------

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)
--
------ TODO: Orphans that need a good home -------

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)

------- Miscellaneous stuff to be moved elsewhere -------

-- TODO: These belong in Data.Functor.Compose -- good luck to anyone who wants to upstream them into base though.
-- Perhaps we could start a small module filled with basic coherences like this.
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

-- TODO: Contribute this to the 'these' package and/or sort out its generalisation.
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)