module Faktory.Settings
  ( Settings(..)
  , defaultSettings
  , envSettings
  , WorkerSettings(..)
  , defaultWorkerSettings
  , envWorkerSettings
  , Queue(..)
  , namespaceQueue
  , queueArg
  , defaultQueue
  , WorkerId
  , randomWorkerId

  -- * Re-exports
  , ConnectionInfo(..)
  , Namespace(..)
  ) where

import Faktory.Prelude

import Data.Aeson
import Data.ByteString.Lazy (ByteString, fromStrict)
import Data.String
import Data.Text.Encoding (encodeUtf8)
import Faktory.Connection
import System.Environment (lookupEnv)
import System.IO (hPutStrLn, stderr)
import System.Random

data Settings = Settings
  { Settings -> ConnectionInfo
settingsConnection :: ConnectionInfo
  , Settings -> String -> IO ()
settingsLogDebug :: String -> IO ()
  , Settings -> String -> IO ()
settingsLogError :: String -> IO ()
  }

defaultSettings :: Settings
defaultSettings :: Settings
defaultSettings = Settings :: ConnectionInfo
-> (String -> IO ()) -> (String -> IO ()) -> Settings
Settings
  { settingsConnection :: ConnectionInfo
settingsConnection = ConnectionInfo
defaultConnectionInfo
  , settingsLogDebug :: String -> IO ()
settingsLogDebug = \String
_msg -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , settingsLogError :: String -> IO ()
settingsLogError = Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"[ERROR]: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>)
  }

-- | Defaults, but read @'Connection'@ from the environment
--
-- See @'envConnection'@
--
envSettings :: IO Settings
envSettings :: IO Settings
envSettings = do
  ConnectionInfo
connection <- IO ConnectionInfo
envConnectionInfo
  Settings -> IO Settings
forall (f :: * -> *) a. Applicative f => a -> f a
pure Settings
defaultSettings { settingsConnection :: ConnectionInfo
settingsConnection = ConnectionInfo
connection }

data WorkerSettings = WorkerSettings
  { WorkerSettings -> Queue
settingsQueue :: Queue
  , WorkerSettings -> Maybe WorkerId
settingsId :: Maybe WorkerId
  , WorkerSettings -> Int
settingsIdleDelay :: Int
  }

defaultWorkerSettings :: WorkerSettings
defaultWorkerSettings :: WorkerSettings
defaultWorkerSettings = WorkerSettings :: Queue -> Maybe WorkerId -> Int -> WorkerSettings
WorkerSettings
  { settingsQueue :: Queue
settingsQueue = Queue
defaultQueue
  , settingsId :: Maybe WorkerId
settingsId = Maybe WorkerId
forall a. Maybe a
Nothing
  , settingsIdleDelay :: Int
settingsIdleDelay = Int
1
  }

envWorkerSettings :: IO WorkerSettings
envWorkerSettings :: IO WorkerSettings
envWorkerSettings = do
  Maybe String
mQueue <- String -> IO (Maybe String)
lookupEnv String
"FAKTORY_QUEUE"
  Maybe String
mWorkerId <- String -> IO (Maybe String)
lookupEnv String
"FAKTORY_WORKER_ID"
  WorkerSettings -> IO WorkerSettings
forall (f :: * -> *) a. Applicative f => a -> f a
pure WorkerSettings
defaultWorkerSettings
    { settingsQueue :: Queue
settingsQueue = Queue -> (String -> Queue) -> Maybe String -> Queue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Queue
defaultQueue (Text -> Queue
Queue (Text -> Queue) -> (String -> Text) -> String -> Queue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) Maybe String
mQueue
    , settingsId :: Maybe WorkerId
settingsId = String -> WorkerId
WorkerId (String -> WorkerId) -> Maybe String -> Maybe WorkerId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
mWorkerId
    }

