{-# LANGUAGE DeriveDataTypeable #-}

-- |
-- Module: Data.Knob
-- Copyright: 2011 John Millikin
-- License: MIT
--
-- Maintainer: jmillikin@gmail.com
-- Portability: GHC only
--
-- Create memory‐backed 'IO.Handle's, referencing virtual files. This is
-- mostly useful for testing 'IO.Handle'‐based APIs without having to
-- interact with the filesystem.
--
-- > import Data.ByteString (pack)
-- > import Data.Knob
-- > import System.IO
-- >
-- > main = do
-- >     knob <- newKnob (pack [])
-- >     h <- newFileHandle knob "test.txt" WriteMode
-- >     hPutStrLn h "Hello world!"
-- >     hClose h
-- >     bytes <- Data.Knob.getContents knob
-- >     putStrLn ("Wrote bytes: " ++ show bytes)
module Data.Knob
	( Knob
	, newKnob
	, Data.Knob.getContents
	, setContents
	
	, newFileHandle
	, withFileHandle
	) where

import qualified Control.Concurrent.MVar as MVar
import           Control.Exception (bracket, throwIO)
import           Control.Monad (when)
import           Control.Monad.IO.Class (MonadIO, liftIO)
import qualified Data.ByteString
import           Data.ByteString (ByteString)
import           Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import           Data.Typeable (Typeable)
import qualified Foreign
import qualified GHC.IO.Buffer as IO
import qualified GHC.IO.BufferedIO as IO
import qualified GHC.IO.Device as IO
import qualified GHC.IO.Exception as IO
import qualified GHC.IO.Handle as IO
import qualified System.IO as IO

-- | A knob is a basic virtual file, which contains a byte buffer. A knob can
-- have multiple 'IO.Handle's open to it, each of which behaves like a standard
-- file handle.
--
-- Use 'getContents' and 'setContents' to inspect and modify the knob&#8217;s
-- byte buffer.
newtype Knob = Knob (MVar.MVar ByteString)

data Device = Device IO.IOMode (MVar.MVar ByteString) (MVar.MVar Int)
	deriving (Typeable)

instance IO.IODevice Device where
	ready :: Device -> Bool -> Int -> IO Bool
ready _ _ _ = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
	close :: Device -> IO ()
close _ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
	isTerminal :: Device -> IO Bool
isTerminal _ = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
	isSeekable :: Device -> IO Bool
isSeekable _ = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
	
	seek :: Device -> SeekMode -> Integer -> IO ()
seek (Device _ _ var :: MVar Int
var) IO.AbsoluteSeek off :: Integer
off = do
		Integer -> IO ()
checkOffset Integer
off
		MVar Int -> (Int -> IO Int) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
MVar.modifyMVar_ MVar Int
var (\_ -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
off))
	
	seek (Device _ _ var :: MVar Int
var) IO.RelativeSeek off :: Integer
off = do
		MVar Int -> (Int -> IO Int) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
MVar.modifyMVar_ MVar Int
var (\old_off :: Int
old_off -> do
			let new_off :: Integer
new_off = Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
old_off Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
off
			Integer -> IO ()
checkOffset Integer
new_off
			Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
new_off))
	
	seek dev :: Device
dev@(Device _ _ off_var :: MVar Int
off_var) IO.SeekFromEnd off :: Integer
off = do
		MVar Int -> (Int -> IO Int) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
MVar.modifyMVar_ MVar Int
off_var (\_ -> do
			Integer
size <- Device -> IO Integer
forall a. IODevice a => a -> IO Integer
IO.getSize Device
dev
			let new_off :: Integer
new_off = Integer
size Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
off
			Integer -> IO ()
checkOffset Integer
new_off
			Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
new_off))
	
	tell :: Device -> IO Integer
tell (Device _ _ var :: MVar Int
var) = (Int -> Integer) -> IO Int -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Integer
forall a. Integral a => a -> Integer
toInteger (MVar Int -> IO Int
forall a. MVar a -> IO a
MVar.readMVar MVar Int
var)
	getSize :: Device -> IO Integer
getSize (Device _ var :: MVar ByteString
var _) = do
		ByteString
bytes <- MVar ByteString -> IO ByteString
forall a. MVar a -> IO a
MVar.readMVar MVar ByteString
var
		Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (ByteString -> Int
Data.ByteString.length ByteString
bytes))
	setSize :: Device -> Integer -> IO ()
setSize dev :: Device
dev size :: Integer
size = Device -> Integer -> IO ()
setDeviceSize Device
dev Integer
size
	devType :: Device -> IO IODeviceType
devType _ = IODeviceType -> IO IODeviceType
forall (m :: * -> *) a. Monad m => a -> m a
return IODeviceType
IO.RegularFile

