{-# LANGUAGE
    CPP,
    DeriveFunctor,
    DerivingVia,
    FlexibleInstances,
    FunctionalDependencies,
    QuantifiedConstraints,
    ScopedTypeVariables
  #-}

module Data.Mapping where

#if MIN_VERSION_GLASGOW_HASKELL(9,6,0,0)
#else
import Control.Applicative (liftA2)
#endif
import Prelude hiding (not, (&&), (||))
import Data.Algebra.Boolean (Boolean(..))
import Data.Foldable.WithIndex (FoldableWithIndex(..))
import Data.Function (on)
import Data.Functor.Const (Const(..))
import Data.Functor.Identity (Identity(..))
import Data.Kind (Type)
import Data.Monoid (All(..))
import Data.PartialOrd
import Data.Set (Set)
import qualified Data.Set as S
import Data.Void (Void)


-- | If @Mapping k m@, then @m v@ represents a function @k -> v@.
--
-- `Mapping` requires an instance of `Foldable`, folding over the
-- values that appear. Given that a value can be associated with a
-- very large collection of keys, the only folds that normally make
-- sense are those over idempotent monoids.
class Foldable m => Mapping k m | m -> k where
  cst :: v -> m v

  act :: m v -> k -> v

  isConst :: Ord v => m v -> Maybe v

  mtraverse :: (Applicative f, Ord v) => (u -> f v) -> m u -> f (m v)

  mmap :: Ord v => (u -> v) -> m u -> m v
  mmap u -> v
p = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (m :: * -> *) (f :: * -> *) v u.
(Mapping k m, Applicative f, Ord v) =>
(u -> f v) -> m u -> f (m v)
mtraverse (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. u -> v
p)

  mergeA :: (Applicative f, Ord w) => (u -> v -> f w) -> m u -> m v -> f (m w)

  merge :: Ord w => (u -> v -> w) -> m u -> m v -> m w
  merge u -> v -> w
p m u
m m v
n = let
    q :: u -> v -> Identity w
q u
x v
y = forall a. a -> Identity a
Identity forall a b. (a -> b) -> a -> b
$ u -> v -> w
p u
x v
y
    in forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall k (m :: * -> *) (f :: * -> *) w u v.
(Mapping k m, Applicative f, Ord w) =>
(u -> v -> f w) -> m u -> m v -> f (m w)
mergeA u -> v -> Identity w
q m u
m m v
n


-- | A simultaneous foldMap over two maps
pairMappings :: forall k m u v a. (Mapping k m, Monoid a) => (u -> v -> a) -> m u -> m v -> a
pairMappings :: forall k (m :: * -> *) u v a.
(Mapping k m, Monoid a) =>
(u -> v -> a) -> m u -> m v -> a
pairMappings u -> v -> a
p m u
m m v
n = let
  q :: u -> v -> Const a Void
  q :: u -> v -> Const a Void
q u
x v
y = forall {k} a (b :: k). a -> Const a b
Const forall a b. (a -> b) -> a -> b
$ u -> v -> a
p u
x v
y
  in forall {k} a (b :: k). Const a b -> a
getConst (forall k (m :: * -> *) (f :: * -> *) w u v.
(Mapping k m, Applicative f, Ord w) =>
(u -> v -> f w) -> m u -> m v -> f (m w)
mergeA u -> v -> Const a Void
q m u
m m v
n)

-- | What values can these two take simultaneously?
mutualValues :: (Ord u, Ord v, Mapping k m) => m u -> m v -> Set (u, v)
mutualValues :: forall u v k (m :: * -> *).
(Ord u, Ord v, Mapping k m) =>
m u -> m v -> Set (u, v)
mutualValues = forall k (m :: * -> *) u v a.
(Mapping k m, Monoid a) =>
(u -> v -> a) -> m u -> m v -> a
pairMappings forall a b. (a -> b) -> a -> b
$ forall a b c. ((a, b) -> c) -> a -> b -> c
curry forall a. a -> Set a
S.singleton



-- | A class representing data structures which have a concept of neighbouring
-- values
class Neighbourly m where
  neighbours :: Ord v => m v -> Set (v, v)


-- | A wrapper for representing pointwise algebraic structures on a Mapping
--
-- Eventually would like to use this only for "deriving via"
newtype AlgebraWrapper k m a = AlgebraWrapper { forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
AlgebraWrapper k m a -> m a
algebraUnwrap :: m a }

instance (Mapping k m, Ord a, Semigroup a) => Semigroup (AlgebraWrapper k m a) where
  <> :: AlgebraWrapper k m a
-> AlgebraWrapper k m a -> AlgebraWrapper k m a
(<>) = (forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
m a -> AlgebraWrapper k m a
AlgebraWrapper .) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (m :: * -> *) w u v.
(Mapping k m, Ord w) =>
(u -> v -> w) -> m u -> m v -> m w
merge forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
AlgebraWrapper k m a -> m a
algebraUnwrap

instance (Mapping k m, Ord a, Monoid a) => Monoid (AlgebraWrapper k m a) where
  mempty :: AlgebraWrapper k m a
mempty = forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
m a -> AlgebraWrapper k m a
AlgebraWrapper forall a b. (a -> b) -> a -> b
$ forall k (m :: * -> *) v. Mapping k m => v -> m v
cst forall a. Monoid a => a
mempty

instance (Mapping k m, Ord a, Num a) => Num (AlgebraWrapper k m a) where
  + :: AlgebraWrapper k m a
-> AlgebraWrapper k m a -> AlgebraWrapper k m a
(+) =  (forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
m a -> AlgebraWrapper k m a
AlgebraWrapper .) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (m :: * -> *) w u v.
(Mapping k m, Ord w) =>
(u -> v -> w) -> m u -> m v -> m w
merge forall a. Num a => a -> a -> a
(+) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
AlgebraWrapper k m a -> m a
algebraUnwrap
  (-) =  (forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
m a -> AlgebraWrapper k m a
AlgebraWrapper .) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (m :: * -> *) w u v.
(Mapping k m, Ord w) =>
(u -> v -> w) -> m u -> m v -> m w
merge (-) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
AlgebraWrapper k m a -> m a
algebraUnwrap
  * :: AlgebraWrapper k m a
-> AlgebraWrapper k m a -> AlgebraWrapper k m a
(*) =  (forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
m a -> AlgebraWrapper k m a
AlgebraWrapper .) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (m :: * -> *) w u v.
(Mapping k m, Ord w) =>
(u -> v -> w) -> m u -> m v -> m w
merge forall a. Num a => a -> a -> a
(*) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
AlgebraWrapper k m a -> m a
algebraUnwrap
  fromInteger :: Integer -> AlgebraWrapper k m a
fromInteger = forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
m a -> AlgebraWrapper k m a
AlgebraWrapper forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (m :: * -> *) v. Mapping k m => v -> m v
cst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger
  abs :: AlgebraWrapper k m a -> AlgebraWrapper k m a
abs = forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
m a -> AlgebraWrapper k m a
AlgebraWrapper forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (m :: * -> *) v u.
(Mapping k m, Ord v) =>
(u -> v) -> m u -> m v
mmap forall a. Num a => a -> a
abs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
AlgebraWrapper k m a -> m a
algebraUnwrap
  negate :: AlgebraWrapper k m a -> AlgebraWrapper k m a
negate = forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
m a -> AlgebraWrapper k m a
AlgebraWrapper forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (m :: * -> *) v u.
(Mapping k m, Ord v) =>
(u -> v) -> m u -> m v
mmap forall a. Num a => a -> a
negate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
AlgebraWrapper k m a -> m a
algebraUnwrap
  signum :: AlgebraWrapper k m a -> AlgebraWrapper k m a
signum = forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
m a -> AlgebraWrapper k m a
AlgebraWrapper forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (m :: * -> *) v u.
(Mapping k m, Ord v) =>
(u -> v) -> m u -> m v
mmap forall a. Num a => a -> a
signum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
AlgebraWrapper k m a -> m a
algebraUnwrap

instance (Mapping k m, Ord a, Boolean a) => Boolean (AlgebraWrapper k m a) where
  true :: AlgebraWrapper k m a
true = forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
m a -> AlgebraWrapper k m a
AlgebraWrapper forall a b. (a -> b) -> a -> b
$ forall k (m :: * -> *) v. Mapping k m => v -> m v
cst forall b. Boolean b => b
true
  false :: AlgebraWrapper k m a
false = forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
m a -> AlgebraWrapper k m a
AlgebraWrapper forall a b. (a -> b) -> a -> b
$ forall k (m :: * -> *) v. Mapping k m => v -> m v
cst forall b. Boolean b => b
false
  not :: AlgebraWrapper k m a -> AlgebraWrapper k m a
not = forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
m a -> AlgebraWrapper k m a
AlgebraWrapper forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (m :: * -> *) v u.
(Mapping k m, Ord v) =>
(u -> v) -> m u -> m v
mmap forall b. Boolean b => b -> b
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
AlgebraWrapper k m a -> m a
algebraUnwrap
  && :: AlgebraWrapper k m a
-> AlgebraWrapper k m a -> AlgebraWrapper k m a
(&&) = (forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
m a -> AlgebraWrapper k m a
AlgebraWrapper .) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (m :: * -> *) w u v.
(Mapping k m, Ord w) =>
(u -> v -> w) -> m u -> m v -> m w
merge forall b. Boolean b => b -> b -> b
(&&) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
AlgebraWrapper k m a -> m a
algebraUnwrap
  || :: AlgebraWrapper k m a
-> AlgebraWrapper k m a -> AlgebraWrapper k m a
(||) = (forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
m a -> AlgebraWrapper k m a
AlgebraWrapper .) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (m :: * -> *) w u v.
(Mapping k m, Ord w) =>
(u -> v -> w) -> m u -> m v -> m w
merge forall b. Boolean b => b -> b -> b
(||) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
AlgebraWrapper k m a -> m a
algebraUnwrap
  xor :: AlgebraWrapper k m a
-> AlgebraWrapper k m a -> AlgebraWrapper k m a
xor = (forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
m a -> AlgebraWrapper k m a
AlgebraWrapper .) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (m :: * -> *) w u v.
(Mapping k m, Ord w) =>
(u -> v -> w) -> m u -> m v -> m w
merge forall b. Boolean b => b -> b -> b
xor forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
AlgebraWrapper k m a -> m a
algebraUnwrap
  --> :: AlgebraWrapper k m a
-> AlgebraWrapper k m a -> AlgebraWrapper k m a
(-->) = (forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
m a -> AlgebraWrapper k m a
AlgebraWrapper .) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (m :: * -> *) w u v.
(Mapping k m, Ord w) =>
(u -> v -> w) -> m u -> m v -> m w
merge forall b. Boolean b => b -> b -> b
(-->) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
AlgebraWrapper k m a -> m a
algebraUnwrap
  <--> :: AlgebraWrapper k m a
-> AlgebraWrapper k m a -> AlgebraWrapper k m a
(<-->) = (forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
m a -> AlgebraWrapper k m a
AlgebraWrapper .) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (m :: * -> *) w u v.
(Mapping k m, Ord w) =>
(u -> v -> w) -> m u -> m v -> m w
merge forall b. Boolean b => b -> b -> b
(<-->) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall {k} {k} (k :: k) (m :: k -> *) (a :: k).
AlgebraWrapper k m a -> m a
algebraUnwrap


-- | Constant functions (on any domain)
newtype Constant k v = Constant { forall {k} (k :: k) v. Constant k v -> v
constantValue :: v }

instance Foldable (Constant k) where
  foldMap :: forall m a. Monoid m => (a -> m) -> Constant k a -> m
foldMap a -> m
f (Constant a
a) = a -> m
f a
a

instance Mapping k (Constant k) where
  cst :: forall v. v -> Constant k v
cst = forall {k} (k :: k) v. v -> Constant k v
Constant
  act :: forall v. Constant k v -> k -> v
act (Constant v
x) k
_ = v
x
  mmap :: forall v u. Ord v => (u -> v) -> Constant k u -> Constant k v
mmap u -> v
f (Constant u
x) = forall {k} (k :: k) v. v -> Constant k v
Constant forall a b. (a -> b) -> a -> b
$ u -> v
f u
x
  mtraverse :: forall (f :: * -> *) v u.
(Applicative f, Ord v) =>
(u -> f v) -> Constant k u -> f (Constant k v)
mtraverse u -> f v
f (Constant u
x) = forall {k} (k :: k) v. v -> Constant k v
Constant forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> u -> f v
f u
x
  isConst :: forall v. Ord v => Constant k v -> Maybe v
isConst (Constant v
x) = forall a. a -> Maybe a
Just v
x
  merge :: forall w u v.
Ord w =>
(u -> v -> w) -> Constant k u -> Constant k v -> Constant k w
merge u -> v -> w
f (Constant u
x) (Constant v
y) = forall {k} (k :: k) v. v -> Constant k v
Constant forall a b. (a -> b) -> a -> b
$ u -> v -> w
f u
x v
y
  mergeA :: forall (f :: * -> *) w u v.
(Applicative f, Ord w) =>
(u -> v -> f w) -> Constant k u -> Constant k v -> f (Constant k w)
mergeA u -> v -> f w
f (Constant u
x) (Constant v
y) = forall {k} (k :: k) v. v -> Constant k v
Constant forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> u -> v -> f w
f u
x v
y

instance Neighbourly (Constant k) where
  neighbours :: forall v. Ord v => Constant k v -> Set (v, v)
neighbours = forall a b. a -> b -> a
const forall a. Set a
S.empty

-- Haven't been able to make deriving via work for this one
instance (Semigroup v) => Semigroup (Constant k v) where
  Constant v
x <> :: Constant k v -> Constant k v -> Constant k v
<> Constant v
y = forall {k} (k :: k) v. v -> Constant k v
Constant (v
x forall a. Semigroup a => a -> a -> a
<> v
y)

-- Haven't been able to make deriving via work for this one
instance (Monoid v) => Monoid (Constant k v) where
  mempty :: Constant k v
mempty = forall {k} (k :: k) v. v -> Constant k v
Constant forall a. Monoid a => a
mempty

-- Haven't been able to make deriving via work for this one
instance (Num v) => Num (Constant k v) where
  Constant v
x + :: Constant k v -> Constant k v -> Constant k v
+ Constant v
y = forall {k} (k :: k) v. v -> Constant k v
Constant (v
x forall a. Num a => a -> a -> a
+ v
y)
  Constant v
x - :: Constant k v -> Constant k v -> Constant k v
- Constant v
y = forall {k} (k :: k) v. v -> Constant k v
Constant (v
x forall a. Num a => a -> a -> a
- v
y)
  Constant v
x * :: Constant k v -> Constant k v -> Constant k v
* Constant v
y = forall {k} (k :: k) v. v -> Constant k v
Constant (v
x forall a. Num a => a -> a -> a
* v
y)
  abs :: Constant k v -> Constant k v
abs (Constant v
x) = forall {k} (k :: k) v. v -> Constant k v
Constant (forall a. Num a => a -> a
abs v
x)
  negate :: Constant k v -> Constant k v
negate (Constant v
x) = forall {k} (k :: k) v. v -> Constant k v
Constant (forall a. Num a => a -> a
negate v
x)
  signum :: Constant k v -> Constant k v
signum (Constant v
x) = forall {k} (k :: k) v. v -> Constant k v
Constant (forall a. Num a => a -> a
signum v
x)
  fromInteger :: Integer -> Constant k v
fromInteger = forall {k} (k :: k) v. v -> Constant k v
Constant forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger

-- Haven't been able to make deriving via work for this one
instance (Boolean v) => Boolean (Constant k v) where
  false :: Constant k v
false = forall {k} (k :: k) v. v -> Constant k v
Constant forall b. Boolean b => b
false
  true :: Constant k v
true = forall {k} (k :: k) v. v -> Constant k v
Constant forall b. Boolean b => b
true
  not :: Constant k v -> Constant k v
not (Constant v
x) = forall {k} (k :: k) v. v -> Constant k v
Constant (forall b. Boolean b => b -> b
not v
x)
  Constant v
x && :: Constant k v -> Constant k v -> Constant k v
&& Constant v
y = forall {k} (k :: k) v. v -> Constant k v
Constant (v
x forall b. Boolean b => b -> b -> b
&& v
y)
  Constant v
x || :: Constant k v -> Constant k v -> Constant k v
|| Constant v
y = forall {k} (k :: k) v. v -> Constant k v
Constant (v
x forall b. Boolean b => b -> b -> b
|| v
y)
  xor :: Constant k v -> Constant k v -> Constant k v
xor (Constant v
x) (Constant v
y) = forall {k} (k :: k) v. v -> Constant k v
Constant (forall b. Boolean b => b -> b -> b
xor v
x v
y)
  Constant v
x <--> :: Constant k v -> Constant k v -> Constant k v
<--> Constant v
y = forall {k} (k :: k) v. v -> Constant k v
Constant (v
x forall b. Boolean b => b -> b -> b
<--> v
y)
  Constant v
x --> :: Constant k v -> Constant k v -> Constant k v
--> Constant v
y = forall {k} (k :: k) v. v -> Constant k v
Constant (v
x forall b. Boolean b => b -> b -> b
--> v
y)


-- | Binary decisions, as functions defined on Bool
data OnBool a = OnBool {
  forall a. OnBool a -> a
onFalse :: a,
  forall a. OnBool a -> a
onTrue :: a
} deriving (OnBool a -> OnBool a -> Bool
forall a. Eq a => OnBool a -> OnBool a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OnBool a -> OnBool a -> Bool
$c/= :: forall a. Eq a => OnBool a -> OnBool a -> Bool
== :: OnBool a -> OnBool a -> Bool
$c== :: forall a. Eq a => OnBool a -> OnBool a -> Bool
Eq, OnBool a -> OnBool a -> Bool
OnBool a -> OnBool a -> Ordering
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 {a}. Ord a => Eq (OnBool a)
forall a. Ord a => OnBool a -> OnBool a -> Bool
forall a. Ord a => OnBool a -> OnBool a -> Ordering
forall a. Ord a => OnBool a -> OnBool a -> OnBool a
min :: OnBool a -> OnBool a -> OnBool a
$cmin :: forall a. Ord a => OnBool a -> OnBool a -> OnBool a
max :: OnBool a -> OnBool a -> OnBool a
$cmax :: forall a. Ord a => OnBool a -> OnBool a -> OnBool a
>= :: OnBool a -> OnBool a -> Bool
$c>= :: forall a. Ord a => OnBool a -> OnBool a -> Bool
> :: OnBool a -> OnBool a -> Bool
$c> :: forall a. Ord a => OnBool a -> OnBool a -> Bool
<= :: OnBool a -> OnBool a -> Bool
$c<= :: forall a. Ord a => OnBool a -> OnBool a -> Bool
< :: OnBool a -> OnBool a -> Bool
$c< :: forall a. Ord a => OnBool a -> OnBool a -> Bool
compare :: OnBool a -> OnBool a -> Ordering
$ccompare :: forall a. Ord a => OnBool a -> OnBool a -> Ordering
Ord, Int -> OnBool a -> ShowS
forall a. Show a => Int -> OnBool a -> ShowS
forall a. Show a => [OnBool a] -> ShowS
forall a. Show a => OnBool a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OnBool a] -> ShowS
$cshowList :: forall a. Show a => [OnBool a] -> ShowS
show :: OnBool a -> String
$cshow :: forall a. Show a => OnBool a -> String
showsPrec :: Int -> OnBool a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> OnBool a -> ShowS
Show, forall a b. a -> OnBool b -> OnBool a
forall a b. (a -> b) -> OnBool a -> OnBool b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> OnBool b -> OnBool a
$c<$ :: forall a b. a -> OnBool b -> OnBool a
fmap :: forall a b. (a -> b) -> OnBool a -> OnBool b
$cfmap :: forall a b. (a -> b) -> OnBool a -> OnBool b
Functor)

