{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-} -- for type equality ~
{-# LANGUAGE UndecidableInstances #-}

--------------------------------------------------------------------------------
-- |
-- Module      : Data.Equivalence.Monad
-- Copyright   : Patrick Bahr, 2010
-- License     : BSD-3-Clause
--
-- Maintainer  :  Patrick Bahr, Andreas Abel
-- Stability   :  stable
-- Portability :  non-portable (MPTC with FD)
--
-- This is an alternative interface to the union-find implementation
-- in ''Data.Equivalence.STT''. It is wrapped into the monad
-- transformer 'EquivT'.
--
--------------------------------------------------------------------------------

module Data.Equivalence.Monad
    (
     MonadEquiv(..),
     EquivT(..),
     EquivT',
     EquivM,
     EquivM',
     runEquivT,
     runEquivT',
     runEquivM,
     runEquivM'
     ) where

import Data.Equivalence.STT hiding (equate, equateAll, equivalent, classDesc, removeClass,
                                    getClass , combine, combineAll, same , desc , remove )
import qualified Data.Equivalence.STT  as S


import Control.Monad.Writer
import Control.Monad.Reader
import Control.Monad.Error.Class
import Control.Monad.State
import Control.Monad.Identity
import Control.Monad.ST.Trans
import Control.Monad.Trans.Except (ExceptT)
import qualified Control.Monad.Fail as Fail


{-| This monad transformer encapsulates computations maintaining an
equivalence relation. A monadic computation of type 'EquivT' @s c v m
a@ maintains a state space indexed by type @s@, maintains an
equivalence relation over elements of type @v@ with equivalence class
descriptors of type @c@ and contains an internal monadic computation
of type @m a@. -}

newtype EquivT s c v m a = EquivT {forall s c v (m :: * -> *) a.
EquivT s c v m a -> ReaderT (Equiv s c v) (STT s m) a
unEquivT :: ReaderT (Equiv s c v) (STT s m) a}
  deriving ((forall a b. (a -> b) -> EquivT s c v m a -> EquivT s c v m b)
-> (forall a b. a -> EquivT s c v m b -> EquivT s c v m a)
-> Functor (EquivT s c v m)
forall a b. a -> EquivT s c v m b -> EquivT s c v m a
forall a b. (a -> b) -> EquivT s c v m a -> EquivT s c v m b
forall s c v (m :: * -> *) a b.
Functor m =>
a -> EquivT s c v m b -> EquivT s c v m a
forall s c v (m :: * -> *) a b.
Functor m =>
(a -> b) -> EquivT s c v m a -> EquivT s c v m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> EquivT s c v m b -> EquivT s c v m a
$c<$ :: forall s c v (m :: * -> *) a b.
Functor m =>
a -> EquivT s c v m b -> EquivT s c v m a
fmap :: forall a b. (a -> b) -> EquivT s c v m a -> EquivT s c v m b
$cfmap :: forall s c v (m :: * -> *) a b.
Functor m =>
(a -> b) -> EquivT s c v m a -> EquivT s c v m b
Functor, Functor (EquivT s c v m)
Functor (EquivT s c v m)
-> (forall a. a -> EquivT s c v m a)
-> (forall a b.
    EquivT s c v m (a -> b) -> EquivT s c v m a -> EquivT s c v m b)
-> (forall a b c.
    (a -> b -> c)
    -> EquivT s c v m a -> EquivT s c v m b -> EquivT s c v m c)
-> (forall a b.
    EquivT s c v m a -> EquivT s c v m b -> EquivT s c v m b)
-> (forall a b.
    EquivT s c v m a -> EquivT s c v m b -> EquivT s c v m a)
-> Applicative (EquivT s c v m)
forall a. a -> EquivT s c v m a
forall a b.
EquivT s c v m a -> EquivT s c v m b -> EquivT s c v m a
forall a b.
EquivT s c v m a -> EquivT s c v m b -> EquivT s c v m b
forall a b.
EquivT s c v m (a -> b) -> EquivT s c v m a -> EquivT s c v m b
forall a b c.
(a -> b -> c)
-> EquivT s c v m a -> EquivT s c v m b -> EquivT s c v m c
forall {s} {c} {v} {m :: * -> *}.
Monad m =>
Functor (EquivT s c v m)
forall s c v (m :: * -> *) a. Monad m => a -> EquivT s c v m a
forall s c v (m :: * -> *) a b.
Monad m =>
EquivT s c v m a -> EquivT s c v m b -> EquivT s c v m a
forall s c v (m :: * -> *) a b.
Monad m =>
EquivT s c v m a -> EquivT s c v m b -> EquivT s c v m b
forall s c v (m :: * -> *) a b.
Monad m =>
EquivT s c v m (a -> b) -> EquivT s c v m a -> EquivT s c v m b
forall s c v (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> EquivT s c v m a -> EquivT s c v m b -> EquivT s c v m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
EquivT s c v m a -> EquivT s c v m b -> EquivT s c v m a
$c<* :: forall s c v (m :: * -> *) a b.
Monad m =>
EquivT s c v m a -> EquivT s c v m b -> EquivT s c v m a
*> :: forall a b.
EquivT s c v m a -> EquivT s c v m b -> EquivT s c v m b
$c*> :: forall s c v (m :: * -> *) a b.
Monad m =>
EquivT s c v m a -> EquivT s c v m b -> EquivT s c v m b
liftA2 :: forall a b c.
(a -> b -> c)
-> EquivT s c v m a -> EquivT s c v m b -> EquivT s c v m c
$cliftA2 :: forall s c v (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> EquivT s c v m a -> EquivT s c v m b -> EquivT s c v m c
<*> :: forall a b.
EquivT s c v m (a -> b) -> EquivT s c v m a -> EquivT s c v m b
$c<*> :: forall s c v (m :: * -> *) a b.
Monad m =>
EquivT s c v m (a -> b) -> EquivT s c v m a -> EquivT s c v m b
pure :: forall a. a -> EquivT s c v m a
$cpure :: forall s c v (m :: * -> *) a. Monad m => a -> EquivT s c v m a
Applicative, Applicative (EquivT s c v m)
Applicative (EquivT s c v m)
-> (forall a b.
    EquivT s c v m a -> (a -> EquivT s c v m b) -> EquivT s c v m b)
-> (forall a b.
    EquivT s c v m a -> EquivT s c v m b -> EquivT s c v m b)
-> (forall a. a -> EquivT s c v m a)
-> Monad (EquivT s c v m)
forall a. a -> EquivT s c v m a
forall a b.
EquivT s c v m a -> EquivT s c v m b -> EquivT s c v m b
forall a b.
EquivT s c v m a -> (a -> EquivT s c v m b) -> EquivT s c v m b
forall s c v (m :: * -> *). Monad m => Applicative (EquivT s c v m)
forall s c v (m :: * -> *) a. Monad m => a -> EquivT s c v m a
forall s c v (m :: * -> *) a b.
Monad m =>
EquivT s c v m a -> EquivT s c v m b -> EquivT s c v m b
forall s c v (m :: * -> *) a b.
Monad m =>
EquivT s c v m a -> (a -> EquivT s c v m b) -> EquivT s c v m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> EquivT s c v m a
$creturn :: forall s c v (m :: * -> *) a. Monad m => a -> EquivT s c v m a
>> :: forall a b.
EquivT s c v m a -> EquivT s c v m b -> EquivT s c v m b
$c>> :: forall s c v (m :: * -> *) a b.
Monad m =>
EquivT s c v m a -> EquivT s c v m b -> EquivT s c v m b
>>= :: forall a b.
EquivT s c v m a -> (a -> EquivT s c v m b) -> EquivT s c v m b
$c>>= :: forall s c v (m :: * -> *) a b.
Monad m =>
EquivT s c v m a -> (a -> EquivT s c v m b) -> EquivT s c v m b
Monad, MonadError e, MonadState st, MonadWriter w)

{-| This monad transformer is a special case of 'EquivT' that only
maintains trivial equivalence class descriptors of type @()@. -}

type EquivT' s = EquivT s ()

{-| This monad encapsulates computations maintaining an equivalence
relation. A monadic computation of type 'EquivM' @s c v a@ maintains a
state space indexed by type @s@, maintains an equivalence relation
over elements of type @v@ with equivalence class descriptors of type
@c@ and returns a value of type @a@.  -}

type EquivM s c v = EquivT s c v Identity

{-| This monad is a special case of 'EquivM' that only maintains
trivial equivalence class descriptors of type @()@. -}

type EquivM' s v = EquivM s () v

-- Instances for EquivT:

instance MonadTrans (EquivT s c v) where
    lift :: forall (m :: * -> *) a. Monad m => m a -> EquivT s c v m a
lift = ReaderT (Equiv s c v) (STT s m) a -> EquivT s c v m a
forall s c v (m :: * -> *) a.
ReaderT (Equiv s c v) (STT s m) a -> EquivT s c v m a
EquivT (ReaderT (Equiv s c v) (STT s m) a -> EquivT s c v m a)
-> (m a -> ReaderT (Equiv s c v) (STT s m) a)
-> m a
-> EquivT s c v m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STT s m a -> ReaderT (Equiv s c v) (STT s m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STT s m a -> ReaderT (Equiv s c v) (STT s m) a)
-> (m a -> STT s m a) -> m a -> ReaderT (Equiv s c v) (STT s m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> STT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance Monad m => Fail.MonadFail (EquivT s c v m) where
    fail :: forall a. String -> EquivT s c v m a
fail = String -> EquivT s c v m a
forall a. HasCallStack => String -> a
error

-- NB: This instance is beyond GeneralizedNewtypeDeriving
-- because EquivT already contains a ReaderT in its monad transformer stack.
instance (MonadReader r m) => MonadReader r (EquivT s c v m) where
    ask :: EquivT s c v m r
ask = ReaderT (Equiv s c v) (STT s m) r -> EquivT s c v m r
forall s c v (m :: * -> *) a.
ReaderT (Equiv s c v) (STT s m) a -> EquivT s c v m a
EquivT (ReaderT (Equiv s c v) (STT s m) r -> EquivT s c v m r)
-> ReaderT (Equiv s c v) (STT s m) r -> EquivT s c v m r
forall a b. (a -> b) -> a -> b
$ STT s m r -> ReaderT (Equiv s c v) (STT s m) r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift STT s m r
forall r (m :: * -> *). MonadReader r m => m r
ask
    local :: forall a. (r -> r) -> EquivT s c v m a -> EquivT s c v m a
local r -> r
f (EquivT (ReaderT Equiv s c v -> STT s m a
m)) = ReaderT (Equiv s c v) (STT s m) a -> EquivT s c v m a
forall s c v (m :: * -> *) a.
ReaderT (Equiv s c v) (STT s m) a -> EquivT s c v m a
EquivT (ReaderT (Equiv s c v) (STT s m) a -> EquivT s c v m a)
-> ReaderT (Equiv s c v) (STT s m) a -> EquivT s c v m a
forall a b. (a -> b) -> a -> b
$ (Equiv s c v -> STT s m a) -> ReaderT (Equiv s c v) (STT s m) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Equiv s c v -> STT s m a) -> ReaderT (Equiv s c v) (STT s m) a)
-> (Equiv s c v -> STT s m a) -> ReaderT (Equiv s c v) (STT s m) a
forall a b. (a -> b) -> a -> b
$ (\ Equiv s c v
r -> (r -> r) -> STT s m a -> STT s m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (Equiv s c v -> STT s m a
m Equiv s c v
r))

{-| This function runs a monadic computation that maintains an
equivalence relation. The first two arguments specify how to construct
an equivalence class descriptor for a singleton class and how to
combine two equivalence class descriptors. -}

runEquivT
  :: (Monad m, Applicative m)
  => (v -> c)      -- ^ Used to construct an equivalence class descriptor for a singleton class.
  -> (c -> c -> c) -- ^ Used to combine the equivalence class descriptor of two classes
                   --   which are meant to be combined.
  -> (forall s. EquivT s c v m a)
  -> m a
runEquivT :: forall (m :: * -> *) v c a.
(Monad m, Applicative m) =>
(v -> c) -> (c -> c -> c) -> (forall s. EquivT s c v m a) -> m a
runEquivT v -> c
mk c -> c -> c
com forall s. EquivT s c v m a
m = (forall s. STT s m a) -> m a
forall (m :: * -> *) a. Monad m => (forall s. STT s m a) -> m a
runSTT ((forall s. STT s m a) -> m a) -> (forall s. STT s m a) -> m a
forall a b. (a -> b) -> a -> b
$ do
  Equiv s c v
p <- (v -> c) -> (c -> c -> c) -> STT s m (Equiv s c v)
forall (m :: * -> *) a c s.
(Monad m, Applicative m) =>
(a -> c) -> (c -> c -> c) -> STT s m (Equiv s c a)
leastEquiv v -> c
mk c -> c -> c
com
  (ReaderT (Equiv s c v) (STT s m) a -> Equiv s c v -> STT s m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` Equiv s c v
p) (ReaderT (Equiv s c v) (STT s m) a -> STT s m a)
-> ReaderT (Equiv s c v) (STT s m) a -> STT s m a
forall a b. (a -> b) -> a -> b
$ EquivT s c v m a -> ReaderT (Equiv s c v) (STT s m) a
forall s c v (m :: * -> *) a.
EquivT s c v m a -> ReaderT (Equiv s c v) (STT s m) a
unEquivT EquivT s c v m a
forall s. EquivT s c v m a
m


{-| This function is a special case of 'runEquivT' that only maintains
trivial equivalence class descriptors of type @()@. -}

runEquivT' :: (Monad m, Applicative m) => (forall s. EquivT' s v m a) -> m a
runEquivT' :: forall (m :: * -> *) v a.
(Monad m, Applicative m) =>
(forall s. EquivT' s v m a) -> m a
runEquivT' = (v -> ())
-> (() -> () -> ()) -> (forall s. EquivT s () v m a) -> m a
forall (m :: * -> *) v c a.
(Monad m, Applicative m) =>
(v -> c) -> (c -> c -> c) -> (forall s. EquivT s c v m a) -> m a
runEquivT (() -> v -> ()
forall a b. a -> b -> a
const ()) (\()
_ ()
_-> ())

{-| This function runs a monadic computation that maintains an
equivalence relation. The first tow arguments specify how to construct
an equivalence class descriptor for a singleton class and how to
combine two equivalence class descriptors. -}

runEquivM
  :: (v -> c)      -- ^ Used to construct an equivalence class descriptor for a singleton class.
  -> (c -> c -> c) -- ^ Used to combine the equivalence class descriptor of two classes
                   --   which are meant to be combined.
  -> (forall s. EquivM s c v a)
  -> a
runEquivM :: forall v c a.
(v -> c) -> (c -> c -> c) -> (forall s. EquivM s c v a) -> a
runEquivM v -> c
sing c -> c -> c
comb forall s. EquivM s c v a
m = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> Identity a -> a
forall a b. (a -> b) -> a -> b
$ (v -> c)
-> (c -> c -> c) -> (forall s. EquivM s c v a) -> Identity a
forall (m :: * -> *) v c a.
(Monad m, Applicative m) =>
(v -> c) -> (c -> c -> c) -> (forall s. EquivT s c v m a) -> m a
runEquivT v -> c
sing c -> c -> c
comb forall s. EquivM s c v a
m

{-| This function is a special case of 'runEquivM' that only maintains
trivial equivalence class descriptors of type @()@. -}

runEquivM' :: (forall s. EquivM' s v a) -> a
runEquivM' :: forall v a. (forall s. EquivM' s v a) -> a
runEquivM' = (v -> ()) -> (() -> () -> ()) -> (forall s. EquivM s () v a) -> a
forall v c a.
(v -> c) -> (c -> c -> c) -> (forall s. EquivM s c v a) -> a
runEquivM (() -> v -> ()
forall a b. a -> b -> a
const ()) (\()
_ ()
_ -> ())

{-| This class specifies the interface for a monadic computation that
maintains an equivalence relation.  -}

class (Monad m, Applicative m, Ord v) => MonadEquiv c v d m | m -> v, m -> c, m -> d where

    {-| This function decides whether the two given elements are
        equivalent in the current equivalence relation. -}

    equivalent :: v -> v -> m Bool

    {-| This function obtains the descriptor of the given element's
        equivalence class. -}

    classDesc :: v -> m d

    {-| This function equates the element in the given list. That is, it
      unions the equivalence classes of the elements and combines their
      descriptor. -}

    equateAll :: [v] -> m ()

    {-| This function equates the given two elements. That is it
        unions the equivalence classes of the two elements. -}

    equate :: v -> v -> m ()
    equate v
x v
y = [v] -> m ()
forall c v d (m :: * -> *). MonadEquiv c v d m => [v] -> m ()
equateAll [v
x,v
y]

    {-| This function removes the equivalence class of the given
      element. If there is no corresponding equivalence class, @False@ is
      returned; otherwise @True@. -}

    removeClass :: v -> m Bool

    {-| This function provides the equivalence class of the given element. -}

    getClass :: v -> m c

    {-| This function combines all equivalence classes in the given
      list. Afterwards all elements in the argument list represent the same
      equivalence class! -}

    combineAll :: [c] -> m ()

    {-| This function combines the two given equivalence
      classes. Afterwards both arguments represent the same equivalence
      class! One of it is returned in order to represent the new combined
      equivalence class. -}

    combine :: c -> c -> m c
    combine c
x c
y = [c] -> m ()
forall c v d (m :: * -> *). MonadEquiv c v d m => [c] -> m ()
combineAll [c
x,c
y] m () -> m c -> m c
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return c
x

    {-| This function decides whether the two given equivalence classes
      are the same. -}

    (===) :: c -> c -> m Bool

    {-| This function returns the descriptor of the given
      equivalence class. -}

    desc :: c -> m d

    {-| This function removes the given equivalence class. If the
      equivalence class does not exist anymore, @False@ is returned;
      otherwise @True@. -}

    remove :: c -> m Bool

    -- Default implementations for lifting via a monad transformer.
    -- Unfortunately, GHC does not permit us to give these also to
    -- 'equate' and 'combine', which already have a default implementation.

    default equivalent  :: (MonadEquiv c v d n, MonadTrans t, t n ~ m) => v -> v -> m Bool
    equivalent v
x v
y       = n Bool -> t n Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n Bool -> t n Bool) -> n Bool -> t n Bool
forall a b. (a -> b) -> a -> b
$ v -> v -> n Bool
forall c v d (m :: * -> *). MonadEquiv c v d m => v -> v -> m Bool
equivalent v
x v
y

    default classDesc   :: (MonadEquiv c v d n, MonadTrans t, t n ~ m) => v -> m d
    classDesc            = n d -> m d
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n d -> m d) -> (v -> n d) -> v -> m d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> n d
forall c v d (m :: * -> *). MonadEquiv c v d m => v -> m d
classDesc

    default equateAll   :: (MonadEquiv c v d n, MonadTrans t, t n ~ m) => [v] -> m ()
    equateAll            = n () -> m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n () -> m ()) -> ([v] -> n ()) -> [v] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> n ()
forall c v d (m :: * -> *). MonadEquiv c v d m => [v] -> m ()
equateAll

    default removeClass :: (MonadEquiv c v d n, MonadTrans t, t n ~ m) => v -> m Bool
    removeClass          = n Bool -> m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n Bool -> m Bool) -> (v -> n Bool) -> v -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> n Bool
forall c v d (m :: * -> *). MonadEquiv c v d m => v -> m Bool
removeClass

    default getClass    :: (MonadEquiv c v d n, MonadTrans t, t n ~ m) => v -> m c
    getClass             = n c -> m c
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n c -> m c) -> (v -> n c) -> v -> m c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> n c
forall c v d (m :: * -> *). MonadEquiv c v d m => v -> m c
getClass

    default combineAll  :: (MonadEquiv c v d n, MonadTrans t, t n ~ m) => [c] -> m ()
    combineAll           = n () -> m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n () -> m ()) -> ([c] -> n ()) -> [c] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [c] -> n ()
forall c v d (m :: * -> *). MonadEquiv c v d m => [c] -> m ()
combineAll

    default (===)       :: (MonadEquiv c v d n, MonadTrans t, t n ~ m) => c -> c -> m Bool
    c
x === c
y              = n Bool -> t n Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n Bool -> t n Bool) -> n Bool -> t n Bool
forall a b. (a -> b) -> a -> b
$ c -> c -> n Bool
forall c v d (m :: * -> *). MonadEquiv c v d m => c -> c -> m Bool
(===) c
x c
y

    default desc        :: (MonadEquiv c v d n, MonadTrans t, t n ~ m) => c -> m d
    desc                 = n d -> m d
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n d -> m d) -> (c -> n d) -> c -> m d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> n d
forall c v d (m :: * -> *). MonadEquiv c v d m => c -> m d
desc

    default remove      :: (MonadEquiv c v d n, MonadTrans t, t n ~ m) => c -> m Bool
    remove               = n Bool -> m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n Bool -> m Bool) -> (c -> n Bool) -> c -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> n Bool
forall c v d (m :: * -> *). MonadEquiv c v d m => c -> m Bool
remove


instance (Monad m, Applicative m, Ord v) => MonadEquiv (Class s d v) v d (EquivT s d v m) where
    equivalent :: v -> v -> EquivT s d v m Bool
equivalent v
x v
y = ReaderT (Equiv s d v) (STT s m) Bool -> EquivT s d v m Bool
forall s c v (m :: * -> *) a.
ReaderT (Equiv s c v) (STT s m) a -> EquivT s c v m a
EquivT (ReaderT (Equiv s d v) (STT s m) Bool -> EquivT s d v m Bool)
-> ReaderT (Equiv s d v) (STT s m) Bool -> EquivT s d v m Bool
forall a b. (a -> b) -> a -> b
$ do
      Equiv s d v
part <- ReaderT (Equiv s d v) (STT s m) (Equiv s d v)
forall r (m :: * -> *). MonadReader r m => m r
ask
      STT s m Bool -> ReaderT (Equiv s d v) (STT s m) Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STT s m Bool -> ReaderT (Equiv s d v) (STT s m) Bool)
-> STT s m Bool -> ReaderT (Equiv s d v) (STT s m) Bool
forall a b. (a -> b) -> a -> b
$ Equiv s d v -> v -> v -> STT s m Bool
forall (m :: * -> *) a s c.
(Monad m, Applicative m, Ord a) =>
Equiv s c a -> a -> a -> STT s m Bool
S.equivalent Equiv s d v
part v
x v
y

    classDesc :: v -> EquivT s d v m d
classDesc v
x = ReaderT (Equiv s d v) (STT s m) d -> EquivT s d v m d
forall s c v (m :: * -> *) a.
ReaderT (Equiv s c v) (STT s m) a -> EquivT s c v m a
EquivT (ReaderT (Equiv s d v) (STT s m) d -> EquivT s d v m d)
-> ReaderT (Equiv s d v) (STT s m) d -> EquivT s d v m d
forall a b. (a -> b) -> a -> b
$ do
      Equiv s d v
part <- ReaderT (Equiv s d v) (STT s m) (Equiv s d v)
forall r (m :: * -> *). MonadReader r m => m r
ask
      STT s m d -> ReaderT (Equiv s d v) (STT s m) d
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STT s m d -> ReaderT (Equiv s d v) (STT s m) d)
-> STT s m d -> ReaderT (Equiv s d v) (STT s m) d
forall a b. (a -> b) -> a -> b
$ Equiv s d v -> v -> STT s m d
forall (m :: * -> *) a s c.
(Monad m, Applicative m, Ord a) =>
Equiv s c a -> a -> STT s m c
S.classDesc Equiv s d v
part v
x

    equateAll :: [v] -> EquivT s d v m ()
equateAll [v]
x = ReaderT (Equiv s d v) (STT s m) () -> EquivT s d v m ()
forall s c v (m :: * -> *) a.
ReaderT (Equiv s c v) (STT s m) a -> EquivT s c v m a
EquivT (ReaderT (Equiv s d v) (STT s m) () -> EquivT s d v m ())
-> ReaderT (Equiv s d v) (STT s m) () -> EquivT s d v m ()
forall a b. (a -> b) -> a -> b
$ do
      Equiv s d v
part <- ReaderT (Equiv s d v) (STT s m) (Equiv s d v)
forall r (m :: * -> *). MonadReader r m => m r
ask
      STT s m () -> ReaderT (Equiv s d v) (STT s m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STT s m () -> ReaderT (Equiv s d v) (STT s m) ())
-> STT s m () -> ReaderT (Equiv s d v) (STT s m) ()
forall a b. (a -> b) -> a -> b
$ Equiv s d v -> [v] -> STT s m ()
forall (m :: * -> *) a s c.
(Monad m, Applicative m, Ord a) =>
Equiv s c a -> [a] -> STT s m ()
S.equateAll Equiv s d v
part [v]
x

    equate :: v -> v -> EquivT s d v m ()
equate v
x v
y = ReaderT (Equiv s d v) (STT s m) () -> EquivT s d v m ()
forall s c v (m :: * -> *) a.
ReaderT (Equiv s c v) (STT s m) a -> EquivT s c v m a
EquivT (ReaderT (Equiv s d v) (STT s m) () -> EquivT s d v m ())
-> ReaderT (Equiv s d v) (STT s m) () -> EquivT s d v m ()
forall a b. (a -> b) -> a -> b
$ do
      Equiv s d v
part <- ReaderT (Equiv s d v) (STT s m) (Equiv s d v)
forall r (m :: * -> *). MonadReader r m => m r
ask
      STT s m () -> ReaderT (Equiv s d v) (STT s m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STT s m () -> ReaderT (Equiv s d v) (STT s m) ())
-> STT s m () -> ReaderT (Equiv s d v) (STT s m) ()
forall a b. (a -> b) -> a -> b
$ Equiv s d v -> v -> v -> STT s m ()
forall (m :: * -> *) a s c.
(Monad m, Applicative m, Ord a) =>
Equiv s c a -> a -> a -> STT s m ()
S.equate Equiv s d v
part v
x v
y

    removeClass :: v -> EquivT s d v m Bool
removeClass v
x = ReaderT (Equiv s d v) (STT s m) Bool -> EquivT s d v m Bool
forall s c v (m :: * -> *) a.
ReaderT (Equiv s c v) (STT s m) a -> EquivT s c v m a
EquivT (ReaderT (Equiv s d v) (STT s m) Bool -> EquivT s d v m Bool)
-> ReaderT (Equiv s d v) (STT s m) Bool -> EquivT s d v m Bool
forall a b. (a -> b) -> a -> b
$ do
      Equiv s d v
part <- ReaderT (Equiv s d v) (STT s m) (Equiv s d v)
forall r (m :: * -> *). MonadReader r m => m r
ask
      STT s m Bool -> ReaderT (Equiv s d v) (STT s m) Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STT s m Bool -> ReaderT (Equiv s d v) (STT s m) Bool)
-> STT s m Bool -> ReaderT (Equiv s d v) (STT s m) Bool
forall a b. (a -> b) -> a -> b
$ Equiv s d v -> v -> STT s m Bool
forall (m :: * -> *) a s c.
(Monad m, Applicative m, Ord a) =>
Equiv s c a -> a -> STT s m Bool
S.removeClass Equiv s d v
part v
x

    getClass :: v -> EquivT s d v m (Class s d v)
getClass v
x = ReaderT (Equiv s d v) (STT s m) (Class s d v)
-> EquivT s d v m (Class s d v)
forall s c v (m :: * -> *) a.
ReaderT (Equiv s c v) (STT s m) a -> EquivT s c v m a
EquivT (ReaderT (Equiv s d v) (STT s m) (Class s d v)
 -> EquivT s d v m (Class s d v))
-> ReaderT (Equiv s d v) (STT s m) (Class s d v)
-> EquivT s d v m (Class s d v)
forall a b. (a -> b) -> a -> b
$ do
      Equiv s d v
part <- ReaderT (Equiv s d v) (STT s m) (Equiv s d v)
forall r (m :: * -> *). MonadReader r m => m r
ask
      STT s m (Class s d v)
-> ReaderT (Equiv s d v) (STT s m) (Class s d v)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STT s m (Class s d v)
 -> ReaderT (Equiv s d v) (STT s m) (Class s d v))
-> STT s m (Class s d v)
-> ReaderT (Equiv s d v) (STT s m) (Class s d v)
forall a b. (a -> b) -> a -> b
$ Equiv s d v -> v -> STT s m (Class s d v)
forall (m :: * -> *) a s c.
(Monad m, Applicative m, Ord a) =>
Equiv s c a -> a -> STT s m (Class s c a)
S.getClass Equiv s d v
part v
x

    combineAll :: [Class s d v] -> EquivT s d v m ()
combineAll [Class s d v]
x = ReaderT (Equiv s d v) (STT s m) () -> EquivT s d v m ()
forall s c v (m :: * -> *) a.
ReaderT (Equiv s c v) (STT s m) a -> EquivT s c v m a
EquivT (ReaderT (Equiv s d v) (STT s m) () -> EquivT s d v m ())
-> ReaderT (Equiv s d v) (STT s m) () -> EquivT s d v m ()
forall a b. (a -> b) -> a -> b
$ do
      Equiv s d v
part <- ReaderT (Equiv s d v) (STT s m) (Equiv s d v)
forall r (m :: * -> *). MonadReader r m => m r
ask
      STT s m () -> ReaderT (Equiv s d v) (STT s m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STT s m () -> ReaderT (Equiv s d v) (STT s m) ())
-> STT s m () -> ReaderT (Equiv s d v) (STT s m) ()
forall a b. (a -> b) -> a -> b
$ Equiv s d v -> [Class s d v] -> STT s m ()
forall (m :: * -> *) a s c.
(Monad m, Applicative m, Ord a) =>
Equiv s c a -> [Class s c a] -> STT s m ()
S.combineAll Equiv s d v
part [Class s d v]
x

    combine :: Class s d v -> Class s d v -> EquivT s d v m (Class s d v)
combine Class s d v
x Class s d v
y = ReaderT (Equiv s d v) (STT s m) (Class s d v)
-> EquivT s d v m (Class s d v)
forall s c v (m :: * -> *) a.
ReaderT (Equiv s c v) (STT s m) a -> EquivT s c v m a
EquivT (ReaderT (Equiv s d v) (STT s m) (Class s d v)
 -> EquivT s d v m (Class s d v))
-> ReaderT (Equiv s d v) (STT s m) (Class s d v)
-> EquivT s d v m (Class s d v)
forall a b. (a -> b) -> a -> b
$ do
      Equiv s d v
part <- ReaderT (Equiv s d v) (STT s m) (Equiv s d v)
forall r (m :: * -> *). MonadReader r m => m r
ask
      STT s m (Class s d v)
-> ReaderT (Equiv s d v) (STT s m) (Class s d v)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STT s m (Class s d v)
 -> ReaderT (Equiv s d v) (STT s m) (Class s d v))
-> STT s m (Class s d v)
-> ReaderT (Equiv s d v) (STT s m) (Class s d v)
forall a b. (a -> b) -> a -> b
$ Equiv s d v -> Class s d v -> Class s d v -> STT s m (Class s d v)
forall (m :: * -> *) a s c.
(Monad m, Applicative m, Ord a) =>
Equiv s c a -> Class s c a -> Class s c a -> STT s m (Class s c a)
S.combine Equiv s d v
part Class s d v
x Class s d v
y

    Class s d v
x === :: Class s d v -> Class s d v -> EquivT s d v m Bool
=== Class s d v
y = ReaderT (Equiv s d v) (STT s m) Bool -> EquivT s d v m Bool
forall s c v (m :: * -> *) a.
ReaderT (Equiv s c v) (STT s m) a -> EquivT s c v m a
EquivT (ReaderT (Equiv s d v) (STT s m) Bool -> EquivT s d v m Bool)
-> ReaderT (Equiv s d v) (STT s m) Bool -> EquivT s d v m Bool
forall a b. (a -> b) -> a -> b
$ do
      Equiv s d v
part <- ReaderT (Equiv s d v) (STT s m) (Equiv s d v)
forall r (m :: * -> *). MonadReader r m => m r
ask
      STT s m Bool -> ReaderT (Equiv s d v) (STT s m) Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STT s m Bool -> ReaderT (Equiv s d v) (STT s m) Bool)
-> STT s m Bool -> ReaderT (Equiv s d v) (STT s m) Bool
forall a b. (a -> b) -> a -> b
$ Equiv s d v -> Class s d v -> Class s d v -> STT s m Bool
forall (m :: * -> *) a s c.
(Monad m, Applicative m, Ord a) =>
Equiv s c a -> Class s c a -> Class s c a -> STT s m Bool
S.same Equiv s d v
part Class s d v
x Class s d v
y

    desc :: Class s d v -> EquivT s d v m d
desc Class s d v
x = ReaderT (Equiv s d v) (STT s m) d -> EquivT s d v m d
forall s c v (m :: * -> *) a.
ReaderT (Equiv s c v) (STT s m) a -> EquivT s c v m a
EquivT (ReaderT (Equiv s d v) (STT s m) d -> EquivT s d v m d)
-> ReaderT (Equiv s d v) (STT s m) d -> EquivT s d v m d
forall a b. (a -> b) -> a -> b
$ do
      Equiv s d v
part <- ReaderT (Equiv s d v) (STT s m) (Equiv s d v)
forall r (m :: * -> *). MonadReader r m => m r
ask
      STT s m d -> ReaderT (Equiv s d v) (STT s m) d
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STT s m d -> ReaderT (Equiv s d v) (STT s m) d)
-> STT s m d -> ReaderT (Equiv s d v) (STT s m) d
forall a b. (a -> b) -> a -> b
$ Equiv s d v -> Class s d v -> STT s m d
forall (m :: * -> *) a s c.
(Monad m, Applicative m, Ord a) =>
Equiv s c a -> Class s c a -> STT s m c
S.desc Equiv s d v
part Class s d v
x

    remove :: Class s d v -> EquivT s d v m Bool
remove Class s d v
x = ReaderT (Equiv s d v) (STT s m) Bool -> EquivT s d v m Bool
forall s c v (m :: * -> *) a.
ReaderT (Equiv s c v) (STT s m) a -> EquivT s c v m a
EquivT (ReaderT (Equiv s d v) (STT s m) Bool -> EquivT s d v m Bool)
-> ReaderT (Equiv s d v) (STT s m) Bool -> EquivT s d v m Bool
forall a b. (a -> b) -> a -> b
$ do
      Equiv s d v
part <- ReaderT (Equiv s d v) (STT s m) (Equiv s d v)
forall r (m :: * -> *). MonadReader r m => m r
ask
      STT s m Bool -> ReaderT (Equiv s d v) (STT s m) Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STT s m Bool -> ReaderT (Equiv s d v) (STT s m) Bool)
-> STT s m Bool -> ReaderT (Equiv s d v) (STT s m) Bool
forall a b. (a -> b) -> a -> b
$ Equiv s d v -> Class s d v -> STT s m Bool
forall (m :: * -> *) a s c.
(Monad m, Applicative m, Ord a) =>
Equiv s c a -> Class s c a -> STT s m Bool
S.remove Equiv s d v
part Class s d v
x

instance (MonadEquiv c v d m, Monoid w) => MonadEquiv c v d (WriterT w m) where
    equate :: v -> v -> WriterT w m ()
equate  v
x v
y = m () -> WriterT w m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WriterT w m ()) -> m () -> WriterT w m ()
forall a b. (a -> b) -> a -> b
$ v -> v -> m ()
forall c v d (m :: * -> *). MonadEquiv c v d m => v -> v -> m ()
equate v
x v
y
    combine :: c -> c -> WriterT w m c
combine c
x c
y = m c -> WriterT w m c
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m c -> WriterT w m c) -> m c -> WriterT w m c
forall a b. (a -> b) -> a -> b
$ c -> c -> m c
forall c v d (m :: * -> *). MonadEquiv c v d m => c -> c -> m c
combine c
x c
y

instance (MonadEquiv c v d m) => MonadEquiv c v d (ExceptT e m) where
    equate :: v -> v -> ExceptT e m ()
equate  v
x v
y = m () -> ExceptT e m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT e m ()) -> m () -> ExceptT e m ()
forall a b. (a -> b) -> a -> b
$ v -> v -> m ()
forall c v d (m :: * -> *). MonadEquiv c v d m => v -> v -> m ()
equate v
x v
y
    combine :: c -> c -> ExceptT e m c
combine c
x c
y = m c -> ExceptT e m c
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m c -> ExceptT e m c) -> m c -> ExceptT e m c
forall a b. (a -> b) -> a -> b
$ c -> c -> m c
forall c v d (m :: * -> *). MonadEquiv c v d m => c -> c -> m c
combine c
x c
y

instance (MonadEquiv c v d m) => MonadEquiv c v d (StateT s m) where
    equate :: v -> v -> StateT s m ()
equate  v
x v
y = m () -> StateT s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ()) -> m () -> StateT s m ()
forall a b. (a -> b) -> a -> b
$ v -> v -> m ()
forall c v d (m :: * -> *). MonadEquiv c v d m => v -> v -> m ()
equate v
x v
y
    combine :: c -> c -> StateT s m c
combine c
x c
y = m c -> StateT s m c
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m c -> StateT s m c) -> m c -> StateT s m c
forall a b. (a -> b) -> a -> b
$ c -> c -> m c
forall c v d (m :: * -> *). MonadEquiv c v d m => c -> c -> m c
combine c
x c
y

instance (MonadEquiv c v d m) => MonadEquiv c v d (ReaderT r m) where
    equate :: v -> v -> ReaderT r m ()
equate  v
x v
y = m () -> ReaderT r m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT r m ()) -> m () -> ReaderT r m ()
forall a b. (a -> b) -> a -> b
$ v -> v -> m ()
forall c v d (m :: * -> *). MonadEquiv c v d m => v -> v -> m ()
equate v
x v
y
    combine :: c -> c -> ReaderT r m c
combine c
x c
y = m c -> ReaderT r m c
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m c -> ReaderT r m c) -> m c -> ReaderT r m c
forall a b. (a -> b) -> a -> b
$ c -> c -> m c
forall c v d (m :: * -> *). MonadEquiv c v d m => c -> c -> m c
combine c
x c
y