checkOffset :: Integer -> IO ()
checkOffset :: Integer -> IO ()
checkOffset off :: Integer
off = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
forall a. Bounded a => a
maxBound :: Int) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
off) (IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO IOException
err) where
	err :: IOException
err = Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IO.IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
IO.InvalidArgument "" "offset > (maxBound :: Int)" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing

setDeviceSize :: Device -> Integer -> IO ()
setDeviceSize :: Device -> Integer -> IO ()
setDeviceSize (Device mode :: IOMode
mode bytes_var :: MVar ByteString
bytes_var _) size :: Integer
size = IO ()
checkSize IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
setBytes where
	intSize :: Int
	intSize :: Int
intSize = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
size
	
	checkSize :: IO ()
checkSize = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
size Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
forall a. Bounded a => a
maxBound :: Int)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
		IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IO.IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
IO.InvalidArgument "" "size > (maxBound :: Int)" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing)
	
	setBytes :: IO ()
setBytes = MVar ByteString -> (ByteString -> IO ByteString) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
MVar.modifyMVar_ MVar ByteString
bytes_var ((ByteString -> IO ByteString) -> IO ())
-> (ByteString -> IO ByteString) -> IO ()
forall a b. (a -> b) -> a -> b
$ \bytes :: ByteString
bytes -> case IOMode
mode of
		IO.ReadMode -> IOException -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO (Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IO.IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
IO.IllegalOperation "" "handle in ReadMode" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing)
		IO.WriteMode -> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Word8 -> ByteString
Data.ByteString.replicate Int
intSize 0)
		IO.ReadWriteMode -> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString
clip ByteString
bytes)
		IO.AppendMode -> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString
clip ByteString
bytes)
	
	clip :: ByteString -> ByteString
clip bytes :: ByteString
bytes = case Int
intSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
Data.ByteString.length ByteString
bytes of
		padLen :: Int
padLen | Int
padLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 -> ByteString -> ByteString -> ByteString
Data.ByteString.append ByteString
bytes (Int -> Word8 -> ByteString
Data.ByteString.replicate Int
padLen 0)
		_ -> Int -> ByteString -> ByteString
Data.ByteString.take Int
intSize ByteString
bytes

instance IO.BufferedIO Device where
	newBuffer :: Device -> BufferState -> IO (Buffer Word8)
newBuffer _ = Int -> BufferState -> IO (Buffer Word8)
IO.newByteBuffer 4096
	
	fillReadBuffer :: Device -> Buffer Word8 -> IO (Int, Buffer Word8)
fillReadBuffer dev :: Device
dev buf :: Buffer Word8
buf = do
		(numRead :: Maybe Int
numRead, newBuf :: Buffer Word8
newBuf) <- Device -> Buffer Word8 -> IO (Maybe Int, Buffer Word8)
forall dev.
BufferedIO dev =>
dev -> Buffer Word8 -> IO (Maybe Int, Buffer Word8)
IO.fillReadBuffer0 Device
dev Buffer Word8
buf
		(Int, Buffer Word8) -> IO (Int, Buffer Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe 0 Int -> Int
forall a. a -> a
id Maybe Int
numRead, Buffer Word8
newBuf)
	
	fillReadBuffer0 :: Device -> Buffer Word8 -> IO (Maybe Int, Buffer Word8)
fillReadBuffer0 (Device _ bytes_var :: MVar ByteString
bytes_var pos_var :: MVar Int
pos_var) buf :: Buffer Word8
buf = do
		MVar ByteString
-> (ByteString -> IO (Maybe Int, Buffer Word8))
-> IO (Maybe Int, Buffer Word8)
forall a b. MVar a -> (a -> IO b) -> IO b
MVar.withMVar MVar ByteString
bytes_var ((ByteString -> IO (Maybe Int, Buffer Word8))
 -> IO (Maybe Int, Buffer Word8))
-> (ByteString -> IO (Maybe Int, Buffer Word8))
-> IO (Maybe Int, Buffer Word8)
forall a b. (a -> b) -> a -> b
$ \bytes :: ByteString
bytes -> do
			MVar Int
-> (Int -> IO (Int, (Maybe Int, Buffer Word8)))
-> IO (Maybe Int, Buffer Word8)
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
MVar.modifyMVar MVar Int
pos_var ((Int -> IO (Int, (Maybe Int, Buffer Word8)))
 -> IO (Maybe Int, Buffer Word8))
-> (Int -> IO (Int, (Maybe Int, Buffer Word8)))
-> IO (Maybe Int, Buffer Word8)
forall a b. (a -> b) -> a -> b
$ \pos :: Int
pos -> do
				if Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ByteString -> Int
