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


module NgxExport.Tools.SplitService (
    -- * Split services
    -- $description

    -- * Exported functions
                                     splitService
                                    ,ignitionService
                                    ,deferredService
                                    ) where

import qualified Data.ByteString.Lazy as L

-- $description
--
-- Split services split the whole service into two separate actions for the
-- first (/ignition/ service) and the following (/deferred/ service) runs.

-- | Sets two different actions as ignition and deferred services.
--
-- When used as a single-shot service (in terms of module
-- "NgxExport.Tools.SimpleService"), the second action only runs on exit of a
-- worker process, and therefore can be used as a cleanup handler.
splitService :: (a -> IO L.ByteString)  -- ^ Ignition service
             -> (a -> IO L.ByteString)  -- ^ Deferred service
             -> a                       -- ^ Configuration
             -> Bool                    -- ^ First-run flag
             -> IO L.ByteString
splitService :: forall a.
(a -> IO ByteString)
-> (a -> IO ByteString) -> a -> Bool -> IO ByteString
splitService a -> IO ByteString
is a -> IO ByteString
ds a
c Bool
fstRun
    | Bool
fstRun = a -> IO ByteString
is a
c
    | Bool
otherwise = a -> IO ByteString
ds a
c

-- | Sets an action as an ignition service.
ignitionService :: (a -> IO L.ByteString)  -- ^ Ignition service
                -> a                       -- ^ Configuration
                -> Bool                    -- ^ First-run flag
                -> IO L.ByteString
ignitionService :: forall a. (a -> IO ByteString) -> a -> Bool -> IO ByteString
ignitionService a -> IO ByteString
is = (a -> IO ByteString)
-> (a -> IO ByteString) -> a -> Bool -> IO ByteString
forall a.
(a -> IO ByteString)
-> (a -> IO ByteString) -> a -> Bool -> IO ByteString
splitService a -> IO ByteString
is ((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
$ ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
L.empty

-- | Sets an action as a deferred service.
--
-- When used as a single-shot service (in terms of module
-- "NgxExport.Tools.SimpleService"), the action only runs on exit of a worker
-- process, and therefore can be used as a cleanup handler.
deferredService :: (a -> IO L.ByteString)  -- ^ Deferred service
                -> a                       -- ^ Configuration
                -> Bool                    -- ^ First-run flag
                -> IO L.ByteString
deferredService :: forall a. (a -> IO ByteString) -> a -> Bool -> IO ByteString
deferredService = (a -> IO ByteString)
-> (a -> IO ByteString) -> a -> Bool -> IO ByteString
forall a.
(a -> IO ByteString)
-> (a -> IO ByteString) -> a -> Bool -> IO ByteString
splitService ((a -> IO ByteString)
 -> (a -> IO ByteString) -> a -> Bool -> IO ByteString)
-> (a -> 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
$ ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
L.empty