beala · August 29, 2015 14:15 · beala · Feb 12, 2015
diff --git a/fizzbuzz.hs b/fizzbuzz.hs
 {-# LANGUAGE DeriveFunctor #-}

 import Control.Monad.Free
 import Data.List

 data FizzBuzz f a = FizzBuzz (Factor f) String a deriving Functor
 newtype Factor a = Factor a

 -- A fizz buzz action that produces a String if the Integral is a factor.
 fizzbuzz :: (Show a, Integral a) => a -> String -> Free (FizzBuzz a) ()
 fizzbuzz fa message = liftF (FizzBuzz (Factor fa) message ())

 -- Run a FizzBuzz program over a single Integral.
 runFizzBuzz :: (Show a, Integral a) => a -> Free (FizzBuzz a) b -> String
 runFizzBuzz i prog = runFizzBuzz_ i [] prog

 runFizzBuzz_ :: (Show a, Integral a) => a -> [(Factor a, String)] -> Free (FizzBuzz a) b -> String
 runFizzBuzz_ num factors (Free (FizzBuzz fa msg n)) =
    runFizzBuzz_ num ((fa, msg):factors) n
 runFizzBuzz_ num factors (Pure _) =
    let inOrderFactors = reverse factors
        divisibleFactors = filter (\ (Factor fa, _) -> num `divisibleBy` fa) inOrderFactors
        messages = fmap (\(_, msg) -> msg) divisibleFactors in
    if (length messages > 0) then concat messages else show num
    where
        n `divisibleBy` m = (n `mod` m) == 0

 -- Run a FizzBuzz program over a range of Integrals.
 runFizzBuzzRange :: (Show a, Integral a) => a -> a -> Free (FizzBuzz a) b -> String
 runFizzBuzzRange start end prog =
    let messages = fmap (\i -> runFizzBuzz i prog) [start..end] in
    intercalate "\n" messages

 program :: Free (FizzBuzz Int) ()
 program = do
    fizzbuzz 5 "Fizz"
    fizzbuzz 3 "Buzz"
    fizzbuzz 2 "Zork"
    fizzbuzz 7 "Bonk"
    fizzbuzz 10 "Bang"

 main :: IO ()
 main = do
    putStrLn $ runFizzBuzzRange 1 100 program
	{-# LANGUAGE DeriveFunctor #-}

	import Control.Monad.Free
	import Data.List

	data FizzBuzz f a = FizzBuzz (Factor f) String a deriving Functor
	newtype Factor a = Factor a

	-- A fizz buzz action that produces a String if the Integral is a factor.
	fizzbuzz :: (Show a, Integral a) => a -> String -> Free (FizzBuzz a) ()
	fizzbuzz fa message = liftF (FizzBuzz (Factor fa) message ())

	-- Run a FizzBuzz program over a single Integral.
	runFizzBuzz :: (Show a, Integral a) => a -> Free (FizzBuzz a) b -> String
	runFizzBuzz i prog = runFizzBuzz_ i [] prog

	runFizzBuzz_ :: (Show a, Integral a) => a -> [(Factor a, String)] -> Free (FizzBuzz a) b -> String
	runFizzBuzz_ num factors (Free (FizzBuzz fa msg n)) =
	runFizzBuzz_ num ((fa, msg):factors) n
	runFizzBuzz_ num factors (Pure _) =
	let inOrderFactors = reverse factors
	divisibleFactors = filter (\ (Factor fa, _) -> num `divisibleBy` fa) inOrderFactors
	messages = fmap (\(_, msg) -> msg) divisibleFactors in
	if (length messages > 0) then concat messages else show num
	where
	n `divisibleBy` m = (n `mod` m) == 0

	-- Run a FizzBuzz program over a range of Integrals.
	runFizzBuzzRange :: (Show a, Integral a) => a -> a -> Free (FizzBuzz a) b -> String
	runFizzBuzzRange start end prog =
	let messages = fmap (\i -> runFizzBuzz i prog) [start..end] in
	intercalate "\n" messages

	program :: Free (FizzBuzz Int) ()
	program = do
	fizzbuzz 5 "Fizz"
	fizzbuzz 3 "Buzz"
	fizzbuzz 2 "Zork"
	fizzbuzz 7 "Bonk"
	fizzbuzz 10 "Bang"

	main :: IO ()
	main = do
	putStrLn $ runFizzBuzzRange 1 100 program