haskell writer

monad2.hs

import Test.HUnit
import System.IO
import Control.Monad.Writer
import Data.Monoid
import Control.Monad.Instances

-- isBigGang :: Int -> Bool
-- isBigGang x = x > 9

isBigGang :: Int -> (Bool, String)
isBigGang x = (x > 9, "Compared gang size 9.")

-- applyLog :: (a, String) -> (a -> (b, String)) -> (b, String)
-- applyLog (x, log) f = let (y, newLog) = f x in
--                        (y, log ++ newLog)

applyLog :: (Monoid m) =>  (a, m) -> (a -> (b, m)) -> (b, m)
applyLog (x, log_) f = let (y, newLog) = f x in
                       (y, log_ `mappend` newLog)

type Food = String
type Price = Sum Int

addDrink :: Food -> (Food, Price)
addDrink "beans" = ("milk", Sum 25)
addDrink "jerky" = ("whisky", Sum 99)
addDrink _ = ("beer", Sum 30)

logNumber :: Int -> Writer [String] Int
logNumber x = writer (x, ["Got number: " ++ show x])

multWithLog :: Writer [String] Int
multWithLog = do
  a <- logNumber 3
  b <- logNumber 5
  tell ["Gonna multiply these two"]
  return (a * b)

gcd' :: Int -> Int -> Writer [String] Int
gcd' a b
  | b == 0 = do
      tell ["Finished with" ++ show a]
      return a
  | otherwise = do
      tell [show a ++ " mod " ++ show b ++ " = " ++ show (a `mod` b)]
      gcd' b (a `mod` b)

newtype DiffList a = DiffList { getDiffList :: [a] -> [a] }

toDiffList :: [a] -> DiffList a
toDiffList xs = DiffList (xs ++ )

fromDiffList :: DiffList a -> [a]
fromDiffList (DiffList f) = f []

instance Monoid (DiffList a) where
  mempty = DiffList (\ xs -> [] ++ xs)
  (DiffList f) `mappend` (DiffList g) = DiffList (\ xs -> f (g xs))

gcdReverse :: Int -> Int -> Writer (DiffList String) Int
gcdReverse a b
  | b == 0 = do
      tell $ toDiffList ["Finished with " ++ show a]
      return a
  | otherwise = do
      result <- gcdReverse b (a `mod` b)
      tell $ toDiffList [show a ++ " mod " ++ show b ++ " = " ++ show (a `mod` b)]
      return result

finalCountDown :: Int -> Writer (DiffList String) ()
finalCountDown 0 = do
  tell $ toDiffList ["0"]
finalCountDown x = do
  finalCountDown $ pred x
  tell $ toDiffList [show x]

addStuff :: Int -> Int
addStuff = do
  a <- (*2)
  b <- (+10)
  return (a + b)

tests = ["monoidTest" ~: (getSum $ Sum 3 `mappend` Sum 9) ~?= 12,
         "addDrink-beans" ~: ("beans", Sum 10) `applyLog` addDrink ~?= ("milk", Sum 35),
         "addDrink-jerky" ~: ("jerky", Sum 25) `applyLog` addDrink ~?= ("whisky", Sum 124),
         "addDrink-other" ~: ("chokolate", Sum 10) `applyLog` addDrink ~?= ("beer", Sum 40),
         "addDrink" ~: ("dogmeat", Sum 3) `applyLog` addDrink `applyLog` addDrink ~?= ("beer", Sum 63),
         "Writer1" ~: (runWriter $ (return 3 :: Writer String Int)) ~?= (3, ""),
         "Writer2" ~: (runWriter $ (return 3 :: Writer (Sum Int) Int)) ~?= (3, Sum 0),
         "Writer3" ~: (runWriter $ (return 3 :: Writer (Product Int) Int)) ~?= (3, Product 1),
         "multWithLog" ~: (runWriter $ multWithLog) ~?= (15, ["Got number: 3", "Got number: 5", "Gonna multiply these two"]),
         "gcd'" ~: (fst . runWriter $ gcd' 8 3)  ~?= 1,
         "diffList" ~: (fromDiffList $ toDiffList [1..4] `mappend` toDiffList [1..3]) ~?= [1,2,3,4,1,2,3],
         "addStuff" ~: addStuff 3 ~?= 19
        ]

runTests = do
  runTestText (putTextToHandle stderr False) $ TestList tests