Data.ByteString.length ByteString
bytes
					then (Int, (Maybe Int, Buffer Word8))
-> IO (Int, (Maybe Int, Buffer Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
pos, (Maybe Int
forall a. Maybe a
Nothing, Buffer Word8
buf))
					else do
						let chunk :: ByteString
chunk = Int -> ByteString -> ByteString
Data.ByteString.take (Buffer Word8 -> Int
forall e. Buffer e -> Int
IO.bufSize Buffer Word8
buf) (Int -> ByteString -> ByteString
Data.ByteString.drop Int
pos ByteString
bytes)
						ByteString
-> (CStringLen -> IO (Int, (Maybe Int, Buffer Word8)))
-> IO (Int, (Maybe Int, Buffer Word8))
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
chunk ((CStringLen -> IO (Int, (Maybe Int, Buffer Word8)))
 -> IO (Int, (Maybe Int, Buffer Word8)))
-> (CStringLen -> IO (Int, (Maybe Int, Buffer Word8)))
-> IO (Int, (Maybe Int, Buffer Word8))
forall a b. (a -> b) -> a -> b
$ \(chunkPtr :: Ptr CChar
chunkPtr, chunkLen :: Int
chunkLen) -> do
							ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr (Buffer Word8 -> ForeignPtr Word8
forall e. Buffer e -> RawBuffer e
IO.bufRaw Buffer Word8
buf) ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Word8
ptr -> do
								Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
Foreign.copyArray Ptr Word8
ptr (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr CChar
chunkPtr) Int
chunkLen
							(Int, (Maybe Int, Buffer Word8))
-> IO (Int, (Maybe Int, Buffer Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
chunkLen, (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
chunkLen, (Buffer Word8
buf { bufL :: Int
IO.bufL = 0, bufR :: Int
IO.bufR = Int
chunkLen })))
	
	flushWriteBuffer :: Device -> Buffer Word8 -> IO (Buffer Word8)
flushWriteBuffer (Device _ bytes_var :: MVar ByteString
bytes_var pos_var :: MVar Int
pos_var) buf :: Buffer Word8
buf = do
		MVar ByteString -> (ByteString -> IO ByteString) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
MVar.modifyMVar_ MVar ByteString
bytes_var ((ByteString -> IO ByteString) -> IO ())
-> (ByteString -> IO ByteString) -> IO ()
forall a b. (a -> b) -> a -> b
$ \bytes :: ByteString
bytes -> do
			MVar Int -> (Int -> IO (Int, ByteString)) -> IO ByteString
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
MVar.modifyMVar MVar Int
pos_var ((Int -> IO (Int, ByteString)) -> IO ByteString)
-> (Int -> IO (Int, ByteString)) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \pos :: Int
pos -> do
				let (before :: ByteString
before, after :: ByteString
after) = Int -> ByteString -> (ByteString, ByteString)
Data.ByteString.splitAt Int
pos ByteString
bytes
				let padding :: ByteString
padding = Int -> Word8 -> ByteString
Data.ByteString.replicate (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
Data.ByteString.length ByteString
before) 0
				
				let bufStart :: Ptr a -> Ptr b
bufStart ptr :: Ptr a
ptr = Ptr Any -> Ptr b
forall a b. Ptr a -> Ptr b
Foreign.castPtr (Ptr a -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
Foreign.plusPtr Ptr a
ptr (Buffer Word8 -> Int
forall e. Buffer e -> Int
IO.bufL Buffer Word8
buf))
				let bufLen :: Int
bufLen = Buffer Word8 -> Int
forall e. Buffer e -> Int
IO.bufR Buffer Word8
buf Int -> Int -> Int
forall a. Num a => a -> a -> a
- Buffer Word8 -> Int
forall e. Buffer e -> Int
IO.bufL Buffer Word8
buf
				ByteString
bufBytes <- ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr (Buffer Word8 -> ForeignPtr Word8
forall e. Buffer e -> RawBuffer e
IO.bufRaw Buffer Word8
buf) (\ptr :: Ptr Word8
ptr ->
					CStringLen -> IO ByteString
Data.ByteString.packCStringLen (Ptr Word8 -> Ptr CChar
forall a b. Ptr a -> Ptr b
bufStart Ptr Word8
ptr, Int
bufLen))
				let newBytes :: ByteString
newBytes = [ByteString] -> ByteString
Data.ByteString.concat [ByteString
before, ByteString
padding, ByteString
bufBytes, Int -> ByteString -> ByteString
Data.ByteString.drop Int
bufLen ByteString
after]
				(Int, ByteString) -> IO (Int, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bufLen, ByteString
newBytes)
		Buffer Word8 -> IO (Buffer Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffer Word8
buf { bufL :: Int
IO.bufL = 0, bufR :: Int
IO.bufR = 0 })
	
	flushWriteBuffer0 :: Device -> Buffer Word8 -> IO (Int, Buffer Word8)
flushWriteBuffer0 dev :: Device
dev buf :: Buffer Word8
buf = do
		Buffer Word8
newBuf <- Device -> Buffer Word8 -> IO (Buffer Word8)
forall dev.
BufferedIO dev =>
dev -> Buffer Word8 -> IO (Buffer Word8)
IO.flushWriteBuffer Device
dev Buffer Word8
buf
		(Int, Buffer Word8) -> IO (Int, Buffer Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffer Word8 -> Int
forall e. Buffer e -> Int
IO.bufR Buffer Word8
buf Int -> Int -> Int
forall a. Num a => a -> a -> a
- Buffer Word8 -> Int
forall e. Buffer e -> Int
IO.bufL Buffer Word8
buf, Buffer Word8
newBuf)

newKnob :: MonadIO m => ByteString -> m Knob
newKnob :: ByteString -> m Knob
newKnob bytes :: ByteString
bytes = do
	MVar ByteString
var <- IO (MVar ByteString) -> m (MVar ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ByteString -> IO (MVar ByteString)
forall a. a -> IO (MVar a)
MVar.newMVar ByteString
bytes)
	Knob -> m Knob
forall (m :: * -> *) a. Monad m => a -> m a
return (MVar ByteString -> Knob
Knob MVar ByteString
var)

getContents :: MonadIO m => Knob -> m ByteString
getContents :: Knob -> m ByteString
getContents (Knob var :: MVar ByteString
var) = IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MVar ByteString -> IO ByteString
forall a. MVar a -> IO a
MVar.readMVar MVar ByteString
var)

setContents :: MonadIO m => Knob -> ByteString -> m ()
setContents :: Knob -> ByteString -> m ()
setContents (Knob var :: MVar ByteString
var) bytes :: ByteString
bytes = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MVar ByteString -> (ByteString -> IO ByteString) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
MVar.modifyMVar_ MVar ByteString
var (\_ -> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bytes))

