------------------------------------------------------------------------------
-- |
-- Module      : PhatSort.Monad.FileSystem
-- Description : filesystem I/O
-- Copyright   : Copyright (c) 2019-2023 Travis Cardwell
-- License     : MIT
------------------------------------------------------------------------------

module PhatSort.Monad.FileSystem
  ( -- * MonadFileSystem
    MonadFileSystem(..)
    -- * FileStatus
  , FileStatus(..)
  ) where

-- https://hackage.haskell.org/package/base
import System.IO.Error (tryIOError)
import System.Posix.Types (DeviceID, EpochTime)

-- https://hackage.haskell.org/package/directory
import qualified System.Directory as Dir

-- https://hackage.haskell.org/package/transformers
import Control.Monad.Trans.Class (MonadTrans(lift))
import Control.Monad.Trans.Except (ExceptT)

-- https://hackage.haskell.org/package/unix-compat
import qualified System.PosixCompat.Files as Files

------------------------------------------------------------------------------
-- $MonadFileSystem

-- | Filesystem I/O
--
-- @since 0.5.0.0
class Monad m => MonadFileSystem m where
  -- | Copy a file
  copyFile
    :: FilePath  -- ^ source
    -> FilePath  -- ^ destination
    -> m (Either IOError ())

  -- | Create a directory
  createDirectory :: FilePath -> m (Either IOError ())

  -- | Check if a path exists
  doesPathExist :: FilePath -> m (Either IOError Bool)

  -- | Get file status information
  getFileStatus :: FilePath -> m (Either IOError FileStatus)

  -- | Get a list of directory entries
  listDirectory :: FilePath -> m (Either IOError [FilePath])

  -- | Convert a path into an absolute path
  makeAbsolute :: FilePath -> m (Either IOError FilePath)

  -- | Remove a directory
  removeDirectory :: FilePath -> m (Either IOError ())

  -- | Rename a directory
  renameDirectory
    :: FilePath  -- ^ target directory
    -> FilePath  -- ^ new directory name
    -> m (Either IOError ())

  -- | Rename a file
  renameFile
    :: FilePath  -- ^ target file
    -> FilePath  -- ^ new file name
    -> m (Either IOError ())

instance MonadFileSystem IO where
  copyFile :: FilePath -> FilePath -> IO (Either IOError ())
copyFile = (forall a. IO a -> IO (Either IOError a)
tryIOError forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> IO ()
Dir.copyFile
  {-# INLINE copyFile #-}

  createDirectory :: FilePath -> IO (Either IOError ())
createDirectory = forall a. IO a -> IO (Either IOError a)
tryIOError forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
Dir.createDirectory
  {-# INLINE createDirectory #-}

  doesPathExist :: FilePath -> IO (Either IOError Bool)
doesPathExist = forall a. IO a -> IO (Either IOError a)
tryIOError forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Bool
Dir.doesPathExist
  {-# INLINE doesPathExist #-}

  getFileStatus :: FilePath -> IO (Either IOError FileStatus)
getFileStatus = forall a. IO a -> IO (Either IOError a)
tryIOError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FileStatus -> FileStatus
toFileStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FileStatus
Files.getFileStatus
  {-# INLINE getFileStatus #-}

  listDirectory :: FilePath -> IO (Either IOError [FilePath])
listDirectory = forall a. IO a -> IO (Either IOError a)
tryIOError forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO [FilePath]
Dir.listDirectory
  {-# INLINE listDirectory #-}

  makeAbsolute :: FilePath -> IO (Either IOError FilePath)
makeAbsolute = forall a. IO a -> IO (Either IOError a)
tryIOError forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
Dir.makeAbsolute
  {-# INLINE makeAbsolute #-}

  removeDirectory :: FilePath -> IO (Either IOError ())
removeDirectory = forall a. IO a -> IO (Either IOError a)
tryIOError forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
Dir.removeDirectory
  {-# INLINE removeDirectory #-}

  renameDirectory :: FilePath -> FilePath -> IO (Either IOError ())
renameDirectory = (forall a. IO a -> IO (Either IOError a)
tryIOError forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> IO ()
Dir.renameDirectory
  {-# INLINE renameDirectory #-}

  renameFile :: FilePath -> FilePath -> IO (Either IOError ())
renameFile = (forall a. IO a -> IO (Either IOError a)
tryIOError forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> IO ()
Dir.renameFile
  {-# INLINE renameFile #-}

instance MonadFileSystem m => MonadFileSystem (ExceptT e m) where
  copyFile :: FilePath -> FilePath -> ExceptT e m (Either IOError ())
copyFile = (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadFileSystem m =>
FilePath -> FilePath -> m (Either IOError ())
copyFile
  {-# INLINE copyFile #-}

  createDirectory :: FilePath -> ExceptT e m (Either IOError ())
createDirectory = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadFileSystem m =>
FilePath -> m (Either IOError ())
createDirectory
  {-# INLINE createDirectory #-}

  doesPathExist :: FilePath -> ExceptT e m (Either IOError Bool)
doesPathExist = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadFileSystem m =>
FilePath -> m (Either IOError Bool)
doesPathExist
  {-# INLINE doesPathExist #-}

  getFileStatus :: FilePath -> ExceptT e m (Either IOError FileStatus)
getFileStatus = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadFileSystem m =>
FilePath -> m (Either IOError FileStatus)
getFileStatus
  {-# INLINE getFileStatus #-}

  listDirectory :: FilePath -> ExceptT e m (Either IOError [FilePath])
listDirectory = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadFileSystem m =>
FilePath -> m (Either IOError [FilePath])
listDirectory
  {-# INLINE listDirectory #-}

  makeAbsolute :: FilePath -> ExceptT e m (Either IOError FilePath)
makeAbsolute = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadFileSystem m =>
FilePath -> m (Either IOError FilePath)
makeAbsolute
  {-# INLINE makeAbsolute #-}

  removeDirectory :: FilePath -> ExceptT e m (Either IOError ())
removeDirectory = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadFileSystem m =>
FilePath -> m (Either IOError ())
removeDirectory
  {-# INLINE removeDirectory #-}

  renameDirectory :: FilePath -> FilePath -> ExceptT e m (Either IOError ())
renameDirectory = (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadFileSystem m =>
FilePath -> FilePath -> m (Either IOError ())
renameDirectory
  {-# INLINE renameDirectory #-}

  renameFile :: FilePath -> FilePath -> ExceptT e m (Either IOError ())
renameFile = (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadFileSystem m =>
FilePath -> FilePath -> m (Either IOError ())
renameFile
  {-# INLINE renameFile #-}

------------------------------------------------------------------------------
-- $FileStatus

-- | Mockable subset of 'Files.FileStatus'
--
-- @since 0.5.0.0
data FileStatus
  = FileStatus
    { FileStatus -> DeviceID
deviceID         :: !DeviceID
    , FileStatus -> Bool
isDirectory      :: !Bool
    , FileStatus -> EpochTime
modificationTime :: !EpochTime
    }

-- | Convert from 'Files.FileStatus' to 'FileStatus'
--
-- @since 0.5.0.0
toFileStatus :: Files.FileStatus -> FileStatus
toFileStatus :: FileStatus -> FileStatus
toFileStatus FileStatus
status = FileStatus
    { deviceID :: DeviceID
deviceID         = FileStatus -> DeviceID
Files.deviceID FileStatus
status
    , isDirectory :: Bool
isDirectory      = FileStatus -> Bool
Files.isDirectory FileStatus
status
    , modificationTime :: EpochTime
modificationTime = FileStatus -> EpochTime
Files.modificationTime FileStatus
status
    }