{-# language KindSignatures      #-}
{-# language RankNTypes          #-}
{-# language ScopedTypeVariables #-}

module System.Nix.Internal.Nar.Effects
  ( NarEffects(..)
  , narEffectsIO
  ) where

import qualified Data.ByteString             as Bytes
import qualified Data.ByteString.Lazy        as Bytes.Lazy
import qualified System.Directory            as Directory
import           System.Posix.Files          ( createSymbolicLink
                                        , fileSize
                                        , getFileStatus
                                        , isDirectory
                                        , readSymbolicLink
                                        )
import qualified System.IO                   as IO
import qualified Control.Monad.IO.Class      as IO
import           Control.Monad.Trans.Control (MonadBaseControl)
import qualified Control.Exception.Lifted    as Exception.Lifted
import qualified Control.Monad.Fail          as MonadFail

data NarEffects (m :: * -> *) = NarEffects {
    NarEffects m -> FilePath -> m ByteString
narReadFile   :: FilePath -> m Bytes.Lazy.ByteString
  , NarEffects m -> FilePath -> ByteString -> m ()
narWriteFile  :: FilePath -> Bytes.Lazy.ByteString -> m ()
  , NarEffects m -> FilePath -> m (Maybe ByteString) -> m ()
narStreamFile :: FilePath -> m (Maybe Bytes.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 ()
}


-- | A particular @NarEffects@ that uses regular POSIX for file manipulation
--   You would replace this with your own @NarEffects@ if you wanted a
--   different backend
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
Bytes.Lazy.readFile
  , narWriteFile :: FilePath -> ByteString -> m ()
narWriteFile  = \FilePath
a -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO () -> m ()) -> (ByteString -> IO ()) -> ByteString -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString -> IO ()
Bytes.Lazy.writeFile FilePath
a
  , 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 -> 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 -> FilePath -> IO ()
createSymbolicLink FilePath
f
  , 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 -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO () -> m ()) -> (Permissions -> IO ()) -> Permissions -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Permissions -> IO ()
Directory.setPermissions FilePath
f
  , narIsDir :: FilePath -> m Bool
narIsDir      = (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)
-> (FilePath -> m FileStatus) -> FilePath -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO FileStatus -> m FileStatus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO FileStatus -> m FileStatus)
-> (FilePath -> IO FileStatus) -> FilePath -> m FileStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FileStatus
getFileStatus
  , 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   = (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)
-> (FilePath -> m FileStatus) -> FilePath -> m Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO FileStatus -> m FileStatus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO FileStatus -> m FileStatus)
-> (FilePath -> IO FileStatus) -> FilePath -> m FileStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FileStatus
getFileStatus
  , 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
  }


-- | This default implementation for @narStreamFile@ requires @IO.MonadIO@
streamStringOutIO
  :: forall m
  .(IO.MonadIO m,
    MonadFail.MonadFail m,
    MonadBaseControl IO m
  ) => FilePath
  -> m (Maybe Bytes.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
Exception.Lifted.bracket
    (IO Handle -> m Handle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO Handle -> m Handle) -> IO Handle -> m Handle
forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> IO Handle
IO.openFile FilePath
f IOMode
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
`Exception.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 (f :: * -> *). Applicative f => f ()
pass
      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 ()
Bytes.hPut Handle
handle ByteString
c
        Handle -> m ()
go Handle
handle
  cleanupException :: SomeException -> m b
cleanupException (SomeException
e :: Exception.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. Semigroup a => a -> a -> a
<> FilePath
f FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
": " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> SomeException -> FilePath
forall b a. (Show a, IsString b) => a -> b
show SomeException
e