FizzBuzz.hs

{-# LANGUAGE DeriveFunctor, TemplateHaskell, FlexibleContexts #-}

module Main where

import Control.Monad.Free (MonadFree, Free (Free, Pure), liftF)
import Control.Monad.Free.TH (makeFree)
import Control.Monad (void, forM_)

data Cmd m k
  = Output m k
  | Skip k
  | Halt
  deriving (Functor)

makeFree ''Cmd

type Prog k = Free (Cmd String) k

type Context = Integer -> Prog () -> Prog ()

run :: Prog () -> IO ()
run (Free (Output m k)) = putStr m >> run k
run (Free (Skip k)) = run k
run (Free Halt) = void $ putStrLn ""
run (Pure ()) = return ()

base :: Context
base n k = k >> output (show n) >> halt

rule :: Integer -> String -> Context
rule d m n k | n `mod` d == 0 = output m >> k >> halt
             | otherwise = k

(|->) :: Context -> Context -> Context
f |-> g = \n k -> f n (g n k)

prog :: Context
prog
  = base
  |-> rule 3 "Fizz"
  |-> rule 5 "Buzz"

fizzbuzz :: Integer -> IO ()
fizzbuzz = run . flip prog skip

main :: IO ()
main = forM_ [1..20] fizzbuzz