instance Foldable OnBool where
  foldMap :: forall m a. Monoid m => (a -> m) -> OnBool a -> m
foldMap a -> m
p (OnBool a
x a
y) = a -> m
p a
x forall a. Semigroup a => a -> a -> a
<> a -> m
p a
y

instance FoldableWithIndex Bool OnBool where
  ifoldMap :: forall m a. Monoid m => (Bool -> a -> m) -> OnBool a -> m
ifoldMap Bool -> a -> m
p (OnBool a
x a
y) = Bool -> a -> m
p Bool
False a
x forall a. Semigroup a => a -> a -> a
<> Bool -> a -> m
p Bool
True a
y

instance Traversable OnBool where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OnBool a -> f (OnBool b)
traverse a -> f b
f (OnBool a
x a
y) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. a -> a -> OnBool a
OnBool (a -> f b
f a
x) (a -> f b
f a
y)

instance Mapping Bool OnBool where
  cst :: forall v. v -> OnBool v
cst v
x = forall a. a -> a -> OnBool a
OnBool v
x v
x
  mmap :: forall v u. Ord v => (u -> v) -> OnBool u -> OnBool v
mmap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  mtraverse :: forall (f :: * -> *) v u.
(Applicative f, Ord v) =>
(u -> f v) -> OnBool u -> f (OnBool v)
mtraverse = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
  act :: forall v. OnBool v -> Bool -> v
