module Faktory.Settings.Queue
  ( Queue (..)
  , namespaceQueue
  , queueArg
  , defaultQueue
  , 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

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
$c== :: Queue -> Queue -> Bool
== :: Queue -> Queue -> Bool
$c/= :: Queue -> Queue -> Bool
/= :: Queue -> Queue -> Bool
Eq, Int -> Queue -> ShowS
[Queue] -> ShowS
Queue -> String
(Int -> Queue -> ShowS)
-> (Queue -> String) -> ([Queue] -> ShowS) -> Show Queue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Queue -> ShowS
showsPrec :: Int -> Queue -> ShowS
$cshow :: Queue -> String
show :: Queue -> String
$cshowList :: [Queue] -> ShowS
showList :: [Queue] -> ShowS
Show)
  deriving newtype (String -> Queue
(String -> Queue) -> IsString Queue
forall a. (String -> a) -> IsString a
$cfromString :: String -> Queue
fromString :: String -> Queue
IsString, Maybe Queue
Value -> Parser [Queue]
Value -> Parser Queue
(Value -> Parser Queue)
-> (Value -> Parser [Queue]) -> Maybe Queue -> FromJSON Queue
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Queue
parseJSON :: Value -> Parser Queue
$cparseJSONList :: Value -> Parser [Queue]
parseJSONList :: Value -> Parser [Queue]
$comittedField :: Maybe Queue
omittedField :: Maybe Queue
FromJSON, [Queue] -> Value
[Queue] -> Encoding
Queue -> Bool
Queue -> Value
Queue -> Encoding
(Queue -> Value)
-> (Queue -> Encoding)
-> ([Queue] -> Value)
-> ([Queue] -> Encoding)
-> (Queue -> Bool)
-> ToJSON Queue
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Queue -> Value
toJSON :: Queue -> Value
$ctoEncoding :: Queue -> Encoding
toEncoding :: Queue -> Encoding
$ctoJSONList :: [Queue] -> Value
toJSONList :: [Queue] -> Value
$ctoEncodingList :: [Queue] -> Encoding
toEncodingList :: [Queue] -> Encoding
$comitField :: Queue -> Bool
omitField :: Queue -> Bool
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"