{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module System.Nix.Internal.Nar.Effects
( NarEffects(..)
, narEffectsIO
) where
import qualified Control.Exception.Lifted as Lifted
import qualified Control.Monad.Fail as MonadFail
import qualified Control.Monad.IO.Class as IO
import Control.Monad.Trans.Control (MonadBaseControl)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Int (Int64)
import qualified System.Directory as Directory
import qualified System.IO as IO
import System.Posix.Files (createSymbolicLink, fileSize,
getFileStatus, isDirectory,
readSymbolicLink)
data NarEffects (m :: * -> *) = NarEffects {
NarEffects m -> FilePath -> m ByteString
narReadFile :: FilePath -> m BSL.ByteString
, NarEffects m -> FilePath -> ByteString -> m ()
narWriteFile :: FilePath -> BSL.ByteString -> m ()
, NarEffects m -> FilePath -> m (Maybe ByteString) -> m ()
narStreamFile :: FilePath -> m (Maybe BS.ByteString) -> m ()
, NarEffects m -> FilePath -> m [FilePath]
narListDir :: FilePath -> m [FilePath]
, NarEffects m -> FilePath -> m ()
narCreateDir :: FilePath -> m ()
, NarEffects m -> FilePath -> FilePath -> m ()
narCreateLink :: FilePath -> FilePath -> m ()
, NarEffects m -> FilePath -> m Permissions
narGetPerms :: FilePath -> m Directory.Permissions
, NarEffects m -> FilePath -> Permissions -> m ()
narSetPerms :: FilePath -> Directory.Permissions -> m ()
, NarEffects m -> FilePath -> m Bool
narIsDir :: FilePath -> m Bool
, NarEffects m -> FilePath -> m Bool
narIsSymLink :: FilePath -> m Bool
, NarEffects m -> FilePath -> m Int64
narFileSize :: FilePath -> m Int64
, NarEffects m -> FilePath -> m FilePath
narReadLink :: FilePath -> m FilePath
, NarEffects m -> FilePath -> m ()
narDeleteDir :: FilePath -> m ()
, NarEffects m -> FilePath -> m ()
narDeleteFile :: FilePath -> m ()
}
narEffectsIO
:: (IO.MonadIO m,
MonadFail.MonadFail m,
MonadBaseControl IO m
) => NarEffects m
narEffectsIO :: NarEffects m
narEffectsIO = NarEffects :: forall (m :: * -> *).
(FilePath -> m ByteString)
-> (FilePath -> ByteString -> m ())
-> (FilePath -> m (Maybe ByteString) -> m ())
-> (FilePath -> m [FilePath])
-> (FilePath -> m ())
-> (FilePath -> FilePath -> m ())
-> (FilePath -> m Permissions)
-> (FilePath -> Permissions -> m ())
-> (FilePath -> m Bool)
-> (FilePath -> m Bool)
-> (FilePath -> m Int64)
-> (FilePath -> m FilePath)
-> (FilePath -> m ())
-> (FilePath -> m ())
-> NarEffects m
NarEffects {
narReadFile :: FilePath -> m ByteString
narReadFile = IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO ByteString -> m ByteString)
-> (FilePath -> IO ByteString) -> FilePath -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ByteString
BSL.readFile
, narWriteFile :: FilePath -> ByteString -> m ()
narWriteFile = \FilePath
a ByteString
b -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
BSL.writeFile FilePath
a ByteString
b
, narStreamFile :: FilePath -> m (Maybe ByteString) -> m ()
narStreamFile = FilePath -> m (Maybe ByteString) -> m ()
forall (m :: * -> *).
(MonadIO m, MonadFail m, MonadBaseControl IO m) =>
FilePath -> m (Maybe ByteString) -> m ()
streamStringOutIO
, narListDir :: FilePath -> m [FilePath]
narListDir = IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO [FilePath] -> m [FilePath])
-> (FilePath -> IO [FilePath]) -> FilePath -> m [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO [FilePath]
Directory.listDirectory
, narCreateDir :: FilePath -> m ()
narCreateDir = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO () -> m ()) -> (FilePath -> IO ()) -> FilePath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
Directory.createDirectory
, narCreateLink :: FilePath -> FilePath -> m ()
narCreateLink = \FilePath
f FilePath
t -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
createSymbolicLink FilePath
f FilePath
t
, narGetPerms :: FilePath -> m Permissions
narGetPerms = IO Permissions -> m Permissions
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO Permissions -> m Permissions)
-> (FilePath -> IO Permissions) -> FilePath -> m Permissions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Permissions
Directory.getPermissions
, narSetPerms :: FilePath -> Permissions -> m ()
narSetPerms = \FilePath
f Permissions
p -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Permissions -> IO ()
Directory.setPermissions FilePath
f Permissions
p
, narIsDir :: FilePath -> m Bool
narIsDir = \FilePath
d -> (FileStatus -> Bool) -> m FileStatus -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FileStatus -> Bool
isDirectory (m FileStatus -> m Bool) -> m FileStatus -> m Bool
forall a b. (a -> b) -> a -> b
$ IO FileStatus -> m FileStatus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (FilePath -> IO FileStatus
getFileStatus FilePath
d)
, narIsSymLink :: FilePath -> m Bool
narIsSymLink = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO Bool -> m Bool) -> (FilePath -> IO Bool) -> FilePath -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Bool
Directory.pathIsSymbolicLink
, narFileSize :: FilePath -> m Int64
narFileSize = \FilePath
n -> (FileStatus -> Int64) -> m FileStatus -> m Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FileOffset -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FileOffset -> Int64)
-> (FileStatus -> FileOffset) -> FileStatus -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> FileOffset
fileSize) (m FileStatus -> m Int64) -> m FileStatus -> m Int64
forall a b. (a -> b) -> a -> b
$ IO FileStatus -> m FileStatus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (FilePath -> IO FileStatus
getFileStatus FilePath
n)
, narReadLink :: FilePath -> m FilePath
narReadLink = IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO FilePath -> m FilePath)
-> (FilePath -> IO FilePath) -> FilePath -> m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
readSymbolicLink
, narDeleteDir :: FilePath -> m ()
narDeleteDir = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO () -> m ()) -> (FilePath -> IO ()) -> FilePath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
Directory.removeDirectoryRecursive
, narDeleteFile :: FilePath -> m ()
narDeleteFile = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO () -> m ()) -> (FilePath -> IO ()) -> FilePath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
Directory.removeFile
}
streamStringOutIO
:: forall m
.(IO.MonadIO m,
MonadFail.MonadFail m,
MonadBaseControl IO m
) => FilePath
-> m (Maybe BS.ByteString)
-> m ()
streamStringOutIO :: FilePath -> m (Maybe ByteString) -> m ()
streamStringOutIO FilePath
f m (Maybe ByteString)
getChunk =
m Handle -> (Handle -> m ()) -> (Handle -> m ()) -> m ()
forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
Lifted.bracket
(IO Handle -> m Handle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (FilePath -> IOMode -> IO Handle
IO.openFile FilePath
f IOMode
IO.WriteMode)) (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO () -> m ()) -> (Handle -> IO ()) -> Handle -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
IO.hClose) Handle -> m ()
go
m () -> (SomeException -> m ()) -> m ()
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
`Lifted.catch`
SomeException -> m ()
forall (m :: * -> *) b.
(MonadIO m, MonadFail m) =>
SomeException -> m b
cleanupException
where
go :: IO.Handle -> m ()
go :: Handle -> m ()
go Handle
handle = do
Maybe ByteString
chunk <- m (Maybe ByteString)
getChunk
case Maybe ByteString
chunk of
Maybe ByteString
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ByteString
c -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ()
BS.hPut Handle
handle ByteString
c
Handle -> m ()
go Handle
handle
cleanupException :: SomeException -> m b
cleanupException (SomeException
e :: Lifted.SomeException) = do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
Directory.removeFile FilePath
f
FilePath -> m b
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
MonadFail.fail (FilePath -> m b) -> FilePath -> m b
forall a b. (a -> b) -> a -> b
$
FilePath
"Failed to stream string to " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ SomeException -> FilePath
forall a. Show a => a -> FilePath
show SomeException
e