act (OnBool v
x v
_) Bool
False = v
x
  act (OnBool v
_ v
x) Bool
True = v
x
  isConst :: forall v. Ord v => OnBool v -> Maybe v
isConst (OnBool v
x v
y)
    | v
x forall a. Eq a => a -> a -> Bool
== v
y    = forall a. a -> Maybe a
Just v
x
    | Bool
otherwise = forall a. Maybe a
Nothing
  mergeA :: forall (f :: * -> *) w u v.
(Applicative f, Ord w) =>
(u -> v -> f w) -> OnBool u -> OnBool v -> f (OnBool w)
mergeA u -> v -> f w
h (OnBool u
x1 u
y1) (OnBool v
x2 v
y2) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. a -> a -> OnBool a
OnBool (u -> v -> f w
h u
x1 v
x2) (u -> v -> f w
h u
y1 v
y2)
  merge :: forall w u v.
Ord w =>
(u -> v -> w) -> OnBool u -> OnBool v -> OnBool w
merge u -> v -> w
h (OnBool u
x1 u
y1) (OnBool v
x2 v
y2) = forall a. a -> a -> OnBool a
OnBool (u -> v -> w
h u
x1 v
x2) (u -> v -> w
h u
y1 v
y2)

instance Neighbourly OnBool where
  neighbours :: forall v. Ord v => OnBool v -> Set (v, v)