newtype Queue = Queue Text
  deriving stock (Queue -> Queue -> Bool
(Queue -> Queue -> Bool) -> (Queue -> Queue -> Bool) -> Eq Queue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Queue -> Queue -> Bool
$c/= :: Queue -> Queue -> Bool
== :: Queue -> Queue -> Bool
$c== :: Queue -> Queue -> Bool
Eq, Int -> Queue -> String -> String
[Queue] -> String -> String
Queue -> String
(Int -> Queue -> String -> String)
-> (Queue -> String) -> ([Queue] -> String -> String) -> Show Queue
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Queue] -> String -> String
$cshowList :: [Queue] -> String -> String
show :: Queue -> String
$cshow :: Queue -> String
showsPrec :: Int -> Queue -> String -> String
$cshowsPrec :: Int -> Queue -> String -> String
Show)
  deriving newtype (String -> Queue
(String -> Queue) -> IsString Queue
forall a. (String -> a) -> IsString a
fromString :: String -> Queue
$cfromString :: String -> Queue
IsString, Value -> Parser [Queue]
Value -> Parser Queue
(Value -> Parser Queue)
-> (Value -> Parser [Queue]) -> FromJSON Queue
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Queue]
$cparseJSONList :: Value -> Parser [Queue]
parseJSON :: Value -> Parser Queue
$cparseJSON :: Value -> Parser Queue
FromJSON, [Queue] -> Encoding
[Queue] -> Value
Queue -> Encoding
Queue -> Value
(Queue -> Value)
-> (Queue -> Encoding)
-> ([Queue] -> Value)
-> ([Queue] -> Encoding)
-> ToJSON Queue
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Queue] -> Encoding
$ctoEncodingList :: [Queue] -> Encoding
toJSONList :: [Queue] -> Value
$ctoJSONList :: [Queue] -> Value
toEncoding :: Queue -> Encoding
$ctoEncoding :: Queue -> Encoding
toJSON :: Queue -> Value
$ctoJSON :: Queue -> Value
ToJSON)

namespaceQueue :: Namespace -> Queue -> Queue
namespaceQueue :: Namespace -> Queue -> Queue
namespaceQueue (Namespace Text
n) (Queue Text
q) = Text -> Queue
Queue (Text -> Queue) -> Text -> Queue
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
n Text
q

queueArg :: Queue -> ByteString
queueArg :: Queue -> ByteString
queueArg (Queue Text
q) = ByteString -> ByteString
fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
q

defaultQueue :: Queue
defaultQueue :: Queue
defaultQueue = Queue
"default"

newtype WorkerId = WorkerId String
  deriving newtype (Value -> Parser [WorkerId]
Value -> Parser WorkerId
(Value -> Parser WorkerId)
-> (Value -> Parser [WorkerId]) -> FromJSON WorkerId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [WorkerId]
$cparseJSONList :: Value -> Parser [WorkerId]
parseJSON :: Value -> Parser WorkerId
$cparseJSON :: Value -> Parser WorkerId
FromJSON, [WorkerId] -> Encoding
[WorkerId] -> Value
WorkerId -> Encoding
WorkerId -> Value
(WorkerId -> Value)
-> (WorkerId -> Encoding)
-> ([WorkerId] -> Value)
-> ([WorkerId] -> Encoding)
-> ToJSON WorkerId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [WorkerId] -> Encoding
$ctoEncodingList :: [WorkerId] -> Encoding
toJSONList :: [WorkerId] -> Value
$ctoJSONList :: [WorkerId] -> Value
toEncoding :: WorkerId -> Encoding
$ctoEncoding :: WorkerId -> Encoding
toJSON :: WorkerId -> Value
$ctoJSON :: WorkerId -> Value
ToJSON)

randomWorkerId :: IO WorkerId
randomWorkerId :: IO WorkerId
randomWorkerId = String -> WorkerId
WorkerId (String -> WorkerId) -> (StdGen -> String) -> StdGen -> WorkerId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
8 (String -> String) -> (StdGen -> String) -> StdGen -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, Char) -> StdGen -> String
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (Char
'a', Char
'z') (StdGen -> WorkerId) -> IO StdGen -> IO WorkerId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen