FizzBuzz implementation using free monads, just because.

FreezBuzz.hs

module Main where

import Control.Monad.Free

data FizzBuzz a
  = Fizz a
  | Buzz a
  | FizzBuzz a
  | Num Integer a
  deriving (Eq, Ord, Show)

instance Functor FizzBuzz where
  fmap f (Fizz a) = Fizz (f a)
  fmap f (Buzz a) = Buzz (f a)
  fmap f (FizzBuzz a) = FizzBuzz (f a)
  fmap f (Num i a) = Num i (f a)

type FizzBuzzF = Free FizzBuzz

fizz, buzz, fizzbuzz :: FizzBuzzF ()
fizz = liftF (Fizz ())
buzz = liftF (Buzz ())
fizzbuzz = liftF (FizzBuzz ())

num :: Integer -> FizzBuzzF ()
num n = liftF $ Num n ()

integerToFB :: Integer -> FizzBuzzF ()
integerToFB n
  | n `mod` 3 == 0 && n `mod` 5 == 0 = fizzbuzz
  | n `mod` 3 == 0 = fizz
  | n `mod` 5 == 0 = buzz
  | otherwise = num n

constructFB :: Integer -> FizzBuzzF ()
constructFB = go 0
  where go n m
          | n == m + 1 = Pure ()
          | otherwise = integerToFB n >> go (n + 1) m

infiniteFB :: Integer -> FizzBuzzF ()
infiniteFB start = integerToFB start >> infiniteFB (start + 1)

-- | Natural transformation from FizzBuzzF ~> IO
interpretFBIO :: FizzBuzzF () -> IO ()
interpretFBIO (Pure ()) = return ()
interpretFBIO (Free (Fizz a)) = putStrLn "Fizz" >> interpretFBIO a
interpretFBIO (Free (Buzz a)) = putStrLn "Buzz" >> interpretFBIO a
interpretFBIO (Free (FizzBuzz a)) = putStrLn "FizzBuzz" >> interpretFBIO a
interpretFBIO (Free (Num n a)) = print n >> interpretFBIO a

-- | Natural transformation from FizzBuzzF ~> []
interpretFBList :: FizzBuzzF () -> [String]
interpretFBList = flip interpretFBList' []

interpretFBList' :: FizzBuzzF () -> [String] -> [String]
interpretFBList' (Pure ()) acc = acc
interpretFBList' (Free (Fizz a)) acc = interpretFBList' a (acc ++ ["Fizz"])
interpretFBList' (Free (Buzz a)) acc = interpretFBList' a (acc ++ ["Buzz"])
interpretFBList' (Free (FizzBuzz a)) acc = interpretFBList' a (acc ++ ["FizzBuzz"])
interpretFBList' (Free (Num n a)) acc = interpretFBList' a (acc ++ [show n])


main :: IO ()
main = interpretFBIO (constructFB 100)