专门针对Haskell中特殊类型类的monad进行绑定

Question

在第二章最后一章为少数Monads更多非常好的教程"为了一个伟大的好事学习你一个Haskell",作者定义了以下monad:

import Data.Ratio  
newtype Prob a = Prob { getProb :: [(a,Rational)] } deriving Show
flatten :: Prob (Prob a) -> Prob a  
flatten (Prob xs) = Prob $ concat $ map multAll xs  
  where multAll (Prob innerxs,p) = map (\(x,r) -> (x,p*r)) innerxs
instance Monad Prob where  
  return x = Prob [(x,1%1)]  
  m >>= f = flatten (fmap f m)  
  fail _ = Prob []

我想知道在Haskell中是否有可能专门化绑定运算符">> ="以防monad中的值属于像Eq这样的特殊类型类,因为我想将属于同一值的所有概率相加.

Answer 1

这称为"受限制的monad",您可以这样定义:

{-# LANGUAGE ConstraintKinds, TypeFamilies, KindSignatures, FlexibleContexts, UndecidableInstances #-}
module Control.Restricted (RFunctor(..),
                           RApplicative(..),
                           RMonad(..),
                           RMonadPlus(..),) where
import Prelude hiding (Functor(..), Monad(..))
import Data.Foldable (Foldable(foldMap))
import GHC.Exts (Constraint)

class RFunctor f where
    type Restriction f a :: Constraint
    fmap :: (Restriction f a, Restriction f b) => (a -> b) -> f a -> f b

class (RFunctor f) => RApplicative f where
    pure :: (Restriction f a) => a -> f a
    (<*>) :: (Restriction f a, Restriction f b) => f (a -> b) -> f a -> f b

class (RApplicative m) => RMonad m where
    (>>=) :: (Restriction m a, Restriction m b) => m a -> (a -> m b) -> m b
    (>>) :: (Restriction m a, Restriction m b)  => m a -> m b ->  m b
    a >> b = a >>= \_ -> b
    join :: (Restriction m a, Restriction m (m a)) => m (m a) -> m a
    join a = a >>= id
    fail :: (Restriction m a) => String -> m a
    fail = error

return :: (RMonad m, Restriction m a) => a -> m a
return = pure

class (RMonad m) => RMonadPlus m where
    mplus :: (Restriction m a) => m a -> m a -> m a
    mzero :: (Restriction m a) => m a
    msum :: (Restriction m a, Foldable t) => t (m a) -> m a
    msum t = getRMonadPlusMonoid $ foldMap RMonadPlusMonoid t

data RMonadPlusMonoid m a = RMonadPlusMonoid { getRMonadPlusMonoid :: m a }

instance (RMonadPlus m, Restriction m a) => Monoid (RMonadPlusMonoid m a) where
    mappend (RMonadPlusMonoid x) (RMonadPlusMonoid y) = RMonadPlusMonoid $ mplus x y
    mempty = RMonadPlusMonoid mzero
    mconcat t = RMonadPlusMonoid . msum $ map getRMonadPlusMonoid t

guard :: (RMonadPlus m, Restriction m a) => Bool -> m ()
guard p = if p then return () else mzero

要使用受限制的monad,您需要像这样开始文件:

{-# LANGUAGE ConstraintKinds, TypeFamilies, RebindableSyntax #-}
module {- module line -} where
import Prelude hiding (Functor(..), Monad(..))
import Control.Restricted