Specializing bind for monads over special typeclasses in Haskell

Question

In the second last chapter For a Few Monads More of the very nice tutorial \"Learn You a Haskell for a Great Good\" the author defines the following monad:

impor         


        

Answer 1

Thanks to Ptharien's Flame's answer (please upvote it!) I managed to adapt the example monad from "Learn You a Haskell for a Great Good" running. As I had to google some details (being a Haskell-newbie) here is what I did at the end (the example flipThree in "Learn..." gives now [(True,9 % 40), (False,31 % 40)]):

file Control/Restricted.hs (to shorten it I removed RApplicative, RMonadPlus etc):

{-# 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

file 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 []