感谢 Ptharien 的 Flame 的回答(请点赞!)我设法改编了“Learn You a Haskell for a Great Good”运行的示例 monad。因为我不得不在谷歌上搜索一些细节(作为一个 Haskell 新手),所以这就是我最后所做的(“Learn ...”中的示例 FlipThree 现在给出 [(True,9 % 40), (False,31 % 40 )]):
文件 Control/Restricted.hs(为了缩短它,我删除了 RApplicative、RMonadPlus 等):
{-# LANGUAGE ConstraintKinds, TypeFamilies, KindSignatures, FlexibleContexts, UndecidableInstances #-}
module Control.Restricted (RFunctor(..),
RMonad(..)) where
import Prelude hiding (Functor(..), Monad(..))
import Data.Foldable (Foldable(foldMap))
import Data.Monoid
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 m) => RMonad m where
return :: (Restriction m a) => a -> m a
(>>=) :: (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
文件 Prob.hs:
{-# LANGUAGE ConstraintKinds, TypeFamilies, RebindableSyntax, FlexibleContexts #-}
import Data.Ratio
import Control.Restricted
import Prelude hiding (Functor(..), Monad(..))
import Control.Arrow (first, second)
import Data.List (all)
newtype Prob a = Prob { getProb :: [(a, Rational)] } deriving Show
instance RFunctor Prob where
type Restriction Prob a = (Eq a)
fmap f (Prob as) = Prob $ map (first f) as
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
compress :: Eq a => Prob a -> Prob a
compress (Prob as) = Prob $ foldr f [] as
where f a [] = [a]
f (a, p) ((b, q):bs) | a == b = (a, p+q):bs
| otherwise = (b, q):f (a, p) bs
instance Eq a => Eq (Prob a) where
(==) (Prob as) (Prob bs) = all (`elem` bs) as
instance RMonad Prob where
return x = Prob [(x, 1%1)]
m >>= f = compress $ flatten (fmap f m)
fail _ = Prob []