An example code for "Making monads" in "Learn You a Haskell for Great Good!".

Prob.hs

-- usage: joinProb $ fmap sort flipThree
--        joinProb $ fmap (all (==Tails)) flipThree

import Control.Monad
import Data.Function (on)
import Data.List (groupBy, sortBy)
import Data.Ord (comparing)
import Data.Ratio

newtype Prob a = Prob { getProb :: [(a, Rational)] } deriving Show

instance Functor Prob where
  fmap f (Prob xs) = Prob $ map (\(x, p) -> (f x, p)) xs

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

data Coin = Heads | Tails deriving (Show, Eq, Ord)

coin :: Prob Coin
coin = Prob [(Heads,1%2), (Tails,1%2)]

loadedCoin :: Prob Coin
loadedCoin = Prob [(Heads,1%10), (Tails,9%10)]

flipThree :: Prob [Coin]
flipThree = do
  a <- coin
  b <- coin
  c <- loadedCoin
  return [a, b, c]

-- example for the exercise is in the below:

joinProb :: (Eq a, Ord a) => Prob a -> Prob a
joinProb (Prob xs) =
  Prob [(fst $ head ys, sum $ map snd ys) | ys <- groupProb . sortProb $ xs]

sortProb :: (Ord a) => [(a, Rational)] -> [(a, Rational)]
sortProb = sortBy (comparing fst)

groupProb :: (Eq a) => [(a, Rational)] -> [[(a, Rational)]]
groupProb = groupBy ((==) `on` fst)

ghci> joinProb $ fmap sort flipThree
Prob {getProb = [([Heads,Heads,Heads],1 % 40),([Heads,Heads,Tails],11 % 40),([Heads,Tails,Tails],19 % 40),([Tails,Tails,Tails],9 % 40)]}

ghci> joinProb $ fmap (all (==Tails)) flipThree
Prob {getProb = [(False,31 % 40),(True,9 % 40)]}

Is there a way to incorporate joinProb into flatten so that >>= would join probabilities by itself?