-----------------------------------------------------------------------------
-- |
-- Module      :  NgxExport.Tools.Combinators
-- Copyright   :  (c) Alexey Radkov 2023-2024
-- License     :  BSD-style
--
-- Maintainer  :  alexey.radkov@gmail.com
-- Stability   :  stable
-- Portability :  portable
--
-----------------------------------------------------------------------------


module NgxExport.Tools.Combinators (
    -- * Combinators of effectful actions
    -- $description

    -- * Exported functions
                                    voidHandler
                                   ,voidHandler'
                                   ,voidService
                                   ,rareService
                                   ,restartPromptly
    -- * Split services
                                   ,module NgxExport.Tools.SplitService
                                   ) where

import           NgxExport.Tools.SimpleService
import           NgxExport.Tools.SplitService
import           NgxExport.Tools.TimeInterval

import qualified Data.ByteString.Lazy as L
import           Control.Monad

-- $description
--
-- A set of functions to combine effectful actions for building handlers and
-- services tuned for special purposes.

-- | Runs an effectful computation and then returns an empty 'L.ByteString'.
--
-- This function saves printing the final @return L.empty@ action in handlers
-- that return unused or empty 'L.ByteString'.
--
-- For example, service /signalUpconf/ being used as an
-- [/update callback/](https://github.com/lyokha/nginx-haskell-module#update-callbacks)
-- in
--
-- @
-- type Upconf = [Text]
--
-- signalUpconf :: Upconf -> t'NgxExport.Tools.Types.NgxExportService'
-- signalUpconf upconf = const $ do
--     mapConcurrently_ getUrl upconf
--     return L.empty
--
-- 'ngxExportSimpleServiceTyped' \'signalUpconf \'\'Upconf $
--     'PersistentService' Nothing
-- @
--
-- returns an empty bytestring which is not used in a meaningful way, therefore
-- it can be rewritten as
--
-- @
-- signalUpconf :: Upconf -> t'NgxExport.Tools.Types.NgxExportService'
-- signalUpconf = const . __/voidHandler/__ . mapConcurrently_ getUrl
-- @
--
-- which helps to focus better on the computation itself.
--
-- @since 1.2.0
voidHandler :: IO a                         -- ^ Target computation
            -> IO L.ByteString
voidHandler :: forall a. IO a -> IO ByteString
voidHandler = (IO a -> IO ByteString -> IO ByteString
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
L.empty)

-- | Runs an effectful computation and then returns an empty 'L.ByteString'.
--
-- The same as 'voidHandler' except it accepts an additional value which is
-- ignored. Implemented as
--
-- @
-- voidHandler' = const . 'voidHandler'
-- @
--
-- This can be useful in declarations of services that accept a boolean flag
-- which marks whether the service is running for the first time. This flag is
-- often ignored though, in which case using @voidHandler'@ can simplify code.
--
-- For instance, service /signalUpconf/ from the example for 'voidHandler' can
-- be further simplified as
--
-- @
-- signalUpconf :: Upconf -> t'NgxExport.Tools.Types.NgxExportService'
-- signalUpconf = __/voidHandler'/__ . mapConcurrently_ getUrl
-- @
--
-- @since 1.2.1
voidHandler' :: IO a                        -- ^ Target computation
             -> b                           -- ^ Ignored value
             -> IO L.ByteString
voidHandler' :: forall a b. IO a -> b -> IO ByteString
voidHandler' = IO ByteString -> b -> IO ByteString
forall a b. a -> b -> a
const (IO ByteString -> b -> IO ByteString)
-> (IO a -> IO ByteString) -> IO a -> b -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO ByteString
forall a. IO a -> IO ByteString
voidHandler

-- | A void service which does nothing and returns an empty 'L.ByteString'.
--
-- The service is implemented as a /split/ service in terms of module
-- "NgxExport.Tools.SplitService". On the first iteration the service returns
-- immediately, on the next iteration it sleeps until the worker process
-- terminates it during the shutdown.
--
-- This can be used for loading global data from the Nginx configuration in a
-- more concise and declarative way.
--
-- For example, if data /Conf/ in
--
-- @
-- newtype Conf = Conf Int deriving (Read, Show)
--
-- testLoadConf :: Conf -> t'NgxExport.Tools.Types.NgxExportService'
-- testLoadConf = __/voidService/__
--
-- 'ngxExportSimpleServiceTyped' \'testLoadConf \'\'Conf 'restartPromptly'
-- @
--
-- gets loaded by service /testLoadConf/ from the Nginx configuration, then it
-- can be accessed in the Haskell code via t'Data.IORef.IORef' data storage
-- /storage_Conf_testLoadConf/.
--
-- Declaration of 'restartPromptly' establishes a /persistent/ service mode
-- without delay. The short iteration at the start of the service can be used
-- for calling a /service update hook/.
--
-- Note that /voidService/ is still an /asynchronous/ service which means that
-- the global data it loads may appear uninitialized in very early client
-- requests. To ensure that the data gets loaded before processing client
-- requests, consider using the /synchronous/ initialization hook
-- 'NgxExport.ngxExportInitHook' as a distinct solution or in conjunction with
-- other services.
--
-- @since 1.2.3
voidService :: a                            -- ^ Ignored configuration
            -> Bool                         -- ^ Ignored boolean value
            -> IO L.ByteString
voidService :: forall a. a -> Bool -> IO ByteString
voidService = (a -> IO ByteString)
-> (a -> IO ByteString) -> a -> Bool -> IO ByteString
forall a.
(a -> IO ByteString)
-> (a -> IO ByteString) -> a -> Bool -> IO ByteString
splitService (IO ByteString -> a -> IO ByteString
forall a b. a -> b -> a
const (IO ByteString -> a -> IO ByteString)
-> IO ByteString -> a -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
L.empty) ((a -> IO ByteString) -> a -> Bool -> IO ByteString)
-> (a -> IO ByteString) -> a -> Bool -> IO ByteString
forall a b. (a -> b) -> a -> b
$
    IO ByteString -> a -> IO ByteString
forall a b. a -> b -> a
const (IO ByteString -> a -> IO ByteString)
-> IO ByteString -> a -> IO ByteString
forall a b. (a -> b) -> a -> b
$ IO () -> IO ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ByteString) -> IO () -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelaySec (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ TimeInterval -> Int
toSec (TimeInterval -> Int) -> TimeInterval -> Int
forall a b. (a -> b) -> a -> b
$ Int -> TimeInterval
Hr Int
24

-- | A persistent service which waits for 24 hours before restart.
--
-- This declaration had been recommended for using with 'voidService' until the
-- latter was reimplemented as a split service. Nevertheless, it still can be
-- used for this purpose.
--
-- @since 1.2.5
rareService :: ServiceMode
rareService :: ServiceMode
rareService = Maybe TimeInterval -> ServiceMode
PersistentService (Maybe TimeInterval -> ServiceMode)
-> Maybe TimeInterval -> ServiceMode
forall a b. (a -> b) -> a -> b
$ TimeInterval -> Maybe TimeInterval
forall a. a -> Maybe a
Just (TimeInterval -> Maybe TimeInterval)
-> TimeInterval -> Maybe TimeInterval
forall a b. (a -> b) -> a -> b
$ Int -> TimeInterval
Hr Int
24

-- | A persistent service which restarts without delay.
--
-- This convenient declaration can be used for loading global data from the
-- Nginx configuration with 'voidService'.
--
-- @since 1.2.6
restartPromptly :: ServiceMode
restartPromptly :: ServiceMode
restartPromptly = Maybe TimeInterval -> ServiceMode
PersistentService Maybe TimeInterval
forall a. Maybe a
Nothing