haskell making monad

MakingMonad.hs

import Test.HUnit
import Control.Monad
import Data.Ratio
import Data.List (all)

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

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


thisSituation :: Prob (Prob Char)
thisSituation = Prob [(Prob [('a', 1 % 2), ('b', 1 % 2)], 1 % 4 ),
                      (Prob [('c', 1 % 2), ('d', 1 % 2)], 3 % 4)]

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)

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

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

flipThree :: Prob Bool
flipThree = do
  a <- coin
  b <- coin
  c <- loadedCoin
  return (all (== Tails) [a, b, c])


tests :: Test
tests =
  let f = (+1) . (*100)
      g = (\ x -> return $ succ x) <=< (\ x -> return $  x + 100)
      h = foldr (.) id [(+8), (*100), (+1)]
  in
  "test" ~:
  ["test1" ~: (f 4) ~?= 401,
   "test2" ~: (Just 4 >>= g) ~?= Just 105,
   "test3" ~: (h 1) ~?= 208,
   "test4" ~: (fmap negate $ (Prob [(3, 1 % 2),(5, 1 % 4), (9, 1 % 4)] :: Prob Int))
   ~?= Prob [(-3, 1 % 2),(-5, 1 % 4), (-9, 1 % 4)]
  ]


main :: IO ()
main = do
  runTestTT $ TestList [tests]
  return ()