{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- Module      :   Grisette.Core.Data.Class.SimpleMergeable
-- 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.SimpleMergeable
  ( -- * Simple mergeable types
    SimpleMergeable (..),
    SimpleMergeable1 (..),
    mrgIte1,
    SimpleMergeable2 (..),
    mrgIte2,

    -- * UnionLike operations
    UnionLike (..),
    mrgIf,
    merge,
    mrgSingle,
    UnionPrjOp (..),
    pattern Single,
    pattern If,
    simpleMerge,
    onUnion,
    onUnion2,
    onUnion3,
    onUnion4,
    (.#),
  )
where

import Control.Monad.Except (ExceptT (ExceptT))
import Control.Monad.Identity
  ( Identity (Identity),
    IdentityT (IdentityT),
  )
import qualified Control.Monad.RWS.Lazy as RWSLazy
import qualified Control.Monad.RWS.Strict as RWSStrict
import Control.Monad.Reader (ReaderT (ReaderT))
import qualified Control.Monad.State.Lazy as StateLazy
import qualified Control.Monad.State.Strict as StateStrict
import Control.Monad.Trans.Cont (ContT (ContT))
import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
import qualified Control.Monad.Writer.Lazy as WriterLazy
import qualified Control.Monad.Writer.Strict as WriterStrict
import Data.Bifunctor (Bifunctor (first))
import Data.Kind (Type)
import GHC.Generics
  ( Generic (Rep, from, to),
    K1 (K1),
    M1 (M1),
    U1,
    V1,
    type (:*:) ((:*:)),
  )
import GHC.TypeNats (KnownNat, type (<=))
import Generics.Deriving (Default (Default))
import Grisette.Core.Control.Exception (AssertionError)
import Grisette.Core.Data.Class.Function (Function (Arg, Ret, (#)))
import Grisette.Core.Data.Class.ITEOp (ITEOp (symIte))
import Grisette.Core.Data.Class.LogicalOp (LogicalOp (symNot, (.&&)))
import Grisette.Core.Data.Class.Mergeable
  ( Mergeable (rootStrategy),
    Mergeable',
    Mergeable1 (liftRootStrategy),
    Mergeable2 (liftRootStrategy2),
    Mergeable3 (liftRootStrategy3),
    MergingStrategy (SimpleStrategy),
  )
import Grisette.Core.Data.Class.Solvable (Solvable (con))
import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
  ( LinkedRep,
    SupportedPrim,
  )
import Grisette.IR.SymPrim.Data.SymPrim
  ( SymBool,
    SymIntN,
    SymInteger,
    SymWordN,
    type (-~>),
    type (=~>),
  )

-- $setup
-- >>> import Grisette.Core
-- >>> import Grisette.IR.SymPrim
-- >>> import Control.Monad.Identity

-- | Auxiliary class for the generic derivation for the 'SimpleMergeable' class.
class SimpleMergeable' f where
  mrgIte' :: SymBool -> f a -> f a -> f a

instance (SimpleMergeable' U1) where
  mrgIte' :: forall a. SymBool -> U1 a -> U1 a -> U1 a
mrgIte' SymBool
_ U1 a
t U1 a
_ = U1 a
t
  {-# INLINE mrgIte' #-}

instance (SimpleMergeable' V1) where
  mrgIte' :: forall a. SymBool -> V1 a -> V1 a -> V1 a
mrgIte' SymBool
_ V1 a
t V1 a
_ = V1 a
t
  {-# INLINE mrgIte' #-}

instance (SimpleMergeable c) => (SimpleMergeable' (K1 i c)) where
  mrgIte' :: forall a. SymBool -> K1 i c a -> K1 i c a -> K1 i c a
mrgIte' SymBool
cond (K1 c
a) (K1 c
b) = c -> K1 i c a
forall k i c (p :: k). c -> K1 i c p
K1 (c -> K1 i c a) -> c -> K1 i c a
forall a b. (a -> b) -> a -> b
$ SymBool -> c -> c -> c
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond c
a c
b
  {-# INLINE mrgIte' #-}

instance (SimpleMergeable' a) => (SimpleMergeable' (M1 i c a)) where
  mrgIte' :: forall a. SymBool -> M1 i c a a -> M1 i c a a -> M1 i c a a
mrgIte' SymBool
cond (M1 a a
a) (M1 a a
b) = a a -> M1 i c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> M1 i c a a) -> a a -> M1 i c a a
forall a b. (a -> b) -> a -> b
$ SymBool -> a a -> a a -> a a
forall a. SymBool -> a a -> a a -> a a
forall (f :: * -> *) a.
SimpleMergeable' f =>
SymBool -> f a -> f a -> f a
mrgIte' SymBool
cond a a
a a a
b
  {-# INLINE mrgIte' #-}

instance (SimpleMergeable' a, SimpleMergeable' b) => (SimpleMergeable' (a :*: b)) where
  mrgIte' :: forall a. SymBool -> (:*:) a b a -> (:*:) a b a -> (:*:) a b a
mrgIte' SymBool
cond (a a
a1 :*: b a
a2) (a a
b1 :*: b a
b2) = SymBool -> a a -> a a -> a a
forall a. SymBool -> a a -> a a -> a a
forall (f :: * -> *) a.
SimpleMergeable' f =>
SymBool -> f a -> f a -> f a
mrgIte' SymBool
cond a a
a1 a a
b1 a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: SymBool -> b a -> b a -> b a
forall a. SymBool -> b a -> b a -> b a
forall (f :: * -> *) a.
SimpleMergeable' f =>
SymBool -> f a -> f a -> f a
mrgIte' SymBool
cond b a
a2 b a
b2
  {-# INLINE mrgIte' #-}

-- | This class indicates that a type has a simple root merge strategy.
--
-- __Note:__ This type class can be derived for algebraic data types.
-- You may need the @DerivingVia@ and @DerivingStrategies@ extensions.
--
-- > data X = ...
-- >   deriving Generic
-- >   deriving (Mergeable, SimpleMergeable) via (Default X)
class (Mergeable a) => SimpleMergeable a where
  -- | Performs if-then-else with the simple root merge strategy.
  --
  -- >>> mrgIte "a" "b" "c" :: SymInteger
  -- (ite a b c)
  mrgIte :: SymBool -> a -> a -> a

instance (Generic a, Mergeable' (Rep a), SimpleMergeable' (Rep a)) => SimpleMergeable (Default a) where
  mrgIte :: SymBool -> Default a -> Default a -> Default a
mrgIte SymBool
cond (Default a
a) (Default a
b) = a -> Default a
forall a. a -> Default a
Default (a -> Default a) -> a -> Default a
forall a b. (a -> b) -> a -> b
$ Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Rep a Any -> a) -> Rep a Any -> a
forall a b. (a -> b) -> a -> b
$ SymBool -> Rep a Any -> Rep a Any -> Rep a Any
forall a. SymBool -> Rep a a -> Rep a a -> Rep a a
forall (f :: * -> *) a.
SimpleMergeable' f =>
SymBool -> f a -> f a -> f a
mrgIte' SymBool
cond (a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from a
a) (a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from a
b)
  {-# INLINE mrgIte #-}

-- | Lifting of the 'SimpleMergeable' class to unary type constructors.
class SimpleMergeable1 u where
  -- | Lift 'mrgIte' through the type constructor.
  --
  -- >>> liftMrgIte mrgIte "a" (Identity "b") (Identity "c") :: Identity SymInteger
  -- Identity (ite a b c)
  liftMrgIte :: (SymBool -> a -> a -> a) -> SymBool -> u a -> u a -> u a

-- | Lift the standard 'mrgIte' function through the type constructor.
--
-- >>> mrgIte1 "a" (Identity "b") (Identity "c") :: Identity SymInteger
-- Identity (ite a b c)
mrgIte1 :: (SimpleMergeable1 u, SimpleMergeable a) => SymBool -> u a -> u a -> u a
mrgIte1 :: forall (u :: * -> *) a.
(SimpleMergeable1 u, SimpleMergeable a) =>
SymBool -> u a -> u a -> u a
mrgIte1 = (SymBool -> a -> a -> a) -> SymBool -> u a -> u a -> u a
forall a. (SymBool -> a -> a -> a) -> SymBool -> u a -> u a -> u a
forall (u :: * -> *) a.
SimpleMergeable1 u =>
(SymBool -> a -> a -> a) -> SymBool -> u a -> u a -> u a
liftMrgIte SymBool -> a -> a -> a
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte
{-# INLINE mrgIte1 #-}

-- | Lifting of the 'SimpleMergeable' class to binary type constructors.
class (Mergeable2 u) => SimpleMergeable2 u where
  -- | Lift 'mrgIte' through the type constructor.
  --
  -- >>> liftMrgIte2 mrgIte mrgIte "a" ("b", "c") ("d", "e") :: (SymInteger, SymBool)
  -- ((ite a b d),(ite a c e))
  liftMrgIte2 :: (SymBool -> a -> a -> a) -> (SymBool -> b -> b -> b) -> SymBool -> u a b -> u a b -> u a b

-- | Lift the standard 'mrgIte' function through the type constructor.
--
-- >>> mrgIte2 "a" ("b", "c") ("d", "e") :: (SymInteger, SymBool)
-- ((ite a b d),(ite a c e))
mrgIte2 :: (SimpleMergeable2 u, SimpleMergeable a, SimpleMergeable b) => SymBool -> u a b -> u a b -> u a b
mrgIte2 :: forall (u :: * -> * -> *) a b.
(SimpleMergeable2 u, SimpleMergeable a, SimpleMergeable b) =>
SymBool -> u a b -> u a b -> u a b
mrgIte2 = (SymBool -> a -> a -> a)
-> (SymBool -> b -> b -> b) -> SymBool -> u a b -> u a b -> u a b
forall a b.
(SymBool -> a -> a -> a)
-> (SymBool -> b -> b -> b) -> SymBool -> u a b -> u a b -> u a b
forall (u :: * -> * -> *) a b.
SimpleMergeable2 u =>
(SymBool -> a -> a -> a)
-> (SymBool -> b -> b -> b) -> SymBool -> u a b -> u a b -> u a b
liftMrgIte2 SymBool -> a -> a -> a
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool -> b -> b -> b
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte
{-# INLINE mrgIte2 #-}

-- | Special case of the 'Mergeable1' and 'SimpleMergeable1' class for type
-- constructors that are 'SimpleMergeable' when applied to any 'Mergeable'
-- types.
--
-- This type class is used to generalize the 'mrgIf' function to other
-- containers, for example, monad transformer transformed Unions.
class (SimpleMergeable1 u, Mergeable1 u) => UnionLike u where
  -- | Wrap a single value in the union.
  --
  -- Note that this function cannot propagate the 'Mergeable' knowledge.
  --
  -- >>> single "a" :: UnionM SymInteger
  -- <a>
  -- >>> mrgSingle "a" :: UnionM SymInteger
  -- {a}
  single :: a -> u a

  -- | If-then-else on two union values.
  --
  -- Note that this function cannot capture the 'Mergeable' knowledge. However,
  -- it may use the merging strategy from the branches to merge the results.
  --
  -- >>> unionIf "a" (single "b") (single "c") :: UnionM SymInteger
  -- <If a b c>
  -- >>> unionIf "a" (mrgSingle "b") (single "c") :: UnionM SymInteger
  -- {(ite a b c)}
  unionIf :: SymBool -> u a -> u a -> u a

  -- | Merge the contents with some merge strategy.
  --
  -- >>> mergeWithStrategy rootStrategy $ unionIf "a" (single "b") (single "c") :: UnionM SymInteger
  -- {(ite a b c)}
  --
  -- __Note:__ Be careful to call this directly in your code.
  -- The supplied merge strategy should be consistent with the type's root merge strategy,
  -- or some internal invariants would be broken and the program can crash.
  --
  -- This function is to be called when the 'Mergeable' constraint can not be resolved,
  -- e.g., the merge strategy for the contained type is given with 'Mergeable1'.
  -- In other cases, 'merge' is usually a better alternative.
  mergeWithStrategy :: MergingStrategy a -> u a -> u a

  -- | Symbolic @if@ control flow with the result merged with some merge strategy.
  --
  -- >>> mrgIfWithStrategy rootStrategy "a" (mrgSingle "b") (single "c") :: UnionM SymInteger
  -- {(ite a b c)}
  --
  -- __Note:__ Be careful to call this directly in your code.
  -- The supplied merge strategy should be consistent with the type's root merge strategy,
  -- or some internal invariants would be broken and the program can crash.
  --
  -- This function is to be called when the 'Mergeable' constraint can not be resolved,
  -- e.g., the merge strategy for the contained type is given with 'Mergeable1'.
  -- In other cases, 'mrgIf' is usually a better alternative.
  mrgIfWithStrategy :: MergingStrategy a -> SymBool -> u a -> u a -> u a
  mrgIfWithStrategy MergingStrategy a
s SymBool
cond u a
l u a
r = MergingStrategy a -> u a -> u a
forall a. MergingStrategy a -> u a -> u a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> u a -> u a
mergeWithStrategy MergingStrategy a
s (u a -> u a) -> u a -> u a
forall a b. (a -> b) -> a -> b
$ SymBool -> u a -> u a -> u a
forall a. SymBool -> u a -> u a -> u a
forall (u :: * -> *) a. UnionLike u => SymBool -> u a -> u a -> u a
unionIf SymBool
cond u a
l u a
r
  {-# INLINE mrgIfWithStrategy #-}

  -- | Wrap a single value in the union and capture the 'Mergeable' knowledge.
  --
  -- >>> mrgSingleWithStrategy rootStrategy "a" :: UnionM SymInteger
  -- {a}
  --
  -- __Note:__ Be careful to call this directly in your code.
  -- The supplied merge strategy should be consistent with the type's root merge strategy,
  -- or some internal invariants would be broken and the program can crash.
  --
  -- This function is to be called when the 'Mergeable' constraint can not be resolved,
  -- e.g., the merge strategy for the contained type is given with 'Mergeable1'.
  -- In other cases, 'mrgSingle' is usually a better alternative.
  mrgSingleWithStrategy :: MergingStrategy a -> a -> u a
  mrgSingleWithStrategy MergingStrategy a
s = MergingStrategy a -> u a -> u a
forall a. MergingStrategy a -> u a -> u a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> u a -> u a
mergeWithStrategy MergingStrategy a
s (u a -> u a) -> (a -> u a) -> a -> u a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> u a
forall a. a -> u a
forall (u :: * -> *) a. UnionLike u => a -> u a
single
  {-# INLINE mrgSingleWithStrategy #-}

-- | Symbolic @if@ control flow with the result merged with the type's root merge strategy.
--
-- Equivalent to @'mrgIfWithStrategy' 'rootStrategy'@.
--
-- >>> mrgIf "a" (single "b") (single "c") :: UnionM SymInteger
-- {(ite a b c)}
mrgIf :: (UnionLike u, Mergeable a) => SymBool -> u a -> u a -> u a
mrgIf :: forall (u :: * -> *) a.
(UnionLike u, Mergeable a) =>
SymBool -> u a -> u a -> u a
mrgIf = MergingStrategy a -> SymBool -> u a -> u a -> u a
forall a. MergingStrategy a -> SymBool -> u a -> u a -> u a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy MergingStrategy a
forall a. Mergeable a => MergingStrategy a
rootStrategy
{-# INLINE mrgIf #-}

-- | Merge the contents with the type's root merge strategy.
--
-- Equivalent to @'mergeWithStrategy' 'rootStrategy'@.
--
-- >>> merge $ unionIf "a" (single "b") (single "c") :: UnionM SymInteger
-- {(ite a b c)}
merge :: (UnionLike u, Mergeable a) => u a -> u a
merge :: forall (u :: * -> *) a. (UnionLike u, Mergeable a) => u a -> u a
merge = MergingStrategy a -> u a -> u a
forall a. MergingStrategy a -> u a -> u a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> u a -> u a
mergeWithStrategy MergingStrategy a
forall a. Mergeable a => MergingStrategy a
rootStrategy
{-# INLINE merge #-}

-- | Wrap a single value in the type and propagate the type's root merge strategy.
--
-- Equivalent to @'mrgSingleWithStrategy' 'rootStrategy'@.
--
-- >>> mrgSingle "a" :: UnionM SymInteger
-- {a}
mrgSingle :: (UnionLike u, Mergeable a) => a -> u a
mrgSingle :: forall (u :: * -> *) a. (UnionLike u, Mergeable a) => a -> u a
mrgSingle = MergingStrategy a -> a -> u a
forall a. MergingStrategy a -> a -> u a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> a -> u a
mrgSingleWithStrategy MergingStrategy a
forall a. Mergeable a => MergingStrategy a
rootStrategy
{-# INLINE mrgSingle #-}

instance SimpleMergeable () where
  mrgIte :: SymBool -> () -> () -> ()
mrgIte SymBool
_ ()
t ()
_ = ()
t
  {-# INLINE mrgIte #-}

instance (SimpleMergeable a, SimpleMergeable b) => SimpleMergeable (a, b) where
  mrgIte :: SymBool -> (a, b) -> (a, b) -> (a, b)
mrgIte SymBool
cond (a
a1, b
b1) (a
a2, b
b2) = (SymBool -> a -> a -> a
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond a
a1 a
a2, SymBool -> b -> b -> b
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond b
b1 b
b2)
  {-# INLINE mrgIte #-}

instance (SimpleMergeable a) => SimpleMergeable1 ((,) a) where
  liftMrgIte :: forall a.
(SymBool -> a -> a -> a) -> SymBool -> (a, a) -> (a, a) -> (a, a)
liftMrgIte SymBool -> a -> a -> a
mb SymBool
cond (a
a1, a
b1) (a
a2, a
b2) = (SymBool -> a -> a -> a
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond a
a1 a
a2, SymBool -> a -> a -> a
mb SymBool
cond a
b1 a
b2)
  {-# INLINE liftMrgIte #-}

instance SimpleMergeable2 (,) where
  liftMrgIte2 :: forall a b.
(SymBool -> a -> a -> a)
-> (SymBool -> b -> b -> b)
-> SymBool
-> (a, b)
-> (a, b)
-> (a, b)
liftMrgIte2 SymBool -> a -> a -> a
ma SymBool -> b -> b -> b
mb SymBool
cond (a
a1, b
b1) (a
a2, b
b2) = (SymBool -> a -> a -> a
ma SymBool
cond a
a1 a
a2, SymBool -> b -> b -> b
mb SymBool
cond b
b1 b
b2)
  {-# INLINE liftMrgIte2 #-}

instance
  (SimpleMergeable a, SimpleMergeable b, SimpleMergeable c) =>
  SimpleMergeable (a, b, c)
  where
  mrgIte :: SymBool -> (a, b, c) -> (a, b, c) -> (a, b, c)
mrgIte SymBool
cond (a
a1, b
b1, c
c1) (a
a2, b
b2, c
c2) = (SymBool -> a -> a -> a
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond a
a1 a
a2, SymBool -> b -> b -> b
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond b
b1 b
b2, SymBool -> c -> c -> c
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond c
c1 c
c2)
  {-# INLINE mrgIte #-}

instance
  ( SimpleMergeable a,
    SimpleMergeable b,
    SimpleMergeable c,
    SimpleMergeable d
  ) =>
  SimpleMergeable (a, b, c, d)
  where
  mrgIte :: SymBool -> (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d)
mrgIte SymBool
cond (a
a1, b
b1, c
c1, d
d1) (a
a2, b
b2, c
c2, d
d2) =
    (SymBool -> a -> a -> a
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond a
a1 a
a2, SymBool -> b -> b -> b
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond b
b1 b
b2, SymBool -> c -> c -> c
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond c
c1 c
c2, SymBool -> d -> d -> d
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond d
d1 d
d2)
  {-# INLINE mrgIte #-}

instance
  ( SimpleMergeable a,
    SimpleMergeable b,
    SimpleMergeable c,
    SimpleMergeable d,
    SimpleMergeable e
  ) =>
  SimpleMergeable (a, b, c, d, e)
  where
  mrgIte :: SymBool -> (a, b, c, d, e) -> (a, b, c, d, e) -> (a, b, c, d, e)
mrgIte SymBool
cond (a
a1, b
b1, c
c1, d
d1, e
e1) (a
a2, b
b2, c
c2, d
d2, e
e2) =
    (SymBool -> a -> a -> a
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond a
a1 a
a2, SymBool -> b -> b -> b
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond b
b1 b
b2, SymBool -> c -> c -> c
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond c
c1 c
c2, SymBool -> d -> d -> d
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond d
d1 d
d2, SymBool -> e -> e -> e
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond e
e1 e
e2)
  {-# INLINE mrgIte #-}

instance
  ( SimpleMergeable a,
    SimpleMergeable b,
    SimpleMergeable c,
    SimpleMergeable d,
    SimpleMergeable e,
    SimpleMergeable f
  ) =>
  SimpleMergeable (a, b, c, d, e, f)
  where
  mrgIte :: SymBool
-> (a, b, c, d, e, f) -> (a, b, c, d, e, f) -> (a, b, c, d, e, f)
mrgIte SymBool
cond (a
a1, b
b1, c
c1, d
d1, e
e1, f
f1) (a
a2, b
b2, c
c2, d
d2, e
e2, f
f2) =
    (SymBool -> a -> a -> a
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond a
a1 a
a2, SymBool -> b -> b -> b
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond b
b1 b
b2, SymBool -> c -> c -> c
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond c
c1 c
c2, SymBool -> d -> d -> d
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond d
d1 d
d2, SymBool -> e -> e -> e
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond e
e1 e
e2, SymBool -> f -> f -> f
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond f
f1 f
f2)
  {-# INLINE mrgIte #-}

instance
  ( SimpleMergeable a,
    SimpleMergeable b,
    SimpleMergeable c,
    SimpleMergeable d,
    SimpleMergeable e,
    SimpleMergeable f,
    SimpleMergeable g
  ) =>
  SimpleMergeable (a, b, c, d, e, f, g)
  where
  mrgIte :: SymBool
-> (a, b, c, d, e, f, g)
-> (a, b, c, d, e, f, g)
-> (a, b, c, d, e, f, g)
mrgIte SymBool
cond (a
a1, b
b1, c
c1, d
d1, e
e1, f
f1, g
g1) (a
a2, b
b2, c
c2, d
d2, e
e2, f
f2, g
g2) =
    ( SymBool -> a -> a -> a
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond a
a1 a
a2,
      SymBool -> b -> b -> b
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond b
b1 b
b2,
      SymBool -> c -> c -> c
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond c
c1 c
c2,
      SymBool -> d -> d -> d
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond d
d1 d
d2,
      SymBool -> e -> e -> e
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond e
e1 e
e2,
      SymBool -> f -> f -> f
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond f
f1 f
f2,
      SymBool -> g -> g -> g
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond g
g1 g
g2
    )
  {-# INLINE mrgIte #-}

instance
  ( SimpleMergeable a,
    SimpleMergeable b,
    SimpleMergeable c,
    SimpleMergeable d,
    SimpleMergeable e,
    SimpleMergeable f,
    SimpleMergeable g,
    SimpleMergeable h
  ) =>
  SimpleMergeable (a, b, c, d, e, f, g, h)
  where
  mrgIte :: SymBool
-> (a, b, c, d, e, f, g, h)
-> (a, b, c, d, e, f, g, h)
-> (a, b, c, d, e, f, g, h)
mrgIte SymBool
cond (a
a1, b
b1, c
c1, d
d1, e
e1, f
f1, g
g1, h
h1) (a
a2, b
b2, c
c2, d
d2, e
e2, f
f2, g
g2, h
h2) =
    ( SymBool -> a -> a -> a
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond a
a1 a
a2,
      SymBool -> b -> b -> b
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond b
b1 b
b2,
      SymBool -> c -> c -> c
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond c
c1 c
c2,
      SymBool -> d -> d -> d
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond d
d1 d
d2,
      SymBool -> e -> e -> e
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond e
e1 e
e2,
      SymBool -> f -> f -> f
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond f
f1 f
f2,
      SymBool -> g -> g -> g
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond g
g1 g
g2,
      SymBool -> h -> h -> h
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond h
h1 h
h2
    )
  {-# INLINE mrgIte #-}

instance (SimpleMergeable b) => SimpleMergeable (a -> b) where
  mrgIte :: SymBool -> (a -> b) -> (a -> b) -> a -> b
mrgIte = SymBool -> (a -> b) -> (a -> b) -> a -> b
forall (u :: * -> *) a.
(SimpleMergeable1 u, SimpleMergeable a) =>
SymBool -> u a -> u a -> u a
mrgIte1
  {-# INLINE mrgIte #-}

instance SimpleMergeable1 ((->) a) where
  liftMrgIte :: forall a.
(SymBool -> a -> a -> a)
-> SymBool -> (a -> a) -> (a -> a) -> a -> a
liftMrgIte SymBool -> a -> a -> a
ms SymBool
cond a -> a
t a -> a
f a
v = SymBool -> a -> a -> a
ms SymBool
cond (a -> a
t a
v) (a -> a
f a
v)
  {-# INLINE liftMrgIte #-}

instance (UnionLike m, Mergeable a) => SimpleMergeable (MaybeT m a) where
  mrgIte :: SymBool -> MaybeT m a -> MaybeT m a -> MaybeT m a
mrgIte = SymBool -> MaybeT m a -> MaybeT m a -> MaybeT m a
forall (u :: * -> *) a.
(UnionLike u, Mergeable a) =>
SymBool -> u a -> u a -> u a
mrgIf
  {-# INLINE mrgIte #-}

instance (UnionLike m) => SimpleMergeable1 (MaybeT m) where
  liftMrgIte :: forall a.
(SymBool -> a -> a -> a)
-> SymBool -> MaybeT m a -> MaybeT m a -> MaybeT m a
liftMrgIte SymBool -> a -> a -> a
m = MergingStrategy a
-> SymBool -> MaybeT m a -> MaybeT m a -> MaybeT m a
forall a.
MergingStrategy a
-> SymBool -> MaybeT m a -> MaybeT m a -> MaybeT m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy ((SymBool -> a -> a -> a) -> MergingStrategy a
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy SymBool -> a -> a -> a
m)
  {-# INLINE liftMrgIte #-}

instance (UnionLike m) => UnionLike (MaybeT m) where
  mergeWithStrategy :: forall a. MergingStrategy a -> MaybeT m a -> MaybeT m a
mergeWithStrategy MergingStrategy a
s (MaybeT m (Maybe a)
v) = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> MaybeT m a) -> m (Maybe a) -> MaybeT m a
forall a b. (a -> b) -> a -> b
$ MergingStrategy (Maybe a) -> m (Maybe a) -> m (Maybe a)
forall a. MergingStrategy a -> m a -> m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> u a -> u a
mergeWithStrategy (MergingStrategy a -> MergingStrategy (Maybe a)
forall a. MergingStrategy a -> MergingStrategy (Maybe a)
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy a
s) m (Maybe a)
v
  {-# INLINE mergeWithStrategy #-}
  mrgIfWithStrategy :: forall a.
MergingStrategy a
-> SymBool -> MaybeT m a -> MaybeT m a -> MaybeT m a
mrgIfWithStrategy MergingStrategy a
s SymBool
cond (MaybeT m (Maybe a)
t) (MaybeT m (Maybe a)
f) = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> MaybeT m a) -> m (Maybe a) -> MaybeT m a
forall a b. (a -> b) -> a -> b
$ MergingStrategy (Maybe a)
-> SymBool -> m (Maybe a) -> m (Maybe a) -> m (Maybe a)
forall a. MergingStrategy a -> SymBool -> m a -> m a -> m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy (MergingStrategy a -> MergingStrategy (Maybe a)
forall a. MergingStrategy a -> MergingStrategy (Maybe a)
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy a
s) SymBool
cond m (Maybe a)
t m (Maybe a)
f
  {-# INLINE mrgIfWithStrategy #-}
  single :: forall a. a -> MaybeT m a
single = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> MaybeT m a)
-> (a -> m (Maybe a)) -> a -> MaybeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> m (Maybe a)
forall a. a -> m a
forall (u :: * -> *) a. UnionLike u => a -> u a
single (Maybe a -> m (Maybe a)) -> (a -> Maybe a) -> a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return
  {-# INLINE single #-}
  unionIf :: forall a. SymBool -> MaybeT m a -> MaybeT m a -> MaybeT m a
unionIf SymBool
cond (MaybeT m (Maybe a)
l) (MaybeT m (Maybe a)
r) = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> MaybeT m a) -> m (Maybe a) -> MaybeT m a
forall a b. (a -> b) -> a -> b
$ SymBool -> m (Maybe a) -> m (Maybe a) -> m (Maybe a)
forall a. SymBool -> m a -> m a -> m a
forall (u :: * -> *) a. UnionLike u => SymBool -> u a -> u a -> u a
unionIf SymBool
cond m (Maybe a)
l m (Maybe a)
r
  {-# INLINE unionIf #-}

instance
  (UnionLike m, Mergeable e, Mergeable a) =>
  SimpleMergeable (ExceptT e m a)
  where
  mrgIte :: SymBool -> ExceptT e m a -> ExceptT e m a -> ExceptT e m a
mrgIte = SymBool -> ExceptT e m a -> ExceptT e m a -> ExceptT e m a
forall (u :: * -> *) a.
(UnionLike u, Mergeable a) =>
SymBool -> u a -> u a -> u a
mrgIf
  {-# INLINE mrgIte #-}

instance
  (UnionLike m, Mergeable e) =>
  SimpleMergeable1 (ExceptT e m)
  where
  liftMrgIte :: forall a.
(SymBool -> a -> a -> a)
-> SymBool -> ExceptT e m a -> ExceptT e m a -> ExceptT e m a
liftMrgIte SymBool -> a -> a -> a
m = MergingStrategy a
-> SymBool -> ExceptT e m a -> ExceptT e m a -> ExceptT e m a
forall a.
MergingStrategy a
-> SymBool -> ExceptT e m a -> ExceptT e m a -> ExceptT e m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy ((SymBool -> a -> a -> a) -> MergingStrategy a
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy SymBool -> a -> a -> a
m)
  {-# INLINE liftMrgIte #-}

instance
  (UnionLike m, Mergeable e) =>
  UnionLike (ExceptT e m)
  where
  mergeWithStrategy :: forall a. MergingStrategy a -> ExceptT e m a -> ExceptT e m a
mergeWithStrategy MergingStrategy a
s (ExceptT m (Either e a)
v) = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> ExceptT e m a)
-> m (Either e a) -> ExceptT e m a
forall a b. (a -> b) -> a -> b
$ MergingStrategy (Either e a) -> m (Either e a) -> m (Either e a)
forall a. MergingStrategy a -> m a -> m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> u a -> u a
mergeWithStrategy (MergingStrategy a -> MergingStrategy (Either e a)
forall a. MergingStrategy a -> MergingStrategy (Either e a)
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy a
s) m (Either e a)
v
  {-# INLINE mergeWithStrategy #-}
  mrgIfWithStrategy :: forall a.
MergingStrategy a
-> SymBool -> ExceptT e m a -> ExceptT e m a -> ExceptT e m a
mrgIfWithStrategy MergingStrategy a
s SymBool
cond (ExceptT m (Either e a)
t) (ExceptT m (Either e a)
f) = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> ExceptT e m a)
-> m (Either e a) -> ExceptT e m a
forall a b. (a -> b) -> a -> b
$ MergingStrategy (Either e a)
-> SymBool -> m (Either e a) -> m (Either e a) -> m (Either e a)
forall a. MergingStrategy a -> SymBool -> m a -> m a -> m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy (MergingStrategy a -> MergingStrategy (Either e a)
forall a. MergingStrategy a -> MergingStrategy (Either e a)
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy a
s) SymBool
cond m (Either e a)
t m (Either e a)
f
  {-# INLINE mrgIfWithStrategy #-}
  single :: forall a. a -> ExceptT e m a
single = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> ExceptT e m a)
-> (a -> m (Either e a)) -> a -> ExceptT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either e a -> m (Either e a)
forall a. a -> m a
forall (u :: * -> *) a. UnionLike u => a -> u a
single (Either e a -> m (Either e a))
-> (a -> Either e a) -> a -> m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either e a
forall a. a -> Either e a
forall (m :: * -> *) a. Monad m => a -> m a
return
  {-# INLINE single #-}
  unionIf :: forall a.
SymBool -> ExceptT e m a -> ExceptT e m a -> ExceptT e m a
unionIf SymBool
cond (ExceptT m (Either e a)
l) (ExceptT m (Either e a)
r) = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> ExceptT e m a)
-> m (Either e a) -> ExceptT e m a
forall a b. (a -> b) -> a -> b
$ SymBool -> m (Either e a) -> m (Either e a) -> m (Either e a)
forall a. SymBool -> m a -> m a -> m a
forall (u :: * -> *) a. UnionLike u => SymBool -> u a -> u a -> u a
unionIf SymBool
cond m (Either e a)
l m (Either e a)
r
  {-# INLINE unionIf #-}

instance
  (Mergeable s, Mergeable a, UnionLike m) =>
  SimpleMergeable (StateLazy.StateT s m a)
  where
  mrgIte :: SymBool -> StateT s m a -> StateT s m a -> StateT s m a
mrgIte = SymBool -> StateT s m a -> StateT s m a -> StateT s m a
forall (u :: * -> *) a.
(UnionLike u, Mergeable a) =>
SymBool -> u a -> u a -> u a
mrgIf
  {-# INLINE mrgIte #-}

instance
  (Mergeable s, UnionLike m) =>
  SimpleMergeable1 (StateLazy.StateT s m)
  where
  liftMrgIte :: forall a.
(SymBool -> a -> a -> a)
-> SymBool -> StateT s m a -> StateT s m a -> StateT s m a
liftMrgIte SymBool -> a -> a -> a
m = MergingStrategy a
-> SymBool -> StateT s m a -> StateT s m a -> StateT s m a
forall a.
MergingStrategy a
-> SymBool -> StateT s m a -> StateT s m a -> StateT s m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy ((SymBool -> a -> a -> a) -> MergingStrategy a
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy SymBool -> a -> a -> a
m)
  {-# INLINE liftMrgIte #-}

instance
  (Mergeable s, UnionLike m) =>
  UnionLike (StateLazy.StateT s m)
  where
  mergeWithStrategy :: forall a. MergingStrategy a -> StateT s m a -> StateT s m a
mergeWithStrategy MergingStrategy a
ms (StateLazy.StateT s -> m (a, s)
f) =
    (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateLazy.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s
v -> MergingStrategy (a, s) -> m (a, s) -> m (a, s)
forall a. MergingStrategy a -> m a -> m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> u a -> u a
mergeWithStrategy (MergingStrategy a -> MergingStrategy s -> MergingStrategy (a, s)
forall a b.
MergingStrategy a -> MergingStrategy b -> MergingStrategy (a, b)
forall (u :: * -> * -> *) a b.
Mergeable2 u =>
MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)
liftRootStrategy2 MergingStrategy a
ms MergingStrategy s
forall a. Mergeable a => MergingStrategy a
rootStrategy) (m (a, s) -> m (a, s)) -> m (a, s) -> m (a, s)
forall a b. (a -> b) -> a -> b
$ s -> m (a, s)
f s
v
  {-# INLINE mergeWithStrategy #-}
  mrgIfWithStrategy :: forall a.
MergingStrategy a
-> SymBool -> StateT s m a -> StateT s m a -> StateT s m a
mrgIfWithStrategy MergingStrategy a
s SymBool
cond (StateLazy.StateT s -> m (a, s)
t) (StateLazy.StateT s -> m (a, s)
f) =
    (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateLazy.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s
v -> MergingStrategy (a, s)
-> SymBool -> m (a, s) -> m (a, s) -> m (a, s)
forall a. MergingStrategy a -> SymBool -> m a -> m a -> m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy (MergingStrategy a -> MergingStrategy s -> MergingStrategy (a, s)
forall a b.
MergingStrategy a -> MergingStrategy b -> MergingStrategy (a, b)
forall (u :: * -> * -> *) a b.
Mergeable2 u =>
MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)
liftRootStrategy2 MergingStrategy a
s MergingStrategy s
forall a. Mergeable a => MergingStrategy a
rootStrategy) SymBool
cond (s -> m (a, s)
t s
v) (s -> m (a, s)
f s
v)
  {-# INLINE mrgIfWithStrategy #-}
  single :: forall a. a -> StateT s m a
single a
x = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateLazy.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s
s -> (a, s) -> m (a, s)
forall a. a -> m a
forall (u :: * -> *) a. UnionLike u => a -> u a
single (a
x, s
s)
  {-# INLINE single #-}
  unionIf :: forall a. SymBool -> StateT s m a -> StateT s m a -> StateT s m a
unionIf SymBool
cond (StateLazy.StateT s -> m (a, s)
l) (StateLazy.StateT s -> m (a, s)
r) =
    (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateLazy.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s
s -> SymBool -> m (a, s) -> m (a, s) -> m (a, s)
forall a. SymBool -> m a -> m a -> m a
forall (u :: * -> *) a. UnionLike u => SymBool -> u a -> u a -> u a
unionIf SymBool
cond (s -> m (a, s)
l s
s) (s -> m (a, s)
r s
s)
  {-# INLINE unionIf #-}

instance
  (Mergeable s, Mergeable a, UnionLike m) =>
  SimpleMergeable (StateStrict.StateT s m a)
  where
  mrgIte :: SymBool -> StateT s m a -> StateT s m a -> StateT s m a
mrgIte = SymBool -> StateT s m a -> StateT s m a -> StateT s m a
forall (u :: * -> *) a.
(UnionLike u, Mergeable a) =>
SymBool -> u a -> u a -> u a
mrgIf
  {-# INLINE mrgIte #-}

instance
  (Mergeable s, UnionLike m) =>
  SimpleMergeable1 (StateStrict.StateT s m)
  where
  liftMrgIte :: forall a.
(SymBool -> a -> a -> a)
-> SymBool -> StateT s m a -> StateT s m a -> StateT s m a
liftMrgIte SymBool -> a -> a -> a
m = MergingStrategy a
-> SymBool -> StateT s m a -> StateT s m a -> StateT s m a
forall a.
MergingStrategy a
-> SymBool -> StateT s m a -> StateT s m a -> StateT s m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy ((SymBool -> a -> a -> a) -> MergingStrategy a
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy SymBool -> a -> a -> a
m)
  {-# INLINE liftMrgIte #-}

instance
  (Mergeable s, UnionLike m) =>
  UnionLike (StateStrict.StateT s m)
  where
  mergeWithStrategy :: forall a. MergingStrategy a -> StateT s m a -> StateT s m a
mergeWithStrategy MergingStrategy a
ms (StateStrict.StateT s -> m (a, s)
f) =
    (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateStrict.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s
v -> MergingStrategy (a, s) -> m (a, s) -> m (a, s)
forall a. MergingStrategy a -> m a -> m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> u a -> u a
mergeWithStrategy (MergingStrategy a -> MergingStrategy s -> MergingStrategy (a, s)
forall a b.
MergingStrategy a -> MergingStrategy b -> MergingStrategy (a, b)
forall (u :: * -> * -> *) a b.
Mergeable2 u =>
MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)
liftRootStrategy2 MergingStrategy a
ms MergingStrategy s
forall a. Mergeable a => MergingStrategy a
rootStrategy) (m (a, s) -> m (a, s)) -> m (a, s) -> m (a, s)
forall a b. (a -> b) -> a -> b
$ s -> m (a, s)
f s
v
  {-# INLINE mergeWithStrategy #-}
  mrgIfWithStrategy :: forall a.
MergingStrategy a
-> SymBool -> StateT s m a -> StateT s m a -> StateT s m a
mrgIfWithStrategy MergingStrategy a
s SymBool
cond (StateStrict.StateT s -> m (a, s)
t) (StateStrict.StateT s -> m (a, s)
f) =
    (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateStrict.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s
v -> MergingStrategy (a, s)
-> SymBool -> m (a, s) -> m (a, s) -> m (a, s)
forall a. MergingStrategy a -> SymBool -> m a -> m a -> m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy (MergingStrategy a -> MergingStrategy s -> MergingStrategy (a, s)
forall a b.
MergingStrategy a -> MergingStrategy b -> MergingStrategy (a, b)
forall (u :: * -> * -> *) a b.
Mergeable2 u =>
MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)
liftRootStrategy2 MergingStrategy a
s MergingStrategy s
forall a. Mergeable a => MergingStrategy a
rootStrategy) SymBool
cond (s -> m (a, s)
t s
v) (s -> m (a, s)
f s
v)
  {-# INLINE mrgIfWithStrategy #-}
  single :: forall a. a -> StateT s m a
single a
x = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateStrict.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s
s -> (a, s) -> m (a, s)
forall a. a -> m a
forall (u :: * -> *) a. UnionLike u => a -> u a
single (a
x, s
s)
  {-# INLINE single #-}
  unionIf :: forall a. SymBool -> StateT s m a -> StateT s m a -> StateT s m a
unionIf SymBool
cond (StateStrict.StateT s -> m (a, s)
l) (StateStrict.StateT s -> m (a, s)
r) =
    (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateStrict.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s
s -> SymBool -> m (a, s) -> m (a, s) -> m (a, s)
forall a. SymBool -> m a -> m a -> m a
forall (u :: * -> *) a. UnionLike u => SymBool -> u a -> u a -> u a
unionIf SymBool
cond (s -> m (a, s)
l s
s) (s -> m (a, s)
r s
s)
  {-# INLINE unionIf #-}

instance
  (Mergeable s, Mergeable a, UnionLike m, Monoid s) =>
  SimpleMergeable (WriterLazy.WriterT s m a)
  where
  mrgIte :: SymBool -> WriterT s m a -> WriterT s m a -> WriterT s m a
mrgIte = SymBool -> WriterT s m a -> WriterT s m a -> WriterT s m a
forall (u :: * -> *) a.
(UnionLike u, Mergeable a) =>
SymBool -> u a -> u a -> u a
mrgIf
  {-# INLINE mrgIte #-}

instance
  (Mergeable s, UnionLike m, Monoid s) =>
  SimpleMergeable1 (WriterLazy.WriterT s m)
  where
  liftMrgIte :: forall a.
(SymBool -> a -> a -> a)
-> SymBool -> WriterT s m a -> WriterT s m a -> WriterT s m a
liftMrgIte SymBool -> a -> a -> a
m = MergingStrategy a
-> SymBool -> WriterT s m a -> WriterT s m a -> WriterT s m a
forall a.
MergingStrategy a
-> SymBool -> WriterT s m a -> WriterT s m a -> WriterT s m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy ((SymBool -> a -> a -> a) -> MergingStrategy a
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy SymBool -> a -> a -> a
m)
  {-# INLINE liftMrgIte #-}

instance
  (Mergeable s, UnionLike m, Monoid s) =>
  UnionLike (WriterLazy.WriterT s m)
  where
  mergeWithStrategy :: forall a. MergingStrategy a -> WriterT s m a -> WriterT s m a
mergeWithStrategy MergingStrategy a
ms (WriterLazy.WriterT m (a, s)
f) = m (a, s) -> WriterT s m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterLazy.WriterT (m (a, s) -> WriterT s m a) -> m (a, s) -> WriterT s m a
forall a b. (a -> b) -> a -> b
$ MergingStrategy (a, s) -> m (a, s) -> m (a, s)
forall a. MergingStrategy a -> m a -> m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> u a -> u a
mergeWithStrategy (MergingStrategy a -> MergingStrategy s -> MergingStrategy (a, s)
forall a b.
MergingStrategy a -> MergingStrategy b -> MergingStrategy (a, b)
forall (u :: * -> * -> *) a b.
Mergeable2 u =>
MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)
liftRootStrategy2 MergingStrategy a
ms MergingStrategy s
forall a. Mergeable a => MergingStrategy a
rootStrategy) m (a, s)
f
  {-# INLINE mergeWithStrategy #-}
  mrgIfWithStrategy :: forall a.
MergingStrategy a
-> SymBool -> WriterT s m a -> WriterT s m a -> WriterT s m a
mrgIfWithStrategy MergingStrategy a
s SymBool
cond (WriterLazy.WriterT m (a, s)
t) (WriterLazy.WriterT m (a, s)
f) =
    m (a, s) -> WriterT s m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterLazy.WriterT (m (a, s) -> WriterT s m a) -> m (a, s) -> WriterT s m a
forall a b. (a -> b) -> a -> b
$ MergingStrategy (a, s)
-> SymBool -> m (a, s) -> m (a, s) -> m (a, s)
forall a. MergingStrategy a -> SymBool -> m a -> m a -> m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy (MergingStrategy a -> MergingStrategy s -> MergingStrategy (a, s)
forall a b.
MergingStrategy a -> MergingStrategy b -> MergingStrategy (a, b)
forall (u :: * -> * -> *) a b.
Mergeable2 u =>
MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)
liftRootStrategy2 MergingStrategy a
s MergingStrategy s
forall a. Mergeable a => MergingStrategy a
rootStrategy) SymBool
cond m (a, s)
t m (a, s)
f
  {-# INLINE mrgIfWithStrategy #-}
  single :: forall a. a -> WriterT s m a
single a
x = m (a, s) -> WriterT s m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterLazy.WriterT (m (a, s) -> WriterT s m a) -> m (a, s) -> WriterT s m a
forall a b. (a -> b) -> a -> b
$ (a, s) -> m (a, s)
forall a. a -> m a
forall (u :: * -> *) a. UnionLike u => a -> u a
single (a
x, s
forall a. Monoid a => a
mempty)
  {-# INLINE single #-}
  unionIf :: forall a.
SymBool -> WriterT s m a -> WriterT s m a -> WriterT s m a
unionIf SymBool
cond (WriterLazy.WriterT m (a, s)
l) (WriterLazy.WriterT m (a, s)
r) =
    m (a, s) -> WriterT s m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterLazy.WriterT (m (a, s) -> WriterT s m a) -> m (a, s) -> WriterT s m a
forall a b. (a -> b) -> a -> b
$ SymBool -> m (a, s) -> m (a, s) -> m (a, s)
forall a. SymBool -> m a -> m a -> m a
forall (u :: * -> *) a. UnionLike u => SymBool -> u a -> u a -> u a
unionIf SymBool
cond m (a, s)
l m (a, s)
r
  {-# INLINE unionIf #-}

instance
  (Mergeable s, Mergeable a, UnionLike m, Monoid s) =>
  SimpleMergeable (WriterStrict.WriterT s m a)
  where
  mrgIte :: SymBool -> WriterT s m a -> WriterT s m a -> WriterT s m a
mrgIte = SymBool -> WriterT s m a -> WriterT s m a -> WriterT s m a
forall (u :: * -> *) a.
(UnionLike u, Mergeable a) =>
SymBool -> u a -> u a -> u a
mrgIf
  {-# INLINE mrgIte #-}

instance
  (Mergeable s, UnionLike m, Monoid s) =>
  SimpleMergeable1 (WriterStrict.WriterT s m)
  where
  liftMrgIte :: forall a.
(SymBool -> a -> a -> a)
-> SymBool -> WriterT s m a -> WriterT s m a -> WriterT s m a
liftMrgIte SymBool -> a -> a -> a
m = MergingStrategy a
-> SymBool -> WriterT s m a -> WriterT s m a -> WriterT s m a
forall a.
MergingStrategy a
-> SymBool -> WriterT s m a -> WriterT s m a -> WriterT s m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy ((SymBool -> a -> a -> a) -> MergingStrategy a
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy SymBool -> a -> a -> a
m)
  {-# INLINE liftMrgIte #-}

instance
  (Mergeable s, UnionLike m, Monoid s) =>
  UnionLike (WriterStrict.WriterT s m)
  where
  mergeWithStrategy :: forall a. MergingStrategy a -> WriterT s m a -> WriterT s m a
mergeWithStrategy MergingStrategy a
ms (WriterStrict.WriterT m (a, s)
f) = m (a, s) -> WriterT s m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterStrict.WriterT (m (a, s) -> WriterT s m a) -> m (a, s) -> WriterT s m a
forall a b. (a -> b) -> a -> b
$ MergingStrategy (a, s) -> m (a, s) -> m (a, s)
forall a. MergingStrategy a -> m a -> m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> u a -> u a
mergeWithStrategy (MergingStrategy a -> MergingStrategy s -> MergingStrategy (a, s)
forall a b.
MergingStrategy a -> MergingStrategy b -> MergingStrategy (a, b)
forall (u :: * -> * -> *) a b.
Mergeable2 u =>
MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)
liftRootStrategy2 MergingStrategy a
ms MergingStrategy s
forall a. Mergeable a => MergingStrategy a
rootStrategy) m (a, s)
f
  {-# INLINE mergeWithStrategy #-}
  mrgIfWithStrategy :: forall a.
MergingStrategy a
-> SymBool -> WriterT s m a -> WriterT s m a -> WriterT s m a
mrgIfWithStrategy MergingStrategy a
s SymBool
cond (WriterStrict.WriterT m (a, s)
t) (WriterStrict.WriterT m (a, s)
f) =
    m (a, s) -> WriterT s m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterStrict.WriterT (m (a, s) -> WriterT s m a) -> m (a, s) -> WriterT s m a
forall a b. (a -> b) -> a -> b
$ MergingStrategy (a, s)
-> SymBool -> m (a, s) -> m (a, s) -> m (a, s)
forall a. MergingStrategy a -> SymBool -> m a -> m a -> m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy (MergingStrategy a -> MergingStrategy s -> MergingStrategy (a, s)
forall a b.
MergingStrategy a -> MergingStrategy b -> MergingStrategy (a, b)
forall (u :: * -> * -> *) a b.
Mergeable2 u =>
MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)
liftRootStrategy2 MergingStrategy a
s MergingStrategy s
forall a. Mergeable a => MergingStrategy a
rootStrategy) SymBool
cond m (a, s)
t m (a, s)
f
  {-# INLINE mrgIfWithStrategy #-}
  single :: forall a. a -> WriterT s m a
single a
x = m (a, s) -> WriterT s m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterStrict.WriterT (m (a, s) -> WriterT s m a) -> m (a, s) -> WriterT s m a
forall a b. (a -> b) -> a -> b
$ (a, s) -> m (a, s)
forall a. a -> m a
forall (u :: * -> *) a. UnionLike u => a -> u a
single (a
x, s
forall a. Monoid a => a
mempty)
  {-# INLINE single #-}
  unionIf :: forall a.
SymBool -> WriterT s m a -> WriterT s m a -> WriterT s m a
unionIf SymBool
cond (WriterStrict.WriterT m (a, s)
l) (WriterStrict.WriterT m (a, s)
r) =
    m (a, s) -> WriterT s m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterStrict.WriterT (m (a, s) -> WriterT s m a) -> m (a, s) -> WriterT s m a
forall a b. (a -> b) -> a -> b
$ SymBool -> m (a, s) -> m (a, s) -> m (a, s)
forall a. SymBool -> m a -> m a -> m a
forall (u :: * -> *) a. UnionLike u => SymBool -> u a -> u a -> u a
unionIf SymBool
cond m (a, s)
l m (a, s)
r
  {-# INLINE unionIf #-}

instance
  (Mergeable a, UnionLike m) =>
  SimpleMergeable (ReaderT s m a)
  where
  mrgIte :: SymBool -> ReaderT s m a -> ReaderT s m a -> ReaderT s m a
mrgIte = SymBool -> ReaderT s m a -> ReaderT s m a -> ReaderT s m a
forall (u :: * -> *) a.
(UnionLike u, Mergeable a) =>
SymBool -> u a -> u a -> u a
mrgIf
  {-# INLINE mrgIte #-}

instance
  (UnionLike m) =>
  SimpleMergeable1 (ReaderT s m)
  where
  liftMrgIte :: forall a.
(SymBool -> a -> a -> a)
-> SymBool -> ReaderT s m a -> ReaderT s m a -> ReaderT s m a
liftMrgIte SymBool -> a -> a -> a
m = MergingStrategy a
-> SymBool -> ReaderT s m a -> ReaderT s m a -> ReaderT s m a
forall a.
MergingStrategy a
-> SymBool -> ReaderT s m a -> ReaderT s m a -> ReaderT s m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy ((SymBool -> a -> a -> a) -> MergingStrategy a
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy SymBool -> a -> a -> a
m)
  {-# INLINE liftMrgIte #-}

instance
  (UnionLike m) =>
  UnionLike (ReaderT s m)
  where
  mergeWithStrategy :: forall a. MergingStrategy a -> ReaderT s m a -> ReaderT s m a
mergeWithStrategy MergingStrategy a
ms (ReaderT s -> m a
f) = (s -> m a) -> ReaderT s m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((s -> m a) -> ReaderT s m a) -> (s -> m a) -> ReaderT s m a
forall a b. (a -> b) -> a -> b
$ \s
v -> MergingStrategy a -> m a -> m a
forall a. MergingStrategy a -> m a -> m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> u a -> u a
mergeWithStrategy MergingStrategy a
ms (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ s -> m a
f s
v
  {-# INLINE mergeWithStrategy #-}
  mrgIfWithStrategy :: forall a.
MergingStrategy a
-> SymBool -> ReaderT s m a -> ReaderT s m a -> ReaderT s m a
mrgIfWithStrategy MergingStrategy a
s SymBool
cond (ReaderT s -> m a
t) (ReaderT s -> m a
f) =
    (s -> m a) -> ReaderT s m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((s -> m a) -> ReaderT s m a) -> (s -> m a) -> ReaderT s m a
forall a b. (a -> b) -> a -> b
$ \s
v -> MergingStrategy a -> SymBool -> m a -> m a -> m a
forall a. MergingStrategy a -> SymBool -> m a -> m a -> m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy MergingStrategy a
s SymBool
cond (s -> m a
t s
v) (s -> m a
f s
v)
  {-# INLINE mrgIfWithStrategy #-}
  single :: forall a. a -> ReaderT s m a
single a
x = (s -> m a) -> ReaderT s m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((s -> m a) -> ReaderT s m a) -> (s -> m a) -> ReaderT s m a
forall a b. (a -> b) -> a -> b
$ \s
_ -> a -> m a
forall a. a -> m a
forall (u :: * -> *) a. UnionLike u => a -> u a
single a
x
  {-# INLINE single #-}
  unionIf :: forall a.
SymBool -> ReaderT s m a -> ReaderT s m a -> ReaderT s m a
unionIf SymBool
cond (ReaderT s -> m a
l) (ReaderT s -> m a
r) = (s -> m a) -> ReaderT s m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((s -> m a) -> ReaderT s m a) -> (s -> m a) -> ReaderT s m a
forall a b. (a -> b) -> a -> b
$ \s
s -> SymBool -> m a -> m a -> m a
forall a. SymBool -> m a -> m a -> m a
forall (u :: * -> *) a. UnionLike u => SymBool -> u a -> u a -> u a
unionIf SymBool
cond (s -> m a
l s
s) (s -> m a
r s
s)
  {-# INLINE unionIf #-}

instance (SimpleMergeable a) => SimpleMergeable (Identity a) where
  mrgIte :: SymBool -> Identity a -> Identity a -> Identity a
mrgIte SymBool
cond (Identity a
l) (Identity a
r) = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> a -> Identity a
forall a b. (a -> b) -> a -> b
$ SymBool -> a -> a -> a
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte SymBool
cond a
l a
r
  {-# INLINE mrgIte #-}

instance SimpleMergeable1 Identity where
  liftMrgIte :: forall a.
(SymBool -> a -> a -> a)
-> SymBool -> Identity a -> Identity a -> Identity a
liftMrgIte SymBool -> a -> a -> a
mite SymBool
cond (Identity a
l) (Identity a
r) = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> a -> Identity a
forall a b. (a -> b) -> a -> b
$ SymBool -> a -> a -> a
mite SymBool
cond a
l a
r
  {-# INLINE liftMrgIte #-}

instance (UnionLike m, Mergeable a) => SimpleMergeable (IdentityT m a) where
  mrgIte :: SymBool -> IdentityT m a -> IdentityT m a -> IdentityT m a
mrgIte = SymBool -> IdentityT m a -> IdentityT m a -> IdentityT m a
forall (u :: * -> *) a.
(UnionLike u, Mergeable a) =>
SymBool -> u a -> u a -> u a
mrgIf
  {-# INLINE mrgIte #-}

instance (UnionLike m) => SimpleMergeable1 (IdentityT m) where
  liftMrgIte :: forall a.
(SymBool -> a -> a -> a)
-> SymBool -> IdentityT m a -> IdentityT m a -> IdentityT m a
liftMrgIte SymBool -> a -> a -> a
m = MergingStrategy a
-> SymBool -> IdentityT m a -> IdentityT m a -> IdentityT m a
forall a.
MergingStrategy a
-> SymBool -> IdentityT m a -> IdentityT m a -> IdentityT m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy ((SymBool -> a -> a -> a) -> MergingStrategy a
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy SymBool -> a -> a -> a
m)
  {-# INLINE liftMrgIte #-}

instance (UnionLike m) => UnionLike (IdentityT m) where
  mergeWithStrategy :: forall a. MergingStrategy a -> IdentityT m a -> IdentityT m a
mergeWithStrategy MergingStrategy a
ms (IdentityT m a
f) =
    m a -> IdentityT m a
forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m a -> IdentityT m a) -> m a -> IdentityT m a
forall a b. (a -> b) -> a -> b
$ MergingStrategy a -> m a -> m a
forall a. MergingStrategy a -> m a -> m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> u a -> u a
mergeWithStrategy MergingStrategy a
ms m a
f
  {-# INLINE mergeWithStrategy #-}
  mrgIfWithStrategy :: forall a.
MergingStrategy a
-> SymBool -> IdentityT m a -> IdentityT m a -> IdentityT m a
mrgIfWithStrategy MergingStrategy a
s SymBool
cond (IdentityT m a
l) (IdentityT m a
r) = m a -> IdentityT m a
forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m a -> IdentityT m a) -> m a -> IdentityT m a
forall a b. (a -> b) -> a -> b
$ MergingStrategy a -> SymBool -> m a -> m a -> m a
forall a. MergingStrategy a -> SymBool -> m a -> m a -> m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy MergingStrategy a
s SymBool
cond m a
l m a
r
  {-# INLINE mrgIfWithStrategy #-}
  single :: forall a. a -> IdentityT m a
single a
x = m a -> IdentityT m a
forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m a -> IdentityT m a) -> m a -> IdentityT m a
forall a b. (a -> b) -> a -> b
$ a -> m a
forall a. a -> m a
forall (u :: * -> *) a. UnionLike u => a -> u a
single a
x
  {-# INLINE single #-}
  unionIf :: forall a.
SymBool -> IdentityT m a -> IdentityT m a -> IdentityT m a
unionIf SymBool
cond (IdentityT m a
l) (IdentityT m a
r) = m a -> IdentityT m a
forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m a -> IdentityT m a) -> m a -> IdentityT m a
forall a b. (a -> b) -> a -> b
$ SymBool -> m a -> m a -> m a
forall a. SymBool -> m a -> m a -> m a
forall (u :: * -> *) a. UnionLike u => SymBool -> u a -> u a -> u a
unionIf SymBool
cond m a
l m a
r
  {-# INLINE unionIf #-}

instance (UnionLike m, Mergeable r) => SimpleMergeable (ContT r m a) where
  mrgIte :: SymBool -> ContT r m a -> ContT r m a -> ContT r m a
mrgIte SymBool
cond (ContT (a -> m r) -> m r
l) (ContT (a -> m r) -> m r
r) = ((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 (((a -> m r) -> m r) -> ContT r m a)
-> ((a -> m r) -> m r) -> ContT r m a
forall a b. (a -> b) -> a -> b
$ \a -> m r
c -> SymBool -> m r -> m r -> m r
forall (u :: * -> *) a.
(UnionLike u, Mergeable a) =>
SymBool -> u a -> u a -> u a
mrgIf SymBool
cond ((a -> m r) -> m r
l a -> m r
c) ((a -> m r) -> m r
r a -> m r
c)
  {-# INLINE mrgIte #-}

instance (UnionLike m, Mergeable r) => SimpleMergeable1 (ContT r m) where
  liftMrgIte :: forall a.
(SymBool -> a -> a -> a)
-> SymBool -> ContT r m a -> ContT r m a -> ContT r m a
liftMrgIte SymBool -> a -> a -> a
m = MergingStrategy a
-> SymBool -> ContT r m a -> ContT r m a -> ContT r m a
forall a.
MergingStrategy a
-> SymBool -> ContT r m a -> ContT r m a -> ContT r m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy ((SymBool -> a -> a -> a) -> MergingStrategy a
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy SymBool -> a -> a -> a
m)
  {-# INLINE liftMrgIte #-}

instance (UnionLike m, Mergeable r) => UnionLike (ContT r m) where
  mergeWithStrategy :: forall a. MergingStrategy a -> ContT r m a -> ContT r m a
mergeWithStrategy MergingStrategy a
_ (ContT (a -> m r) -> m r
f) = ((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 (((a -> m r) -> m r) -> ContT r m a)
-> ((a -> m r) -> m r) -> ContT r m a
forall a b. (a -> b) -> a -> b
$ \a -> m r
c -> m r -> m r
forall (u :: * -> *) a. (UnionLike u, Mergeable a) => u a -> u a
merge ((a -> m r) -> m r
f a -> m r
c)
  {-# INLINE mergeWithStrategy #-}
  mrgIfWithStrategy :: forall a.
MergingStrategy a
-> SymBool -> ContT r m a -> ContT r m a -> ContT r m a
mrgIfWithStrategy MergingStrategy a
_ SymBool
cond (ContT (a -> m r) -> m r
l) (ContT (a -> m r) -> m r
r) = ((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 (((a -> m r) -> m r) -> ContT r m a)
-> ((a -> m r) -> m r) -> ContT r m a
forall a b. (a -> b) -> a -> b
$ \a -> m r
c -> SymBool -> m r -> m r -> m r
forall (u :: * -> *) a.
(UnionLike u, Mergeable a) =>
SymBool -> u a -> u a -> u a
mrgIf SymBool
cond ((a -> m r) -> m r
l a -> m r
c) ((a -> m r) -> m r
r a -> m r
c)
  {-# INLINE mrgIfWithStrategy #-}
  single :: forall a. a -> ContT r m a
single a
x = ((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 (((a -> m r) -> m r) -> ContT r m a)
-> ((a -> m r) -> m r) -> ContT r m a
forall a b. (a -> b) -> a -> b
$ \a -> m r
c -> a -> m r
c a
x
  {-# INLINE single #-}
  unionIf :: forall a. SymBool -> ContT r m a -> ContT r m a -> ContT r m a
unionIf SymBool
cond (ContT (a -> m r) -> m r
l) (ContT (a -> m r) -> m r
r) = ((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 (((a -> m r) -> m r) -> ContT r m a)
-> ((a -> m r) -> m r) -> ContT r m a
forall a b. (a -> b) -> a -> b
$ \a -> m r
c -> SymBool -> m r -> m r -> m r
forall a. SymBool -> m a -> m a -> m a
forall (u :: * -> *) a. UnionLike u => SymBool -> u a -> u a -> u a
unionIf SymBool
cond ((a -> m r) -> m r
l a -> m r
c) ((a -> m r) -> m r
r a -> m r
c)
  {-# INLINE unionIf #-}

instance
  (Mergeable s, Mergeable w, Monoid w, Mergeable a, UnionLike m) =>
  SimpleMergeable (RWSLazy.RWST r w s m a)
  where
  mrgIte :: SymBool -> RWST r w s m a -> RWST r w s m a -> RWST r w s m a
mrgIte = SymBool -> RWST r w s m a -> RWST r w s m a -> RWST r w s m a
forall (u :: * -> *) a.
(UnionLike u, Mergeable a) =>
SymBool -> u a -> u a -> u a
mrgIf
  {-# INLINE mrgIte #-}

instance
  (Mergeable s, Mergeable w, Monoid w, UnionLike m) =>
  SimpleMergeable1 (RWSLazy.RWST r w s m)
  where
  liftMrgIte :: forall a.
(SymBool -> a -> a -> a)
-> SymBool -> RWST r w s m a -> RWST r w s m a -> RWST r w s m a
liftMrgIte SymBool -> a -> a -> a
m = MergingStrategy a
-> SymBool -> RWST r w s m a -> RWST r w s m a -> RWST r w s m a
forall a.
MergingStrategy a
-> SymBool -> RWST r w s m a -> RWST r w s m a -> RWST r w s m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy ((SymBool -> a -> a -> a) -> MergingStrategy a
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy SymBool -> a -> a -> a
m)
  {-# INLINE liftMrgIte #-}

instance
  (Mergeable s, Mergeable w, Monoid w, UnionLike m) =>
  UnionLike (RWSLazy.RWST r w s m)
  where
  mergeWithStrategy :: forall a. MergingStrategy a -> RWST r w s m a -> RWST r w s m a
mergeWithStrategy MergingStrategy a
ms (RWSLazy.RWST r -> s -> m (a, s, w)
f) =
    (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 ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> MergingStrategy (a, s, w) -> m (a, s, w) -> m (a, s, w)
forall a. MergingStrategy a -> m a -> m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> u a -> u a
mergeWithStrategy (MergingStrategy a
-> MergingStrategy s
-> MergingStrategy w
-> MergingStrategy (a, s, w)
forall a b c.
MergingStrategy a
-> MergingStrategy b
-> MergingStrategy c
-> MergingStrategy (a, b, c)
forall (u :: * -> * -> * -> *) a b c.
Mergeable3 u =>
MergingStrategy a
-> MergingStrategy b
-> MergingStrategy c
-> MergingStrategy (u a b c)
liftRootStrategy3 MergingStrategy a
ms MergingStrategy s
forall a. Mergeable a => MergingStrategy a
rootStrategy MergingStrategy w
forall a. Mergeable a => MergingStrategy a
rootStrategy) (m (a, s, w) -> m (a, s, w)) -> m (a, s, w) -> m (a, s, w)
forall a b. (a -> b) -> a -> b
$ r -> s -> m (a, s, w)
f r
r s
s
  {-# INLINE mergeWithStrategy #-}
  mrgIfWithStrategy :: forall a.
MergingStrategy a
-> SymBool -> RWST r w s m a -> RWST r w s m a -> RWST r w s m a
mrgIfWithStrategy MergingStrategy a
ms SymBool
cond (RWSLazy.RWST r -> s -> m (a, s, w)
t) (RWSLazy.RWST r -> s -> m (a, s, w)
f) =
    (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 ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> MergingStrategy (a, s, w)
-> SymBool -> m (a, s, w) -> m (a, s, w) -> m (a, s, w)
forall a. MergingStrategy a -> SymBool -> m a -> m a -> m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy (MergingStrategy a
-> MergingStrategy s
-> MergingStrategy w
-> MergingStrategy (a, s, w)
forall a b c.
MergingStrategy a
-> MergingStrategy b
-> MergingStrategy c
-> MergingStrategy (a, b, c)
forall (u :: * -> * -> * -> *) a b c.
Mergeable3 u =>
MergingStrategy a
-> MergingStrategy b
-> MergingStrategy c
-> MergingStrategy (u a b c)
liftRootStrategy3 MergingStrategy a
ms MergingStrategy s
forall a. Mergeable a => MergingStrategy a
rootStrategy MergingStrategy w
forall a. Mergeable a => MergingStrategy a
rootStrategy) SymBool
cond (r -> s -> m (a, s, w)
t r
r s
s) (r -> s -> m (a, s, w)
f r
r s
s)
  {-# INLINE mrgIfWithStrategy #-}
  single :: forall a. a -> RWST r w s m a
single a
x = (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 ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
_ s
s -> (a, s, w) -> m (a, s, w)
forall a. a -> m a
forall (u :: * -> *) a. UnionLike u => a -> u a
single (a
x, s
s, w
forall a. Monoid a => a
mempty)
  {-# INLINE single #-}
  unionIf :: forall a.
SymBool -> RWST r w s m a -> RWST r w s m a -> RWST r w s m a
unionIf SymBool
cond (RWSLazy.RWST r -> s -> m (a, s, w)
t) (RWSLazy.RWST r -> s -> m (a, s, w)
f) =
    (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 ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> SymBool -> m (a, s, w) -> m (a, s, w) -> m (a, s, w)
forall a. SymBool -> m a -> m a -> m a
forall (u :: * -> *) a. UnionLike u => SymBool -> u a -> u a -> u a
unionIf SymBool
cond (r -> s -> m (a, s, w)
t r
r s
s) (r -> s -> m (a, s, w)
f r
r s
s)
  {-# INLINE unionIf #-}

instance
  (Mergeable s, Mergeable w, Monoid w, Mergeable a, UnionLike m) =>
  SimpleMergeable (RWSStrict.RWST r w s m a)
  where
  mrgIte :: SymBool -> RWST r w s m a -> RWST r w s m a -> RWST r w s m a
mrgIte = SymBool -> RWST r w s m a -> RWST r w s m a -> RWST r w s m a
forall (u :: * -> *) a.
(UnionLike u, Mergeable a) =>
SymBool -> u a -> u a -> u a
mrgIf
  {-# INLINE mrgIte #-}

instance
  (Mergeable s, Mergeable w, Monoid w, UnionLike m) =>
  SimpleMergeable1 (RWSStrict.RWST r w s m)
  where
  liftMrgIte :: forall a.
(SymBool -> a -> a -> a)
-> SymBool -> RWST r w s m a -> RWST r w s m a -> RWST r w s m a
liftMrgIte SymBool -> a -> a -> a
m = MergingStrategy a
-> SymBool -> RWST r w s m a -> RWST r w s m a -> RWST r w s m a
forall a.
MergingStrategy a
-> SymBool -> RWST r w s m a -> RWST r w s m a -> RWST r w s m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy ((SymBool -> a -> a -> a) -> MergingStrategy a
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy SymBool -> a -> a -> a
m)
  {-# INLINE liftMrgIte #-}

instance
  (Mergeable s, Mergeable w, Monoid w, UnionLike m) =>
  UnionLike (RWSStrict.RWST r w s m)
  where
  mergeWithStrategy :: forall a. MergingStrategy a -> RWST r w s m a -> RWST r w s m a
mergeWithStrategy MergingStrategy a
ms (RWSStrict.RWST r -> s -> m (a, s, w)
f) =
    (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 ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> MergingStrategy (a, s, w) -> m (a, s, w) -> m (a, s, w)
forall a. MergingStrategy a -> m a -> m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> u a -> u a
mergeWithStrategy (MergingStrategy a
-> MergingStrategy s
-> MergingStrategy w
-> MergingStrategy (a, s, w)
forall a b c.
MergingStrategy a
-> MergingStrategy b
-> MergingStrategy c
-> MergingStrategy (a, b, c)
forall (u :: * -> * -> * -> *) a b c.
Mergeable3 u =>
MergingStrategy a
-> MergingStrategy b
-> MergingStrategy c
-> MergingStrategy (u a b c)
liftRootStrategy3 MergingStrategy a
ms MergingStrategy s
forall a. Mergeable a => MergingStrategy a
rootStrategy MergingStrategy w
forall a. Mergeable a => MergingStrategy a
rootStrategy) (m (a, s, w) -> m (a, s, w)) -> m (a, s, w) -> m (a, s, w)
forall a b. (a -> b) -> a -> b
$ r -> s -> m (a, s, w)
f r
r s
s
  {-# INLINE mergeWithStrategy #-}
  mrgIfWithStrategy :: forall a.
MergingStrategy a
-> SymBool -> RWST r w s m a -> RWST r w s m a -> RWST r w s m a
mrgIfWithStrategy MergingStrategy a
ms SymBool
cond (RWSStrict.RWST r -> s -> m (a, s, w)
t) (RWSStrict.RWST r -> s -> m (a, s, w)
f) =
    (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 ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> MergingStrategy (a, s, w)
-> SymBool -> m (a, s, w) -> m (a, s, w) -> m (a, s, w)
forall a. MergingStrategy a -> SymBool -> m a -> m a -> m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy (MergingStrategy a
-> MergingStrategy s
-> MergingStrategy w
-> MergingStrategy (a, s, w)
forall a b c.
MergingStrategy a
-> MergingStrategy b
-> MergingStrategy c
-> MergingStrategy (a, b, c)
forall (u :: * -> * -> * -> *) a b c.
Mergeable3 u =>
MergingStrategy a
-> MergingStrategy b
-> MergingStrategy c
-> MergingStrategy (u a b c)
liftRootStrategy3 MergingStrategy a
ms MergingStrategy s
forall a. Mergeable a => MergingStrategy a
rootStrategy MergingStrategy w
forall a. Mergeable a => MergingStrategy a
rootStrategy) SymBool
cond (r -> s -> m (a, s, w)
t r
r s
s) (r -> s -> m (a, s, w)
f r
r s
s)
  {-# INLINE mrgIfWithStrategy #-}
  single :: forall a. a -> RWST r w s m a
single a
x = (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 ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
_ s
s -> (a, s, w) -> m (a, s, w)
forall a. a -> m a
forall (u :: * -> *) a. UnionLike u => a -> u a
single (a
x, s
s, w
forall a. Monoid a => a
mempty)
  {-# INLINE single #-}
  unionIf :: forall a.
SymBool -> RWST r w s m a -> RWST r w s m a -> RWST r w s m a
unionIf SymBool
cond (RWSStrict.RWST r -> s -> m (a, s, w)
t) (RWSStrict.RWST r -> s -> m (a, s, w)
f) =
    (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 ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> SymBool -> m (a, s, w) -> m (a, s, w) -> m (a, s, w)
forall a. SymBool -> m a -> m a -> m a
forall (u :: * -> *) a. UnionLike u => SymBool -> u a -> u a -> u a
unionIf SymBool
cond (r -> s -> m (a, s, w)
t r
r s
s) (r -> s -> m (a, s, w)
f r
r s
s)
  {-# INLINE unionIf #-}

-- | Union containers that can be projected back into single value or
-- if-guarded values.
class (UnionLike u) => UnionPrjOp (u :: Type -> Type) where
  -- | Pattern match to extract single values.
  --
  -- >>> singleView (single 1 :: UnionM Integer)
  -- Just 1
  -- >>> singleView (unionIf "a" (single 1) (single 2) :: UnionM Integer)
  -- Nothing
  singleView :: u a -> Maybe a

  -- | Pattern match to extract if values.
  --
  -- >>> ifView (single 1 :: UnionM Integer)
  -- Nothing
  -- >>> ifView (unionIf "a" (single 1) (single 2) :: UnionM Integer)
  -- Just (a,<1>,<2>)
  -- >>> ifView (mrgIf "a" (single 1) (single 2) :: UnionM Integer)
  -- Just (a,{1},{2})
  ifView :: u a -> Maybe (SymBool, u a, u a)

  -- | The leftmost value in the union.
  --
  -- >>> leftMost (unionIf "a" (single 1) (single 2) :: UnionM Integer)
  -- 1
  leftMost :: u a -> a

  -- | Convert the union to a guarded list.
  --
  -- >>> toGuardedList (mrgIf "a" (single 1) (mrgIf "b" (single 2) (single 3)) :: UnionM Integer)
  -- [(a,1),((&& b (! a)),2),((! (|| b a)),3)]
  toGuardedList :: u a -> [(SymBool, a)]
  toGuardedList u a
u =
    case (u a -> Maybe a
forall a. u a -> Maybe a
forall (u :: * -> *) a. UnionPrjOp u => u a -> Maybe a
singleView u a
u, u a -> Maybe (SymBool, u a, u a)
forall a. u a -> Maybe (SymBool, u a, u a)
forall (u :: * -> *) a.
UnionPrjOp u =>
u a -> Maybe (SymBool, u a, u a)
ifView u a
u) of
      (Just a
x, Maybe (SymBool, u a, u a)
_) -> [(Bool -> SymBool
forall c t. Solvable c t => c -> t
con Bool
True, a
x)]
      (Maybe a
_, Just (SymBool
c, u a
l, u a
r)) ->
        ((SymBool, a) -> (SymBool, a)) -> [(SymBool, a)] -> [(SymBool, a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SymBool -> SymBool) -> (SymBool, a) -> (SymBool, a)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (SymBool -> SymBool -> SymBool
forall b. LogicalOp b => b -> b -> b
.&& SymBool
c)) (u a -> [(SymBool, a)]
forall a. u a -> [(SymBool, a)]
forall (u :: * -> *) a. UnionPrjOp u => u a -> [(SymBool, a)]
toGuardedList u a
l)
          [(SymBool, a)] -> [(SymBool, a)] -> [(SymBool, a)]
forall a. [a] -> [a] -> [a]
++ ((SymBool, a) -> (SymBool, a)) -> [(SymBool, a)] -> [(SymBool, a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SymBool -> SymBool) -> (SymBool, a) -> (SymBool, a)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (SymBool -> SymBool -> SymBool
forall b. LogicalOp b => b -> b -> b
.&& SymBool -> SymBool
forall b. LogicalOp b => b -> b
symNot SymBool
c)) (u a -> [(SymBool, a)]
forall a. u a -> [(SymBool, a)]
forall (u :: * -> *) a. UnionPrjOp u => u a -> [(SymBool, a)]
toGuardedList u a
r)
      (Maybe a, Maybe (SymBool, u a, u a))
_ -> [Char] -> [(SymBool, a)]
forall a. HasCallStack => [Char] -> a
error [Char]
"Should not happen"

-- | Pattern match to extract single values with 'singleView'.
--
-- >>> case (single 1 :: UnionM Integer) of Single v -> v
-- 1
pattern Single :: (UnionPrjOp u, Mergeable a) => a -> u a
pattern $mSingle :: forall {r} {u :: * -> *} {a}.
(UnionPrjOp u, Mergeable a) =>
u a -> (a -> r) -> ((# #) -> r) -> r
$bSingle :: forall (u :: * -> *) a. (UnionPrjOp u, Mergeable a) => a -> u a
Single x <-
  (singleView -> Just x)
  where
    Single a
x = a -> u a
forall (u :: * -> *) a. (UnionLike u, Mergeable a) => a -> u a
mrgSingle a
x

-- | Pattern match to extract guard values with 'ifView'
-- >>> case (unionIf "a" (single 1) (single 2) :: UnionM Integer) of If c t f -> (c,t,f)
-- (a,<1>,<2>)
pattern If :: (UnionPrjOp u, Mergeable a) => SymBool -> u a -> u a -> u a
pattern $mIf :: forall {r} {u :: * -> *} {a}.
(UnionPrjOp u, Mergeable a) =>
u a -> (SymBool -> u a -> u a -> r) -> ((# #) -> r) -> r
$bIf :: forall (u :: * -> *) a.
(UnionPrjOp u, Mergeable a) =>
SymBool -> u a -> u a -> u a
If c t f <-
  (ifView -> Just (c, t, f))
  where
    If SymBool
c u a
t u a
f = SymBool -> u a -> u a -> u a
forall a. SymBool -> u a -> u a -> u a
forall (u :: * -> *) a. UnionLike u => SymBool -> u a -> u a -> u a
unionIf SymBool
c u a
t u a
f

-- | Merge the simply mergeable values in a union, and extract the merged value.
--
-- In the following example, 'unionIf' will not merge the results, and
-- 'simpleMerge' will merge it and extract the single merged value.
--
-- >>> unionIf (ssym "a") (return $ ssym "b") (return $ ssym "c") :: UnionM SymBool
-- <If a b c>
-- >>> simpleMerge $ (unionIf (ssym "a") (return $ ssym "b") (return $ ssym "c") :: UnionM SymBool)
-- (ite a b c)
simpleMerge :: forall u a. (SimpleMergeable a, UnionLike u, UnionPrjOp u) => u a -> a
simpleMerge :: forall (u :: * -> *) a.
(SimpleMergeable a, UnionLike u, UnionPrjOp u) =>
u a -> a
simpleMerge u a
u = case u a -> u a
forall (u :: * -> *) a. (UnionLike u, Mergeable a) => u a -> u a
merge u a
u of
  Single a
x -> a
x
  u a
_ -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Should not happen"
{-# INLINE simpleMerge #-}

-- | Lift a function to work on union values.
--
-- >>> sumU = onUnion sum
-- >>> sumU (unionIf "cond" (return ["a"]) (return ["b","c"]) :: UnionM [SymInteger])
-- (ite cond a (+ b c))
onUnion ::
  forall u a r.
  (SimpleMergeable r, UnionLike u, UnionPrjOp u, Monad u) =>
  (a -> r) ->
  (u a -> r)
onUnion :: forall (u :: * -> *) a r.
(SimpleMergeable r, UnionLike u, UnionPrjOp u, Monad u) =>
(a -> r) -> u a -> r
onUnion a -> r
f = u r -> r
forall (u :: * -> *) a.
(SimpleMergeable a, UnionLike u, UnionPrjOp u) =>
u a -> a
simpleMerge (u r -> r) -> (u a -> u r) -> u a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> r) -> u a -> u r
forall a b. (a -> b) -> u a -> u b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> r
f

-- | Lift a function to work on union values.
onUnion2 ::
  forall u a b r.
  (SimpleMergeable r, UnionLike u, UnionPrjOp u, Monad u) =>
  (a -> b -> r) ->
  (u a -> u b -> r)
onUnion2 :: forall (u :: * -> *) a b r.
(SimpleMergeable r, UnionLike u, UnionPrjOp u, Monad u) =>
(a -> b -> r) -> u a -> u b -> r
onUnion2 a -> b -> r
f u a
ua u b
ub = u r -> r
forall (u :: * -> *) a.
(SimpleMergeable a, UnionLike u, UnionPrjOp u) =>
u a -> a
simpleMerge (u r -> r) -> u r -> r
forall a b. (a -> b) -> a -> b
$ a -> b -> r
f (a -> b -> r) -> u a -> u (b -> r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> u a
ua u (b -> r) -> u b -> u r
forall a b. u (a -> b) -> u a -> u b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> u b
ub

-- | Lift a function to work on union values.
onUnion3 ::
  forall u a b c r.
  (SimpleMergeable r, UnionLike u, UnionPrjOp u, Monad u) =>
  (a -> b -> c -> r) ->
  (u a -> u b -> u c -> r)
onUnion3 :: forall (u :: * -> *) a b c r.
(SimpleMergeable r, UnionLike u, UnionPrjOp u, Monad u) =>
(a -> b -> c -> r) -> u a -> u b -> u c -> r
onUnion3 a -> b -> c -> r
f u a
ua u b
ub u c
uc = u r -> r
forall (u :: * -> *) a.
(SimpleMergeable a, UnionLike u, UnionPrjOp u) =>
u a -> a
simpleMerge (u r -> r) -> u r -> r
forall a b. (a -> b) -> a -> b
$ a -> b -> c -> r
f (a -> b -> c -> r) -> u a -> u (b -> c -> r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> u a
ua u (b -> c -> r) -> u b -> u (c -> r)
forall a b. u (a -> b) -> u a -> u b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> u b
ub u (c -> r) -> u c -> u r
forall a b. u (a -> b) -> u a -> u b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> u c
uc

-- | Lift a function to work on union values.
onUnion4 ::
  forall u a b c d r.
  (SimpleMergeable r, UnionLike u, UnionPrjOp u, Monad u) =>
  (a -> b -> c -> d -> r) ->
  (u a -> u b -> u c -> u d -> r)
onUnion4 :: forall (u :: * -> *) a b c d r.
(SimpleMergeable r, UnionLike u, UnionPrjOp u, Monad u) =>
(a -> b -> c -> d -> r) -> u a -> u b -> u c -> u d -> r
onUnion4 a -> b -> c -> d -> r
f u a
ua u b
ub u c
uc u d
ud = u r -> r
forall (u :: * -> *) a.
(SimpleMergeable a, UnionLike u, UnionPrjOp u) =>
u a -> a
simpleMerge (u r -> r) -> u r -> r
forall a b. (a -> b) -> a -> b
$ a -> b -> c -> d -> r
f (a -> b -> c -> d -> r) -> u a -> u (b -> c -> d -> r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> u a
ua u (b -> c -> d -> r) -> u b -> u (c -> d -> r)
forall a b. u (a -> b) -> u a -> u b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> u b
ub u (c -> d -> r) -> u c -> u (d -> r)
forall a b. u (a -> b) -> u a -> u b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> u c
uc u (d -> r) -> u d -> u r
forall a b. u (a -> b) -> u a -> u b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> u d
ud

-- | Helper for applying functions on 'UnionPrjOp' and 'SimpleMergeable'.
--
-- >>> let f :: Integer -> UnionM Integer = \x -> mrgIf (ssym "a") (mrgSingle $ x + 1) (mrgSingle $ x + 2)
-- >>> f .# (mrgIf (ssym "b" :: SymBool) (mrgSingle 0) (mrgSingle 2) :: UnionM Integer)
-- {If (&& b a) 1 (If b 2 (If a 3 4))}
(.#) ::
  (Function f, SimpleMergeable (Ret f), UnionPrjOp u, Functor u) =>
  f ->
  u (Arg f) ->
  Ret f
.# :: forall f (u :: * -> *).
(Function f, SimpleMergeable (Ret f), UnionPrjOp u, Functor u) =>
f -> u (Arg f) -> Ret f
(.#) f
f u (Arg f)
u = u (Ret f) -> Ret f
forall (u :: * -> *) a.
(SimpleMergeable a, UnionLike u, UnionPrjOp u) =>
u a -> a
simpleMerge (u (Ret f) -> Ret f) -> u (Ret f) -> Ret f
forall a b. (a -> b) -> a -> b
$ (Arg f -> Ret f) -> u (Arg f) -> u (Ret f)
forall a b. (a -> b) -> u a -> u b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (f
f f -> Arg f -> Ret f
forall f. Function f => f -> Arg f -> Ret f
#) u (Arg f)
u
{-# INLINE (.#) #-}

infixl 9 .#

#define SIMPLE_MERGEABLE_SIMPLE(symtype) \
instance SimpleMergeable symtype where \
  mrgIte = symIte; \
  {-# INLINE mrgIte #-}

#define SIMPLE_MERGEABLE_BV(symtype) \
instance (KnownNat n, 1 <= n) => SimpleMergeable (symtype n) where \
  mrgIte = symIte; \
  {-# INLINE mrgIte #-}

#define SIMPLE_MERGEABLE_FUN(op) \
instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb) => SimpleMergeable (sa op sb) where \
  mrgIte = symIte; \
  {-# INLINE mrgIte #-}

#if 1
SIMPLE_MERGEABLE_SIMPLE(SymBool)
SIMPLE_MERGEABLE_SIMPLE(SymInteger)
SIMPLE_MERGEABLE_BV(SymIntN)
SIMPLE_MERGEABLE_BV(SymWordN)
SIMPLE_MERGEABLE_FUN(=~>)
SIMPLE_MERGEABLE_FUN(-~>)
#endif

-- Exception
deriving via (Default AssertionError) instance SimpleMergeable AssertionError