neighbours (OnBool v
x v
y)
    | v
x forall a. Eq a => a -> a -> Bool
== v
y    = forall a. Set a
S.empty
    | Bool
otherwise = forall a. a -> Set a
S.singleton (v
x, v
y)

deriving via (AlgebraWrapper Bool OnBool a)
  instance (Ord a, Semigroup a) => Semigroup (OnBool a)

deriving via (AlgebraWrapper Bool OnBool a)
  instance (Ord a, Monoid a) => Monoid (OnBool a)

deriving via (AlgebraWrapper Bool OnBool a)
  instance (Ord a, Num a) => Num (OnBool a)

deriving via (AlgebraWrapper Bool OnBool b)
  instance (Ord b, Boolean b) => Boolean (OnBool b)


-- | Maps on Maybe
data OnMaybe k m v = OnMaybe {
  forall {k} (k :: k) (m :: * -> *) v. OnMaybe k m v -> v
onNothing :: v,
  forall {k} (k :: k) (m :: * -> *) v. OnMaybe k m v -> m v
onJust :: m v
}

instance Foldable m => Foldable (OnMaybe k m) where
  foldMap :: forall m a. Monoid m => (a -> m) -> OnMaybe k m a -> m
foldMap a -> m
f (OnMaybe a
x m a
a) = a -> m
f a
x forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f m a
a

instance FoldableWithIndex k m => FoldableWithIndex (Maybe k) (OnMaybe k m) where
  ifoldMap :: forall m a. Monoid m => (Maybe k -> a -> m) -> OnMaybe k m a -> m
ifoldMap Maybe k -> a -> m
f (OnMaybe a
x m a
a) = Maybe k -> a -> m
f forall a. Maybe a
Nothing a
x forall a. Semigroup a => a -> a -> a
<> forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (Maybe k -> a -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) m a
a

instance Mapping k m => Mapping (Maybe k) (OnMaybe k m) where
  cst :: forall v. v -> OnMaybe k m v
cst v
x = forall {k} (k :: k) (m :: * -> *) v. v -> m v -> OnMaybe k m v
OnMaybe v
x forall a b. (a -> b) -> a -> b
$ forall k (m :: * -> *) v. Mapping k m => v -> m v
cst v
x
  mmap :: forall v u. Ord v => (u -> v) -> OnMaybe k m u -> OnMaybe k m v
mmap u -> v
p (OnMaybe u
x m u
a) = forall {k} (k :: k) (m :: * -> *) v. v -> m v -> OnMaybe k m v
OnMaybe (u -> v
p u
x) (forall k (m :: * -> *) v u.
(Mapping k m, Ord v) =>
(u -> v) -> m u -> m v
mmap u -> v
p m u
a)
  mtraverse :: forall (f :: * -> *) v u.
(Applicative f, Ord v) =>
(u -> f v) -> OnMaybe k m u -> f (OnMaybe k m v)
mtraverse u -> f v
p (OnMaybe u
x m u
a) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall {k} (k :: k) (m :: * -> *) v. v -> m v -> OnMaybe k m v
OnMaybe (u -> f v
p u
x) (forall k (m :: * -> *) (f :: * -> *) v u.
(Mapping k m, Applicative f, Ord v) =>
(u -> f v) -> m u -> f (m v)
mtraverse u -> f v
p m u
a)
  act :: forall v. OnMaybe k m v -> Maybe k -> v
act (OnMaybe v
x m v
_) Maybe k
Nothing = v
x
  act (OnMaybe v
_ m v
a) (Just k
y) = forall k (m :: * -> *) v. Mapping k m => m v -> k -> v
act m v
a k
y
  isConst :: forall v. Ord v => OnMaybe k m v -> Maybe v
isConst (OnMaybe v
x m v
a) = do
    v
y <- forall k (m :: * -> *) v. (Mapping k m, Ord v) => m v -> Maybe v
isConst m v
a
    if v
