{-# LANGUAGE CPP #-}

module Compat where

import Control.Concurrent (mkWeakThreadId, myThreadId)
import Control.Exception (AsyncException (UserInterrupt), throwTo)
import System.Mem.Weak (deRefWeak)
import Unison.Prelude
import UnliftIO qualified

{- ORMOLU_DISABLE -}
#if defined(mingw32_HOST_OS)
import qualified GHC.ConsoleHandler as WinSig
#else
import qualified System.Posix.Signals as Sig
#endif

onWindows :: Bool
onWindows :: Bool
onWindows =
#if defined(mingw32_HOST_OS)
  True
#else
  Bool
False
#endif
{- ORMOLU_ENABLE -}

-- | Constructs a default interrupt handler which builds an interrupt handler which throws a
-- UserInterrupt exception to the thread in which the setup was initially called.
defaultInterruptHandler :: IO (IO ())
defaultInterruptHandler :: IO (IO ())
defaultInterruptHandler = do
  ThreadId
main_thread <- IO ThreadId
myThreadId
  Weak ThreadId
wtid <- ThreadId -> IO (Weak ThreadId)
mkWeakThreadId ThreadId
main_thread
  let interrupt :: IO ()
interrupt = do
        Maybe ThreadId
r <- Weak ThreadId -> IO (Maybe ThreadId)
forall v. Weak v -> IO (Maybe v)
deRefWeak Weak ThreadId
wtid
        case Maybe ThreadId
r of
          Maybe ThreadId
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just ThreadId
t -> ThreadId -> AsyncException -> IO ()
forall e. Exception e => ThreadId -> e -> IO ()
throwTo ThreadId
t AsyncException
UserInterrupt
  IO () -> IO (IO ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IO ()
interrupt

-- | Replaces any existing interrupt handlers with the provided IO action while the provided
-- action is running, restoring any existing handlers afterwards.
withInterruptHandler :: IO () -> IO a -> IO a
withInterruptHandler :: forall a. IO () -> IO a -> IO a
withInterruptHandler IO ()
handler IO a
action = do
  IO (IO ()) -> (IO () -> IO ()) -> (IO () -> IO a) -> IO a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
UnliftIO.bracket
    IO (IO ())
installNewHandlers
    IO () -> IO ()
restoreOldHandlers
    (\IO ()
_ -> IO a
action)
  where
    -- Installs the new handler and returns an action to restore the old handlers.
    installNewHandlers :: IO (IO ())
    installNewHandlers :: IO (IO ())
installNewHandlers = do
{- ORMOLU_DISABLE -}
#if defined(mingw32_HOST_OS)
      let sig_handler WinSig.ControlC = handler
          sig_handler WinSig.Break    = handler
          sig_handler _               = return ()
      oldHandler <- WinSig.installHandler (WinSig.Catch sig_handler)
      pure (void $ WinSig.installHandler oldHandler)
#else
      Handler
oldQuitHandler <- Signal -> Handler -> Maybe SignalSet -> IO Handler
Sig.installHandler Signal
Sig.sigQUIT  (IO () -> Handler
Sig.Catch IO ()
handler) Maybe SignalSet
forall a. Maybe a
Nothing
      Handler
oldInterruptHandler <- Signal -> Handler -> Maybe SignalSet -> IO Handler
Sig.installHandler Signal
Sig.sigINT   (IO () -> Handler
Sig.Catch IO ()
handler) Maybe SignalSet
forall a. Maybe a
Nothing
      pure do
        IO Handler -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Handler -> IO ()) -> IO Handler -> IO ()
forall a b. (a -> b) -> a -> b
$ Signal -> Handler -> Maybe SignalSet -> IO Handler
Sig.installHandler Signal
Sig.sigQUIT Handler
oldQuitHandler Maybe SignalSet
forall a. Maybe a
Nothing
        IO Handler -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Handler -> IO ()) -> IO Handler -> IO ()
forall a b. (a -> b) -> a -> b
$ Signal -> Handler -> Maybe SignalSet -> IO Handler
Sig.installHandler Signal
Sig.sigINT Handler
oldInterruptHandler Maybe SignalSet
forall a. Maybe a
Nothing
#endif
    restoreOldHandlers :: IO () -> IO ()
    restoreOldHandlers :: IO () -> IO ()
restoreOldHandlers IO ()
restore = IO ()
restore
{- ORMOLU_ENABLE -}