-- | A demonstration of concurrent vs serialized fanout. A single
-- input is fed to two workers who both perform a CPU intensive
-- task. The concurrent version is approximately twice as fast when
-- two CPU cores are available.
import Control.Monad (when)
import Data.List (sort)
import Data.Machine.Concurrent
import qualified Data.Machine.Fanout as M
import Data.Time.Clock
import Text.Printf

-- A slow Fibonacci sequence can occupy the CPU
fib :: Int -> Int
fib 0 = 0
fib 1 = 1
fib n = fib (n-1) + fib (n-2)

-- Build a worker process with the given name.
worker :: String -> ProcessT IO Int [String]
worker name = repeatedly $ do
                seed <- await
                let x = fib seed
                x `seq` yield $ [name++": "++show seed++" => "++show x]

main :: IO ()
main = do t1 <- getCurrentTime
          [responses] <- runT $ supply [42] (fanout workers) ~> taking 1
          t2 <- getCurrentTime
          [responses'] <- runT $ supply [42] (M.fanout workers) ~> taking 1
          t3 <- getCurrentTime
          when (map sort responses /= map sort responses') $
            putStrLn "Concurrent and serial workers gave different results!"
          let dt = realToFrac (diffUTCTime t2 t1) :: Double
              dt' = realToFrac (diffUTCTime t3 t2) :: Double
          putStrLn $ "Concurrent vs. serial ("++show responses++"): "
          putStrLn $ "  " ++ printf "%0.1fs vs %0.1fs" dt dt'
  where workers = [ worker "alpha"
                  , worker "beta" ]