x forall a. Eq a => a -> a -> Bool
== v
y then forall a. a -> Maybe a
Just v
x else forall a. Maybe a
Nothing
  merge :: forall w u v.
Ord w =>
(u -> v -> w) -> OnMaybe k m u -> OnMaybe k m v -> OnMaybe k m w
merge u -> v -> w
h (OnMaybe u
x m u
a) (OnMaybe v
y m v
b) = forall {k} (k :: k) (m :: * -> *) v. v -> m v -> OnMaybe k m v
OnMaybe (u -> v -> w
h u
x v
y) (forall k (m :: * -> *) w u v.
(Mapping k m, Ord w) =>
(u -> v -> w) -> m u -> m v -> m w
merge u -> v -> w
h m u
a m v
b)
  mergeA :: forall (f :: * -> *) w u v.
(Applicative f, Ord w) =>
(u -> v -> f w)
-> OnMaybe k m u -> OnMaybe k m v -> f (OnMaybe k m w)
mergeA u -> v -> f w
h (OnMaybe u
x m u
a) (OnMaybe v
y m v
b) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall {k} (k :: k) (m :: * -> *) v. v -> m v -> OnMaybe k m v
OnMaybe (u -> v -> f w
h u
x v
y) (forall k (m :: * -> *) (f :: * -> *) w u v.
(Mapping k m, Applicative f, Ord w) =>
(u -> v -> f w) -> m u -> m v -> f (m w)
mergeA u -> v -> f w
h m u
a m v
b)

deriving via (AlgebraWrapper (Maybe k) (OnMaybe k m) a)
  instance (Mapping k m, Ord a, Semigroup a) => Semigroup (OnMaybe k m a)

deriving via (AlgebraWrapper (Maybe k) (OnMaybe k m) a)
  instance (Mapping k m, Ord a, Monoid a) => Monoid (OnMaybe k m a)

deriving via (AlgebraWrapper (Maybe k) (OnMaybe k m) a)
  instance (Mapping k m, Ord a, Num a) => Num (OnMaybe k m a)

deriving via (AlgebraWrapper (Maybe k) (OnMaybe k m) a)
  instance (Mapping k m, Ord a, Boolean a) => Boolean (OnMaybe k m a)


-- | Maps on Either
data OnEither k l m n v = OnEither {
  forall {k} {k} {k} (k :: k) (l :: k) (m :: k -> *) (n :: k -> *)
       (v :: k).
OnEither k l m n v -> m v
onLeft :: m v,
  forall {k} {k} {k} (k :: k) (l :: k) (m :: k -> *) (n :: k -> *)
       (v :: k).
OnEither k l m n v -> n v
onRight :: n v
} deriving (OnEither k l m n v -> OnEither k l m n v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (k :: k) k (l :: k) k (m :: k -> *) (n :: k -> *)
       (v :: k).
(Eq (m v), Eq (n v)) =>
OnEither k l m n v -> OnEither k l m n v -> Bool
/= :: OnEither k l m n v -> OnEither k l m n v -> Bool
$c/= :: forall k (k :: k) k (l :: k) k (m :: k -> *) (n :: k -> *)
       (v :: k).
(Eq (m v), Eq (n v)) =>
OnEither k l m n v -> OnEither k l m n v -> Bool
== :: OnEither k l m n v -> OnEither k l m n v -> Bool
$c== :: forall k (k :: k) k (l :: k) k (m :: k -> *) (n :: k -> *)
       (v :: k).
(Eq (m v), Eq (n v)) =>
OnEither k l m n v -> OnEither k l m n v -> Bool
Eq, OnEither k l m n v -> OnEither k l m n v -> Bool
OnEither k l m n v -> OnEither k l m n v -> Ordering
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 :: k} {k} {l :: k} {k} {m :: k -> *} {n :: k -> *}
       {v :: k}.
(Ord (m v), Ord (n v)) =>
Eq (OnEither k l m n v)
forall k (k :: k) k (l :: k) k (m :: k -> *) (n :: k -> *)
       (v :: k).
(Ord (m v), Ord (n v)) =>
OnEither k l m n v -> OnEither k l m n v -> Bool
forall k (k :: k) k (l :: k) k (m :: k -> *) (n :: k -> *)
       (v :: k).
(Ord (m v), Ord (n v)) =>
OnEither k l m n v -> OnEither k l m n v -> Ordering
forall k (k :: k) k (l :: k) k (m :: k -> *) (n :: k -> *)
       (v :: k).
(Ord (m v), Ord (n v)) =>
OnEither k l m n v -> OnEither k l m n v -> OnEither k l m n v
min :: OnEither k l m n v -> OnEither k l m n v -> OnEither k l m n v
$cmin :: forall k (k :: k) k (l :: k) k (m :: k -> *) (n :: k -> *)
       (v :: k).
(Ord (m v), Ord (n v)) =>
OnEither k l m n v -> OnEither k l m n v -> OnEither k l m n v
max :: OnEither k l m n v -> OnEither k l m n v -> OnEither k l m n v
$cmax :: forall k (k :: k) k (l :: k) k (m :: k -> *) (n :: k -> *)
       (v :: k).
(Ord (m v), Ord (n v)) =>
OnEither k l m n v -> OnEither k l m n v -> OnEither k l m n v
>= :: OnEither k l m n v -> OnEither k l m n v -> Bool
$c>= :: forall k (k :: k) k (l :: k) k (m :: k -> *) (n :: k -> *)
       (v :: k).
(Ord (m v), Ord (n v)) =>
OnEither k l m n v -> OnEither k l m n v -> Bool
> :: OnEither k l m n v -> OnEither k l m n v -> Bool
$c> :: forall k (k :: k) k (l :: k) k (m :: k -> *) (n :: k -> *)
       (v :: k).
(Ord (m v), Ord (n v)) =>
OnEither k l m n v -> OnEither k l m n v -> Bool
<= :: OnEither k l m n v -> OnEither k l m n v -> Bool
$c<= :: forall k (k :: k) k (l :: k) k (m :: k -> *) (n :: k -> *)
       (v :: k).
(Ord (m v), Ord (n v)) =>
OnEither k l m n v -> OnEither k l m n v -> Bool
< :: OnEither k l m n v -> OnEither k l m n v -> Bool
$c< :: forall k (k :: k) k (l :: k) k (m :: k -> *) (n :: k -> *)
       (v :: k).
(Ord (m v), Ord (n v)) =>
OnEither k l m n v -> OnEither k l m n v -> Bool
compare :: OnEither k l m n v -> OnEither k l m n v -> Ordering
$ccompare :: forall k (k :: k) k (l :: k) k (m :: k -> *) (n :: k -> *)
       (v :: k).
(Ord (m v), Ord (n v)) =>
OnEither k l m n v -> OnEither k l m n v -> Ordering
Ord)

