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

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

import Data.Kind ()
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 :: Type -> Type) = NarEffects {
    forall (m :: * -> *). NarEffects m -> FilePath -> m ByteString
narReadFile   :: FilePath -> m Bytes.Lazy.ByteString
  , forall (m :: * -> *).
NarEffects m -> FilePath -> ByteString -> m ()
narWriteFile  :: FilePath -> Bytes.Lazy.ByteString -> m ()
  , forall (m :: * -> *).
NarEffects m -> FilePath -> m (Maybe ByteString) -> m ()
narStreamFile :: FilePath -> m (Maybe Bytes.ByteString) -> m ()
  , forall (m :: * -> *). NarEffects m -> FilePath -> m [FilePath]
narListDir    :: FilePath -> m [FilePath]
  , forall (m :: * -> *). NarEffects m -> FilePath -> m ()
narCreateDir  :: FilePath -> m ()
  , forall (m :: * -> *). NarEffects m -> FilePath -> FilePath -> m ()
narCreateLink :: FilePath -> FilePath -> m ()
  , forall (m :: * -> *). NarEffects m -> FilePath -> m Permissions
narGetPerms   :: FilePath -> m Directory.Permissions
  , forall (m :: * -> *).
NarEffects m -> FilePath -> Permissions -> m ()
narSetPerms   :: FilePath -> Directory.Permissions ->  m ()
  , forall (m :: * -> *). NarEffects m -> FilePath -> m Bool
narIsDir      :: FilePath -> m Bool
  , forall (m :: * -> *). NarEffects m -> FilePath -> m Bool
narIsSymLink  :: FilePath -> m Bool
  , forall (m :: * -> *). NarEffects m -> FilePath -> m Int64
narFileSize   :: FilePath -> m Int64
  , forall (m :: * -> *). NarEffects m -> FilePath -> m FilePath
narReadLink   :: FilePath -> m FilePath
  , forall (m :: * -> *). NarEffects m -> FilePath -> m ()
narDeleteDir  :: FilePath -> m ()
  , forall (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 :: forall (m :: * -> *).
(MonadIO m, MonadFail m, MonadBaseControl IO m) =>
NarEffects m
narEffectsIO = NarEffects {
    narReadFile :: FilePath -> m ByteString
narReadFile   = forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ByteString
Bytes.Lazy.readFile
  , narWriteFile :: FilePath -> ByteString -> m ()
narWriteFile  = \FilePath
a -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO 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 = forall (m :: * -> *).
(MonadIO m, MonadFail m, MonadBaseControl IO m) =>
FilePath -> m (Maybe ByteString) -> m ()
streamStringOutIO
  , narListDir :: FilePath -> m [FilePath]
narListDir    = forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO [FilePath]
Directory.listDirectory
  , narCreateDir :: FilePath -> m ()
narCreateDir  = forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
Directory.createDirectory
  , narCreateLink :: FilePath -> FilePath -> m ()
narCreateLink = \FilePath
f -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> IO ()
createSymbolicLink FilePath
f
  , narGetPerms :: FilePath -> m Permissions
narGetPerms   = forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Permissions
Directory.getPermissions
  , narSetPerms :: FilePath -> Permissions -> m ()
narSetPerms   = \FilePath
f -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Permissions -> IO ()
Directory.setPermissions FilePath
f
  , narIsDir :: FilePath -> m Bool
narIsDir      = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FileStatus -> Bool
isDirectory forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FileStatus
getFileStatus
  , narIsSymLink :: FilePath -> m Bool
narIsSymLink  = forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Bool
Directory.pathIsSymbolicLink
  , narFileSize :: FilePath -> m Int64
narFileSize   = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> FileOffset
fileSize) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FileStatus
getFileStatus
  , narReadLink :: FilePath -> m FilePath
narReadLink   = forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
readSymbolicLink
  , narDeleteDir :: FilePath -> m ()
narDeleteDir  = forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
Directory.removeDirectoryRecursive
  , narDeleteFile :: FilePath -> m ()
narDeleteFile = forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO 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 :: forall (m :: * -> *).
(MonadIO m, MonadFail m, MonadBaseControl IO m) =>
FilePath -> m (Maybe ByteString) -> m ()
streamStringOutIO FilePath
f m (Maybe ByteString)
getChunk =
  forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
Exception.Lifted.bracket
    (forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> IO Handle
IO.openFile FilePath
f IOMode
WriteMode)
    (forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
IO.hClose)
    Handle -> m ()
go
  forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
`Exception.Lifted.catch`
    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 -> forall (f :: * -> *). Applicative f => f ()
pass
      Just ByteString
c  -> do
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO 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
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
Directory.removeFile FilePath
f
    forall (m :: * -> *) a. MonadFail m => FilePath -> m a
MonadFail.fail forall a b. (a -> b) -> a -> b
$
      FilePath
"Failed to stream string to " forall a. Semigroup a => a -> a -> a
<> FilePath
f forall a. Semigroup a => a -> a -> a
<> FilePath
": " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show SomeException
e