module Effectful.Posix.Signals.Handler
  ( -- * Handler
    Handler (..),
    mapHandler,

    -- ** Posix
    PosixHandler,
    mapHandlerToPosix,
    mapHandlerFromPosix,

    -- * Concurrency strategy
    persistence,
    limit,
  )
where

import Effectful (Limit (Unlimited), Persistence (Ephemeral))
import System.Posix.Signals (SignalInfo)
import System.Posix.Signals qualified as Signals

-- | Alias for unix's 'Signals.Handler'.
--
-- @since 0.1
type PosixHandler = Signals.Handler

-- | @since 0.1
data Handler m
  = Default
  | Ignore
  | Catch (m ())
  | CatchOnce (m ())
  | CatchInfo (SignalInfo -> m ())
  | CatchInfoOnce (SignalInfo -> m ())

-- | @since 0.1
mapHandler :: (forall x. m x -> n x) -> Handler m -> Handler n
mapHandler :: forall (m :: * -> *) (n :: * -> *).
(forall x. m x -> n x) -> Handler m -> Handler n
mapHandler forall x. m x -> n x
f = \case
  Handler m
Default -> Handler n
forall (m :: * -> *). Handler m
Default
  Handler m
Ignore -> Handler n
forall (m :: * -> *). Handler m
Ignore
  Catch m ()
x -> n () -> Handler n
forall (m :: * -> *). m () -> Handler m
Catch (n () -> Handler n) -> n () -> Handler n
forall a b. (a -> b) -> a -> b
$ m () -> n ()
forall x. m x -> n x
f m ()
x
  CatchOnce m ()
x -> n () -> Handler n
forall (m :: * -> *). m () -> Handler m
CatchOnce (n () -> Handler n) -> n () -> Handler n
forall a b. (a -> b) -> a -> b
$ m () -> n ()
forall x. m x -> n x
f m ()
x
  CatchInfo SignalInfo -> m ()
x -> (SignalInfo -> n ()) -> Handler n
forall (m :: * -> *). (SignalInfo -> m ()) -> Handler m
CatchInfo ((SignalInfo -> n ()) -> Handler n)
-> (SignalInfo -> n ()) -> Handler n
forall a b. (a -> b) -> a -> b
$ m () -> n ()
forall x. m x -> n x
f (m () -> n ()) -> (SignalInfo -> m ()) -> SignalInfo -> n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignalInfo -> m ()
x
  CatchInfoOnce SignalInfo -> m ()