instance (Foldable m, Foldable n) => Foldable (OnEither k l m n) where
  foldMap :: forall m a. Monoid m => (a -> m) -> OnEither k l m n a -> m
foldMap a -> m
p (OnEither m a
f n a
g) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
p m a
f forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
p n a
g

instance (FoldableWithIndex k m, FoldableWithIndex l n) => FoldableWithIndex (Either k l) (OnEither k l m n) where
  ifoldMap :: forall m a.
Monoid m =>
(Either k l -> a -> m) -> OnEither k l m n a -> m
ifoldMap Either k l -> a -> m
p (OnEither m a
f n a
g) = forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (Either k l -> a -> m
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) m a
f forall a. Semigroup a => a -> a -> a
<> forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (Either k l -> a -> m
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) n a
g

instance (Mapping k m,
          Mapping l n)
       => Mapping (Either k l) (OnEither k l m n) where
  cst :: forall v. v -> OnEither k l m n v
cst v
x = forall {k} {k} {k} (k :: k) (l :: k) (m :: k -> *) (n :: k -> *)
       (v :: k).
m v -> n v -> OnEither k l m n v
OnEither (forall k (m :: * -> *) v. Mapping k m => v -> m v
cst v
x) (forall k (m :: * -> *) v. Mapping k m => v -> m v
cst v
x)
  mmap :: forall v u.
Ord v =>
(u -> v) -> OnEither k l m n u -> OnEither k l m n v
mmap u -> v
p (OnEither m u
f n u
g) = forall {k} {k} {k} (k :: k) (l :: k) (m :: k -> *) (n :: k -> *)
       (v :: k).
m v -> n v -> OnEither k l m n v
OnEither (forall k (m :: * -> *) v u.
(Mapping k m, Ord v) =>
(u -> v) -> m u -> m v
mmap u -> v
p m u
f) (forall k (m :: * -> *) v u.
(Mapping k m, Ord v) =>
(u -> v) -> m u -> m v
mmap u -> v
p n u
g)
  mtraverse :: forall (f :: * -> *) v u.
(Applicative f, Ord v) =>
(u -> f v) -> OnEither k l m n u -> f (OnEither k l m n v)
mtraverse u -> f v
p (OnEither m u
f n u
g) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall {k} {k} {k} (k :: k) (l :: k) (m :: k -> *) (n :: k -> *)
       (v :: k).
m v -> n v -> OnEither k l m n v
OnEither (forall k (m :: * -> *) (f :: * -> *) v u.
(Mapping k m, Applicative f, Ord v) =>
(u -> f v) -> m u -> f (m v)
mtraverse u -> f v
p m u
f) (forall k (m :: * -> *) (f :: * -> *) v u.
(Mapping k m, Applicative f, Ord v) =>
(u -> f v) -> m u -> f (m v)
mtraverse u -> f v
p n u
g)
  act :: forall v. OnEither k l m n v -> Either k l -> v
act (OnEither m v
f n v
_) (Left k
x) = forall k (m :: * -> *) v. Mapping k m => m v -> k -> v
act m v
f k
x
  act (OnEither m v
_ n v
g) (Right l
y) = forall k (m :: * -> *) v. Mapping k m => m v -> k -> v
act n v
g l
y
  isConst :: forall v. Ord v => OnEither k l m n v -> Maybe v
isConst (OnEither m v
f n v
g) = do
    v
x <- forall k (m :: * -> *) v. (Mapping k m, Ord v) => m v -> Maybe v
isConst m v
f
    v
y <- forall k (m :: * -> *) v. (Mapping k m, Ord v) => m v -> Maybe v
isConst n v
g
    if v
x forall a. Eq a => a -> a -> Bool
== v
y then forall a. a -> Maybe a
Just v
x else forall a. Maybe a
Nothing
  mergeA :: forall (f :: * -> *) w u v.
(Applicative f, Ord w) =>
(u -> v -> f w)
-> OnEither k l m n u
-> OnEither k l m n v
-> f (OnEither k l m n w)
mergeA u -> v -> f w
h (OnEither m u
f1 n u
g1) (OnEither m v
f2 n v
g2) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall {k} {k} {k} (k :: k) (l :: k) (m :: k -> *) (n :: k -> *)
       (v :: k).
m v -> n v -> OnEither k l m n v
OnEither (forall k (m :: * -> *) (f :: * -> *) w u v.
(Mapping k m, Applicative f, Ord w) =>
(u -> v -> f w) -> m u -> m v -> f (m w)
mergeA u -> v -> f w
h m u
f1 m v
f2) (forall k (m :: * -> *) (f :: * -> *) w u v.
(Mapping k m, Applicative f, Ord w) =>
(u -> v -> f w) -> m u -> m v -> f (m w)
mergeA u -> v -> f w
h n u
g1 n v
g2)
  merge :: forall w u v.
Ord w =>
(u -> v -> w)
-> OnEither k l m n u -> OnEither k l m n v -> OnEither k l m n w
merge u -> v -> w
h (OnEither m u
f1 n u
g1) (OnEither m v
f2 n v
g2) = forall {k} {k} {k} (k :: k) (l :: k) (m :: k -> *) (n :: k -> *)
       (v :: k).
m v -> n v -> OnEither k l m n v
OnEither (forall k (m :: * -> *) w u v.
(Mapping k m, Ord w) =>
(u -> v -> w) -> m u -> m v -> m w
merge u -> v -> w
h m u
f1 m v
f2) (forall k (m :: * -> *) w u v.
(Mapping k m, Ord w) =>
(u -> v -> w) -> m u -> m v -> m w
merge u -> v -> w
h n u
g1 n v
g2)

deriving via (AlgebraWrapper (Either k l) (OnEither k l (m :: Type -> Type) n) a)
  instance (Mapping k m, Mapping l n, Ord a, Semigroup a) => Semigroup (OnEither k l m n a)

deriving via (AlgebraWrapper (Either k l) (OnEither k l (m :: Type -> Type) n) a)
  instance (Mapping k m, Mapping l n, Ord a, Monoid a) => Monoid (OnEither k l m n a)

deriving via (AlgebraWrapper (Either k l) (OnEither k l (m :: Type -> Type) n) a)
  instance (Mapping k m, Mapping l n, Ord a, Num a) => Num (OnEither k l m n a)

deriving via (AlgebraWrapper (Either k l) (OnEither k l (m :: Type -> Type) n) a)
  instance (Mapping k m, Mapping l n, Ord a, Boolean a) => Boolean (OnEither k l m n a)


