{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} module Hercules.CNix.Exception where import Hercules.CNix.Store.Context (context) import qualified Language.C.Inline.Cpp as C import qualified Language.C.Inline.Cpp.Exception as C import Protolude import qualified System.Environment C.context context C.include "<nix/config.h>" C.include "<nix/shared.hh>" C.include "<nix/globals.hh>" handleExceptions :: IO a -> IO a handleExceptions :: forall a. IO a -> IO a handleExceptions IO a io = do String progName <- IO String System.Environment.getProgName (ExitCode -> IO a) -> Text -> IO a -> IO a forall a. (ExitCode -> IO a) -> Text -> IO a -> IO a handleExceptions' ExitCode -> IO a forall a. ExitCode -> IO a exitWith (String -> Text forall a b. ConvertText a b => a -> b toS String progName) IO a io handleExceptions' :: (ExitCode -> IO a) -> Text -> IO a -> IO a handleExceptions' :: forall a. (ExitCode -> IO a) -> Text -> IO a -> IO a handleExceptions' ExitCode -> IO a handleExit Text programName IO a io = let select :: CppException -> Maybe CppExceptionPtr select (C.CppStdException CppExceptionPtr eptr ByteString _msg Maybe ByteString _t) = CppExceptionPtr -> Maybe CppExceptionPtr forall a. a -> Maybe a Just CppExceptionPtr eptr select CppException _ = Maybe CppExceptionPtr forall a. Maybe a Nothing convertExit :: a -> ExitCode convertExit a 0 = ExitCode ExitSuccess convertExit a e = Int -> ExitCode ExitFailure (a -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral a e) doHandle :: CppExceptionPtr -> IO a doHandle = ExitCode -> IO a handleExit (ExitCode -> IO a) -> (CInt -> ExitCode) -> CInt -> IO a forall b c a. (b -> c) -> (a -> b) -> a -> c . CInt -> ExitCode forall {a}. Integral a => a -> ExitCode convertExit (CInt -> IO a) -> (CppExceptionPtr -> IO CInt) -> CppExceptionPtr -> IO a forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< ByteString -> CppExceptionPtr -> IO CInt handleExceptionPtr (Text -> ByteString encodeUtf8 Text programName) in (CppException -> Maybe CppExceptionPtr) -> (CppExceptionPtr -> IO a) -> IO a -> IO a forall e b a. Exception e => (e -> Maybe b) -> (b -> IO a) -> IO a -> IO a handleJust CppException -> Maybe CppExceptionPtr select CppExceptionPtr -> IO a doHandle IO a io handleExceptionPtr :: ByteString -> C.CppExceptionPtr -> IO C.CInt handleExceptionPtr :: ByteString -> CppExceptionPtr -> IO CInt handleExceptionPtr ByteString programName CppExceptionPtr eptr = [C.throwBlock| int { auto & eptr = *$fptr-ptr:(std::exception_ptr *eptr); std::string programName($bs-ptr:programName, $bs-len:programName); return nix::handleExceptions(programName, [&]() { std::rethrow_exception(eptr); }); }|]