feed-gipeda-0.1.0.3: src/FeedGipeda.hs

{-| The API part of @feed-gipeda@. The console client is just a thin wrapper
    around this.
-}

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                                         (fromMaybe,
                                                                     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


{-| The parameters correspond exactly to the command line parameters, to
    you should read the @--help@ message for more thorough documentation.

    @feedGipeda@ determines the appropriate mode of operation (e.g. watching or one-shot).
    It also works as master or slave node, depending on which endpoints are given.
    Lastly, @verbose@ will lead to more debug output.
-}
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 ->
      -- Just perform a syntax check on the given configFile
      Config.checkFile (configFile paths) >>= maybe exitSuccess error
    Build mode timeout -> 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 timeout)
                liftIO (finalize result)

            let
              onNewCommit :: (String -> IO ()) -> String -> Repo -> SHA -> IO ()
              onNewCommit finalize benchmarkScript repo commit =
                writeChan tasks (finalize . fromMaybe "", benchmarkScript, repo, commit)

            liftIO (Master.checkForNewCommits paths deployment mode onNewCommit)