-- | Maps on pairs
newtype OnPair k l m n v = OnPair {
  forall {k} {k} {k} {k} (k :: k) (l :: k) (m :: k -> *)
       (n :: k -> k) (v :: k).
OnPair k l m n v -> m (n v)
asComposite :: m (n v)
} deriving (OnPair k l m n v -> OnPair k l m n v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (k :: k) k (l :: k) k (m :: k -> *) k (n :: k -> k)
       (v :: k).
Eq (m (n v)) =>
OnPair k l m n v -> OnPair k l m n v -> Bool
/= :: OnPair k l m n v -> OnPair k l m n v -> Bool
$c/= :: forall k (k :: k) k (l :: k) k (m :: k -> *) k (n :: k -> k)
       (v :: k).
Eq (m (n v)) =>
OnPair k l m n v -> OnPair k l m n v -> Bool
== :: OnPair k l m n v -> OnPair k l m n v -> Bool
$c== :: forall k (k :: k) k (l :: k) k (m :: k -> *) k (n :: k -> k)
       (v :: k).
Eq (m (n v)) =>
OnPair k l m n v -> OnPair k l m n v -> Bool
Eq, OnPair k l m n v -> OnPair k l m n v -> Bool
OnPair k l m n v -> OnPair k l m n v -> Ordering
OnPair k l m n v -> OnPair k l m n v -> OnPair k l m n 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} {k :: k} {k} {l :: k} {k} {m :: k -> *} {k}
       {n :: k -> k} {v :: k}.
Ord (m (n v)) =>
Eq (OnPair k l m n v)
forall k (k :: k) k (l :: k) k (m :: k -> *) k (n :: k -> k)
       (v :: k).
Ord (m (n v)) =>
OnPair k l m n v -> OnPair k l m n v -> Bool
forall k (k :: k) k (l :: k) k (m :: k -> *) k (n :: k -> k)
       (v :: k).
Ord (m (n v)) =>
OnPair k l m n v -> OnPair k l m n v -> Ordering
forall k (k :: k) k (l :: k) k (m :: k -> *) k (n :: k -> k)
       (v :: k).
Ord (m (n v)) =>
OnPair k l m n v -> OnPair k l m n v -> OnPair k l m n v
min :: OnPair k l m n v -> OnPair k l m n v -> OnPair k l m n v
$cmin :: forall k (k :: k) k (l :: k) k (m :: k -> *) k (n :: k -> k)
       (v :: k).
Ord (m (n v)) =>
OnPair k l m n v -> OnPair k l m n v -> OnPair k l m n v
max :: OnPair k l m n v -> OnPair k l m n v -> OnPair k l m n v
$cmax :: forall k (k :: k) k (l :: k) k (m :: k -> *) k (n :: k -> k)
       (v :: k).
Ord (m (n v)) =>
OnPair k l m n v -> OnPair k l m n v -> OnPair k l m n v
>= :: OnPair k l m n v -> OnPair k l m n v -> Bool
$c>= :: forall k (k :: k) k (l :: k) k (m :: k -> *) k (n :: k -> k)
       (v :: k).
Ord (m (n v)) =>
OnPair k l m n v -> OnPair k l m n v -> Bool
> :: OnPair k l m n v -> OnPair k l m n v -> Bool
$c> :: forall k (k :: k) k (l :: k) k (m :: k -> *) k (n :: k -> k)
       (v :: k).
Ord (m (n v)) =>
OnPair k l m n v -> OnPair k l m n v -> Bool
<= :: OnPair k l m n v -> OnPair k l m n v -> Bool
$c<= :: forall k (k :: k) k (l :: k) k (m :: k -> *) k (n :: k -> k)
       (v :: k).
Ord (m (n v)) =>
OnPair k l m n v -> OnPair k l m n v -> Bool
< :: OnPair k l m n v -> OnPair k l m n v -> Bool
$c< :: forall k (k :: k) k (l :: k) k (m :: k -> *) k (n :: k -> k)
       (v :: k).
Ord (m (n v)) =>
OnPair k l m n v -> OnPair k l m n v -> Bool
compare :: OnPair k l m n v -> OnPair k l m n v -> Ordering
$ccompare :: forall k (k :: k) k (l :: k) k (m :: k -> *) k (n :: k -> k)
       (v :: k).
Ord (m (n v)) =>
OnPair k l m n v -> OnPair k l m n v -> Ordering
Ord)

instance (Foldable m, Foldable n) => Foldable (OnPair k l m n) where
  foldMap :: forall m a. Monoid m => (a -> m) -> OnPair k l m n a -> m
foldMap a -> m
p (OnPair m (n a)
f) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
p) m (n a)
f

instance (Mapping k m,
          Mapping l n,
          forall v. Ord v => Ord (n v))
       => Mapping (k, l) (OnPair k l m n) where
  cst :: forall v. v -> OnPair k l m n v
cst v
x = forall {k} {k} {k} {k} (k :: k) (l :: k) (m :: k -> *)
       (n :: k -> k) (v :: k).
m (n v) -> OnPair k l m n v
OnPair forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (m :: * -> *) v. Mapping k m => v -> m v
cst forall a b. (a -> b) -> a -> b
$ forall k (m :: * -> *) v. Mapping k m => v -> m v
cst v
x
  mmap :: forall v u.
Ord v =>
(u -> v) -> OnPair k l m n u -> OnPair k l m n v
mmap u -> v
p (OnPair m (n u)
f) = forall {k} {k} {k} {k} (k :: k) (l :: k) (m :: k -> *)
       (n :: k -> k) (v :: k).
m (n v) -> OnPair k l m n v
OnPair (forall k (m :: * -> *) v u.
(Mapping k m, Ord v) =>
(u -> v) -> m u -> m v
mmap (forall k (m :: * -> *) v u.
(Mapping k m, Ord v) =>
(u -> v) -> m u -> m v
mmap u -> v
p) m (n u)
f)
  mtraverse :: forall (f :: * -> *) v u.
(Applicative f, Ord v) =>
(u -> f v) -> OnPair k l m n u -> f (OnPair k l m n v)
mtraverse u -> f v
p (OnPair m (n u)
f) = forall {k} {k} {k} {k} (k :: k) (l :: k) (m :: k -> *)
       (n :: k -> k) (v :: k).
m (n v) -> OnPair k l m n v
OnPair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k (m :: * -> *) (f :: * -> *) v u.
(Mapping k m, Applicative f, Ord v) =>
(u -> f v) -> m u -> f (m v)
mtraverse (forall k (m :: * -> *) (f :: * -> *) v u.
(Mapping k m, Applicative f, Ord v) =>
(u -> f v) -> m u -> f (m v)
mtraverse u -> f v
p) m (n u)
f
  act :: forall v. OnPair k l m n v -> (k, l) -> v
