beala/fizzbuzz.hs

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