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


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

    -- * Void handler
                                    voidHandler
    -- * Split services
                                   ,module NgxExport.Tools.SplitService
                                   ) where

import           NgxExport.Tools.SplitService

import qualified Data.ByteString.Lazy as L

-- $description
--
-- A set of convenient combinators of effectful actions for building handlers
-- and services tuned for special purposes.

-- | Runs an effectful computation and then returns an empty 'L.ByteString'
--
-- This combinator saves printing the final @return L.empty@ action in handlers
-- that return unused or empty 'L.ByteString'.
--
-- For example, handler /signalUpconf/ being declared as an
-- [/update callback/](https://github.com/lyokha/nginx-haskell-module#update-callbacks)
-- in
--
-- @
-- type Upconf = [Text]
--
-- signalUpconf :: Upconf -> Bool -> IO L.ByteString
-- signalUpconf upconf = const $ do
--     mapConcurrently_ getUrl upconf
--     return L.empty
--
-- 'NgxExport.Tools.SimpleService.ngxExportSimpleServiceTyped' \'signalUpconf \'\'Upconf $
--     'NgxExport.Tools.SimpleService.PersistentService' Nothing
-- @
--
-- returns an empty bytestring which is not used in a meaningful way, therefore
-- it can be rewritten as
--
-- @
-- signalUpconf :: Upconf -> Bool -> IO L.ByteString
-- 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)