act (OnPair m (n v)
f) (k
x, l
y) = forall k (m :: * -> *) v. Mapping k m => m v -> k -> v
act (forall k (m :: * -> *) v. Mapping k m => m v -> k -> v
act m (n v)
f k
x) l
y
  isConst :: forall v. Ord v => OnPair k l m n v -> Maybe v
isConst (OnPair m (n v)
f) = forall k (m :: * -> *) v. (Mapping k m, Ord v) => m v -> Maybe v
isConst forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k (m :: * -> *) v. (Mapping k m, Ord v) => m v -> Maybe v
isConst m (n v)
f
  mergeA :: forall (f :: * -> *) w u v.
(Applicative f, Ord w) =>
(u -> v -> f w)
-> OnPair k l m n u -> OnPair k l m n v -> f (OnPair k l m n w)
mergeA u -> v -> f w
h (OnPair m (n u)
f) (OnPair m (n v)
g) = forall {k} {k} {k} {k} (k :: k) (l :: k) (m :: k -> *)
       (n :: k -> k) (v :: k).
m (n v) -> OnPair k l m n v
OnPair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k (m :: * -> *) (f :: * -> *) w u v.
(Mapping k m, Applicative f, Ord w) =>
(u -> v -> f w) -> m u -> m v -> f (m w)
mergeA (forall k (m :: * -> *) (f :: * -> *) w u v.
(Mapping k m, Applicative f, Ord w) =>
(u -> v -> f w) -> m u -> m v -> f (m w)
mergeA u -> v -> f w
h) m (n u)
f m (n v)
g
  merge :: forall w u v.
Ord w =>
(u -> v -> w)
-> OnPair k l m n u -> OnPair k l m n v -> OnPair k l m n w
merge u -> v -> w
h (OnPair m (n u)
f) (OnPair m (n v)
g) = forall {k} {k} {k} {k} (k :: k) (l :: k) (m :: k -> *)
       (n :: k -> k) (v :: k).
m (n v) -> OnPair k l m n v
OnPair forall a b. (a -> b) -> a -> b
$ forall k (m :: * -> *) w u v.
(Mapping k m, Ord w) =>
(u -> v -> w) -> m u -> m v -> m w
merge (forall k (m :: * -> *) w u v.
(Mapping k m, Ord w) =>
(u -> v -> w) -> m u -> m v -> m w
merge u -> v -> w
h) m (n u)
f m (n v)
g

deriving via (AlgebraWrapper (k, l) (OnPair k l (m :: Type -> Type) (n :: Type -> Type)) a)
  instance (Mapping k m, Mapping l n, Ord a, Semigroup a, forall v. Ord v => Ord (n v)) => Semigroup (OnPair k l m n a)

deriving via (AlgebraWrapper (k, l) (OnPair k l (m :: Type -> Type) (n :: Type -> Type)) a)
  instance (Mapping k m, Mapping l n, Ord a, Monoid a, forall v. Ord v => Ord (n v)) => Monoid (OnPair k l m n a)

deriving via (AlgebraWrapper (k, l) (OnPair k l (m :: Type -> Type) (n :: Type -> Type)) a)
  instance (Mapping k m, Mapping l n, Ord a, Num a, forall v. Ord v => Ord (n v)) => Num (OnPair k l m n a)

deriving via (AlgebraWrapper (k, l) (OnPair k l (m :: Type -> Type) (n :: Type -> Type)) b)
  instance (Mapping k m, Mapping l n, Ord b, Boolean b, forall v. Ord v => Ord (n v)) => Boolean (OnPair k l m n b)


-- Is the first a subset of the second?
--
-- With a future version of cond, we should be able to generalise this
isSubset :: Mapping k m => m Bool -> m Bool -> Bool
isSubset :: forall k (m :: * -> *). Mapping k m => m Bool -> m Bool -> Bool
isSubset m Bool
m m Bool
n = let
  p :: Bool -> Bool -> All
p Bool
True Bool
False = Bool -> All
All Bool
False
  p Bool
_ Bool
_        = Bool -> All
All Bool
True
  in All -> Bool
getAll forall a b. (a -> b) -> a -> b
$ forall k (m :: * -> *) u v a.
(Mapping k m, Monoid a) =>
(u -> v -> a) -> m u -> m v -> a
pairMappings Bool -> Bool -> All
p m Bool
m m Bool
n

-- Are the two true on distinct values?
--
-- Again, with a future version of cond, we should be able to generalise this
isDisjoint :: Mapping k m => m Bool -> m Bool -> Bool
isDisjoint :: forall k (m :: * -> *). Mapping k m => m Bool -> m Bool -> Bool
isDisjoint m Bool
m m Bool
n = let
  p :: Bool -> Bool -> All
p Bool
True Bool
True = Bool -> All
All Bool
False
  p Bool
_ Bool
_       = Bool -> All
All Bool
True
  in All -> Bool
getAll forall a b. (a -> b) -> a -> b
$ forall k (m :: * -> *) u v a.
(Mapping k m, Monoid a) =>
(u -> v -> a) -> m u -> m v -> a
pairMappings Bool -> Bool -> All
p m Bool
m m Bool
n


-- | A wrapper to allow defining `PartialOrd` instances on mappings whose keys
-- have an `Ord` instance.
newtype OrdWrapper k m v = OrdWrapper {
  forall {k} {k} (k :: k) (m :: k -> *) (v :: k).
OrdWrapper k m v -> m v
getOrdMapping :: m v
}

instance (Mapping k m, Ord v) => PartialOrd (OrdWrapper k m v) where
  compare' :: OrdWrapper k m v -> OrdWrapper k m v -> PartialOrdering
compare' (OrdWrapper m v
u) (OrdWrapper m v
v) = forall k (m :: * -> *) u v a.
(Mapping k m, Monoid a) =>
(u -> v -> a) -> m u -> m v -> a
pairMappings forall a. Ord a => a -> a -> PartialOrdering
fromCompare m v
u m v
v


  -- | A wrapper to allow defining `PartialOrd` instances on mappings whose keys
  -- have a `PartialOrd` instance.
newtype PartialOrdWrapper k m v = PartialOrdWrapper {
  forall {k} {k} (k :: k) (m :: k -> *) (v :: k).
PartialOrdWrapper k m v -> m v
getPartialOrdMapping :: m v
}

instance (Mapping k m, PartialOrd v) => PartialOrd (PartialOrdWrapper k m v) where
  compare' :: PartialOrdWrapper k m v
-> PartialOrdWrapper k m v -> PartialOrdering
compare' (PartialOrdWrapper m v
u) (PartialOrdWrapper m v
v) = forall k (m :: * -> *) u v a.
(Mapping k m, Monoid a) =>
(u -> v -> a) -> m u -> m v -> a
pairMappings forall a. PartialOrd a => a -> a -> PartialOrdering
compare' m v
u m v
v