[Haskell-cafe] Monad instance for Data.Set, again
Henning Thielemann
lemming at henning-thielemann.de
Mon Mar 24 15:47:27 EDT 2008
The blog article
http://www.randomhacks.net/articles/2007/03/15/data-set-monad-haskell-macros
describes a variant of the Monad class which allows to restrict the type
of the monadic result, in order to be able to make Data.Set an instance of
Monad (requiring Ord constraint for the monadic result). The same problem
arises for container data structures with restricted element types, where
the element type restriction depends on the implementation of the
container structure (such as UArray). It would be cumbersome to have
several class parts, even more, type constraints in type signatures may
reveal implementation details. E.g. constraint (Container c x y z) might
be needed for a 'zipWith' function, whereas (Container c y x z) is needed
if you use 'zipWith' with swapped arguments.
Here is another approach that looks tempting, but unfortunately does not
work, and I wonder whether this can be made working.
module RestrictedMonad where
import Data.Set(Set)
import qualified Data.Set as Set
class AssociatedMonad m a where
class RestrictedMonad m where
return :: AssociatedMonad m a => a -> m a
(>>=) :: (AssociatedMonad m a, AssociatedMonad m b) => m a -> (a -> m b) -> m b
instance (Ord a) => AssociatedMonad Set a where
instance RestrictedMonad Set where
return = Set.singleton
x >>= f = Set.unions (map f (Set.toList x))
GHC says:
RestrictedMonad.hs:21:13:
Could not deduce (Ord b)
from the context (RestrictedMonad Set,
AssociatedMonad Set a,
AssociatedMonad Set b)
arising from use of `Data.Set.unions' at RestrictedMonad.hs:21:13-22
Probable fix: add (Ord b) to the class or instance method `RestrictedMonad.>>='
In the definition of `>>=':
>>= x f = Data.Set.unions (map f (Data.Set.toList x))
In the definition for method `RestrictedMonad.>>='
In the instance declaration for `RestrictedMonad Set'
More information about the Haskell-Cafe
mailing list