{-# LANGUAGE ApplicativeDo     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

module Hyperion.Command where

import           Control.Distributed.Process
import           Data.Text                   (Text)
import qualified Data.Text                   as T
import           Hyperion.Remote
import           Options.Applicative

-- Note: The argument list in hyperionWorkerCommand and the workerOpts
-- parser must be kept in sync.

-- | Haskell representation of arguments passed to the worker process.
data Worker = Worker
  { Worker -> Text
workerMasterAddress :: Text
  , Worker -> ServiceId
workerService       :: ServiceId
  , Worker -> FilePath
workerLogFile       :: FilePath
  } deriving Int -> Worker -> ShowS
[Worker] -> ShowS
Worker -> FilePath
(Int -> Worker -> ShowS)
-> (Worker -> FilePath) -> ([Worker] -> ShowS) -> Show Worker
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Worker] -> ShowS
$cshowList :: [Worker] -> ShowS
show :: Worker -> FilePath
$cshow :: Worker -> FilePath
showsPrec :: Int -> Worker -> ShowS
$cshowsPrec :: Int -> Worker -> ShowS
Show

-- | Parses worker command-line arguments. Essentially inverse to 'hyperionWorkerCommand'.
workerOpts :: Parser Worker
workerOpts :: Parser Worker
workerOpts = do
  Text
workerMasterAddress <- FilePath -> Text
T.pack (FilePath -> Text) -> Parser FilePath -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"address"
               Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"HOST:PORT"
               Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Address of the master process")
  ServiceId
workerService <- FilePath -> ServiceId
ServiceId (FilePath -> ServiceId) -> Parser FilePath -> Parser ServiceId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"service"
               Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"SERVICENAME"
               Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Name of service on master process")
  FilePath
workerLogFile <-
    Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"logFile"
               Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PATH"
               Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Path for worker log file")
  return Worker :: Text -> ServiceId -> FilePath -> Worker
Worker{FilePath
Text
ServiceId
workerLogFile :: FilePath
workerService :: ServiceId
workerMasterAddress :: Text
workerLogFile :: FilePath
workerService :: ServiceId
workerMasterAddress :: Text
..}

-- | Returns the @(command, [arguments])@ to run the worker process
hyperionWorkerCommand :: FilePath -> NodeId -> ServiceId -> FilePath -> (String, [String])
hyperionWorkerCommand :: FilePath
-> NodeId -> ServiceId -> FilePath -> (FilePath, [FilePath])
hyperionWorkerCommand FilePath
hyperionExecutable NodeId
masterNode ServiceId
masterService FilePath
logFile =
  (FilePath
hyperionExecutable, (Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
T.unpack [Text]
args)
  where
    args :: [Text]
args = [ Text
"worker"
           , Text
"--address", NodeId -> Text
nodeIdToAddress NodeId
masterNode
           , Text
"--service", ServiceId -> Text
serviceIdToText ServiceId
masterService
           , Text
"--logFile", FilePath -> Text
T.pack FilePath
logFile
           ]