equivalence 0.3.5 → 0.4

raw patch · 6 files changed

+220/−207 lines, 6 filesdep +equivalencedep ~STMonadTransdep ~basedep ~mtlnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: equivalence

Dependency ranges changed: STMonadTrans, base, mtl, transformers, transformers-compat

API changes (from Hackage documentation)

Files

• CHANGES.md +31/−0
• CHANGES.txt +0/−27
• equivalence.cabal +73/−21
• src/Data/Equivalence/Monad.hs +80/−127
• src/Data/Equivalence/STT.hs +30/−30
• testsuite/tests/Data/Equivalence/Monad_Test.hs +6/−2

@@ -0,0 +1,31 @@+0.4+---+* remove ErrorT instance for compatibility with transformers-0.6 and mtl-2.3++0.3.5+-----+* compatibility with GHC 8.8++0.3.4+-----+* MonadFail instance for EquivT++0.3.3+-----+* compatibility with GHC 8.6++0.3.2+-----+* add Applicative constraints for backwards compatibility with GHC 7.8++0.3.1+-----+* use transformers-compat for backwards compatibility with older versions of transformers++0.3.0.1+-------+* add CHANGES.txt to .cabal file++0.3+---+* add suport for Control.Monad.Except (thus the new dependency constraint 'mtl >= 2.2.1')

@@ -1,27 +0,0 @@-0.3.5-------* compatibility with GHC 8.8--0.3.4-------* MonadFail instance for EquivT--0.3.3-------* compatibility with GHC 8.6--0.3.2-------* add Applicative constraints for backwards compatibility with GHC 7.8--0.3.1-------* use transformers-compat for backwards compatibility with older versions of transformers--0.3.0.1---------* add CHANGES.txt to .cabal file--0.3-----* add suport for Control.Monad.Except (thus the new dependency constraint 'mtl >= 2.2.1')

@@ -1,47 +1,99 @@+Cabal-Version:   >= 1.10 Name:            equivalence-Version:         0.3.5+Version:         0.4 License:         BSD3 License-File:    LICENSE Author:          Patrick Bahr Maintainer:      paba@itu.dk Homepage:        https://github.com/pa-ba/equivalence-bug-reports:     https://github.com/pa-ba/equivalence/issues/new+bug-reports:     https://github.com/pa-ba/equivalence/issues Synopsis:        Maintaining an equivalence relation implemented as union-find using STT.-Description:	 +Description:   This is an implementation of Tarjan's Union-Find algorithm (Robert   E. Tarjan. "Efficiency of a Good But Not Linear Set Union   Algorithm", JACM 22(2), 1975) in order to maintain an equivalence-  relation. -  +  relation.+   This implementation is a port of the /union-find/ package using the   ST monad transformer (instead of the IO monad). Category:        Algorithms, Data Stability:       provisional Build-Type:      Simple-Cabal-Version:   >=1.9.2 -Extra-Source-Files: CHANGES.txt+tested-with:+  GHC == 7.10.3+  GHC == 8.0.2+  GHC == 8.2.2+  GHC == 8.4.4+  GHC == 8.6.5+  GHC == 8.8.4+  GHC == 8.10.7+  GHC == 9.0.2+  GHC == 9.2.1 +Extra-Source-Files: CHANGES.md  source-repository head   type:     git   location: https://github.com/pa-ba/equivalence  -Test-Suite test-  Type:                 exitcode-stdio-1.0-  Main-is:		Data_Test.hs-  Other-Modules:	Data.Equivalence.Monad_Test,Data.Equivalence.Monad, Data.Equivalence.STT-  hs-source-dirs:	src testsuite/tests-  Build-Depends:        base >= 4, template-haskell, containers, mtl >= 2.0.1, QuickCheck >= 2,-                        STMonadTrans >= 0.4.3, transformers >= 0.2, transformers-compat >= 0.3, fail- Library-  Build-Depends:-    base >= 4 && < 5, containers, mtl >= 2.0.1, STMonadTrans >= 0.4.3,-    transformers >= 0.2, transformers-compat >= 0.3   Exposed-Modules:-    Data.Equivalence.STT,+    Data.Equivalence.STT     Data.Equivalence.Monad-  Hs-Source-Dirs: src-  build-depends: fail+  Hs-Source-Dirs:       src+  default-language:     Haskell2010+  Build-Depends:+    base                   >= 4.8    && < 5+    , containers+    , mtl                  >= 2.2.1+    , STMonadTrans         >= 0.4.3+    , transformers         >= 0.2+    , transformers-compat  >= 0.3+  if impl(ghc < 8.0)+    Build-Depends:+      fail++  ghc-options:+      -Wall+      -fno-warn-name-shadowing+      -fno-warn-incomplete-record-updates+  if impl(ghc >= 8.0)+    ghc-options:+      -Wcompat++Test-Suite test+  Type:                 exitcode-stdio-1.0+  Main-is:              Data_Test.hs+  Other-Modules:+    Data.Equivalence.Monad_Test+    Data.Equivalence.Monad+    Data.Equivalence.STT+  hs-source-dirs:       src testsuite/tests+  default-language:     Haskell2010+  Build-Depends:+    equivalence+    -- inherited dependencies from library+    , base+    , containers+    , mtl+    , STMonadTrans+    , transformers+    , transformers-compat+    -- Additional dependencies for testsuite+    , QuickCheck           >= 2+    , template-haskell+  if impl(ghc < 8.0)+    Build-Depends:+      fail++  ghc-options:+      -Wall+      -fno-warn-name-shadowing+      -fno-warn-incomplete-record-updates+      -fno-warn-missing-signatures+      -fno-warn-unused-do-bind+  if impl(ghc >= 8.0)+    ghc-options:+      -Wcompat

