{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module      :   Grisette.Core.Data.Class.Mergeable
-- Copyright   :   (c) Sirui Lu 2021-2023
-- License     :   BSD-3-Clause (see the LICENSE file)
--
-- Maintainer  :   siruilu@cs.washington.edu
-- Stability   :   Experimental
-- Portability :   GHC only
module Grisette.Core.Data.Class.Mergeable
  ( -- * Merging strategy
    MergingStrategy (..),

    -- * Mergeable
    Mergeable (..),
    Mergeable1 (..),
    rootStrategy1,
    Mergeable2 (..),
    rootStrategy2,
    Mergeable3 (..),
    rootStrategy3,
    Mergeable' (..),
    derivedRootStrategy,

    -- * Combinators for manually building merging strategies
    wrapStrategy,
    product2Strategy,
    DynamicSortedIdx (..),
    StrategyList (..),
    buildStrategyList,
    resolveStrategy,
    resolveStrategy',
  )
where

import Control.Monad.Cont
import Control.Monad.Except
import Control.Monad.Identity
import qualified Control.Monad.RWS.Lazy as RWSLazy
import qualified Control.Monad.RWS.Strict as RWSStrict
import Control.Monad.Reader
import qualified Control.Monad.State.Lazy as StateLazy
import qualified Control.Monad.State.Strict as StateStrict
import Control.Monad.Trans.Maybe
import qualified Control.Monad.Writer.Lazy as WriterLazy
import qualified Control.Monad.Writer.Strict as WriterStrict
import qualified Data.ByteString as B
import Data.Functor.Classes
import Data.Functor.Sum
import Data.Int
import Data.Kind
import qualified Data.Monoid as Monoid
import Data.Typeable
import Data.Word
import Generics.Deriving
import Grisette.Core.Data.Class.Bool
import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
import {-# SOURCE #-} Grisette.IR.SymPrim.Data.SymPrim
import Unsafe.Coerce

-- | Helper type for combining arbitrary number of indices into one.
-- Useful when trying to write efficient merge strategy for lists/vectors.
data DynamicSortedIdx where
  DynamicSortedIdx :: forall idx. (Show idx, Ord idx, Typeable idx) => idx -> DynamicSortedIdx

instance Eq DynamicSortedIdx where
  (DynamicSortedIdx (idx
a :: a)) == :: DynamicSortedIdx -> DynamicSortedIdx -> Bool
== (DynamicSortedIdx (idx
b :: b)) = case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @a @b of
    Just idx :~: idx
Refl -> idx
a idx -> idx -> Bool
forall a. Eq a => a -> a -> Bool
== idx
idx
b
    Maybe (idx :~: idx)
_ -> Bool
False
  {-# INLINE (==) #-}

instance Ord DynamicSortedIdx where
  compare :: DynamicSortedIdx -> DynamicSortedIdx -> Ordering
compare (DynamicSortedIdx (idx
a :: a)) (DynamicSortedIdx (idx
b :: b)) = case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @a @b of
    Just idx :~: idx
Refl -> idx -> idx -> Ordering
forall a. Ord a => a -> a -> Ordering
compare idx
a idx
idx
b
    Maybe (idx :~: idx)
_ -> [Char] -> Ordering
forall a. HasCallStack => [Char] -> a
error [Char]
"This Ord is incomplete"
  {-# INLINE compare #-}

instance Show DynamicSortedIdx where
  show :: DynamicSortedIdx -> [Char]
show (DynamicSortedIdx idx
a) = idx -> [Char]
forall a. Show a => a -> [Char]
show idx
a

-- | Resolves the indices and the terminal merge strategy for a value of some 'Mergeable' type.
resolveStrategy :: forall x. MergingStrategy x -> x -> ([DynamicSortedIdx], MergingStrategy x)
resolveStrategy :: forall x.
MergingStrategy x -> x -> ([DynamicSortedIdx], MergingStrategy x)
resolveStrategy MergingStrategy x
s x
x = x -> MergingStrategy x -> ([DynamicSortedIdx], MergingStrategy x)
forall x.
x -> MergingStrategy x -> ([DynamicSortedIdx], MergingStrategy x)
resolveStrategy' x
x MergingStrategy x
s
{-# INLINE resolveStrategy #-}

-- | Resolves the indices and the terminal merge strategy for a value given a merge strategy for its type.
resolveStrategy' :: forall x. x -> MergingStrategy x -> ([DynamicSortedIdx], MergingStrategy x)
resolveStrategy' :: forall x.
x -> MergingStrategy x -> ([DynamicSortedIdx], MergingStrategy x)
resolveStrategy' x
x = MergingStrategy x -> ([DynamicSortedIdx], MergingStrategy x)
go
  where
    go :: MergingStrategy x -> ([DynamicSortedIdx], MergingStrategy x)
    go :: MergingStrategy x -> ([DynamicSortedIdx], MergingStrategy x)
go (SortedStrategy x -> idx
idxFun idx -> MergingStrategy x
subStrategy) = case MergingStrategy x -> ([DynamicSortedIdx], MergingStrategy x)
go MergingStrategy x
ss of
      ([DynamicSortedIdx]
idxs, MergingStrategy x
r) -> (idx -> DynamicSortedIdx
forall bool.
(Show bool, Ord bool, Typeable bool) =>
bool -> DynamicSortedIdx
DynamicSortedIdx idx
idx DynamicSortedIdx -> [DynamicSortedIdx] -> [DynamicSortedIdx]
forall a. a -> [a] -> [a]
: [DynamicSortedIdx]
idxs, MergingStrategy x
r)
      where
        idx :: idx
idx = x -> idx
idxFun x
x
        ss :: MergingStrategy x
ss = idx -> MergingStrategy x
subStrategy idx
idx
    go MergingStrategy x
s = ([], MergingStrategy x
s)
{-# INLINE resolveStrategy' #-}

-- | Merging strategies.
--
-- __You probably do not need to know the details of this type if you are only going__
-- __to use algebraic data types. You can get merging strategies for them with type__
-- __derivation.__
--
-- In Grisette, a merged union (if-then-else tree) follows the __/hierarchical/__
-- __/sorted representation invariant/__ with regards to some merging strategy.
--
-- A merging strategy encodes how to merge a __/subset/__ of the values of a
-- given type. We have three types of merging strategies:
--
-- * Simple strategy
-- * Sorted strategy
-- * No strategy
--
-- The 'SimpleStrategy' merges values with a simple merge function.
-- For example,
--
--    * the symbolic boolean values can be directly merged with 'ites'.
--
--    * the set @{1}@, which is a subset of the values of the type @Integer@,
--        can be simply merged as the set contains only a single value.
--
--    * all the 'Just' values of the type @Maybe SymBool@ can be simply merged
--        by merging the wrapped symbolic boolean with 'ites'.
--
-- The 'SortedStrategy' merges values by first grouping the values with an
-- indexing function, and the values with the same index will be organized as
-- a sub-tree in the if-then-else structure of 'Grisette.Core.Data.UnionBase.UnionBase'.
-- Each group (sub-tree) will be further merged with a sub-strategy for the
-- index.
-- The index type should be a totally ordered type (with the 'Ord'
-- type class). Grisette will use the indexing function to partition the values
-- into sub-trees, and organize them in a sorted way. The sub-trees will further
-- be merged with the sub-strategies. For example,
--
--    * all the integers can be merged with 'SortedStrategy' by indexing with
--      the identity function and use the 'SimpleStrategy' shown before as the
--      sub-strategies.
--
--    * all the @Maybe SymBool@ values can be merged with 'SortedStrategy' by
--      indexing with 'Data.Maybe.isJust', the 'Nothing' and 'Just' values can then
--      then be merged with different simple strategies as sub-strategies.
--
-- The 'NoStrategy' does not perform any merging.
-- For example, we cannot merge values with function types that returns concrete
-- lists.
--
-- For ADTs, we can automatically derive the 'Mergeable' type class, which
-- provides a merging strategy.
--
-- If the derived version does not work for you, you should determine
-- if your type can be directly merged with a merging function. If so, you can
-- implement the merging strategy as a 'SimpleStrategy'.
-- If the type cannot be directly merged with a merging function, but could be
-- partitioned into subsets of values that can be simply merged with a function,
-- you should implement the merging strategy as a 'SortedStrategy'.
-- For easier building of the merging strategies, check out the combinators
-- like `wrapStrategy`.
--
-- For more details, please see the documents of the constructors, or refer to
-- [Grisette's paper](https://lsrcz.github.io/files/POPL23.pdf).
data MergingStrategy a where
  -- | Simple mergeable strategy.
  --
  -- For symbolic booleans, we can implement its merge strategy as follows:
  --
  -- > SimpleStrategy ites :: MergingStrategy SymBool
  SimpleStrategy ::
    -- | Merge function.
    (SymBool -> a -> a -> a) ->
    MergingStrategy a
  -- | Sorted mergeable strategy.
  --
  -- For Integers, we can implement its merge strategy as follows:
  --
  -- > SortedStrategy id (\_ -> SimpleStrategy $ \_ t _ -> t)
  --
  -- For @Maybe SymBool@, we can implement its merge strategy as follows:
  --
  -- > SortedStrategy
  -- >   (\case; Nothing -> False; Just _ -> True)
  -- >   (\idx ->
  -- >      if idx
  -- >        then SimpleStrategy $ \_ t _ -> t
  -- >        else SimpleStrategy $ \cond (Just l) (Just r) -> Just $ ites cond l r)
  SortedStrategy ::
    (Ord idx, Typeable idx, Show idx) =>
    -- | Indexing function
    (a -> idx) ->
    -- | Sub-strategy function
    (idx -> MergingStrategy a) ->
    MergingStrategy a
  -- | For preventing the merging intentionally. This could be
  -- useful for keeping some value concrete and may help generate more efficient
  -- formulas.
  --
  -- See [Grisette's paper](https://lsrcz.github.io/files/POPL23.pdf) for
  -- details.
  NoStrategy :: MergingStrategy a

-- | Useful utility function for building merge strategies manually.
--
-- For example, to build the merge strategy for the just branch of @Maybe a@,
-- one could write
--
-- > wrapStrategy Just fromMaybe rootStrategy :: MergingStrategy (Maybe a)
wrapStrategy ::
  -- | The merge strategy to be wrapped
  MergingStrategy a ->
  -- | The wrap function
  (a -> b) ->
  -- | The unwrap function, which does not have to be defined for every value
  (b -> a) ->
  MergingStrategy b
wrapStrategy :: forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (SimpleStrategy SymBool -> a -> a -> a
m) a -> b
wrap b -> a
unwrap =
  (SymBool -> b -> b -> b) -> MergingStrategy b
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy
    ( \SymBool
cond b
ifTrue b
ifFalse ->
        a -> b
wrap (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ SymBool -> a -> a -> a
m SymBool
cond (b -> a
unwrap b
ifTrue) (b -> a
unwrap b
ifFalse)
    )
wrapStrategy (SortedStrategy a -> idx
idxFun idx -> MergingStrategy a
substrategy) a -> b
wrap b -> a
unwrap =
  (b -> idx) -> (idx -> MergingStrategy b) -> MergingStrategy b
forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy
    (a -> idx
idxFun (a -> idx) -> (b -> a) -> b -> idx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
unwrap)
    (\idx
idx -> MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (idx -> MergingStrategy a
substrategy idx
idx) a -> b
wrap b -> a
unwrap)
wrapStrategy MergingStrategy a
NoStrategy a -> b
_ b -> a
_ = MergingStrategy b
forall a. MergingStrategy a
NoStrategy
{-# INLINE wrapStrategy #-}

-- | Each type is associated with a root merge strategy given by 'rootStrategy'.
-- The root merge strategy should be able to merge every value of the type.
-- Grisette will use the root merge strategy to merge the values of the type in
-- a union.
--
-- __Note 1:__ This type class can be derived for algebraic data types.
-- You may need the @DerivingVia@ and @DerivingStrategies@ extensions.
--
-- > data X = ... deriving Generic deriving Mergeable via (Default X)
class Mergeable a where
  -- | The root merging strategy for the type.
  rootStrategy :: MergingStrategy a

instance (Generic a, Mergeable' (Rep a)) => Mergeable (Default a) where
  rootStrategy :: MergingStrategy (Default a)
rootStrategy = MergingStrategy a -> MergingStrategy (Default a)
forall a b. a -> b
unsafeCoerce (MergingStrategy a
forall a. (Generic a, Mergeable' (Rep a)) => MergingStrategy a
derivedRootStrategy :: MergingStrategy a)
  {-# NOINLINE rootStrategy #-}

-- | Generic derivation for the 'Mergeable' class.
--
-- Usually you can derive the merging strategy with the @DerivingVia@ and
-- @DerivingStrategies@ extension.
--
-- > data X = ... deriving (Generic) deriving Mergeable via (Default X)
derivedRootStrategy :: (Generic a, Mergeable' (Rep a)) => MergingStrategy a
derivedRootStrategy :: forall a. (Generic a, Mergeable' (Rep a)) => MergingStrategy a
derivedRootStrategy = MergingStrategy (Rep a Any)
-> (Rep a Any -> a) -> (a -> Rep a Any) -> MergingStrategy a
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy MergingStrategy (Rep a Any)
forall (f :: * -> *) a. Mergeable' f => MergingStrategy (f a)
rootStrategy' Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from
{-# INLINE derivedRootStrategy #-}

-- | Lifting of the 'Mergeable' class to unary type constructors.
class Mergeable1 (u :: Type -> Type) where
  -- | Lift merge strategy through the type constructor.
  liftRootStrategy :: MergingStrategy a -> MergingStrategy (u a)

-- | Lift the root merge strategy through the unary type constructor.
rootStrategy1 :: (Mergeable a, Mergeable1 u) => MergingStrategy (u a)
rootStrategy1 :: forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1 = MergingStrategy a -> MergingStrategy (u a)
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy a
forall a. Mergeable a => MergingStrategy a
rootStrategy
{-# INLINE rootStrategy1 #-}

-- | Lifting of the 'Mergeable' class to binary type constructors.
class Mergeable2 (u :: Type -> Type -> Type) where
  -- | Lift merge strategy through the type constructor.
  liftRootStrategy2 :: MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)

-- | Lift the root merge strategy through the binary type constructor.
rootStrategy2 :: (Mergeable a, Mergeable b, Mergeable2 u) => MergingStrategy (u a b)
rootStrategy2 :: forall a b (u :: * -> * -> *).
(Mergeable a, Mergeable b, Mergeable2 u) =>
MergingStrategy (u a b)
rootStrategy2 = MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)
forall (u :: * -> * -> *) a b.
Mergeable2 u =>
MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)
liftRootStrategy2 MergingStrategy a
forall a. Mergeable a => MergingStrategy a
rootStrategy MergingStrategy b
forall a. Mergeable a => MergingStrategy a
rootStrategy
{-# INLINE rootStrategy2 #-}

-- | Lifting of the 'Mergeable' class to ternary type constructors.
class Mergeable3 (u :: Type -> Type -> Type -> Type) where
  -- | Lift merge strategy through the type constructor.
  liftRootStrategy3 :: MergingStrategy a -> MergingStrategy b -> MergingStrategy c -> MergingStrategy (u a b c)

-- | Lift the root merge strategy through the binary type constructor.
rootStrategy3 :: (Mergeable a, Mergeable b, Mergeable c, Mergeable3 u) => MergingStrategy (u a b c)
rootStrategy3 :: forall a b c (u :: * -> * -> * -> *).
(Mergeable a, Mergeable b, Mergeable c, Mergeable3 u) =>
MergingStrategy (u a b c)
rootStrategy3 = MergingStrategy a
-> MergingStrategy b
-> MergingStrategy c
-> MergingStrategy (u a b c)
forall (u :: * -> * -> * -> *) a b c.
Mergeable3 u =>
MergingStrategy a
-> MergingStrategy b
-> MergingStrategy c
-> MergingStrategy (u a b c)
liftRootStrategy3 MergingStrategy a
forall a. Mergeable a => MergingStrategy a
rootStrategy MergingStrategy b
forall a. Mergeable a => MergingStrategy a
rootStrategy MergingStrategy c
forall a. Mergeable a => MergingStrategy a
rootStrategy
{-# INLINE rootStrategy3 #-}

instance (Generic1 u, Mergeable1' (Rep1 u)) => Mergeable1 (Default1 u) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (Default1 u a)
liftRootStrategy = (MergingStrategy Any -> MergingStrategy (u Any))
-> MergingStrategy a -> MergingStrategy (Default1 u a)
forall a b. a -> b
unsafeCoerce (forall {a}. MergingStrategy a -> MergingStrategy (u a)
forall (u :: * -> *) a.
(Generic1 u, Mergeable1' (Rep1 u)) =>
MergingStrategy a -> MergingStrategy (u a)
derivedLiftMergingStrategy :: MergingStrategy a -> MergingStrategy (u a))
  {-# NOINLINE liftRootStrategy #-}

class Mergeable1' (u :: Type -> Type) where
  liftRootStrategy' :: MergingStrategy a -> MergingStrategy (u a)

instance Mergeable1' U1 where
  liftRootStrategy' :: forall a. MergingStrategy a -> MergingStrategy (U1 a)
liftRootStrategy' MergingStrategy a
_ = (SymBool -> U1 a -> U1 a -> U1 a) -> MergingStrategy (U1 a)
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy (\SymBool
_ U1 a
t U1 a
_ -> U1 a
t)
  {-# INLINE liftRootStrategy' #-}

instance Mergeable1' V1 where
  liftRootStrategy' :: forall a. MergingStrategy a -> MergingStrategy (V1 a)
liftRootStrategy' MergingStrategy a
_ = (SymBool -> V1 a -> V1 a -> V1 a) -> MergingStrategy (V1 a)
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy (\SymBool
_ V1 a
t V1 a
_ -> V1 a
t)
  {-# INLINE liftRootStrategy' #-}

instance Mergeable1' Par1 where
  liftRootStrategy' :: forall a. MergingStrategy a -> MergingStrategy (Par1 a)
liftRootStrategy' MergingStrategy a
m = MergingStrategy a
-> (a -> Par1 a) -> (Par1 a -> a) -> MergingStrategy (Par1 a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy MergingStrategy a
m a -> Par1 a
forall p. p -> Par1 p
Par1 Par1 a -> a
forall p. Par1 p -> p
unPar1
  {-# INLINE liftRootStrategy' #-}

instance Mergeable1 f => Mergeable1' (Rec1 f) where
  liftRootStrategy' :: forall a. MergingStrategy a -> MergingStrategy (Rec1 f a)
liftRootStrategy' MergingStrategy a
m = MergingStrategy (f a)
-> (f a -> Rec1 f a)
-> (Rec1 f a -> f a)
-> MergingStrategy (Rec1 f a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (MergingStrategy a -> MergingStrategy (f a)
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy a
m) f a -> Rec1 f a
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 Rec1 f a -> f a
forall k (f :: k -> *) (p :: k). Rec1 f p -> f p
unRec1
  {-# INLINE liftRootStrategy' #-}

instance Mergeable c => Mergeable1' (K1 i c) where
  liftRootStrategy' :: forall a. MergingStrategy a -> MergingStrategy (K1 i c a)
liftRootStrategy' MergingStrategy a
_ = MergingStrategy c
-> (c -> K1 i c a) -> (K1 i c a -> c) -> MergingStrategy (K1 i c a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy MergingStrategy c
forall a. Mergeable a => MergingStrategy a
rootStrategy c -> K1 i c a
forall k i c (p :: k). c -> K1 i c p
K1 K1 i c a -> c
forall k i c (p :: k). K1 i c p -> c
unK1
  {-# INLINE liftRootStrategy' #-}

instance Mergeable1' a => Mergeable1' (M1 i c a) where
  liftRootStrategy' :: forall a. MergingStrategy a -> MergingStrategy (M1 i c a a)
liftRootStrategy' MergingStrategy a
m = MergingStrategy (a a)
-> (a a -> M1 i c a a)
-> (M1 i c a a -> a a)
-> MergingStrategy (M1 i c a a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (MergingStrategy a -> MergingStrategy (a a)
forall (u :: * -> *) a.
Mergeable1' u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy' MergingStrategy a
m) a a -> M1 i c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 M1 i c a a -> a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
  {-# INLINE liftRootStrategy' #-}

instance (Mergeable1' a, Mergeable1' b) => Mergeable1' (a :+: b) where
  liftRootStrategy' :: forall a. MergingStrategy a -> MergingStrategy ((:+:) a b a)
liftRootStrategy' MergingStrategy a
m =
    ((:+:) a b a -> Bool)
-> (Bool -> MergingStrategy ((:+:) a b a))
-> MergingStrategy ((:+:) a b a)
forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy
      ( \case
          L1 a a
_ -> Bool
False
          R1 b a
_ -> Bool
True
      )
      ( \Bool
idx ->
          if Bool -> Bool
not Bool
idx
            then MergingStrategy (a a)
-> (a a -> (:+:) a b a)
-> ((:+:) a b a -> a a)
-> MergingStrategy ((:+:) a b a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (MergingStrategy a -> MergingStrategy (a a)
forall (u :: * -> *) a.
Mergeable1' u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy' MergingStrategy a
m) a a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (\case (L1 a a
v) -> a a
v; (:+:) a b a
_ -> [Char] -> a a
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible")
            else MergingStrategy (b a)
-> (b a -> (:+:) a b a)
-> ((:+:) a b a -> b a)
-> MergingStrategy ((:+:) a b a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (MergingStrategy a -> MergingStrategy (b a)
forall (u :: * -> *) a.
Mergeable1' u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy' MergingStrategy a
m) b a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (\case (R1 b a
v) -> b a
v; (:+:) a b a
_ -> [Char] -> b a
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible")
      )
  {-# INLINE liftRootStrategy' #-}

instance (Mergeable1' a, Mergeable1' b) => Mergeable1' (a :*: b) where
  liftRootStrategy' :: forall a. MergingStrategy a -> MergingStrategy ((:*:) a b a)
liftRootStrategy' MergingStrategy a
m = (a a -> b a -> (:*:) a b a)
-> ((:*:) a b a -> (a a, b a))
-> MergingStrategy (a a)
-> MergingStrategy (b a)
-> MergingStrategy ((:*:) a b a)
forall a b r.
(a -> b -> r)
-> (r -> (a, b))
-> MergingStrategy a
-> MergingStrategy b
-> MergingStrategy r
product2Strategy a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (\(a a
a :*: b a
b) -> (a a
a, b a
b)) (MergingStrategy a -> MergingStrategy (a a)
forall (u :: * -> *) a.
Mergeable1' u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy' MergingStrategy a
m) (MergingStrategy a -> MergingStrategy (b a)
forall (u :: * -> *) a.
Mergeable1' u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy' MergingStrategy a
m)
  {-# INLINE liftRootStrategy' #-}

-- | Generic derivation for the 'Mergeable' class.
derivedLiftMergingStrategy :: (Generic1 u, Mergeable1' (Rep1 u)) => MergingStrategy a -> MergingStrategy (u a)
derivedLiftMergingStrategy :: forall (u :: * -> *) a.
(Generic1 u, Mergeable1' (Rep1 u)) =>
MergingStrategy a -> MergingStrategy (u a)
derivedLiftMergingStrategy MergingStrategy a
m = MergingStrategy (Rep1 u a)
-> (Rep1 u a -> u a) -> (u a -> Rep1 u a) -> MergingStrategy (u a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (MergingStrategy a -> MergingStrategy (Rep1 u a)
forall (u :: * -> *) a.
Mergeable1' u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy' MergingStrategy a
m) Rep1 u a -> u a
forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 u a -> Rep1 u a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1
{-# INLINE derivedLiftMergingStrategy #-}

-- | Auxiliary class for the generic derivation for the 'Mergeable' class.
class Mergeable' f where
  rootStrategy' :: MergingStrategy (f a)

instance Mergeable' U1 where
  rootStrategy' :: forall a. MergingStrategy (U1 a)
rootStrategy' = (SymBool -> U1 a -> U1 a -> U1 a) -> MergingStrategy (U1 a)
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy (\SymBool
_ U1 a
t U1 a
_ -> U1 a
t)
  {-# INLINE rootStrategy' #-}

instance Mergeable' V1 where
  rootStrategy' :: forall a. MergingStrategy (V1 a)
rootStrategy' = (SymBool -> V1 a -> V1 a -> V1 a) -> MergingStrategy (V1 a)
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy (\SymBool
_ V1 a
t V1 a
_ -> V1 a
t)
  {-# INLINE rootStrategy' #-}

instance (Mergeable c) => Mergeable' (K1 i c) where
  rootStrategy' :: forall a. MergingStrategy (K1 i c a)
rootStrategy' = MergingStrategy c
-> (c -> K1 i c a) -> (K1 i c a -> c) -> MergingStrategy (K1 i c a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy MergingStrategy c
forall a. Mergeable a => MergingStrategy a
rootStrategy c -> K1 i c a
forall k i c (p :: k). c -> K1 i c p
K1 K1 i c a -> c
forall k i c (p :: k). K1 i c p -> c
unK1
  {-# INLINE rootStrategy' #-}

instance (Mergeable' a) => Mergeable' (M1 i c a) where
  rootStrategy' :: forall a. MergingStrategy (M1 i c a a)
rootStrategy' = MergingStrategy (a a)
-> (a a -> M1 i c a a)
-> (M1 i c a a -> a a)
-> MergingStrategy (M1 i c a a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy MergingStrategy (a a)
forall (f :: * -> *) a. Mergeable' f => MergingStrategy (f a)
rootStrategy' a a -> M1 i c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 M1 i c a a -> a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
  {-# INLINE rootStrategy' #-}

instance (Mergeable' a, Mergeable' b) => Mergeable' (a :+: b) where
  rootStrategy' :: forall a. MergingStrategy ((:+:) a b a)
rootStrategy' =
    ((:+:) a b a -> Bool)
-> (Bool -> MergingStrategy ((:+:) a b a))
-> MergingStrategy ((:+:) a b a)
forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy
      ( \case
          L1 a a
_ -> Bool
False
          R1 b a
_ -> Bool
True
      )
      ( \Bool
idx ->
          if Bool -> Bool
not Bool
idx
            then MergingStrategy (a a)
-> (a a -> (:+:) a b a)
-> ((:+:) a b a -> a a)
-> MergingStrategy ((:+:) a b a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy MergingStrategy (a a)
forall (f :: * -> *) a. Mergeable' f => MergingStrategy (f a)
rootStrategy' a a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (\case (L1 a a
v) -> a a
v; (:+:) a b a
_ -> a a
forall a. HasCallStack => a
undefined)
            else MergingStrategy (b a)
-> (b a -> (:+:) a b a)
-> ((:+:) a b a -> b a)
-> MergingStrategy ((:+:) a b a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy MergingStrategy (b a)
forall (f :: * -> *) a. Mergeable' f => MergingStrategy (f a)
rootStrategy' b a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (\case (R1 b a
v) -> b a
v; (:+:) a b a
_ -> b a
forall a. HasCallStack => a
undefined)
      )
  {-# INLINE rootStrategy' #-}

-- | Useful utility function for building merge strategies for product types
-- manually.
--
-- For example, to build the merge strategy for the following product type,
-- one could write
--
-- > data X = X { x1 :: Int, x2 :: Bool }
-- > product2Strategy X (\(X a b) -> (a, b)) rootStrategy rootStrategy
-- >   :: MergingStrategy X
product2Strategy ::
  -- | The wrap function
  (a -> b -> r) ->
  -- | The unwrap function, which does not have to be defined for every value
  (r -> (a, b)) ->
  -- | The first merge strategy to be wrapped
  MergingStrategy a ->
  -- | The second merge strategy to be wrapped
  MergingStrategy b ->
  MergingStrategy r
product2Strategy :: forall a b r.
(a -> b -> r)
-> (r -> (a, b))
-> MergingStrategy a
-> MergingStrategy b
-> MergingStrategy r
product2Strategy a -> b -> r
wrap r -> (a, b)
unwrap MergingStrategy a
strategy1 MergingStrategy b
strategy2 =
  case (MergingStrategy a
strategy1, MergingStrategy b
strategy2) of
    (MergingStrategy a
NoStrategy, MergingStrategy b
_) -> MergingStrategy r
forall a. MergingStrategy a
NoStrategy
    (MergingStrategy a
_, MergingStrategy b
NoStrategy) -> MergingStrategy r
forall a. MergingStrategy a
NoStrategy
    (SimpleStrategy SymBool -> a -> a -> a
m1, SimpleStrategy SymBool -> b -> b -> b
m2) ->
      (SymBool -> r -> r -> r) -> MergingStrategy r
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy ((SymBool -> r -> r -> r) -> MergingStrategy r)
-> (SymBool -> r -> r -> r) -> MergingStrategy r
forall a b. (a -> b) -> a -> b
$ \SymBool
cond r
t r
f -> case (r -> (a, b)
unwrap r
t, r -> (a, b)
unwrap r
f) of
        ((a
hdt, b
tlt), (a
hdf, b
tlf)) ->
          a -> b -> r
wrap (SymBool -> a -> a -> a
m1 SymBool
cond a
hdt a
hdf) (SymBool -> b -> b -> b
m2 SymBool
cond b
tlt b
tlf)
    (s1 :: MergingStrategy a
s1@(SimpleStrategy SymBool -> a -> a -> a
_), SortedStrategy b -> idx
idxf idx -> MergingStrategy b
subf) ->
      (r -> idx) -> (idx -> MergingStrategy r) -> MergingStrategy r
forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy (b -> idx
idxf (b -> idx) -> (r -> b) -> r -> idx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> b
forall a b. (a, b) -> b
snd ((a, b) -> b) -> (r -> (a, b)) -> r -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> (a, b)
unwrap) ((a -> b -> r)
-> (r -> (a, b))
-> MergingStrategy a
-> MergingStrategy b
-> MergingStrategy r
forall a b r.
(a -> b -> r)
-> (r -> (a, b))
-> MergingStrategy a
-> MergingStrategy b
-> MergingStrategy r
product2Strategy a -> b -> r
wrap r -> (a, b)
unwrap MergingStrategy a
s1 (MergingStrategy b -> MergingStrategy r)
-> (idx -> MergingStrategy b) -> idx -> MergingStrategy r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. idx -> MergingStrategy b
subf)
    (SortedStrategy a -> idx
idxf idx -> MergingStrategy a
subf, MergingStrategy b
s2) ->
      (r -> idx) -> (idx -> MergingStrategy r) -> MergingStrategy r
forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy (a -> idx
idxf (a -> idx) -> (r -> a) -> r -> idx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> a
forall a b. (a, b) -> a
fst ((a, b) -> a) -> (r -> (a, b)) -> r -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> (a, b)
unwrap) (\idx
idx -> (a -> b -> r)
-> (r -> (a, b))
-> MergingStrategy a
-> MergingStrategy b
-> MergingStrategy r
forall a b r.
(a -> b -> r)
-> (r -> (a, b))
-> MergingStrategy a
-> MergingStrategy b
-> MergingStrategy r
product2Strategy a -> b -> r
wrap r -> (a, b)
unwrap (idx -> MergingStrategy a
subf idx
idx) MergingStrategy b
s2)
{-# INLINE product2Strategy #-}

instance (Mergeable' a, Mergeable' b) => Mergeable' (a :*: b) where
  rootStrategy' :: forall a. MergingStrategy ((:*:) a b a)
rootStrategy' = (a a -> b a -> (:*:) a b a)
-> ((:*:) a b a -> (a a, b a))
-> MergingStrategy (a a)
-> MergingStrategy (b a)
-> MergingStrategy ((:*:) a b a)
forall a b r.
(a -> b -> r)
-> (r -> (a, b))
-> MergingStrategy a
-> MergingStrategy b
-> MergingStrategy r
product2Strategy a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (\(a a
a :*: b a
b) -> (a a
a, b a
b)) MergingStrategy (a a)
forall (f :: * -> *) a. Mergeable' f => MergingStrategy (f a)
rootStrategy' MergingStrategy (b a)
forall (f :: * -> *) a. Mergeable' f => MergingStrategy (f a)
rootStrategy'
  {-# INLINE rootStrategy' #-}

-- instances

#define CONCRETE_ORD_MERGEABLE(type) \
instance Mergeable type where \
  rootStrategy = \
    let sub = SimpleStrategy $ \_ t _ -> t \
     in SortedStrategy id $ const sub; \
  {-# INLINE rootStrategy #-}

#if 1
CONCRETE_ORD_MERGEABLE(Bool)
CONCRETE_ORD_MERGEABLE(Integer)
CONCRETE_ORD_MERGEABLE(Char)
CONCRETE_ORD_MERGEABLE(Int)
CONCRETE_ORD_MERGEABLE(Int8)
CONCRETE_ORD_MERGEABLE(Int16)
CONCRETE_ORD_MERGEABLE(Int32)
CONCRETE_ORD_MERGEABLE(Int64)
CONCRETE_ORD_MERGEABLE(Word)
CONCRETE_ORD_MERGEABLE(Word8)
CONCRETE_ORD_MERGEABLE(Word16)
CONCRETE_ORD_MERGEABLE(Word32)
CONCRETE_ORD_MERGEABLE(Word64)
CONCRETE_ORD_MERGEABLE(B.ByteString)
#endif

-- ()
deriving via (Default ()) instance Mergeable ()

-- Either
deriving via (Default (Either e a)) instance (Mergeable e, Mergeable a) => Mergeable (Either e a)

deriving via (Default1 (Either e)) instance (Mergeable e) => Mergeable1 (Either e)

instance Mergeable2 Either where
  liftRootStrategy2 :: forall a b.
MergingStrategy a
-> MergingStrategy b -> MergingStrategy (Either a b)
liftRootStrategy2 MergingStrategy a
m1 MergingStrategy b
m2 =
    (Either a b -> Bool)
-> (Bool -> MergingStrategy (Either a b))
-> MergingStrategy (Either a b)
forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy
      ( \case
          Left a
_ -> Bool
False
          Right b
_ -> Bool
True
      )
      ( \case
          Bool
False -> MergingStrategy a
-> (a -> Either a b)
-> (Either a b -> a)
-> MergingStrategy (Either a b)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy MergingStrategy a
m1 a -> Either a b
forall a b. a -> Either a b
Left (\case (Left a
v) -> a
v; Either a b
_ -> a
forall a. HasCallStack => a
undefined)
          Bool
True -> MergingStrategy b
-> (b -> Either a b)
-> (Either a b -> b)
-> MergingStrategy (Either a b)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy MergingStrategy b
m2 b -> Either a b
forall a b. b -> Either a b
Right (\case (Right b
v) -> b
v; Either a b
_ -> b
forall a. HasCallStack => a
undefined)
      )
  {-# INLINE liftRootStrategy2 #-}

-- Maybe
deriving via (Default (Maybe a)) instance (Mergeable a) => Mergeable (Maybe a)

deriving via (Default1 Maybe) instance Mergeable1 Maybe

-- | Helper type for building efficient merge strategy for list-like containers.
data StrategyList container where
  StrategyList ::
    forall bool a container.
    container [DynamicSortedIdx] ->
    container (MergingStrategy a) ->
    StrategyList container

-- | Helper function for building efficient merge strategy for list-like containers.
buildStrategyList ::
  forall bool a container.
  (Functor container) =>
  MergingStrategy a ->
  container a ->
  StrategyList container
buildStrategyList :: forall bool a (container :: * -> *).
Functor container =>
MergingStrategy a -> container a -> StrategyList container
buildStrategyList MergingStrategy a
s container a
l = container [DynamicSortedIdx]
-> container (MergingStrategy a) -> StrategyList container
forall bool a (container :: * -> *).
container [DynamicSortedIdx]
-> container (MergingStrategy a) -> StrategyList container
StrategyList container [DynamicSortedIdx]
idxs container (MergingStrategy a)
strategies
  where
    r :: container ([DynamicSortedIdx], MergingStrategy a)
r = MergingStrategy a -> a -> ([DynamicSortedIdx], MergingStrategy a)
forall x.
MergingStrategy x -> x -> ([DynamicSortedIdx], MergingStrategy x)
resolveStrategy MergingStrategy a
s (a -> ([DynamicSortedIdx], MergingStrategy a))
-> container a -> container ([DynamicSortedIdx], MergingStrategy a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> container a
l
    idxs :: container [DynamicSortedIdx]
idxs = ([DynamicSortedIdx], MergingStrategy a) -> [DynamicSortedIdx]
forall a b. (a, b) -> a
fst (([DynamicSortedIdx], MergingStrategy a) -> [DynamicSortedIdx])
-> container ([DynamicSortedIdx], MergingStrategy a)
-> container [DynamicSortedIdx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> container ([DynamicSortedIdx], MergingStrategy a)
r
    strategies :: container (MergingStrategy a)
strategies = ([DynamicSortedIdx], MergingStrategy a) -> MergingStrategy a
forall a b. (a, b) -> b
snd (([DynamicSortedIdx], MergingStrategy a) -> MergingStrategy a)
-> container ([DynamicSortedIdx], MergingStrategy a)
-> container (MergingStrategy a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> container ([DynamicSortedIdx], MergingStrategy a)
r
{-# INLINE buildStrategyList #-}

instance Eq1 container => Eq (StrategyList container) where
  (StrategyList container [DynamicSortedIdx]
idxs1 container (MergingStrategy a)
_) == :: StrategyList container -> StrategyList container -> Bool
== (StrategyList container [DynamicSortedIdx]
idxs2 container (MergingStrategy a)
_) = container [DynamicSortedIdx]
-> container [DynamicSortedIdx] -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1 container [DynamicSortedIdx]
idxs1 container [DynamicSortedIdx]
idxs2
  {-# INLINE (==) #-}

instance Ord1 container => Ord (StrategyList container) where
  compare :: StrategyList container -> StrategyList container -> Ordering
compare (StrategyList container [DynamicSortedIdx]
idxs1 container (MergingStrategy a)
_) (StrategyList container [DynamicSortedIdx]
idxs2 container (MergingStrategy a)
_) = container [DynamicSortedIdx]
-> container [DynamicSortedIdx] -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1 container [DynamicSortedIdx]
idxs1 container [DynamicSortedIdx]
idxs2
  {-# INLINE compare #-}

instance Show1 container => Show (StrategyList container) where
  showsPrec :: Int -> StrategyList container -> ShowS
showsPrec Int
i (StrategyList container [DynamicSortedIdx]
idxs1 container (MergingStrategy a)
_) = Int -> container [DynamicSortedIdx] -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1 Int
i container [DynamicSortedIdx]
idxs1

-- List
instance (Mergeable a) => Mergeable [a] where
  rootStrategy :: MergingStrategy [a]
rootStrategy = case MergingStrategy a
forall a. Mergeable a => MergingStrategy a
rootStrategy :: MergingStrategy a of
    SimpleStrategy SymBool -> a -> a -> a
m ->
      ([a] -> Int) -> (Int -> MergingStrategy [a]) -> MergingStrategy [a]
forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Int -> MergingStrategy [a]) -> MergingStrategy [a])
-> (Int -> MergingStrategy [a]) -> MergingStrategy [a]
forall a b. (a -> b) -> a -> b
$ \Int
_ ->
        (SymBool -> [a] -> [a] -> [a]) -> MergingStrategy [a]
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy ((SymBool -> [a] -> [a] -> [a]) -> MergingStrategy [a])
-> (SymBool -> [a] -> [a] -> [a]) -> MergingStrategy [a]
forall a b. (a -> b) -> a -> b
$ \SymBool
cond -> (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (SymBool -> a -> a -> a
m SymBool
cond)
    MergingStrategy a
NoStrategy ->
      ([a] -> Int) -> (Int -> MergingStrategy [a]) -> MergingStrategy [a]
forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Int -> MergingStrategy [a]) -> MergingStrategy [a])
-> (Int -> MergingStrategy [a]) -> MergingStrategy [a]
forall a b. (a -> b) -> a -> b
$ MergingStrategy [a] -> Int -> MergingStrategy [a]
forall a b. a -> b -> a
const MergingStrategy [a]
forall a. MergingStrategy a
NoStrategy
    MergingStrategy a
_ -> ([a] -> Int) -> (Int -> MergingStrategy [a]) -> MergingStrategy [a]
forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Int -> MergingStrategy [a]) -> MergingStrategy [a])
-> (Int -> MergingStrategy [a]) -> MergingStrategy [a]
forall a b. (a -> b) -> a -> b
$ \Int
_ ->
      ([a] -> StrategyList [])
-> (StrategyList [] -> MergingStrategy [a]) -> MergingStrategy [a]
forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy (MergingStrategy a -> [a] -> StrategyList []
forall bool a (container :: * -> *).
Functor container =>
MergingStrategy a -> container a -> StrategyList container
buildStrategyList MergingStrategy a
forall a. Mergeable a => MergingStrategy a
rootStrategy) ((StrategyList [] -> MergingStrategy [a]) -> MergingStrategy [a])
-> (StrategyList [] -> MergingStrategy [a]) -> MergingStrategy [a]
forall a b. (a -> b) -> a -> b
$ \(StrategyList [[DynamicSortedIdx]]
_ [MergingStrategy a]
strategies) ->
        let [MergingStrategy a]
s :: [MergingStrategy a] = [MergingStrategy a] -> [MergingStrategy a]
forall a b. a -> b
unsafeCoerce [MergingStrategy a]
strategies
            allSimple :: Bool
allSimple = (MergingStrategy a -> Bool) -> [MergingStrategy a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\case SimpleStrategy SymBool -> a -> a -> a
_ -> Bool
True; MergingStrategy a
_ -> Bool
False) [MergingStrategy a]
s
         in if Bool
allSimple
              then (SymBool -> [a] -> [a] -> [a]) -> MergingStrategy [a]
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy ((SymBool -> [a] -> [a] -> [a]) -> MergingStrategy [a])
-> (SymBool -> [a] -> [a] -> [a]) -> MergingStrategy [a]
forall a b. (a -> b) -> a -> b
$ \SymBool
cond [a]
l [a]
r ->
                (\case (SimpleStrategy SymBool -> a -> a -> a
f, a
l1, a
r1) -> SymBool -> a -> a -> a
f SymBool
cond a
l1 a
r1; (MergingStrategy a, a, a)
_ -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible") ((MergingStrategy a, a, a) -> a)
-> [(MergingStrategy a, a, a)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MergingStrategy a] -> [a] -> [a] -> [(MergingStrategy a, a, a)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [MergingStrategy a]
s [a]
l [a]
r
              else MergingStrategy [a]
forall a. MergingStrategy a
NoStrategy
  {-# INLINE rootStrategy #-}

instance Mergeable1 [] where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy [a]
liftRootStrategy (MergingStrategy a
ms :: MergingStrategy a) = case MergingStrategy a
ms of
    SimpleStrategy SymBool -> a -> a -> a
m ->
      ([a] -> Int) -> (Int -> MergingStrategy [a]) -> MergingStrategy [a]
forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Int -> MergingStrategy [a]) -> MergingStrategy [a])
-> (Int -> MergingStrategy [a]) -> MergingStrategy [a]
forall a b. (a -> b) -> a -> b
$ \Int
_ ->
        (SymBool -> [a] -> [a] -> [a]) -> MergingStrategy [a]
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy ((SymBool -> [a] -> [a] -> [a]) -> MergingStrategy [a])
-> (SymBool -> [a] -> [a] -> [a]) -> MergingStrategy [a]
forall a b. (a -> b) -> a -> b
$ \SymBool
cond -> (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (SymBool -> a -> a -> a
m SymBool
cond)
    MergingStrategy a
NoStrategy ->
      ([a] -> Int) -> (Int -> MergingStrategy [a]) -> MergingStrategy [a]
forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Int -> MergingStrategy [a]) -> MergingStrategy [a])
-> (Int -> MergingStrategy [a]) -> MergingStrategy [a]
forall a b. (a -> b) -> a -> b
$ MergingStrategy [a] -> Int -> MergingStrategy [a]
forall a b. a -> b -> a
const MergingStrategy [a]
forall a. MergingStrategy a
NoStrategy
    MergingStrategy a
_ -> ([a] -> Int) -> (Int -> MergingStrategy [a]) -> MergingStrategy [a]
forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Int -> MergingStrategy [a]) -> MergingStrategy [a])
-> (Int -> MergingStrategy [a]) -> MergingStrategy [a]
forall a b. (a -> b) -> a -> b
$ \Int
_ ->
      ([a] -> StrategyList [])
-> (StrategyList [] -> MergingStrategy [a]) -> MergingStrategy [a]
forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy (MergingStrategy a -> [a] -> StrategyList []
forall bool a (container :: * -> *).
Functor container =>
MergingStrategy a -> container a -> StrategyList container
buildStrategyList MergingStrategy a
ms) ((StrategyList [] -> MergingStrategy [a]) -> MergingStrategy [a])
-> (StrategyList [] -> MergingStrategy [a]) -> MergingStrategy [a]
forall a b. (a -> b) -> a -> b
$ \(StrategyList [[DynamicSortedIdx]]
_ [MergingStrategy a]
strategies) ->
        let [MergingStrategy a]
s :: [MergingStrategy a] = [MergingStrategy a] -> [MergingStrategy a]
forall a b. a -> b
unsafeCoerce [MergingStrategy a]
strategies
            allSimple :: Bool
allSimple = (MergingStrategy a -> Bool) -> [MergingStrategy a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\case SimpleStrategy SymBool -> a -> a -> a
_ -> Bool
True; MergingStrategy a
_ -> Bool
False) [MergingStrategy a]
s
         in if Bool
allSimple
              then (SymBool -> [a] -> [a] -> [a]) -> MergingStrategy [a]
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy ((SymBool -> [a] -> [a] -> [a]) -> MergingStrategy [a])
-> (SymBool -> [a] -> [a] -> [a]) -> MergingStrategy [a]
forall a b. (a -> b) -> a -> b
$ \SymBool
cond [a]
l [a]
r ->
                (\case (SimpleStrategy SymBool -> a -> a -> a
f, a
l1, a
r1) -> SymBool -> a -> a -> a
f SymBool
cond a
l1 a
r1; (MergingStrategy a, a, a)
_ -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible") ((MergingStrategy a, a, a) -> a)
-> [(MergingStrategy a, a, a)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MergingStrategy a] -> [a] -> [a] -> [(MergingStrategy a, a, a)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [MergingStrategy a]
s [a]
l [a]
r
              else MergingStrategy [a]
forall a. MergingStrategy a
NoStrategy
  {-# INLINE liftRootStrategy #-}

-- (,)
deriving via (Default (a, b)) instance (Mergeable a, Mergeable b) => Mergeable (a, b)

deriving via (Default1 ((,) a)) instance (Mergeable a) => Mergeable1 ((,) a)

instance Mergeable2 (,) where
  liftRootStrategy2 :: forall a b.
MergingStrategy a -> MergingStrategy b -> MergingStrategy (a, b)
liftRootStrategy2 = (a -> b -> (a, b))
-> ((a, b) -> (a, b))
-> MergingStrategy a
-> MergingStrategy b
-> MergingStrategy (a, b)
forall a b r.
(a -> b -> r)
-> (r -> (a, b))
-> MergingStrategy a
-> MergingStrategy b
-> MergingStrategy r
product2Strategy (,) (a, b) -> (a, b)
forall a. a -> a
id
  {-# INLINE liftRootStrategy2 #-}

-- (,,)
deriving via
  (Default (a, b, c))
  instance
    (Mergeable a, Mergeable b, Mergeable c) => Mergeable (a, b, c)

deriving via
  (Default1 ((,,) a b))
  instance
    (Mergeable a, Mergeable b) => Mergeable1 ((,,) a b)

instance (Mergeable a) => Mergeable2 ((,,) a) where
  liftRootStrategy2 :: forall a b.
MergingStrategy a -> MergingStrategy b -> MergingStrategy (a, a, b)
liftRootStrategy2 = MergingStrategy a
-> MergingStrategy a
-> MergingStrategy b
-> MergingStrategy (a, a, b)
forall (u :: * -> * -> * -> *) a b c.
Mergeable3 u =>
MergingStrategy a
-> MergingStrategy b
-> MergingStrategy c
-> MergingStrategy (u a b c)
liftRootStrategy3 MergingStrategy a
forall a. Mergeable a => MergingStrategy a
rootStrategy
  {-# INLINE liftRootStrategy2 #-}

instance Mergeable3 (,,) where
  liftRootStrategy3 :: forall a b c.
MergingStrategy a
-> MergingStrategy b
-> MergingStrategy c
-> MergingStrategy (a, b, c)
liftRootStrategy3 MergingStrategy a
m1 MergingStrategy b
m2 MergingStrategy c
m3 =
    (a -> (b, c) -> (a, b, c))
-> ((a, b, c) -> (a, (b, c)))
-> MergingStrategy a
-> MergingStrategy (b, c)
-> MergingStrategy (a, b, c)
forall a b r.
(a -> b -> r)
-> (r -> (a, b))
-> MergingStrategy a
-> MergingStrategy b
-> MergingStrategy r
product2Strategy
      (\a
a (b
b, c
c) -> (a
a, b
b, c
c))
      (\(a
a, b
b, c
c) -> (a
a, (b
b, c
c)))
      MergingStrategy a
m1
      (MergingStrategy b -> MergingStrategy c -> MergingStrategy (b, c)
forall (u :: * -> * -> *) a b.
Mergeable2 u =>
MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)
liftRootStrategy2 MergingStrategy b
m2 MergingStrategy c
m3)
  {-# INLINE liftRootStrategy3 #-}

-- (,,,)
deriving via
  (Default (a, b, c, d))
  instance
    (Mergeable a, Mergeable b, Mergeable c, Mergeable d) =>
    Mergeable (a, b, c, d)

deriving via
  (Default1 ((,,,) a b c))
  instance
    (Mergeable a, Mergeable b, Mergeable c) =>
    Mergeable1 ((,,,) a b c)

-- (,,,,)
deriving via
  (Default (a, b, c, d, e))
  instance
    (Mergeable a, Mergeable b, Mergeable c, Mergeable d, Mergeable e) =>
    Mergeable (a, b, c, d, e)

deriving via
  (Default1 ((,,,,) a b c d))
  instance
    (Mergeable a, Mergeable b, Mergeable c, Mergeable d) =>
    Mergeable1 ((,,,,) a b c d)

-- (,,,,,)
deriving via
  (Default (a, b, c, d, e, f))
  instance
    ( Mergeable a,
      Mergeable b,
      Mergeable c,
      Mergeable d,
      Mergeable e,
      Mergeable f
    ) =>
    Mergeable (a, b, c, d, e, f)

deriving via
  (Default1 ((,,,,,) a b c d e))
  instance
    (Mergeable a, Mergeable b, Mergeable c, Mergeable d, Mergeable e) =>
    Mergeable1 ((,,,,,) a b c d e)

-- (,,,,,,)
deriving via
  (Default (a, b, c, d, e, f, g))
  instance
    ( Mergeable a,
      Mergeable b,
      Mergeable c,
      Mergeable d,
      Mergeable e,
      Mergeable f,
      Mergeable g
    ) =>
    Mergeable (a, b, c, d, e, f, g)

deriving via
  (Default1 ((,,,,,,) a b c d e f))
  instance
    ( Mergeable a,
      Mergeable b,
      Mergeable c,
      Mergeable d,
      Mergeable e,
      Mergeable f
    ) =>
    Mergeable1 ((,,,,,,) a b c d e f)

-- (,,,,,,,)
deriving via
  (Default (a, b, c, d, e, f, g, h))
  instance
    ( Mergeable a,
      Mergeable b,
      Mergeable c,
      Mergeable d,
      Mergeable e,
      Mergeable f,
      Mergeable g,
      Mergeable h
    ) =>
    Mergeable (a, b, c, d, e, f, g, h)

deriving via
  (Default1 ((,,,,,,,) a b c d e f g))
  instance
    ( Mergeable a,
      Mergeable b,
      Mergeable c,
      Mergeable d,
      Mergeable e,
      Mergeable f,
      Mergeable g
    ) =>
    Mergeable1 ((,,,,,,,) a b c d e f g)

-- function
instance (Mergeable b) => Mergeable (a -> b) where
  rootStrategy :: MergingStrategy (a -> b)
rootStrategy = case forall a. Mergeable a => MergingStrategy a
rootStrategy @b of
    SimpleStrategy SymBool -> b -> b -> b
m -> (SymBool -> (a -> b) -> (a -> b) -> a -> b)
-> MergingStrategy (a -> b)
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy ((SymBool -> (a -> b) -> (a -> b) -> a -> b)
 -> MergingStrategy (a -> b))
-> (SymBool -> (a -> b) -> (a -> b) -> a -> b)
-> MergingStrategy (a -> b)
forall a b. (a -> b) -> a -> b
$ \SymBool
cond a -> b
t a -> b
f a
v -> SymBool -> b -> b -> b
m SymBool
cond (a -> b
t a
v) (a -> b
f a
v)
    MergingStrategy b
_ -> MergingStrategy (a -> b)
forall a. MergingStrategy a
NoStrategy
  {-# INLINE rootStrategy #-}

instance Mergeable1 ((->) a) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (a -> a)
liftRootStrategy MergingStrategy a
ms = case MergingStrategy a
ms of
    SimpleStrategy SymBool -> a -> a -> a
m -> (SymBool -> (a -> a) -> (a -> a) -> a -> a)
-> MergingStrategy (a -> a)
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy ((SymBool -> (a -> a) -> (a -> a) -> a -> a)
 -> MergingStrategy (a -> a))
-> (SymBool -> (a -> a) -> (a -> a) -> a -> a)
-> MergingStrategy (a -> a)
forall a b. (a -> b) -> a -> b
$ \SymBool
cond a -> a
t a -> a
f a
v -> SymBool -> a -> a -> a
m SymBool
cond (a -> a
t a
v) (a -> a
f a
v)
    MergingStrategy a
_ -> MergingStrategy (a -> a)
forall a. MergingStrategy a
NoStrategy
  {-# INLINE liftRootStrategy #-}

-- MaybeT
instance (Mergeable1 m, Mergeable a) => Mergeable (MaybeT m a) where
  rootStrategy :: MergingStrategy (MaybeT m a)
rootStrategy = MergingStrategy (m (Maybe a))
-> (m (Maybe a) -> MaybeT m a)
-> (MaybeT m a -> m (Maybe a))
-> MergingStrategy (MaybeT m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy MergingStrategy (m (Maybe a))
forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1 m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT MaybeT m a -> m (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT
  {-# INLINE rootStrategy #-}

instance (Mergeable1 m) => Mergeable1 (MaybeT m) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (MaybeT m a)
liftRootStrategy MergingStrategy a
m = MergingStrategy (m (Maybe a))
-> (m (Maybe a) -> MaybeT m a)
-> (MaybeT m a -> m (Maybe a))
-> MergingStrategy (MaybeT m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (MergingStrategy (Maybe a) -> MergingStrategy (m (Maybe a))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (MergingStrategy a -> MergingStrategy (Maybe a)
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy a
m)) m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT MaybeT m a -> m (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT
  {-# INLINE liftRootStrategy #-}

-- ExceptT
instance
  (Mergeable1 m, Mergeable e, Mergeable a) =>
  Mergeable (ExceptT e m a)
  where
  rootStrategy :: MergingStrategy (ExceptT e m a)
rootStrategy = MergingStrategy (m (Either e a))
-> (m (Either e a) -> ExceptT e m a)
-> (ExceptT e m a -> m (Either e a))
-> MergingStrategy (ExceptT e m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy MergingStrategy (m (Either e a))
forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1 m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT ExceptT e m a -> m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
  {-# INLINE rootStrategy #-}

instance (Mergeable1 m, Mergeable e) => Mergeable1 (ExceptT e m) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (ExceptT e m a)
liftRootStrategy MergingStrategy a
m = MergingStrategy (m (Either e a))
-> (m (Either e a) -> ExceptT e m a)
-> (ExceptT e m a -> m (Either e a))
-> MergingStrategy (ExceptT e m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (MergingStrategy (Either e a) -> MergingStrategy (m (Either e a))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (MergingStrategy a -> MergingStrategy (Either e a)
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy a
m)) m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT ExceptT e m a -> m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
  {-# INLINE liftRootStrategy #-}

-- state
instance
  (Mergeable s, Mergeable a, Mergeable1 m) =>
  Mergeable (StateLazy.StateT s m a)
  where
  rootStrategy :: MergingStrategy (StateT s m a)
rootStrategy = MergingStrategy (s -> m (a, s))
-> ((s -> m (a, s)) -> StateT s m a)
-> (StateT s m a -> s -> m (a, s))
-> MergingStrategy (StateT s m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (MergingStrategy (m (a, s)) -> MergingStrategy (s -> m (a, s))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy (m (a, s))
forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1) (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateLazy.StateT StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
StateLazy.runStateT
  {-# INLINE rootStrategy #-}

instance (Mergeable s, Mergeable1 m) => Mergeable1 (StateLazy.StateT s m) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (StateT s m a)
liftRootStrategy MergingStrategy a
m =
    MergingStrategy (s -> m (a, s))
-> ((s -> m (a, s)) -> StateT s m a)
-> (StateT s m a -> s -> m (a, s))
-> MergingStrategy (StateT s m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy
      (MergingStrategy (m (a, s)) -> MergingStrategy (s -> m (a, s))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (MergingStrategy (a, s) -> MergingStrategy (m (a, s))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (MergingStrategy a -> MergingStrategy s -> MergingStrategy (a, s)
forall (u :: * -> * -> *) a b.
Mergeable2 u =>
MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)
liftRootStrategy2 MergingStrategy a
m MergingStrategy s
forall a. Mergeable a => MergingStrategy a
rootStrategy)))
      (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateLazy.StateT
      StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
StateLazy.runStateT
  {-# INLINE liftRootStrategy #-}

instance
  (Mergeable s, Mergeable a, Mergeable1 m) =>
  Mergeable (StateStrict.StateT s m a)
  where
  rootStrategy :: MergingStrategy (StateT s m a)
rootStrategy =
    MergingStrategy (s -> m (a, s))
-> ((s -> m (a, s)) -> StateT s m a)
-> (StateT s m a -> s -> m (a, s))
-> MergingStrategy (StateT s m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (MergingStrategy (m (a, s)) -> MergingStrategy (s -> m (a, s))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy (m (a, s))
forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1) (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateStrict.StateT StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
StateStrict.runStateT
  {-# INLINE rootStrategy #-}

instance (Mergeable s, Mergeable1 m) => Mergeable1 (StateStrict.StateT s m) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (StateT s m a)
liftRootStrategy MergingStrategy a
m =
    MergingStrategy (s -> m (a, s))
-> ((s -> m (a, s)) -> StateT s m a)
-> (StateT s m a -> s -> m (a, s))
-> MergingStrategy (StateT s m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy
      (MergingStrategy (m (a, s)) -> MergingStrategy (s -> m (a, s))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (MergingStrategy (a, s) -> MergingStrategy (m (a, s))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (MergingStrategy a -> MergingStrategy s -> MergingStrategy (a, s)
forall (u :: * -> * -> *) a b.
Mergeable2 u =>
MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)
liftRootStrategy2 MergingStrategy a
m MergingStrategy s
forall a. Mergeable a => MergingStrategy a
rootStrategy)))
      (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateStrict.StateT
      StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
StateStrict.runStateT
  {-# INLINE liftRootStrategy #-}

-- writer
instance
  (Mergeable s, Mergeable a, Mergeable1 m) =>
  Mergeable (WriterLazy.WriterT s m a)
  where
  rootStrategy :: MergingStrategy (WriterT s m a)
rootStrategy = MergingStrategy (m (a, s))
-> (m (a, s) -> WriterT s m a)
-> (WriterT s m a -> m (a, s))
-> MergingStrategy (WriterT s m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (MergingStrategy (a, s) -> MergingStrategy (m (a, s))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy (a, s)
forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1) m (a, s) -> WriterT s m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterLazy.WriterT WriterT s m a -> m (a, s)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
WriterLazy.runWriterT
  {-# INLINE rootStrategy #-}

instance (Mergeable s, Mergeable1 m) => Mergeable1 (WriterLazy.WriterT s m) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (WriterT s m a)
liftRootStrategy MergingStrategy a
m =
    MergingStrategy (m (a, s))
-> (m (a, s) -> WriterT s m a)
-> (WriterT s m a -> m (a, s))
-> MergingStrategy (WriterT s m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy
      (MergingStrategy (a, s) -> MergingStrategy (m (a, s))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (MergingStrategy a -> MergingStrategy s -> MergingStrategy (a, s)
forall (u :: * -> * -> *) a b.
Mergeable2 u =>
MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)
liftRootStrategy2 MergingStrategy a
m MergingStrategy s
forall a. Mergeable a => MergingStrategy a
rootStrategy))
      m (a, s) -> WriterT s m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterLazy.WriterT
      WriterT s m a -> m (a, s)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
WriterLazy.runWriterT
  {-# INLINE liftRootStrategy #-}

instance
  (Mergeable s, Mergeable a, Mergeable1 m) =>
  Mergeable (WriterStrict.WriterT s m a)
  where
  rootStrategy :: MergingStrategy (WriterT s m a)
rootStrategy = MergingStrategy (m (a, s))
-> (m (a, s) -> WriterT s m a)
-> (WriterT s m a -> m (a, s))
-> MergingStrategy (WriterT s m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (MergingStrategy (a, s) -> MergingStrategy (m (a, s))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy (a, s)
forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1) m (a, s) -> WriterT s m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterStrict.WriterT WriterT s m a -> m (a, s)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
WriterStrict.runWriterT
  {-# INLINE rootStrategy #-}

instance (Mergeable s, Mergeable1 m) => Mergeable1 (WriterStrict.WriterT s m) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (WriterT s m a)
liftRootStrategy MergingStrategy a
m =
    MergingStrategy (m (a, s))
-> (m (a, s) -> WriterT s m a)
-> (WriterT s m a -> m (a, s))
-> MergingStrategy (WriterT s m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy
      (MergingStrategy (a, s) -> MergingStrategy (m (a, s))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (MergingStrategy a -> MergingStrategy s -> MergingStrategy (a, s)
forall (u :: * -> * -> *) a b.
Mergeable2 u =>
MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)
liftRootStrategy2 MergingStrategy a
m MergingStrategy s
forall a. Mergeable a => MergingStrategy a
rootStrategy))
      m (a, s) -> WriterT s m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterStrict.WriterT
      WriterT s m a -> m (a, s)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
WriterStrict.runWriterT
  {-# INLINE liftRootStrategy #-}

-- reader
instance
  (Mergeable a, Mergeable1 m) =>
  Mergeable (ReaderT s m a)
  where
  rootStrategy :: MergingStrategy (ReaderT s m a)
rootStrategy = MergingStrategy (s -> m a)
-> ((s -> m a) -> ReaderT s m a)
-> (ReaderT s m a -> s -> m a)
-> MergingStrategy (ReaderT s m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (MergingStrategy (m a) -> MergingStrategy (s -> m a)
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy (m a)
forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1) (s -> m a) -> ReaderT s m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ReaderT s m a -> s -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
  {-# INLINE rootStrategy #-}

instance (Mergeable1 m) => Mergeable1 (ReaderT s m) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (ReaderT s m a)
liftRootStrategy MergingStrategy a
m =
    MergingStrategy (s -> m a)
-> ((s -> m a) -> ReaderT s m a)
-> (ReaderT s m a -> s -> m a)
-> MergingStrategy (ReaderT s m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy
      (MergingStrategy (m a) -> MergingStrategy (s -> m a)
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (MergingStrategy a -> MergingStrategy (m a)
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy a
m))
      (s -> m a) -> ReaderT s m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT
      ReaderT s m a -> s -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
  {-# INLINE liftRootStrategy #-}

-- Sum
instance
  (Mergeable1 l, Mergeable1 r, Mergeable x) =>
  Mergeable (Sum l r x)
  where
  rootStrategy :: MergingStrategy (Sum l r x)
rootStrategy =
    (Sum l r x -> Bool)
-> (Bool -> MergingStrategy (Sum l r x))
-> MergingStrategy (Sum l r x)
forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy
      ( \case
          InL l x
_ -> Bool
False
          InR r x
_ -> Bool
True
      )
      ( \case
          Bool
False -> MergingStrategy (l x)
-> (l x -> Sum l r x)
-> (Sum l r x -> l x)
-> MergingStrategy (Sum l r x)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy MergingStrategy (l x)
forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1 l x -> Sum l r x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL (\case (InL l x
v) -> l x
v; Sum l r x
_ -> [Char] -> l x
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible")
          Bool
True -> MergingStrategy (r x)
-> (r x -> Sum l r x)
-> (Sum l r x -> r x)
-> MergingStrategy (Sum l r x)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy MergingStrategy (r x)
forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1 r x -> Sum l r x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (\case (InR r x
v) -> r x
v; Sum l r x
_ -> [Char] -> r x
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible")
      )
  {-# INLINE rootStrategy #-}

instance (Mergeable1 l, Mergeable1 r) => Mergeable1 (Sum l r) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (Sum l r a)
liftRootStrategy MergingStrategy a
m =
    (Sum l r a -> Bool)
-> (Bool -> MergingStrategy (Sum l r a))
-> MergingStrategy (Sum l r a)
forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy
      ( \case
          InL l a
_ -> Bool
False
          InR r a
_ -> Bool
True
      )
      ( \case
          Bool
False -> MergingStrategy (l a)
-> (l a -> Sum l r a)
-> (Sum l r a -> l a)
-> MergingStrategy (Sum l r a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (MergingStrategy a -> MergingStrategy (l a)
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy a
m) l a -> Sum l r a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL (\case (InL l a
v) -> l a
v; Sum l r a
_ -> [Char] -> l a
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible")
          Bool
True -> MergingStrategy (r a)
-> (r a -> Sum l r a)
-> (Sum l r a -> r a)
-> MergingStrategy (Sum l r a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (MergingStrategy a -> MergingStrategy (r a)
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy a
m) r a -> Sum l r a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (\case (InR r a
v) -> r a
v; Sum l r a
_ -> [Char] -> r a
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible")
      )
  {-# INLINE liftRootStrategy #-}

-- Ordering
deriving via
  (Default Ordering)
  instance
    Mergeable Ordering

-- Generic
deriving via
  (Default (U1 x))
  instance
    Mergeable (U1 x)

deriving via
  (Default (V1 x))
  instance
    Mergeable (V1 x)

deriving via
  (Default (K1 i c x))
  instance
    (Mergeable c) => Mergeable (K1 i c x)

deriving via
  (Default (M1 i c a x))
  instance
    (Mergeable (a x)) => Mergeable (M1 i c a x)

deriving via
  (Default ((a :+: b) x))
  instance
    (Mergeable (a x), Mergeable (b x)) => Mergeable ((a :+: b) x)

deriving via
  (Default ((a :*: b) x))
  instance
    (Mergeable (a x), Mergeable (b x)) => Mergeable ((a :*: b) x)

-- Identity
instance (Mergeable a) => Mergeable (Identity a) where
  rootStrategy :: MergingStrategy (Identity a)
rootStrategy = MergingStrategy a
-> (a -> Identity a)
-> (Identity a -> a)
-> MergingStrategy (Identity a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy MergingStrategy a
forall a. Mergeable a => MergingStrategy a
rootStrategy a -> Identity a
forall a. a -> Identity a
Identity Identity a -> a
forall a. Identity a -> a
runIdentity
  {-# INLINE rootStrategy #-}

instance Mergeable1 Identity where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (Identity a)
liftRootStrategy MergingStrategy a
m = MergingStrategy a
-> (a -> Identity a)
-> (Identity a -> a)
-> MergingStrategy (Identity a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy MergingStrategy a
m a -> Identity a
forall a. a -> Identity a
Identity Identity a -> a
forall a. Identity a -> a
runIdentity
  {-# INLINE liftRootStrategy #-}

-- IdentityT
instance (Mergeable1 m, Mergeable a) => Mergeable (IdentityT m a) where
  rootStrategy :: MergingStrategy (IdentityT m a)
rootStrategy = MergingStrategy (m a)
-> (m a -> IdentityT m a)
-> (IdentityT m a -> m a)
-> MergingStrategy (IdentityT m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy MergingStrategy (m a)
forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1 m a -> IdentityT m a
forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT IdentityT m a -> m a
forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT
  {-# INLINE rootStrategy #-}

instance (Mergeable1 m) => Mergeable1 (IdentityT m) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (IdentityT m a)
liftRootStrategy MergingStrategy a
m = MergingStrategy (m a)
-> (m a -> IdentityT m a)
-> (IdentityT m a -> m a)
-> MergingStrategy (IdentityT m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (MergingStrategy a -> MergingStrategy (m a)
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy a
m) m a -> IdentityT m a
forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT IdentityT m a -> m a
forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT
  {-# INLINE liftRootStrategy #-}

-- ContT
instance (Mergeable1 m, Mergeable r) => Mergeable (ContT r m a) where
  rootStrategy :: MergingStrategy (ContT r m a)
rootStrategy =
    MergingStrategy ((a -> m r) -> m r)
-> (((a -> m r) -> m r) -> ContT r m a)
-> (ContT r m a -> (a -> m r) -> m r)
-> MergingStrategy (ContT r m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy
      (MergingStrategy (m r) -> MergingStrategy ((a -> m r) -> m r)
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy (m r)
forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1)
      ((a -> m r) -> m r) -> ContT r m a
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT
      (\(ContT (a -> m r) -> m r
v) -> (a -> m r) -> m r
v)
  {-# INLINE rootStrategy #-}

instance (Mergeable1 m, Mergeable r) => Mergeable1 (ContT r m) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (ContT r m a)
liftRootStrategy MergingStrategy a
_ =
    MergingStrategy ((a -> m r) -> m r)
-> (((a -> m r) -> m r) -> ContT r m a)
-> (ContT r m a -> (a -> m r) -> m r)
-> MergingStrategy (ContT r m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy
      (MergingStrategy (m r) -> MergingStrategy ((a -> m r) -> m r)
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy (m r)
forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1)
      ((a -> m r) -> m r) -> ContT r m a
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT
      (\(ContT (a -> m r) -> m r
v) -> (a -> m r) -> m r
v)
  {-# INLINE liftRootStrategy #-}

-- RWS
instance
  (Mergeable s, Mergeable w, Mergeable a, Mergeable1 m) =>
  Mergeable (RWSLazy.RWST r w s m a)
  where
  rootStrategy :: MergingStrategy (RWST r w s m a)
rootStrategy = MergingStrategy (r -> s -> m (a, s, w))
-> ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (RWST r w s m a -> r -> s -> m (a, s, w))
-> MergingStrategy (RWST r w s m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (MergingStrategy (s -> m (a, s, w))
-> MergingStrategy (r -> s -> m (a, s, w))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (MergingStrategy (m (a, s, w)) -> MergingStrategy (s -> m (a, s, w))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy (m (a, s, w))
forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1)) (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWSLazy.RWST (\(RWSLazy.RWST r -> s -> m (a, s, w)
m) -> r -> s -> m (a, s, w)
m)
  {-# INLINE rootStrategy #-}

instance
  (Mergeable s, Mergeable w, Mergeable1 m) =>
  Mergeable1 (RWSLazy.RWST r w s m)
  where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (RWST r w s m a)
liftRootStrategy MergingStrategy a
m =
    MergingStrategy (r -> s -> m (a, s, w))
-> ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (RWST r w s m a -> r -> s -> m (a, s, w))
-> MergingStrategy (RWST r w s m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy
      (MergingStrategy (s -> m (a, s, w))
-> MergingStrategy (r -> s -> m (a, s, w))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (MergingStrategy (m (a, s, w)) -> MergingStrategy (s -> m (a, s, w))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (MergingStrategy (a, s, w) -> MergingStrategy (m (a, s, w))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (MergingStrategy a
-> MergingStrategy s
-> MergingStrategy w
-> MergingStrategy (a, s, w)
forall (u :: * -> * -> * -> *) a b c.
Mergeable3 u =>
MergingStrategy a
-> MergingStrategy b
-> MergingStrategy c
-> MergingStrategy (u a b c)
liftRootStrategy3 MergingStrategy a
m MergingStrategy s
forall a. Mergeable a => MergingStrategy a
rootStrategy MergingStrategy w
forall a. Mergeable a => MergingStrategy a
rootStrategy))))
      (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWSLazy.RWST
      (\(RWSLazy.RWST r -> s -> m (a, s, w)
rws) -> r -> s -> m (a, s, w)
rws)
  {-# INLINE liftRootStrategy #-}

instance
  (Mergeable s, Mergeable w, Mergeable a, Mergeable1 m) =>
  Mergeable (RWSStrict.RWST r w s m a)
  where
  rootStrategy :: MergingStrategy (RWST r w s m a)
rootStrategy = MergingStrategy (r -> s -> m (a, s, w))
-> ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (RWST r w s m a -> r -> s -> m (a, s, w))
-> MergingStrategy (RWST r w s m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (MergingStrategy (s -> m (a, s, w))
-> MergingStrategy (r -> s -> m (a, s, w))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (MergingStrategy (m (a, s, w)) -> MergingStrategy (s -> m (a, s, w))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy (m (a, s, w))
forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1)) (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWSStrict.RWST (\(RWSStrict.RWST r -> s -> m (a, s, w)
m) -> r -> s -> m (a, s, w)
m)
  {-# INLINE rootStrategy #-}

instance
  (Mergeable s, Mergeable w, Mergeable1 m) =>
  Mergeable1 (RWSStrict.RWST r w s m)
  where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (RWST r w s m a)
liftRootStrategy MergingStrategy a
m =
    MergingStrategy (r -> s -> m (a, s, w))
-> ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (RWST r w s m a -> r -> s -> m (a, s, w))
-> MergingStrategy (RWST r w s m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy
      (MergingStrategy (s -> m (a, s, w))
-> MergingStrategy (r -> s -> m (a, s, w))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (MergingStrategy (m (a, s, w)) -> MergingStrategy (s -> m (a, s, w))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (MergingStrategy (a, s, w) -> MergingStrategy (m (a, s, w))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (MergingStrategy a
-> MergingStrategy s
-> MergingStrategy w
-> MergingStrategy (a, s, w)
forall (u :: * -> * -> * -> *) a b c.
Mergeable3 u =>
MergingStrategy a
-> MergingStrategy b
-> MergingStrategy c
-> MergingStrategy (u a b c)
liftRootStrategy3 MergingStrategy a
m MergingStrategy s
forall a. Mergeable a => MergingStrategy a
rootStrategy MergingStrategy w
forall a. Mergeable a => MergingStrategy a
rootStrategy))))
      (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWSStrict.RWST
      (\(RWSStrict.RWST r -> s -> m (a, s, w)
rws) -> r -> s -> m (a, s, w)
rws)
  {-# INLINE liftRootStrategy #-}

-- Data.Monoid module
deriving via
  (Default (Monoid.Sum a))
  instance
    (Mergeable a) => Mergeable (Monoid.Sum a)

deriving via (Default1 Monoid.Sum) instance Mergeable1 Monoid.Sum

instance (SupportedPrim a) => Mergeable (Sym a) where
  rootStrategy :: MergingStrategy (Sym a)
rootStrategy = (SymBool -> Sym a -> Sym a -> Sym a) -> MergingStrategy (Sym a)
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy SymBool -> Sym a -> Sym a -> Sym a
forall v. ITEOp v => SymBool -> v -> v -> v
ites