----------------------------------------------------------------------------- -- | -- 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