[Haskell-cafe] Monad instance for Data.Set, again
Wolfgang Jeltsch
g9ks157k at acme.softbase.org
Thu Mar 27 20:05:59 EDT 2008
Am Montag, 24. März 2008 20:47 schrieb Henning Thielemann:
> […]
> 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))
> […]
The problem is that while an expression of type
(AssociatedMonad Set a, AssociatedMonad Set b) =>
Set a -> (a -> Set b) -> Set b
has type
(Ord a, Ord b) => Set a -> (a -> Set b) -> Set b,
the opposite doesn’t hold.
Your AssociatedMonad class doesn’t provide you any Ord dictionary which you
need in order to use the Set functions. The instance declaration
instance (Ord a) => AssociatedMonad Set a
says how to construct an AssociatedMonad dictionary from an Ord dictionary but
not the other way round.
But it is possible to give a construction of an Ord dictionary from an
AssociatedMonad dictionary. See the attached code. It works like a
charm. :-)
Best wishes,
Wolfgang
-------------- next part --------------
{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-}
import Data.Set (Set)
import qualified Data.Set as Set
class Suitable monad val where
data Constraints monad val :: *
constraints :: monad val -> Constraints monad val
class NewMonad monad where
newReturn :: (Suitable monad val) => val -> monad val
newBind :: (Suitable monad val, Suitable monad val') =>
monad val -> (val -> monad val') -> monad val'
instance (Ord val) => Suitable Set val where
data Constraints Set val = Ord val => SetConstraints
constraints _ = SetConstraints
instance NewMonad Set where
newReturn = Set.singleton
newBind set1 set2Gen = let
set2Constraints = constraints result
result = case set2Constraints of
SetConstraints -> Set.unions $
map set2Gen $
Set.toList set1
in result
More information about the Haskell-Cafe
mailing list