module System.IO.SaferFileHandles.Internal where
import Control.Monad ( fmap , return )
import Data.Function ( ($) )
import Data.Tuple ( uncurry )
import Data.Bool ( Bool(False, True) )
import Data.Char ( String )
import Data.Maybe ( Maybe(Nothing, Just) )
import Data.Function.Unicode ( (∘) )
import Control.Monad.Trans ( MonadIO, liftIO )
import Control.Resource ( Resource, openResource, closeResource )
import qualified Control.Resource as R ( Handle )
import Control.Monad.Trans.Region ( RegionalHandle )
import Control.Monad.Trans.Region.Unsafe ( internalHandle )
import System.IO.ExplicitIOModes ( IOMode(..)
, R, W, RW
, IO
, FilePath
)
import qualified System.IO.ExplicitIOModes as E
( Handle
, stdin, stdout, stderr
, openFile
, openBinaryFile
, openTempFile
, openBinaryTempFile
#if MIN_VERSION_base(4,2,0)
, openTempFileWithDefaultPermissions
, openBinaryTempFileWithDefaultPermissions
#endif
, hClose
)
data File ioMode where
File ∷ Binary → FilePath → IOMode ioMode → File ioMode
TempFile ∷ Binary
→ FilePath
→ Template
#if MIN_VERSION_base(4,2,0)
→ DefaultPermissions
#endif
→ File RW
Std ∷ Standard ioMode → File ioMode
type Binary = Bool
type Template = String
#if MIN_VERSION_base(4,2,0)
type DefaultPermissions = Bool
#endif
data Standard ioMode where
In ∷ Standard R
Out ∷ Standard W
Err ∷ Standard W
stdHndl ∷ Standard ioMode → E.Handle ioMode
stdHndl In = E.stdin
stdHndl Out = E.stdout
stdHndl Err = E.stderr
instance Resource (File ioMode) where
data R.Handle (File ioMode) = FileHandle (Maybe FilePath)
(E.Handle ioMode)
openResource (File isBinary filePath ioMode) =
fmap (FileHandle Nothing) $
(if isBinary then E.openBinaryFile else E.openFile)
filePath ioMode
#if MIN_VERSION_base(4,2,0)
openResource (TempFile isBinary filePath template defaultPerms) = do
fmap (uncurry (FileHandle ∘ Just)) $
(case (isBinary, defaultPerms) of
(False, False) → E.openTempFile
(True, False) → E.openBinaryTempFile
(False, True) → E.openTempFileWithDefaultPermissions
(True, True) → E.openBinaryTempFileWithDefaultPermissions
) filePath template
#else
openResource (TempFile isBinary filePath template) = do
fmap (uncurry (FileHandle ∘ Just)) $
(if isBinary then E.openBinaryTempFile else E.openTempFile)
filePath template
#endif
openResource (Std std) = return $ FileHandle Nothing $ stdHndl std
closeResource (FileHandle _ h) = E.hClose h
type RegionalFileHandle ioMode r = RegionalHandle (File ioMode) r
regularHandle ∷ RegionalFileHandle ioMode r → E.Handle ioMode
regularHandle (internalHandle → FileHandle _ h) = h
wrap ∷ MonadIO m
⇒ (E.Handle ioMode → IO α)
→ (RegionalFileHandle ioMode r → m α)
wrap f = \h → liftIO $ f (regularHandle h)
wrap2 ∷ MonadIO m
⇒ (E.Handle ioMode → β → IO α)
→ (RegionalFileHandle ioMode r → β → m α)
wrap2 f = \h y → liftIO $ f (regularHandle h) y
wrap3 ∷ MonadIO m
⇒ (E.Handle ioMode → γ → β → IO α)
→ (RegionalFileHandle ioMode r → γ → β → m α)
wrap3 f = \h z y → liftIO $ f (regularHandle h) z y