module FeedGipeda
( Endpoint (..)
, feedGipeda
, module FeedGipeda.Types
) where
import Control.Arrow (second)
import Control.Concurrent (forkIO)
import Control.Concurrent.Chan (Chan,
newChan,
readChan,
writeChan)
import Control.Distributed.Process (Process,
RemoteTable,
liftIO,
say,
spawnLocal)
import qualified Control.Distributed.Process.Backend.SimpleLocalnet as SLN
import Control.Distributed.Process.Node (initRemoteTable,
runProcess)
import Control.Logging as Logging
import Control.Monad (forever,
void, when)
import Data.List (elemIndex)
import Data.Maybe (isJust)
import Data.Set (Set)
import Data.Time (NominalDiffTime)
import qualified FeedGipeda.Config as Config
import FeedGipeda.GitShell (SHA)
import qualified FeedGipeda.Master as Master
import FeedGipeda.Repo (Repo)
import qualified FeedGipeda.TaskQueue as TaskQueue
import qualified FeedGipeda.THGenerated as THGenerated
import FeedGipeda.Types
import Network.URI (parseURI)
import System.Directory (getAppUserDataDirectory)
import System.Exit (exitSuccess)
import System.FilePath ((</>))
remoteTable :: RemoteTable
remoteTable =
THGenerated.__remoteTable initRemoteTable
feedGipeda
:: Paths
-> Command
-> Deployment
-> ProcessRole
-> Verbosity
-> IO ()
feedGipeda paths cmd deployment role_ verbosity = do
case verbosity of
Verbose -> Logging.setLogLevel Logging.LevelDebug
NotVerbose -> Logging.setLogLevel Logging.LevelWarn
case cmd of
Check ->
Config.checkFile (configFile paths) >>= maybe exitSuccess error
Build mode -> do
case slaveEndpoint role_ of
Just (Endpoint host port) -> do
let
run = if isBoth role_ then void . forkIO else id
run $ do
backend <- SLN.initializeBackend host (show port) remoteTable
TaskQueue.work backend
_ -> return ()
case masterEndpoint role_ of
Nothing -> return ()
Just (Endpoint host port) -> do
backend <- SLN.initializeBackend host (show port) remoteTable
node <- SLN.newLocalNode backend
tasks <- newChan
runProcess node $ do
taskQueue <- TaskQueue.start backend
spawnLocal $ forever $ do
(finalize, benchmarkScript, repo, commit) <- liftIO (readChan tasks)
spawnLocal $ do
result <- TaskQueue.execute taskQueue
THGenerated.stringDict
(THGenerated.benchmarkClosure benchmarkScript repo commit)
liftIO (finalize result)
let
onNewCommit :: (String -> IO ()) -> String -> Repo -> SHA -> IO ()
onNewCommit finalize benchmarkScript repo commit =
writeChan tasks (finalize, benchmarkScript, repo, commit)
liftIO (Master.checkForNewCommits paths deployment mode onNewCommit)