WithToOpenClose.hs

Ashley Yakeley 2017-12-14 23:27:19.471783 UTC

1{-# LANGUAGE RankNTypes #-}
2module WithToOpenClose where
3
4import Control.Exception
5import System.IO
6import Control.Concurrent
7
8type OpenClose h = IO (h,IO ()) -- opens a resource, returns a handle and a "closer"
9type With h = forall r. (h -> IO r) -> IO r
10
11openCloseFile :: FilePath -> IOMode -> OpenClose Handle
12openCloseFile path mode = do
13 h <- openFile path mode
14 return (h, hClose h)
15
16openCloseToWith :: OpenClose h -> With h
17openCloseToWith oc f = do
18 (h,closer) <- oc
19 finally (f h) closer
20
21withToOpenClose :: With h -> OpenClose h
22withToOpenClose with = do
23 hVar <- newEmptyMVar
24 closerVar <- newEmptyMVar
25 doneVar <- newEmptyMVar
26 _ <-
27 forkIO $ do
28 with $ \h -> do
29 putMVar hVar h
30 takeMVar closerVar
31 putMVar doneVar ()
32 h <- takeMVar hVar
33 let
34 close :: IO ()
35 close = do
36 putMVar closerVar ()
37 takeMVar doneVar
38 return (h, close)