Ticket #4343: STMError.hs

File STMError.hs, 671 bytes (added by AntoineLatter, 4 years ago)

Proposed implementation

Line 
1{-# LANGUAGE MagicHash, DeriveDataTypeable #-}
2
3import Control.Exception
4import Control.Concurrent.STM hiding (catchSTM)
5import Data.Data
6import Data.Maybe
7import Data.Typeable
8
9import GHC.Prim (raiseIO#)
10import qualified GHC.Conc as C
11import GHC.Conc (STM(..))
12
13throwSTM :: Exception e => e -> STM a
14throwSTM = STM . raiseIO# . toException
15
16catchSTM :: Exception e => (STM a) -> (e -> STM a) -> STM a
17catchSTM stm h = C.catchSTM stm (h . fromJust . fromException . toException)
18
19data DummyException = DummyException
20 deriving (Data,Typeable,Show)
21
22instance Exception DummyException
23
24test1 = throwSTM DummyException
25
26test2 = catchSTM test1 $ \DummyException -> return 5
27