Source

equivalence / src / Data / UnionFind / Monad.hs

{-# LANGUAGE
  RankNTypes,
  FlexibleInstances,
  FlexibleContexts,
  MultiParamTypeClasses,
  UndecidableInstances,
  FunctionalDependencies #-}


module Data.UnionFind.Monad
    (
     MonadPartition(..),
     PartitionT,
     runPartitionT
     ) where

import Data.UnionFind.STT hiding (equate, equivalent, equivalenceClass)
import qualified Data.UnionFind.STT  as S

 
import Control.Monad.Writer
import Control.Monad.Reader
import Control.Monad.Error
import Control.Monad.State
import Control.Monad.Trans
import Control.Monad.Identity
import Control.Monad.ST.Trans



newtype PartitionT s v m a = PartitionT {unPartitionT :: ReaderT (Partition s v) (STT s m) a}
type PartitionM s v = PartitionT s v Identity

instance (Monad m) => Monad (PartitionT s v m) where
    PartitionT m >>= f = PartitionT (m >>= (unPartitionT . f))
    return = PartitionT . return

instance MonadTrans (PartitionT s v) where
    lift = PartitionT . lift . lift

instance (MonadReader r m) => MonadReader r (PartitionT s v m) where
    ask = PartitionT $ lift ask
    local f (PartitionT (ReaderT m)) = PartitionT $ ReaderT $ (\ r -> local f (m r))

instance (Monoid w, MonadWriter w m) => MonadWriter w (PartitionT s v m) where
    tell w = PartitionT $ tell w
    listen (PartitionT m) = PartitionT $ listen m
    pass (PartitionT m) = PartitionT $ pass m

instance (MonadState st m) => MonadState st (PartitionT s v m) where
    get = PartitionT get
    put s = PartitionT $ put s

instance (MonadError e m) => MonadError e (PartitionT s v m) where
    throwError e = lift $ throwError e
    catchError (PartitionT m) f = PartitionT $ catchError m (unPartitionT . f)
    

runPartitionT :: (Monad m) => (forall s. PartitionT s v m a) -> m a
runPartitionT m = runST $ do
  p <- emptyPartition
  (`runReaderT` p) $ unPartitionT m


class (Monad m, Ord v) => MonadPartition v m | m -> v where
    equivalent :: v -> v -> m Bool
    equivalenceClass :: v -> m [v]
    equate :: v -> v -> m ()

instance (Monad m, Ord v) => MonadPartition v (PartitionT s v m) where
    equivalent x y = PartitionT $ do
      part <- ask
      lift $ S.equivalent part x y

    equivalenceClass x = PartitionT $ do
      part <- ask
      lift $ S.equivalenceClass part x
           
    equate x y = PartitionT $ do
      part <- ask
      lift $ S.equate part x y

instance (MonadPartition v m, MonadTrans t, Monad (t m)) => MonadPartition v (t m) where
    equivalent x y = lift $ equivalent x y
    equivalenceClass = lift . equivalenceClass
    equate x y = lift $ equate x y
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.