-- | Create a new 'IO.Handle' pointing to a 'Knob'. This handle behaves like
-- a file-backed handle for most purposes.
newFileHandle :: MonadIO m
              => Knob
              -> String -- ^ Filename shown in error messages
              -> IO.IOMode -> m IO.Handle
newFileHandle :: Knob -> String -> IOMode -> m Handle
newFileHandle (Knob var :: MVar ByteString
var) name :: String
name mode :: IOMode
mode = IO Handle -> m Handle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> m Handle) -> IO Handle -> m Handle
forall a b. (a -> b) -> a -> b
$ do
	Int
startPosition <- MVar ByteString -> (ByteString -> IO Int) -> IO Int
forall a b. MVar a -> (a -> IO b) -> IO b
MVar.withMVar MVar ByteString
var ((ByteString -> IO Int) -> IO Int)
-> (ByteString -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \bytes :: ByteString
bytes -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ case IOMode
mode of
		IO.AppendMode -> ByteString -> Int
Data.ByteString.length ByteString
bytes
		_ -> 0
	MVar Int
posVar <- Int -> IO (MVar Int)
forall a. a -> IO (MVar a)
MVar.newMVar Int
startPosition
	Device
-> String
-> IOMode
-> Maybe TextEncoding
-> NewlineMode
-> IO Handle
forall dev.
(IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> String
-> IOMode
-> Maybe TextEncoding
-> NewlineMode
-> IO Handle
IO.mkFileHandle (IOMode -> MVar ByteString -> MVar Int -> Device
Device IOMode
mode MVar ByteString
var MVar Int
posVar) String
name IOMode
mode Maybe TextEncoding
forall a. Maybe a
Nothing NewlineMode
IO.noNewlineTranslation

-- | See 'newFileHandle'.
withFileHandle :: MonadIO m
               => Knob
               -> String -- ^ Filename shown in error messages.
               -> IO.IOMode -> (IO.Handle -> IO a) -> m a
withFileHandle :: Knob -> String -> IOMode -> (Handle -> IO a) -> m a
withFileHandle knob :: Knob
knob name :: String
name mode :: IOMode
mode io :: Handle -> IO a
io = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> (Handle -> IO ()) -> (Handle -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Knob -> String -> IOMode -> IO Handle
forall (m :: * -> *).
MonadIO m =>
Knob -> String -> IOMode -> m Handle
newFileHandle Knob
knob String
name IOMode
mode) Handle -> IO ()
IO.hClose Handle -> IO a
io)