x -> (SignalInfo -> n ()) -> Handler n
forall (m :: * -> *). (SignalInfo -> m ()) -> Handler m
CatchInfoOnce ((SignalInfo -> n ()) -> Handler n)
-> (SignalInfo -> n ()) -> Handler n
forall a b. (a -> b) -> a -> b
$ m () -> n ()
forall x. m x -> n x
f (m () -> n ()) -> (SignalInfo -> m ()) -> SignalInfo -> n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignalInfo -> m ()
x
{-# INLINEABLE mapHandler #-}

-- | @since 0.1
mapHandlerToPosix :: (forall x. m x -> IO x) -> Handler m -> PosixHandler
mapHandlerToPosix :: forall (m :: * -> *).
(forall x. m x -> IO x) -> Handler m -> PosixHandler
mapHandlerToPosix forall x. m x -> IO x
f = \case
  Handler m
Default -> PosixHandler
Signals.Default
  Handler m
Ignore -> PosixHandler
Signals.Ignore
  Catch m ()
x -> IO () -> PosixHandler
Signals.Catch (IO () -> PosixHandler) -> IO () -> PosixHandler
forall a b. (a -> b) -> a -> b
$ m () -> IO ()
forall x. m x -> IO x
f m ()
x
  CatchOnce m ()
x -> IO () -> PosixHandler
Signals.CatchOnce (IO () -> PosixHandler) -> IO () -> PosixHandler
forall a b. (a -> b) -> a -> b
$ m () -> IO ()
forall x. m x -> IO x
f m ()
x
  CatchInfo SignalInfo -> m ()
x -> (SignalInfo -> IO ()) -> PosixHandler
Signals.CatchInfo ((SignalInfo -> IO ()) -> PosixHandler)
-> (SignalInfo -> IO ()) -> PosixHandler
forall a b. (a -> b) -> a -> b
$ m () -> IO ()
forall x. m x -> IO x
f (m () -> IO ()) -> (SignalInfo -> m ()) -> SignalInfo -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignalInfo -> m ()
x
  CatchInfoOnce SignalInfo -> m ()
x -> (SignalInfo -> IO ()) -> PosixHandler
Signals.CatchInfoOnce ((SignalInfo -> IO ()) -> PosixHandler)
-> (SignalInfo -> IO ()) -> PosixHandler
forall a b. (a -> b) -> a -> b
$ m () -> IO ()
forall x. m x -> IO x
f (m () -> IO ()) -> (SignalInfo -> m ()) -> SignalInfo -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignalInfo -> m ()
x
{-# INLINEABLE mapHandlerToPosix #-}

-- | @since 0.1
mapHandlerFromPosix :: (forall x. IO x -> n x) -> PosixHandler -> Handler n
mapHandlerFromPosix :: forall (n :: * -> *).
(forall x. IO x -> n x) -> PosixHandler -> Handler n
mapHandlerFromPosix forall x. IO x -> n x
f = \case
  PosixHandler
Signals.Default -> Handler n
forall (m :: * -> *). Handler m
Default
  PosixHandler
Signals.Ignore -> Handler n
forall (m :: * -> *). Handler m
Ignore
  Signals.Catch IO ()
x -> n () -> Handler n
forall (m :: * -> *). m () -> Handler m
Catch (n () -> Handler n) -> n () -> Handler n
forall a b. (a -> b) -> a -> b
$ IO () -> n ()
forall x. IO x -> n x
f IO ()
x
  Signals.CatchOnce IO ()
x -> n () -> Handler n
forall (m :: * -> *). m () -> Handler m
CatchOnce (n () -> Handler n) -> n () -> Handler n
forall a b. (a -> b) -> a -> b
$ IO () -> n ()
forall x. IO x -> n x
f IO ()
x
  Signals.CatchInfo SignalInfo -> IO ()
x -> (SignalInfo -> n ()) -> Handler n
forall (m :: * -> *). (SignalInfo -> m ()) -> Handler m
CatchInfo ((SignalInfo -> n ()) -> Handler n)
-> (SignalInfo -> n ()) -> Handler n
forall a b. (a -> b) -> a -> b
$ IO () -> n ()
forall x. IO x -> n x
f (IO () -> n ()) -> (SignalInfo -> IO ()) -> SignalInfo -> n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignalInfo -> IO ()
x
  Signals.CatchInfoOnce SignalInfo -> IO ()
x -> (SignalInfo -> n ()) -> Handler n
forall (m :: * -> *). (SignalInfo -> m ()) -> Handler m
CatchInfoOnce ((SignalInfo -> n ()) -> Handler n)
-> (SignalInfo -> n ()) -> Handler n
forall a b. (a -> b) -> a -> b
$ IO () -> n ()
forall x. IO x -> n x
f (IO () -> n ()) -> (SignalInfo -> IO ()) -> SignalInfo -> n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignalInfo -> IO ()
x
{-# INLINEABLE mapHandlerFromPosix #-}

-- NOTE: [installHandler concurrency]
--
-- We /cannot/ use the sequential unlifting strategy for installHandler,
-- because the handler action might be invoked from a new thread (e.g. Catch).
--
-- A real-life bug was observed when this installHandler used seqUnliftIO,
-- and the action threw an Exception to another thread. I am unsure if the
-- action matters (e.g. trying with 'pure ()' would be interesting).
--
-- Regarding the strategy:
--
-- - Persistence: Persistent/Ephemeral matters when the unlifting function
--   is called multiple times /in the same thread/. Persistent persists
--   state changes, Ephemeral does not.
--
--   In the absence of a compelling example, let's default to Ephemeral.
--
-- - Limit: Anecdotally, usage seems to work with 'Limited 1', but we
--   will allow Unlimited, out of an abundance of caution.

persistence :: Persistence
persistence :: Persistence
persistence = Persistence
Ephemeral

limit :: Limit
limit :: Limit
limit = Limit
Unlimited