libjenkins-0.6.0: bench/Concurrency.hs

{-# LANGUAGE OverloadedStrings #-}
-- | Concurrency benchmark
--
-- The benchmark does the folllowing:
--
--   * it asks Jenkins instance for accessible jobs
--
--   * it sends queries to get jobs descriptions
--
--   * it prints all descriptions
--
-- The benchmark can be run sequentially or concurrently
--
-- See @bench/README.md@ for usage instructions
module Main (main) where

import           Control.Lens                  -- lens
import           Data.Aeson.Lens               -- lens-aeson
import           Data.Text (Text)              -- text
import qualified Data.Text as Text             -- text
import           Jenkins.Rest (Jenkins, (-?-), (-=-))
import qualified Jenkins.Rest as Jenkins       -- libjenkins
import           System.Environment (getArgs)  -- base
import           System.Exit (exitFailure)     -- base
import           System.IO (hPutStrLn, stderr) -- base


type Aggregate a b = (a -> Jenkins b) -> [a] -> Jenkins [b]

main :: IO ()
main = do
  m:url:user:token:_ <- getArgs
  ds <- descriptions (aggregate m) $
    Jenkins.defaultMaster
    & Jenkins.url .~ url
    & Jenkins.user .~ Text.pack user
    & Jenkins.apiToken .~ Text.pack token
  case ds of
    Jenkins.Ok ds'      -> mapM_ print ds'
    Jenkins.Disconnect  -> die "disconnect!"
    Jenkins.Exception e -> die (show e)
 where
  die message = do
    hPutStrLn stderr message
    exitFailure

  aggregate :: String -> Aggregate a b
  aggregate "concurrent" = Jenkins.traverse
  aggregate "sequential" = mapM
  aggregate _ = error "Unknown mode"

descriptions
  :: Aggregate Text (Maybe Text)
  -> Jenkins.Master
  -> IO (Jenkins.Result [Maybe Text])
descriptions aggregate settings = Jenkins.run settings $ do
  res <- Jenkins.get Jenkins.json ("" -?- "tree" -=- "jobs[name]")
  aggregate describe (res ^.. key "jobs".values.key "name"._String)

describe :: Text -> Jenkins (Maybe Text)
describe name = do
  desc <- Jenkins.get Jenkins.json (Jenkins.job name -?- "tree" -=- "description")
  return (desc ^? key "description"._String)