Bench.hs

module Bench( -- sequential benchmarks
              seq
              -- parallel benchmarks
            , par
              -- distributed benhcmarks
            , dist
              -- miscellaneous
            , main
            , getAnswer
            ) where

import           Control.Distributed.Process
import qualified Control.Distributed.Process.Backend.SimpleLocalnet as SLN
import           Control.Distributed.Process.Node
import           Prelude                                                    hiding (seq)
import           Network.Transport.TCP
import           System.Environment                                                (getArgs)

import           MasterWorker
import           Utils

type Result = ([Vertex], [MasterStats])
--type Result = String

-- | Gets the result of the calculation
result :: ([Vertex], [MasterStats]) -> Result
result = id
--result = sz . snd

-- | Gets the size (as a string) from the result
getAnswer :: Result -> String
getAnswer = sz . snd
--getAnswer = id

-----------------------------------------------------------------------------
-- benchmarks, parametrised by
-- * list of Generators
-- * size of space N > 0
-- * number of processors P > 0 (per node)
-- * list of Workers (in short node name format 'name@host')
-- sequential orbit computation
seq :: (Vertex -> GenClos) -> Vertex -> Process Result
seq generators n =
    orbit (generators n) [0] (Seq (2 * n))
      >>= return . result

-- parallel orbit computation (w/ False does not spawn image computation)
par :: Bool -> (Vertex -> GenClos) -> Vertex -> Int -> Process Result
par iwp generators n p =
     orbit (generators n) [0]
       (Par (JustOne (p, ((2 * n) `div` p) + 1, 0, iwp)))
       >>= return . result

-- distributed orbit computation (w/ False does not spawn image computation)
dist :: Bool -> (Vertex -> GenClos) -> Vertex -> Int -> [NodeId] -> Process Result
dist iwp generators n p workers =
    orbit (generators n) [0]
      (Par (Many [(h, p, (2 * n) `div` (w * p) + 1, 0, iwp) | h <- workers]))
      >>= return . result
  where w = length workers

sz :: [MasterStats] -> String
sz [] = "false"
sz (mainStats : _) =
    case "size" `lookup` mainStats of
        Nothing -> "false"
        Just s  -> "{size," ++ s ++ "}"

select_par_bench :: String -> (Vertex -> GenClos) -> Vertex -> Int -> Process Result
select_par_bench "True" = par True
select_par_bench "False" = par False
select_par_bench _ = error "Invalid IWP Flag"

select_dist_bench :: String -> (Vertex -> GenClos) -> Vertex -> Int -> [NodeId] -> Process Result
select_dist_bench "True" = dist True
select_dist_bench "False" = dist False
select_dist_bench _ = error "Invalid IWP Flag"

bench_args :: String -> (Vertex -> GenClos, Int)
bench_args "short" = (gg13, 15000)
bench_args "intermediate" = (gg124, 40000)
bench_args "long" = (gg1245, 60000)
bench_args _ = error "Invalid Version"

main :: IO ()
main = do
    args <- getArgs
    case args of
        -- Sequential Orbit
        ["seq", version, host, port] -> do
            let (gnrt, n) = bench_args version
            Right t <- createTransport host port defaultTCPParameters
            node <- newLocalNode t rtable
            runProcess node $ do
                res <- seq gnrt n
                liftIO $ print res
        -- Parallel Orbit
        ["par", iwp, version, w, host, port] -> do
            let (gnrt, n) = bench_args version
            Right t <- createTransport host port defaultTCPParameters
            node <- newLocalNode t rtable
            runProcess node $ do
                let bench = select_par_bench iwp
                res <- bench gnrt n (read w :: Int)
                liftIO $ print res
        -- Distributed Orbit
        ["dist", "master", iwp, version, w, host, port] -> do
            let (gnrt, n) = bench_args version
            b <- SLN.initializeBackend host port rtable
            print $ "Starting master @ " ++ host ++ ":" ++ port ++ " with slaves:"
            SLN.startMaster b $ \slaves -> do
                let bench = select_dist_bench iwp
                liftIO $ print $ "  " ++ show slaves
                res <- bench gnrt n (read w :: Int) slaves
                SLN.terminateAllSlaves b
                liftIO $ print res
        ["dist", "slave", host, port] -> do
            b <- SLN.initializeBackend host port rtable
            print $ "Starting slave @ " ++ host ++ ":" ++ port
            SLN.startSlave b
        -- Invalid configuration
        _ -> do
            putStrLn "Usage:"
            putStrLn "  Sequential Version"
            putStrLn "    ./orbit seq [short|intermediate|long] host port"
            putStrLn "  Paraller Version"
            putStrLn "    ./orbit par [True|False] [short|intermediate|long] nWorkers host port"
            putStrLn "  Distributed Version"
            putStrLn "  - Master Node:"
            putStrLn "    ./orbit dist master [True|False] [short|intermediate|long] nWorkers host port"
            putStrLn "  - Slave Node:"
            putStrLn "    ./orbit dist slave host port"
    where rtable :: RemoteTable
          rtable = MasterWorker.__remoteTable initRemoteTable

{-
main :: IO ()
main = do
    Right t1 <- createTransport "127.0.0.1" "5050" defaultTCPParameters
    node1 <- newLocalNode t1 rtable

    Right t2 <- createTransport "127.0.0.1" "5051" defaultTCPParameters
    node2 <- newLocalNode t2 rtable

    Right t3 <- createTransport "127.0.0.1" "5052" defaultTCPParameters
    node3 <- newLocalNode t3 rtable

    runProcess node1 $ do
        res <- par_seq gg1245 2512 32 --[localNodeId node1, localNodeId node2, localNodeId node3]
        liftIO $ print res
  where rtable :: RemoteTable
        rtable = MasterWorker.__remoteTable initRemoteTable
-}

{-
import qualified Control.Distributed.Process.Backend.SimpleLocalnet as SLN
import           System.Environment                                        (getArgs)

    args <- getArgs

    case args of
        ["master", host, port] -> do
            b <- SLN.initializeBackend host port rtable
            print $ "Starting master @ " ++ host ++ ":" ++ port ++ " with slaves:"
            SLN.startMaster b $ \slaves -> do
                liftIO $ print $ "  " ++ show slaves
                res <- dist gg13 11 2 slaves
                liftIO $ print res
        ["slave", host, port] -> do
            b <- SLN.initializeBackend host port rtable
            print $ "Starting slave @ " ++ host ++ ":" ++ port
            SLN.startSlave b
-}
    -- 1 second wait. Otherwise the main thread can terminate before
    -- our messages reach the logging process or get flushed to stdio
    --threadDelay (1 * 1000000)