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

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

onWindows :: Bool
#if defined(mingw32_HOST_OS)
onWindows = True
#else
onWindows :: Bool
onWindows = Bool
False
#endif

-- | 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
  main_thread <- IO ThreadId
myThreadId
  wtid <- mkWeakThreadId main_thread
  let interrupt = do
        r <- Weak ThreadId -> IO (Maybe ThreadId)
forall v. Weak v -> IO (Maybe v)
deRefWeak Weak ThreadId
wtid
        case 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
  pure 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 ())
#if defined(mingw32_HOST_OS)
    installNewHandlers = do
      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
    installNewHandlers :: IO (IO ())
installNewHandlers = do
      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
      oldInterruptHandler <- Sig.installHandler Sig.sigINT   (Sig.Catch handler) Nothing
      pure do
        void $ Sig.installHandler Sig.sigQUIT oldQuitHandler Nothing
        void $ Sig.installHandler Sig.sigINT oldInterruptHandler Nothing
#endif
    restoreOldHandlers :: IO () -> IO ()
    restoreOldHandlers :: IO () -> IO ()
restoreOldHandlers IO ()
restore = IO ()
restore