@@ -1,25 +1,22 @@-{-# LANGUAGE-  RankNTypes,-  FlexibleInstances,-  FlexibleContexts,-  MultiParamTypeClasses,-  UndecidableInstances,-  FunctionalDependencies #-}---- Suppress warnings about ''Control.Monad.Error'' being deprecated.--{-# OPTIONS_GHC -fno-warn-deprecations #-}-+{-# 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     : All Rights Reserved+-- License     : BSD-3-Clause ----- Maintainer  :  Patrick Bahr--- Stability   :  unknown--- Portability :  unknown+-- 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@@ -44,17 +41,14 @@                                     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.Trans import Control.Monad.Identity import Control.Monad.ST.Trans-import Control.Monad.Trans.Error (ErrorT) import Control.Monad.Trans.Except (ExceptT)-import Control.Applicative import qualified Control.Monad.Fail as Fail  @@ -66,7 +60,7 @@ of type @m a@. -}  newtype EquivT s c v m a = EquivT {unEquivT :: ReaderT (Equiv s c v) (STT s m) a}-+  deriving (Functor, Applicative, 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 @()@. -}@@ -81,22 +75,12 @@  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 -instance Functor m => Functor (EquivT s c v m) where-  fmap f (EquivT m) = EquivT $ fmap f m--instance (Applicative m, Monad m) => Applicative (EquivT s c v m) where-  pure = EquivT . pure-  (EquivT f) <*> (EquivT a) = EquivT (f <*> a)--instance (Monad m) => Monad (EquivT s c v m) where-    EquivT m >>= f = EquivT (m >>= (unEquivT . f))-    return = EquivT . return+-- Instances for EquivT:  instance MonadTrans (EquivT s c v) where     lift = EquivT . lift . lift@@ -104,35 +88,25 @@ instance Monad m => Fail.MonadFail (EquivT s c v m) where     fail = 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 $ lift ask     local f (EquivT (ReaderT m)) = EquivT $ ReaderT $ (\ r -> local f (m r)) -instance (Monoid w, MonadWriter w m) => MonadWriter w (EquivT s c v m) where-    tell w = EquivT $ tell w-    listen (EquivT m) = EquivT $ listen m-    pass (EquivT m) = EquivT $ pass m--instance (MonadState st m) => MonadState st (EquivT s c v m) where-    get = EquivT get-    put s = EquivT $ put s--instance (MonadError e m) => MonadError e (EquivT s c v m) where-    throwError e = lift $ throwError e-    catchError (EquivT m) f = EquivT $ catchError m (unEquivT . f)-     {-| This function runs a monadic computation that maintains an-equivalence relation. The first tow arguments specify how to construct+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 mk com m = runST $ do+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 mk com m = runSTT $ do   p <- leastEquiv mk com   (`runReaderT` p) $ unEquivT m @@ -147,11 +121,13 @@ 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+  :: (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 sing comb m = runIdentity $ runEquivT sing comb m  {-| This function is a special case of 'runEquivM' that only maintains@@ -164,21 +140,23 @@ 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 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. -} @@ -188,22 +166,19 @@     {-| 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 the given element-      is contained in. -}+    {-| 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@@ -211,27 +186,55 @@      combine :: c -> c -> m c     combine x y = combineAll [x,y] >> return 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 exists anymore @False@ is returned;+      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 x y       = lift $ equivalent x y +    default classDesc   :: (MonadEquiv c v d n, MonadTrans t, t n ~ m) => v -> m d+    classDesc            = lift . classDesc++    default equateAll   :: (MonadEquiv c v d n, MonadTrans t, t n ~ m) => [v] -> m ()+    equateAll            = lift . equateAll++    default removeClass :: (MonadEquiv c v d n, MonadTrans t, t n ~ m) => v -> m Bool+    removeClass          = lift . removeClass++    default getClass    :: (MonadEquiv c v d n, MonadTrans t, t n ~ m) => v -> m c+    getClass             = lift . getClass++    default combineAll  :: (MonadEquiv c v d n, MonadTrans t, t n ~ m) => [c] -> m ()+    combineAll           = lift . combineAll++    default (===)       :: (MonadEquiv c v d n, MonadTrans t, t n ~ m) => c -> c -> m Bool+    x === y              = lift $ (===) x y++    default desc        :: (MonadEquiv c v d n, MonadTrans t, t n ~ m) => c -> m d+    desc                 = lift . desc++    default remove      :: (MonadEquiv c v d n, MonadTrans t, t n ~ m) => c -> m Bool+    remove               = lift . remove++ instance (Monad m, Applicative m, Ord v) => MonadEquiv (Class s d v) v d (EquivT s d v m) where     equivalent x y = EquivT $ do       part <- ask@@ -240,11 +243,11 @@     classDesc x = EquivT $ do       part <- ask       lift $ S.classDesc part x-           +     equateAll x = EquivT $ do       part <- ask       lift $ S.equateAll part x-           +     equate x y = EquivT $ do       part <- ask       lift $ S.equate part x y@@ -278,67 +281,17 @@       lift $ S.remove part x  instance (MonadEquiv c v d m, Monoid w) => MonadEquiv c v d (WriterT w m) where-    equivalent x y = lift $ equivalent x y-    classDesc = lift . classDesc-    equateAll x = lift $ equateAll x-    equate x y = lift $ equate x y-    removeClass x = lift $ removeClass x-    getClass x = lift $ getClass x-    combineAll x = lift $ combineAll x+    equate  x y = lift $ equate x y     combine x y = lift $ combine x y-    x === y = lift $ (===) x y-    desc x = lift $ desc x-    remove x = lift $ remove x -instance (MonadEquiv c v d m, Error e) => MonadEquiv c v d (ErrorT e m) where-    equivalent x y = lift $ equivalent x y-    classDesc = lift . classDesc-    equateAll x = lift $ equateAll x-    equate x y = lift $ equate x y-    removeClass x = lift $ removeClass x-    getClass x = lift $ getClass x-    combineAll x = lift $ combineAll x-    combine x y = lift $ combine x y-    x === y = lift $ (===) x y-    desc x = lift $ desc x-    remove x = lift $ remove x- instance (MonadEquiv c v d m) => MonadEquiv c v d (ExceptT e m) where-    equivalent x y = lift $ equivalent x y-    classDesc = lift . classDesc-    equateAll x = lift $ equateAll x-    equate x y = lift $ equate x y-    removeClass x = lift $ removeClass x-    getClass x = lift $ getClass x-    combineAll x = lift $ combineAll x+    equate  x y = lift $ equate x y     combine x y = lift $ combine x y-    x === y = lift $ (===) x y-    desc x = lift $ desc x-    remove x = lift $ remove x - instance (MonadEquiv c v d m) => MonadEquiv c v d (StateT s m) where-    equivalent x y = lift $ equivalent x y-    classDesc = lift . classDesc-    equateAll x = lift $ equateAll x-    equate x y = lift $ equate x y-    removeClass x = lift $ removeClass x-    getClass x = lift $ getClass x-    combineAll x = lift $ combineAll x+    equate  x y = lift $ equate x y     combine x y = lift $ combine x y-    x === y = lift $ (===) x y-    desc x = lift $ desc x-    remove x = lift $ remove x  instance (MonadEquiv c v d m) => MonadEquiv c v d (ReaderT r m) where-    equivalent x y = lift $ equivalent x y-    classDesc = lift . classDesc-    equateAll x = lift $ equateAll x-    equate x y = lift $ equate x y-    removeClass x = lift $ removeClass x-    getClass x = lift $ getClass x-    combineAll x = lift $ combineAll x+    equate  x y = lift $ equate x y     combine x y = lift $ combine x y-    x === y = lift $ (===) x y-    desc x = lift $ desc x-    remove x = lift $ remove x

@@ -3,18 +3,18 @@ -------------------------------------------------------------------------------- -- | -- Module      : Data.Equivalence.STT--- Copyright   : 3gERP, 2010--- License     : All Rights Reserved+-- Copyright   : Patrick Bahr, 2010+-- License     : BSD-3-Clause ----- Maintainer  :  Patrick Bahr--- Stability   :  unknown--- Portability :  unknown+-- Maintainer  :  Patrick Bahr, Andreas Abel+-- Stability   :  stable+-- Portability :  non-portable (MPTC) -- -- This is an implementation of Tarjan's Union-Find algorithm (Robert -- E. Tarjan. "Efficiency of a Good But Not Linear Set Union -- Algorithm", JACM 22(2), 1975) in order to maintain an equivalence--- relation. --- +-- relation.+-- -- This implementation is a port of the /union-find/ package using the -- ST monad transformer (instead of the IO monad). --@@ -39,7 +39,7 @@ --------------------------------------------------------------------------------  module Data.Equivalence.STT-  ( +  (    -- * Equivalence Relation     Equiv   , Class@@ -61,15 +61,15 @@  import Control.Monad.ST.Trans import Control.Monad-import Control.Applicative  import Data.Maybe  import Data.Map (Map) import qualified Data.Map as Map -newtype Class s c a = Class (STRef s (Entry s c a))+{-| Abstract representation of an equivalence class. -} +newtype Class s c a = Class (STRef s (Entry s c a))  {-| This type represents a reference to an entry in the tree data structure. An entry of type 'Entry' @s c a@ lives in the state space@@ -102,32 +102,32 @@ descriptors of type @c@ and has elements of type @a@. -}  data Equiv s c a = Equiv {-      -- | maps elements to their entry in the tree data structure-      entries :: Entries s c a, -      -- | constructs an equivalence class descriptor for a singleton class+      -- | Maps elements to their entry in the tree data structure.+      entries :: Entries s c a,+      -- | Constructs an equivalence class descriptor for a singleton class.       singleDesc :: a -> c,-      -- | combines the equivalence class descriptor of two classes+      -- | Combines the equivalence class descriptor of two classes       --   which are meant to be combined.       combDesc :: c -> c -> c       }  {-| This function constructs the initial data structure for-maintaining an equivalence relation. That is it represents, the fines+maintaining an equivalence relation. That is, it represents the finest (or least) equivalence class (of the set of all elements of type @a@). The arguments are used to maintain equivalence class descriptors. -} -leastEquiv :: (Monad m, Applicative m)-           => (a -> 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.-           -> STT s m (Equiv s c a)-leastEquiv mk com = do +leastEquiv+  :: (Monad m, Applicative m)+  => (a -> 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.+  -> STT s m (Equiv s c a)+leastEquiv mk com = do   es <- newSTRef Map.empty   return Equiv {entries = es, singleDesc = mk, combDesc = com}  - {-| This function returns the representative entry of the argument's equivalence class (i.e. the root of its tree) or @Nothing@ if it is the representative itself.@@ -182,8 +182,8 @@                 return en'               else return (fromMaybe en mrepr)     else return (fromMaybe entry mrepr)-   + {-| This function constructs a new (root) entry containing the given entry's value, inserts it into the lookup table (thereby removing any existing entry). -}@@ -216,11 +216,11 @@ contained in. -}  getClass :: (Monad m, Applicative m, Ord a) => Equiv s c a -> a -> STT s m (Class s c a)-getClass eq v = do +getClass eq v = do   en <- (getEntry' eq v)   liftM Class $ newSTRef en-   + getEntry' :: (Monad m, Applicative m, Ord a) => Equiv s c a -> a -> STT s m (Entry s c a) getEntry' eq v = do   mentry <- getEntry eq v@@ -247,7 +247,7 @@ equivalence class -}  equateEntry :: (Monad m, Applicative m, Ord a) => Equiv s c a -> Entry s c a -> Entry s c a -> STT s m (Entry s c a)-equateEntry Equiv {combDesc = mkDesc} repx@(Entry rx) repy@(Entry ry) = +equateEntry Equiv {combDesc = mkDesc} repx@(Entry rx) repy@(Entry ry) =   if (rx /= ry) then do     dx <- readSTRef rx     dy <- readSTRef ry@@ -368,7 +368,7 @@   {-| This function removes the given equivalence class. If the-equivalence class does not exists anymore @False@ is returned;+equivalence class does not exist anymore, @False@ is returned; otherwise @True@. -}  remove :: (Monad m, Applicative m, Ord a) => Equiv s c a -> Class s c a -> STT s m Bool@@ -380,10 +380,10 @@         men <- getEntry eq v         case men of           Nothing -> return False-          Just en -> do      +          Just en -> do             writeSTRef p en             (mentry,del) <- representative' en-            if del +            if del               then return False               else removeEntry (fromMaybe en mentry)                    >> return True@@ -401,7 +401,7 @@     Nothing -> return False     Just entry -> do       (mentry, del) <- representative' entry-      if del +      if del         then return False         else removeEntry (fromMaybe entry mentry)              >> return True

@@ -10,6 +10,7 @@ import Control.Monad import Data.Set (Set) import qualified Data.Set as Set+import System.Exit   @@ -108,7 +109,7 @@   cx <- getClass x   remove cx   allM check l-      where check e = liftM (== Set.singleton e) $ getClass e >>= desc +      where check e = liftM (== Set.singleton e) $ getClass e >>= desc  prop_removeClass' x y l1' l2' = runInt $ do   let l1 = x:l1'@@ -157,5 +158,8 @@   return []-main = $quickCheckAll +main :: IO ()+main = do+  success <- $quickCheckAll+  if success then exitSuccess else exitFailure