{- |
Module:      PFile.Path
Copyright:   (c) 2024 Illia Shkroba
License:     BSD3
Maintainer:  Illia Shkroba <is@pjwstk.edu.pl>
Stability:   unstable
Portability: non-portable (Non-Unix systems are not supported)

Wrapper of 'System.Directory' and 'System.FilePath'.
-}

{-# LANGUAGE BlockArguments             #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE ViewPatterns               #-}

module PFile.Path
  ( findDirectories
  , findFiles
  , find
  , FindResult (..)
  , (<//>)
  , parseAbsolute
  , canonicalizePath
  , copy
  , copyDirectory
  , copyDirectoryLink
  , copyFile
  , copyFileLink
  , copyLink
  , showCopyError
  , CopyError (..)
  , showCopyLinkError
  , CopyLinkError (..)
  , showCopyFileError
  , CopyFileError (..)
  , createDirectory
  , showCreateDirectoryError
  , CreateDirectoryError (..)
  , createDirectoryLink
  , showCreateDirectoryLinkError
  , CreateDirectoryLinkError (..)
  , createEmptyFile
  , createFileLink
  , showCreateFileLinkError
  , CreateFileLinkError (..)
  , createLink
  , showCreateLinkError
  , CreateLinkError (..)
  , createParent
  , showCreateParentError
  , CreateParentError (..)
  , doesDirectoryExist
  , doesFileExist
  , doesPathExist
  , dropDrive
  , dropFileName
  , dropTrailingPathSeparator
  , getSymbolicLinkTarget
  , listDirectory
  , makeRelative
  , move
  , moveDirectory
  , moveDirectoryLink
  , moveFile
  , moveFileLink
  , showMoveError
  , MoveError (..)
  , showMoveDirectoryError
  , MoveDirectoryError (..)
  , showMoveDirectoryLinkError
  , MoveDirectoryLinkError (..)
  , showMoveFileError
  , MoveFileError (..)
  , showMoveFileLinkError
  , MoveFileLinkError (..)
  , pathIsSymbolicLink
  , remove
  , showRemoveError
  , RemoveError (..)
  , renameDirectory
  , renameFile
  , takeBaseName
  , typeOf
  , showType
  , Type (..)
  , PFile.Path.writeFile
  , showWriteFileError
  , WriteFileError (..)
  , showAbsolute
  , Absolute (..)
  ) where

import           Data.Aeson       (FromJSON, ToJSON)
import           Data.HashSet     (HashSet)
import qualified Data.HashSet     as HashSet
import           GHC.IO.Exception (IOErrorType (..))
import           PFile.Error      (liftIOWithError, modifyError, onIOError)
import           Protolude        hiding (Type, find, typeOf)
import qualified System.Directory as Directory
import           System.Directory (makeAbsolute)
import qualified System.FilePath  as FilePath
import           System.FilePath  ((</>))
import           System.IO.Error  (ioeGetErrorType, tryIOError)

findDirectories :: MonadIO m => Absolute -> m [Absolute]
findDirectories :: forall (m :: * -> *). MonadIO m => Absolute -> m [Absolute]
findDirectories Absolute
root = HashSet Absolute -> [Absolute]
forall a. HashSet a -> [a]
HashSet.toList (HashSet Absolute -> [Absolute])
-> (FindResult -> HashSet Absolute) -> FindResult -> [Absolute]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FindResult -> HashSet Absolute
dirs (FindResult -> [Absolute]) -> m FindResult -> m [Absolute]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Absolute -> m FindResult
forall (m :: * -> *). MonadIO m => Absolute -> m FindResult
find Absolute
root

findFiles :: MonadIO m => Absolute -> m [Absolute]
findFiles :: forall (m :: * -> *). MonadIO m => Absolute -> m [Absolute]
findFiles Absolute
root = HashSet Absolute -> [Absolute]
forall a. HashSet a -> [a]
HashSet.toList (HashSet Absolute -> [Absolute])
-> (FindResult -> HashSet Absolute) -> FindResult -> [Absolute]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FindResult -> HashSet Absolute
files (FindResult -> [Absolute]) -> m FindResult -> m [Absolute]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Absolute -> m FindResult
forall (m :: * -> *). MonadIO m => Absolute -> m FindResult
find Absolute
root

find ::
     forall m. MonadIO m
  => Absolute
  -> m FindResult
find :: forall (m :: * -> *). MonadIO m => Absolute -> m FindResult
find = FindResult -> Absolute -> m FindResult
go FindResult {files :: HashSet Absolute
files = HashSet Absolute
forall a. HashSet a
HashSet.empty, dirs :: HashSet Absolute
dirs = HashSet Absolute
forall a. HashSet a
HashSet.empty}
  where
    go :: FindResult -> Absolute -> m FindResult
    go :: FindResult -> Absolute -> m FindResult
go acc :: FindResult
acc@FindResult {HashSet Absolute
files :: FindResult -> HashSet Absolute
files :: HashSet Absolute
files, HashSet Absolute
dirs :: FindResult -> HashSet Absolute
dirs :: HashSet Absolute
dirs} Absolute
root = do
      Absolute
path <- Absolute -> m Absolute
forall (m :: * -> *). MonadIO m => Absolute -> m Absolute
canonicalizePath Absolute
root
      m Bool -> m FindResult -> m FindResult -> m FindResult
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Absolute -> m Bool
forall (m :: * -> *). MonadIO m => Absolute -> m Bool
doesFileExist Absolute
path)
        (FindResult -> m FindResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FindResult
acc {files :: HashSet Absolute
files = Absolute -> HashSet Absolute -> HashSet Absolute
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert Absolute
path HashSet Absolute
files})
        if Absolute
path Absolute -> HashSet Absolute -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HashSet.member` HashSet Absolute
dirs
          then FindResult -> m FindResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FindResult
acc
          else IO [Absolute] -> IO (Either IOException [Absolute])
forall a. IO a -> IO (Either IOException a)
tryIOError (Absolute -> IO [Absolute]
forall (m :: * -> *). MonadIO m => Absolute -> m [Absolute]
listDirectory Absolute
path) IO (Either IOException [Absolute])
-> (IO (Either IOException [Absolute])
    -> m (Either IOException [Absolute]))
-> m (Either IOException [Absolute])
forall a b. a -> (a -> b) -> b
& IO (Either IOException [Absolute])
-> m (Either IOException [Absolute])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO m (Either IOException [Absolute])
-> (Either IOException [Absolute] -> m FindResult) -> m FindResult
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IOException -> m FindResult)
-> ([Absolute] -> m FindResult)
-> Either IOException [Absolute]
-> m FindResult
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
            (m FindResult -> IOException -> m FindResult
forall a b. a -> b -> a
const (m FindResult -> IOException -> m FindResult)
-> m FindResult -> IOException -> m FindResult
forall a b. (a -> b) -> a -> b
$ FindResult -> m FindResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FindResult
acc)
            ((FindResult -> Absolute -> m FindResult)
-> FindResult -> [Absolute] -> m FindResult
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM FindResult -> Absolute -> m FindResult
go FindResult
acc {dirs :: HashSet Absolute
dirs = Absolute -> HashSet Absolute -> HashSet Absolute
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert Absolute
path HashSet Absolute
dirs})

data FindResult
  = FindResult
      { FindResult -> HashSet Absolute
files :: !(HashSet Absolute)
      , FindResult -> HashSet Absolute
dirs  :: !(HashSet Absolute)
      }

infixr 5 <//>

(<//>) :: Absolute -> FilePath -> Absolute
<//> :: Absolute -> FilePath -> Absolute
(<//>) (Absolute FilePath
x) FilePath
y = FilePath -> Absolute
Absolute (FilePath -> Absolute) -> FilePath -> Absolute
forall a b. (a -> b) -> a -> b
$ FilePath
x FilePath -> FilePath -> FilePath
</> FilePath
y

parseAbsolute :: MonadIO m => FilePath -> m (Maybe Absolute)
parseAbsolute :: forall (m :: * -> *). MonadIO m => FilePath -> m (Maybe Absolute)
parseAbsolute FilePath
inputPath =
  FilePath -> IO FilePath
makeAbsolute FilePath
inputPath IO FilePath
-> (IO FilePath -> IO (Either IOException FilePath))
-> IO (Either IOException FilePath)
forall a b. a -> (a -> b) -> b
& IO FilePath -> IO (Either IOException FilePath)
forall a. IO a -> IO (Either IOException a)
tryIOError IO (Either IOException FilePath)
-> (IO (Either IOException FilePath)
    -> m (Either IOException FilePath))
-> m (Either IOException FilePath)
forall a b. a -> (a -> b) -> b
& IO (Either IOException FilePath) -> m (Either IOException FilePath)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    m (Either IOException FilePath)
-> (Either IOException FilePath -> m (Maybe Absolute))
-> m (Maybe Absolute)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IOException -> m (Maybe Absolute))
-> (FilePath -> m (Maybe Absolute))
-> Either IOException FilePath
-> m (Maybe Absolute)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (m (Maybe Absolute) -> IOException -> m (Maybe Absolute)
forall a b. a -> b -> a
const (m (Maybe Absolute) -> IOException -> m (Maybe Absolute))
-> m (Maybe Absolute) -> IOException -> m (Maybe Absolute)
forall a b. (a -> b) -> a -> b
$ Maybe Absolute -> m (Maybe Absolute)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Absolute
forall a. Maybe a
Nothing) \(FilePath -> Absolute
Absolute -> Absolute
path) ->
      Absolute -> m Bool
forall (m :: * -> *). MonadIO m => Absolute -> m Bool
doesPathExist Absolute
path m Bool -> (Bool -> Maybe Absolute) -> m (Maybe Absolute)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Maybe Absolute -> Maybe Absolute -> Bool -> Maybe Absolute
forall a. a -> a -> Bool -> a
bool Maybe Absolute
forall a. Maybe a
Nothing (Absolute -> Maybe Absolute
forall a. a -> Maybe a
Just (Absolute -> Maybe Absolute) -> Absolute -> Maybe Absolute
forall a b. (a -> b) -> a -> b
$ Absolute -> Absolute
dropTrailingPathSeparator Absolute
path)

canonicalizePath :: MonadIO m => Absolute -> m Absolute
canonicalizePath :: forall (m :: * -> *). MonadIO m => Absolute -> m Absolute
canonicalizePath (Absolute FilePath
path) =
  FilePath -> IO FilePath
Directory.canonicalizePath FilePath
path IO FilePath -> (FilePath -> Absolute) -> IO Absolute
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> FilePath -> Absolute
Absolute IO Absolute -> (IO Absolute -> m Absolute) -> m Absolute
forall a b. a -> (a -> b) -> b
& IO Absolute -> m Absolute
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

copy :: (MonadError CopyError m, MonadIO m) => Absolute -> Absolute -> m ()
copy :: forall (m :: * -> *).
(MonadError CopyError m, MonadIO m) =>
Absolute -> Absolute -> m ()
copy Absolute
src Absolute
dest =
  Absolute -> m (Maybe Type)
forall (m :: * -> *). MonadIO m => Absolute -> m (Maybe Type)
typeOf Absolute
src m (Maybe Type) -> (Maybe Type -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m () -> (Type -> m ()) -> Maybe Type -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CopyError -> m ()
forall a. CopyError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CopyError -> m ()) -> CopyError -> m ()
forall a b. (a -> b) -> a -> b
$ Absolute -> CopyError
SourceTypeResolveCopyError Absolute
src) \case
    Type
Directory     -> Absolute -> Absolute -> m ()
forall (m :: * -> *).
(MonadError CopyError m, MonadIO m) =>
Absolute -> Absolute -> m ()
copyDirectory Absolute
src Absolute
dest
    Type
DirectoryLink -> Absolute -> Absolute -> ExceptT CopyLinkError m ()
forall (m :: * -> *).
(MonadError CopyLinkError m, MonadIO m) =>
Absolute -> Absolute -> m ()
copyDirectoryLink Absolute
src Absolute
dest ExceptT CopyLinkError m ()
-> (ExceptT CopyLinkError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CopyLinkError -> CopyError) -> ExceptT CopyLinkError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CopyLinkError -> CopyError
CopyLinkError
    Type
File          -> Absolute -> Absolute -> ExceptT CopyFileError m ()
forall (m :: * -> *).
(MonadError CopyFileError m, MonadIO m) =>
Absolute -> Absolute -> m ()
copyFile Absolute
src Absolute
dest ExceptT CopyFileError m ()
-> (ExceptT CopyFileError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CopyFileError -> CopyError) -> ExceptT CopyFileError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CopyFileError -> CopyError
CopyFileError
    Type
FileLink      -> Absolute -> Absolute -> ExceptT CopyLinkError m ()
forall (m :: * -> *).
(MonadError CopyLinkError m, MonadIO m) =>
Absolute -> Absolute -> m ()
copyFileLink Absolute
src Absolute
dest ExceptT CopyLinkError m ()
-> (ExceptT CopyLinkError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CopyLinkError -> CopyError) -> ExceptT CopyLinkError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CopyLinkError -> CopyError
CopyLinkError

copyDirectory ::
     (MonadError CopyError m, MonadIO m) => Absolute -> Absolute -> m ()
copyDirectory :: forall (m :: * -> *).
(MonadError CopyError m, MonadIO m) =>
Absolute -> Absolute -> m ()
copyDirectory Absolute
src Absolute
dest = do
  [FilePath]
paths <- FilePath -> IO [FilePath]
Directory.listDirectory (Absolute -> FilePath
unAbsolute Absolute
src)
    IO [FilePath] -> (IOException -> CopyError) -> m [FilePath]
forall e (m :: * -> *) a.
(MonadError e m, MonadIO m) =>
IO a -> (IOException -> e) -> m a
`liftIOWithError` Absolute -> IOException -> CopyError
ListDirectoryError Absolute
src
  if [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
paths
    then Absolute -> ExceptT CreateDirectoryError m ()
forall (m :: * -> *).
(MonadError CreateDirectoryError m, MonadIO m) =>
Absolute -> m ()
createDirectory Absolute
dest ExceptT CreateDirectoryError m ()
-> (ExceptT CreateDirectoryError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CreateDirectoryError -> CopyError)
-> ExceptT CreateDirectoryError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CreateDirectoryError -> CopyError
CreateDirectoryInCopyError
    else (Absolute -> Absolute -> m ()) -> [Absolute] -> [Absolute] -> m ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ Absolute -> Absolute -> m ()
forall (m :: * -> *).
(MonadError CopyError m, MonadIO m) =>
Absolute -> Absolute -> m ()
copy ((Absolute
src Absolute -> FilePath -> Absolute
<//>) (FilePath -> Absolute) -> [FilePath] -> [Absolute]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
paths) ((Absolute
dest Absolute -> FilePath -> Absolute
<//>) (FilePath -> Absolute) -> [FilePath] -> [Absolute]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
paths)

copyDirectoryLink ::
     (MonadError CopyLinkError m, MonadIO m) => Absolute -> Absolute -> m ()
copyDirectoryLink :: forall (m :: * -> *).
(MonadError CopyLinkError m, MonadIO m) =>
Absolute -> Absolute -> m ()
copyDirectoryLink Absolute
src Absolute
dest = do
  Absolute -> ExceptT CreateParentError m ()
forall (m :: * -> *).
(MonadError CreateParentError m, MonadIO m) =>
Absolute -> m ()
createParent Absolute
dest
    ExceptT CreateParentError m ()
-> (ExceptT CreateParentError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CreateParentError -> CopyLinkError)
-> ExceptT CreateParentError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CreateParentError -> CopyLinkError
CreateParentInCopyLinkError
  Absolute
target <- Absolute -> IO Absolute
forall (m :: * -> *). MonadIO m => Absolute -> m Absolute
getSymbolicLinkTarget Absolute
src
    IO Absolute -> (IOException -> CopyLinkError) -> m Absolute
forall e (m :: * -> *) a.
(MonadError e m, MonadIO m) =>
IO a -> (IOException -> e) -> m a
`liftIOWithError` Absolute -> IOException -> CopyLinkError
LinkTargetResolveError Absolute
src
  Absolute -> Absolute -> ExceptT CreateDirectoryLinkError m ()
forall (m :: * -> *).
(MonadError CreateDirectoryLinkError m, MonadIO m) =>
Absolute -> Absolute -> m ()
createDirectoryLink Absolute
target Absolute
dest
    ExceptT CreateDirectoryLinkError m ()
-> (ExceptT CreateDirectoryLinkError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CreateDirectoryLinkError -> CopyLinkError)
-> ExceptT CreateDirectoryLinkError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CreateDirectoryLinkError -> CopyLinkError
CreateDirectoryLinkInCopyLinkError

copyFile ::
     (MonadError CopyFileError m, MonadIO m) => Absolute -> Absolute -> m ()
copyFile :: forall (m :: * -> *).
(MonadError CopyFileError m, MonadIO m) =>
Absolute -> Absolute -> m ()
copyFile Absolute
src Absolute
dest = do
  Absolute -> ExceptT CreateParentError m ()
forall (m :: * -> *).
(MonadError CreateParentError m, MonadIO m) =>
Absolute -> m ()
createParent Absolute
dest
    ExceptT CreateParentError m ()
-> (ExceptT CreateParentError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CreateParentError -> CopyFileError)
-> ExceptT CreateParentError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CreateParentError -> CopyFileError
CreateParentInCopyFileError
  FilePath -> FilePath -> IO ()
Directory.copyFileWithMetadata (Absolute -> FilePath
unAbsolute Absolute
src) (Absolute -> FilePath
unAbsolute Absolute
dest)
    IO () -> (IOException -> CopyFileError) -> m ()
forall e (m :: * -> *) a.
(MonadError e m, MonadIO m) =>
IO a -> (IOException -> e) -> m a
`liftIOWithError` Absolute -> Absolute -> IOException -> CopyFileError
CopyFileWithMetadataError Absolute
src Absolute
dest

copyFileLink ::
     (MonadError CopyLinkError m, MonadIO m) => Absolute -> Absolute -> m ()
copyFileLink :: forall (m :: * -> *).
(MonadError CopyLinkError m, MonadIO m) =>
Absolute -> Absolute -> m ()
copyFileLink Absolute
src Absolute
dest = do
  Absolute -> ExceptT CreateParentError m ()
forall (m :: * -> *).
(MonadError CreateParentError m, MonadIO m) =>
Absolute -> m ()
createParent Absolute
dest
    ExceptT CreateParentError m ()
-> (ExceptT CreateParentError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CreateParentError -> CopyLinkError)
-> ExceptT CreateParentError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CreateParentError -> CopyLinkError
CreateParentInCopyLinkError
  Absolute
target <- Absolute -> IO Absolute
forall (m :: * -> *). MonadIO m => Absolute -> m Absolute
getSymbolicLinkTarget Absolute
src
    IO Absolute -> (IOException -> CopyLinkError) -> m Absolute
forall e (m :: * -> *) a.
(MonadError e m, MonadIO m) =>
IO a -> (IOException -> e) -> m a
`liftIOWithError` Absolute -> IOException -> CopyLinkError
LinkTargetResolveError Absolute
src
  Absolute -> Absolute -> ExceptT CreateFileLinkError m ()
forall (m :: * -> *).
(MonadError CreateFileLinkError m, MonadIO m) =>
Absolute -> Absolute -> m ()
createFileLink Absolute
target Absolute
dest
    ExceptT CreateFileLinkError m ()
-> (ExceptT CreateFileLinkError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CreateFileLinkError -> CopyLinkError)
-> ExceptT CreateFileLinkError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CreateFileLinkError -> CopyLinkError
CreateFileLinkInCopyLinkError

copyLink ::
     (MonadError CopyLinkError m, MonadIO m) => Absolute -> Absolute -> m ()
copyLink :: forall (m :: * -> *).
(MonadError CopyLinkError m, MonadIO m) =>
Absolute -> Absolute -> m ()
copyLink Absolute
src Absolute
dest =
  m Bool -> m () -> m () -> m ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Absolute -> m Bool
forall (m :: * -> *). MonadIO m => Absolute -> m Bool
doesDirectoryExist Absolute
src)
    (Absolute -> Absolute -> m ()
forall (m :: * -> *).
(MonadError CopyLinkError m, MonadIO m) =>
Absolute -> Absolute -> m ()
copyDirectoryLink Absolute
src Absolute
dest)
    (Absolute -> Absolute -> m ()
forall (m :: * -> *).
(MonadError CopyLinkError m, MonadIO m) =>
Absolute -> Absolute -> m ()
copyFileLink Absolute
src Absolute
dest)

showCopyError :: CopyError -> Text
showCopyError :: CopyError -> Text
showCopyError = \case
  SourceTypeResolveCopyError Absolute
path
    -> Text
"Unable to resolve type of path: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
  ListDirectoryError Absolute
path IOException
cause
    -> Text
"Unable to list directory " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
path
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a b. (Show a, StringConv FilePath b) => a -> b
show IOException
cause
  CreateDirectoryInCopyError CreateDirectoryError
cause -> CreateDirectoryError -> Text
showCreateDirectoryError CreateDirectoryError
cause
  CopyLinkError CopyLinkError
cause -> CopyLinkError -> Text
showCopyLinkError CopyLinkError
cause
  CopyFileError CopyFileError
cause -> CopyFileError -> Text
showCopyFileError CopyFileError
cause

data CopyError
  = SourceTypeResolveCopyError !Absolute
  | ListDirectoryError !Absolute !IOException
  | CreateDirectoryInCopyError !CreateDirectoryError
  | CopyLinkError !CopyLinkError
  | CopyFileError !CopyFileError

showCopyLinkError :: CopyLinkError -> Text
showCopyLinkError :: CopyLinkError -> Text
showCopyLinkError = \case
  CreateParentInCopyLinkError CreateParentError
cause -> CreateParentError -> Text
showCreateParentError CreateParentError
cause
  LinkTargetResolveError Absolute
path IOException
cause
    -> Text
"Unable to resolve link of path " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
path
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a b. (Show a, StringConv FilePath b) => a -> b
show IOException
cause
  CreateDirectoryLinkInCopyLinkError CreateDirectoryLinkError
cause -> CreateDirectoryLinkError -> Text
showCreateDirectoryLinkError CreateDirectoryLinkError
cause
  CreateFileLinkInCopyLinkError CreateFileLinkError
cause -> CreateFileLinkError -> Text
showCreateFileLinkError CreateFileLinkError
cause

data CopyLinkError
  = CreateParentInCopyLinkError !CreateParentError
  | LinkTargetResolveError !Absolute !IOException
  | CreateDirectoryLinkInCopyLinkError !CreateDirectoryLinkError
  | CreateFileLinkInCopyLinkError !CreateFileLinkError

showCopyFileError :: CopyFileError -> Text
showCopyFileError :: CopyFileError -> Text
showCopyFileError = \case
  CreateParentInCopyFileError CreateParentError
cause -> CreateParentError -> Text
showCreateParentError CreateParentError
cause
  CopyFileWithMetadataError Absolute
src Absolute
dest IOException
cause
    -> Text
"Unable to copy file " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
src
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" into " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
dest
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a b. (Show a, StringConv FilePath b) => a -> b
show IOException
cause

data CopyFileError
  = CreateParentInCopyFileError !CreateParentError
  | CopyFileWithMetadataError !Absolute !Absolute !IOException

createDirectory ::
     (MonadError CreateDirectoryError m, MonadIO m) => Absolute -> m ()
createDirectory :: forall (m :: * -> *).
(MonadError CreateDirectoryError m, MonadIO m) =>
Absolute -> m ()
createDirectory Absolute
path =
  Bool -> FilePath -> IO ()
Directory.createDirectoryIfMissing Bool
True (Absolute -> FilePath
unAbsolute Absolute
path)
    IO () -> (IOException -> CreateDirectoryError) -> m ()
forall e (m :: * -> *) a.
(MonadError e m, MonadIO m) =>
IO a -> (IOException -> e) -> m a
`liftIOWithError` Absolute -> IOException -> CreateDirectoryError
CreateDirectoryError Absolute
path

showCreateDirectoryError :: CreateDirectoryError -> Text
showCreateDirectoryError :: CreateDirectoryError -> Text
showCreateDirectoryError = \case
  CreateDirectoryError Absolute
path IOException
cause
    -> Text
"Unable to create directory " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
path
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a b. (Show a, StringConv FilePath b) => a -> b
show IOException
cause

data CreateDirectoryError
  = CreateDirectoryError !Absolute !IOException

createDirectoryLink ::
     (MonadError CreateDirectoryLinkError m, MonadIO m)
  => Absolute
  -> Absolute
  -> m ()
createDirectoryLink :: forall (m :: * -> *).
(MonadError CreateDirectoryLinkError m, MonadIO m) =>
Absolute -> Absolute -> m ()
createDirectoryLink
    (Absolute -> Absolute
dropTrailingPathSeparator -> Absolute
dest)
    (Absolute -> Absolute
dropTrailingPathSeparator -> Absolute
src) = do
  Absolute -> ExceptT CreateParentError m ()
forall (m :: * -> *).
(MonadError CreateParentError m, MonadIO m) =>
Absolute -> m ()
createParent Absolute
src
    ExceptT CreateParentError m ()
-> (ExceptT CreateParentError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CreateParentError -> CreateDirectoryLinkError)
-> ExceptT CreateParentError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CreateParentError -> CreateDirectoryLinkError
CreateParentInCreateDirectoryLinkError
  FilePath -> FilePath -> IO ()
Directory.createDirectoryLink (Absolute -> FilePath
unAbsolute Absolute
dest) (Absolute -> FilePath
unAbsolute Absolute
src)
    IO () -> (IOException -> CreateDirectoryLinkError) -> m ()
forall e (m :: * -> *) a.
(MonadError e m, MonadIO m) =>
IO a -> (IOException -> e) -> m a
`liftIOWithError` Absolute -> Absolute -> IOException -> CreateDirectoryLinkError
CreateDirectoryLinkError Absolute
dest Absolute
src

showCreateDirectoryLinkError :: CreateDirectoryLinkError -> Text
showCreateDirectoryLinkError :: CreateDirectoryLinkError -> Text
showCreateDirectoryLinkError = \case
  CreateParentInCreateDirectoryLinkError CreateParentError
cause -> CreateParentError -> Text
showCreateParentError CreateParentError
cause
  CreateDirectoryLinkError Absolute
dest Absolute
src IOException
cause
    -> Text
"Unable to link " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
src
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
dest
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a b. (Show a, StringConv FilePath b) => a -> b
show IOException
cause

data CreateDirectoryLinkError
  = CreateParentInCreateDirectoryLinkError !CreateParentError
  | CreateDirectoryLinkError !Absolute !Absolute !IOException

createEmptyFile :: (MonadError WriteFileError m, MonadIO m) => Absolute -> m ()
createEmptyFile :: forall (m :: * -> *).
(MonadError WriteFileError m, MonadIO m) =>
Absolute -> m ()
createEmptyFile Absolute
path = Absolute -> Text -> m ()
forall (m :: * -> *).
(MonadError WriteFileError m, MonadIO m) =>
Absolute -> Text -> m ()
PFile.Path.writeFile Absolute
path Text
""

createFileLink ::
     (MonadError CreateFileLinkError m, MonadIO m)
  => Absolute
  -> Absolute
  -> m ()
createFileLink :: forall (m :: * -> *).
(MonadError CreateFileLinkError m, MonadIO m) =>
Absolute -> Absolute -> m ()
createFileLink
    (Absolute -> Absolute
dropTrailingPathSeparator -> Absolute
dest)
    (Absolute -> Absolute
dropTrailingPathSeparator -> Absolute
src) = do
  Absolute -> ExceptT CreateParentError m ()
forall (m :: * -> *).
(MonadError CreateParentError m, MonadIO m) =>
Absolute -> m ()
createParent Absolute
src
    ExceptT CreateParentError m ()
-> (ExceptT CreateParentError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CreateParentError -> CreateFileLinkError)
-> ExceptT CreateParentError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CreateParentError -> CreateFileLinkError
CreateParentInCreateFileLinkError
  FilePath -> FilePath -> IO ()
Directory.createFileLink (Absolute -> FilePath
unAbsolute Absolute
dest) (Absolute -> FilePath
unAbsolute Absolute
src)
    IO () -> (IOException -> CreateFileLinkError) -> m ()
forall e (m :: * -> *) a.
(MonadError e m, MonadIO m) =>
IO a -> (IOException -> e) -> m a
`liftIOWithError` Absolute -> Absolute -> IOException -> CreateFileLinkError
CreateFileLinkError Absolute
dest Absolute
src

showCreateFileLinkError :: CreateFileLinkError -> Text
showCreateFileLinkError :: CreateFileLinkError -> Text
showCreateFileLinkError = \case
  CreateParentInCreateFileLinkError CreateParentError
cause -> CreateParentError -> Text
showCreateParentError CreateParentError
cause
  CreateFileLinkError Absolute
dest Absolute
src IOException
cause
    -> Text
"Unable to link " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
src
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
dest
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a b. (Show a, StringConv FilePath b) => a -> b
show IOException
cause

data CreateFileLinkError
  = CreateParentInCreateFileLinkError !CreateParentError
  | CreateFileLinkError !Absolute !Absolute !IOException

createLink ::
     (MonadError CreateLinkError m, MonadIO m) => Absolute -> Absolute -> m ()
createLink :: forall (m :: * -> *).
(MonadError CreateLinkError m, MonadIO m) =>
Absolute -> Absolute -> m ()
createLink Absolute
dest Absolute
src =
  m Bool -> m () -> m () -> m ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Absolute -> m Bool
forall (m :: * -> *). MonadIO m => Absolute -> m Bool
doesDirectoryExist Absolute
dest)
    (Absolute -> Absolute -> ExceptT CreateDirectoryLinkError m ()
forall (m :: * -> *).
(MonadError CreateDirectoryLinkError m, MonadIO m) =>
Absolute -> Absolute -> m ()
createDirectoryLink Absolute
dest Absolute
src ExceptT CreateDirectoryLinkError m ()
-> (ExceptT CreateDirectoryLinkError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CreateDirectoryLinkError -> CreateLinkError)
-> ExceptT CreateDirectoryLinkError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CreateDirectoryLinkError -> CreateLinkError
DirectoryLinkError)
    (Absolute -> Absolute -> ExceptT CreateFileLinkError m ()
forall (m :: * -> *).
(MonadError CreateFileLinkError m, MonadIO m) =>
Absolute -> Absolute -> m ()
createFileLink Absolute
dest Absolute
src ExceptT CreateFileLinkError m ()
-> (ExceptT CreateFileLinkError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CreateFileLinkError -> CreateLinkError)
-> ExceptT CreateFileLinkError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CreateFileLinkError -> CreateLinkError
FileLinkError)

showCreateLinkError :: CreateLinkError -> Text
showCreateLinkError :: CreateLinkError -> Text
showCreateLinkError = \case
  DirectoryLinkError CreateDirectoryLinkError
cause -> CreateDirectoryLinkError -> Text
showCreateDirectoryLinkError CreateDirectoryLinkError
cause
  FileLinkError CreateFileLinkError
cause      -> CreateFileLinkError -> Text
showCreateFileLinkError CreateFileLinkError
cause

data CreateLinkError
  = DirectoryLinkError !CreateDirectoryLinkError
  | FileLinkError !CreateFileLinkError

createParent :: (MonadError CreateParentError m, MonadIO m) => Absolute -> m ()
createParent :: forall (m :: * -> *).
(MonadError CreateParentError m, MonadIO m) =>
Absolute -> m ()
createParent (Absolute -> Absolute
dropTrailingPathSeparator -> Absolute
path) =
  Absolute -> ExceptT CreateDirectoryError m ()
forall (m :: * -> *).
(MonadError CreateDirectoryError m, MonadIO m) =>
Absolute -> m ()
createDirectory (Absolute -> Absolute
dropFileName Absolute
path)
    ExceptT CreateDirectoryError m ()
-> (ExceptT CreateDirectoryError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CreateDirectoryError -> CreateParentError)
-> ExceptT CreateDirectoryError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError (Absolute -> CreateDirectoryError -> CreateParentError
CreateParentError Absolute
path)

showCreateParentError :: CreateParentError -> Text
showCreateParentError :: CreateParentError -> Text
showCreateParentError = \case
  CreateParentError Absolute
path (CreateDirectoryError Absolute
_ IOException
cause)
    -> Text
"Unable to create parent directory for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
path
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a b. (Show a, StringConv FilePath b) => a -> b
show IOException
cause

data CreateParentError
  = CreateParentError !Absolute !CreateDirectoryError

doesDirectoryExist :: MonadIO m => Absolute -> m Bool
doesDirectoryExist :: forall (m :: * -> *). MonadIO m => Absolute -> m Bool
doesDirectoryExist (Absolute FilePath
path) =
  FilePath -> IO Bool
Directory.doesDirectoryExist FilePath
path IO Bool -> IO Bool -> IO Bool
forall a. IO a -> IO a -> IO a
`onIOError` Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False IO Bool -> (IO Bool -> m Bool) -> m Bool
forall a b. a -> (a -> b) -> b
& IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

doesFileExist :: MonadIO m => Absolute -> m Bool
doesFileExist :: forall (m :: * -> *). MonadIO m => Absolute -> m Bool
doesFileExist (Absolute FilePath
path) =
  FilePath -> IO Bool
Directory.doesFileExist FilePath
path IO Bool -> IO Bool -> IO Bool
forall a. IO a -> IO a -> IO a
`onIOError` Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False IO Bool -> (IO Bool -> m Bool) -> m Bool
forall a b. a -> (a -> b) -> b
& IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

doesPathExist :: MonadIO m => Absolute -> m Bool
doesPathExist :: forall (m :: * -> *). MonadIO m => Absolute -> m Bool
doesPathExist (Absolute FilePath
path) =
  FilePath -> IO Bool
Directory.doesPathExist FilePath
path IO Bool -> IO Bool -> IO Bool
forall a. IO a -> IO a -> IO a
`onIOError` Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False IO Bool -> (IO Bool -> m Bool) -> m Bool
forall a b. a -> (a -> b) -> b
& IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

dropDrive :: Absolute -> FilePath
dropDrive :: Absolute -> FilePath
dropDrive (Absolute FilePath
path) = FilePath -> FilePath
FilePath.dropDrive FilePath
path

dropFileName :: Absolute -> Absolute
dropFileName :: Absolute -> Absolute
dropFileName (Absolute FilePath
path) = FilePath -> Absolute
Absolute (FilePath -> Absolute) -> FilePath -> Absolute
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
FilePath.dropFileName FilePath
path

dropTrailingPathSeparator :: Absolute -> Absolute
dropTrailingPathSeparator :: Absolute -> Absolute
dropTrailingPathSeparator (Absolute FilePath
path) =
  FilePath -> Absolute
Absolute (FilePath -> Absolute) -> FilePath -> Absolute
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
FilePath.dropTrailingPathSeparator FilePath
path

getSymbolicLinkTarget :: MonadIO m => Absolute -> m Absolute
getSymbolicLinkTarget :: forall (m :: * -> *). MonadIO m => Absolute -> m Absolute
getSymbolicLinkTarget (Absolute -> Absolute
dropTrailingPathSeparator -> Absolute FilePath
path) =
  FilePath -> IO FilePath
Directory.getSymbolicLinkTarget FilePath
path IO FilePath -> (FilePath -> Absolute) -> IO Absolute
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> FilePath -> Absolute
Absolute IO Absolute -> (IO Absolute -> m Absolute) -> m Absolute
forall a b. a -> (a -> b) -> b
& IO Absolute -> m Absolute
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

listDirectory :: MonadIO m => Absolute -> m [Absolute]
listDirectory :: forall (m :: * -> *). MonadIO m => Absolute -> m [Absolute]
listDirectory Absolute
path
  =   FilePath -> IO [FilePath]
Directory.listDirectory (Absolute -> FilePath
unAbsolute Absolute
path)
  IO [FilePath] -> ([FilePath] -> [Absolute]) -> IO [Absolute]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (FilePath -> Absolute) -> [FilePath] -> [Absolute]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Absolute
path Absolute -> FilePath -> Absolute
<//>) IO [Absolute] -> (IO [Absolute] -> m [Absolute]) -> m [Absolute]
forall a b. a -> (a -> b) -> b
& IO [Absolute] -> m [Absolute]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

makeRelative :: Absolute -> Absolute -> FilePath
makeRelative :: Absolute -> Absolute -> FilePath
makeRelative (Absolute FilePath
root) (Absolute FilePath
path) = FilePath -> FilePath -> FilePath
FilePath.makeRelative FilePath
root FilePath
path

move :: (MonadError MoveError m, MonadIO m) => Absolute -> Absolute -> m ()
move :: forall (m :: * -> *).
(MonadError MoveError m, MonadIO m) =>
Absolute -> Absolute -> m ()
move Absolute
src Absolute
dest =
  Absolute -> m (Maybe Type)
forall (m :: * -> *). MonadIO m => Absolute -> m (Maybe Type)
typeOf Absolute
src m (Maybe Type) -> (Maybe Type -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m () -> (Type -> m ()) -> Maybe Type -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MoveError -> m ()
forall a. MoveError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MoveError -> m ()) -> MoveError -> m ()
forall a b. (a -> b) -> a -> b
$ Absolute -> MoveError
SourceTypeResolveMoveError Absolute
src) \case
    Type
Directory     -> Absolute -> Absolute -> ExceptT MoveDirectoryError m ()
forall (m :: * -> *).
(MonadError MoveDirectoryError m, MonadIO m) =>
Absolute -> Absolute -> m ()
moveDirectory Absolute
src Absolute
dest ExceptT MoveDirectoryError m ()
-> (ExceptT MoveDirectoryError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (MoveDirectoryError -> MoveError)
-> ExceptT MoveDirectoryError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError MoveDirectoryError -> MoveError
MoveDirectoryError
    Type
DirectoryLink -> Absolute -> Absolute -> ExceptT MoveDirectoryLinkError m ()
forall (m :: * -> *).
(MonadError MoveDirectoryLinkError m, MonadIO m) =>
Absolute -> Absolute -> m ()
moveDirectoryLink Absolute
src Absolute
dest ExceptT MoveDirectoryLinkError m ()
-> (ExceptT MoveDirectoryLinkError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (MoveDirectoryLinkError -> MoveError)
-> ExceptT MoveDirectoryLinkError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError MoveDirectoryLinkError -> MoveError
MoveDirectoryLinkError
    Type
File          -> Absolute -> Absolute -> ExceptT MoveFileError m ()
forall (m :: * -> *).
(MonadError MoveFileError m, MonadIO m) =>
Absolute -> Absolute -> m ()
moveFile Absolute
src Absolute
dest ExceptT MoveFileError m ()
-> (ExceptT MoveFileError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (MoveFileError -> MoveError) -> ExceptT MoveFileError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError MoveFileError -> MoveError
MoveFileError
    Type
FileLink      -> Absolute -> Absolute -> ExceptT MoveFileLinkError m ()
forall (m :: * -> *).
(MonadError MoveFileLinkError m, MonadIO m) =>
Absolute -> Absolute -> m ()
moveFileLink Absolute
src Absolute
dest ExceptT MoveFileLinkError m ()
-> (ExceptT MoveFileLinkError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (MoveFileLinkError -> MoveError)
-> ExceptT MoveFileLinkError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError MoveFileLinkError -> MoveError
MoveFileLinkError

moveDirectory ::
     (MonadError MoveDirectoryError m, MonadIO m)
  => Absolute
  -> Absolute
  -> m ()
moveDirectory :: forall (m :: * -> *).
(MonadError MoveDirectoryError m, MonadIO m) =>
Absolute -> Absolute -> m ()
moveDirectory Absolute
src Absolute
dest = do
  Absolute -> ExceptT CreateParentError m ()
forall (m :: * -> *).
(MonadError CreateParentError m, MonadIO m) =>
Absolute -> m ()
createParent Absolute
dest
    ExceptT CreateParentError m ()
-> (ExceptT CreateParentError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CreateParentError -> MoveDirectoryError)
-> ExceptT CreateParentError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CreateParentError -> MoveDirectoryError
CreateParentInMoveDirectoryError
  IO () -> IO (Either IOException ())
forall a. IO a -> IO (Either IOException a)
tryIOError (Absolute -> Absolute -> IO ()
forall (m :: * -> *). MonadIO m => Absolute -> Absolute -> m ()
renameDirectory Absolute
src Absolute
dest) IO (Either IOException ())
-> (IO (Either IOException ()) -> m (Either IOException ()))
-> m (Either IOException ())
forall a b. a -> (a -> b) -> b
& IO (Either IOException ()) -> m (Either IOException ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    m (Either IOException ())
-> (Either IOException () -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((IOException -> m ())
 -> (() -> m ()) -> Either IOException () -> m ())
-> (() -> m ())
-> (IOException -> m ())
-> Either IOException ()
-> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (IOException -> m ())
-> (() -> m ()) -> Either IOException () -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (m () -> () -> m ()
forall a b. a -> b -> a
const (m () -> () -> m ()) -> m () -> () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) \IOException
cause ->
      if IOException -> Bool
isCrossDeviceLinkError IOException
cause
        then do
          Absolute -> Absolute -> ExceptT CopyError m ()
forall (m :: * -> *).
(MonadError CopyError m, MonadIO m) =>
Absolute -> Absolute -> m ()
copyDirectory Absolute
src Absolute
dest
            ExceptT CopyError m () -> (ExceptT CopyError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CopyError -> MoveDirectoryError) -> ExceptT CopyError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CopyError -> MoveDirectoryError
FallbackCopyDirectoryError
          Absolute -> ExceptT RemoveError m ()
forall (m :: * -> *).
(MonadError RemoveError m, MonadIO m) =>
Absolute -> m ()
remove Absolute
src
            ExceptT RemoveError m ()
-> (ExceptT RemoveError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (RemoveError -> MoveDirectoryError)
-> ExceptT RemoveError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError RemoveError -> MoveDirectoryError
SourceDirectoryRemoveError
        else MoveDirectoryError -> m ()
forall a. MoveDirectoryError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MoveDirectoryError -> m ()) -> MoveDirectoryError -> m ()
forall a b. (a -> b) -> a -> b
$ Absolute -> Absolute -> IOException -> MoveDirectoryError
RenameDirectoryError Absolute
src Absolute
dest IOException
cause

moveDirectoryLink ::
     (MonadError MoveDirectoryLinkError m, MonadIO m)
  => Absolute
  -> Absolute
  -> m ()
moveDirectoryLink :: forall (m :: * -> *).
(MonadError MoveDirectoryLinkError m, MonadIO m) =>
Absolute -> Absolute -> m ()
moveDirectoryLink Absolute
src Absolute
dest = do
  Absolute -> ExceptT CreateParentError m ()
forall (m :: * -> *).
(MonadError CreateParentError m, MonadIO m) =>
Absolute -> m ()
createParent Absolute
dest
    ExceptT CreateParentError m ()
-> (ExceptT CreateParentError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CreateParentError -> MoveDirectoryLinkError)
-> ExceptT CreateParentError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CreateParentError -> MoveDirectoryLinkError
CreateParentInMoveDirectoryLinkError
  IO () -> IO (Either IOException ())
forall a. IO a -> IO (Either IOException a)
tryIOError (Absolute -> Absolute -> IO ()
forall (m :: * -> *). MonadIO m => Absolute -> Absolute -> m ()
renameDirectory Absolute
src Absolute
dest) IO (Either IOException ())
-> (IO (Either IOException ()) -> m (Either IOException ()))
-> m (Either IOException ())
forall a b. a -> (a -> b) -> b
& IO (Either IOException ()) -> m (Either IOException ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    m (Either IOException ())
-> (Either IOException () -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((IOException -> m ())
 -> (() -> m ()) -> Either IOException () -> m ())
-> (() -> m ())
-> (IOException -> m ())
-> Either IOException ()
-> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (IOException -> m ())
-> (() -> m ()) -> Either IOException () -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (m () -> () -> m ()
forall a b. a -> b -> a
const (m () -> () -> m ()) -> m () -> () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) \IOException
cause ->
      if IOException -> Bool
isCrossDeviceLinkError IOException
cause
        then do
          Absolute -> Absolute -> ExceptT CopyLinkError m ()
forall (m :: * -> *).
(MonadError CopyLinkError m, MonadIO m) =>
Absolute -> Absolute -> m ()
copyDirectoryLink Absolute
src Absolute
dest
            ExceptT CopyLinkError m ()
-> (ExceptT CopyLinkError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CopyLinkError -> MoveDirectoryLinkError)
-> ExceptT CopyLinkError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CopyLinkError -> MoveDirectoryLinkError
FallbackCopyDirectoryLinkError
          Absolute -> ExceptT RemoveError m ()
forall (m :: * -> *).
(MonadError RemoveError m, MonadIO m) =>
Absolute -> m ()
remove Absolute
src
            ExceptT RemoveError m ()
-> (ExceptT RemoveError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (RemoveError -> MoveDirectoryLinkError)
-> ExceptT RemoveError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError RemoveError -> MoveDirectoryLinkError
SourceDirectoryLinkRemoveError
        else MoveDirectoryLinkError -> m ()
forall a. MoveDirectoryLinkError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MoveDirectoryLinkError -> m ()) -> MoveDirectoryLinkError -> m ()
forall a b. (a -> b) -> a -> b
$ Absolute -> Absolute -> IOException -> MoveDirectoryLinkError
RenameDirectoryLinkError Absolute
src Absolute
dest IOException
cause

moveFile ::
     (MonadError MoveFileError m, MonadIO m) => Absolute -> Absolute -> m ()
moveFile :: forall (m :: * -> *).
(MonadError MoveFileError m, MonadIO m) =>
Absolute -> Absolute -> m ()
moveFile Absolute
src Absolute
dest = do
  Absolute -> ExceptT CreateParentError m ()
forall (m :: * -> *).
(MonadError CreateParentError m, MonadIO m) =>
Absolute -> m ()
createParent Absolute
dest
    ExceptT CreateParentError m ()
-> (ExceptT CreateParentError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CreateParentError -> MoveFileError)
-> ExceptT CreateParentError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CreateParentError -> MoveFileError
CreateParentInMoveFileError
  IO () -> IO (Either IOException ())
forall a. IO a -> IO (Either IOException a)
tryIOError (Absolute -> Absolute -> IO ()
forall (m :: * -> *). MonadIO m => Absolute -> Absolute -> m ()
renameFile Absolute
src Absolute
dest) IO (Either IOException ())
-> (IO (Either IOException ()) -> m (Either IOException ()))
-> m (Either IOException ())
forall a b. a -> (a -> b) -> b
& IO (Either IOException ()) -> m (Either IOException ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    m (Either IOException ())
-> (Either IOException () -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((IOException -> m ())
 -> (() -> m ()) -> Either IOException () -> m ())
-> (() -> m ())
-> (IOException -> m ())
-> Either IOException ()
-> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (IOException -> m ())
-> (() -> m ()) -> Either IOException () -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (m () -> () -> m ()
forall a b. a -> b -> a
const (m () -> () -> m ()) -> m () -> () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) \IOException
cause ->
      if IOException -> Bool
isCrossDeviceLinkError IOException
cause
        then do
          Absolute -> Absolute -> ExceptT CopyFileError m ()
forall (m :: * -> *).
(MonadError CopyFileError m, MonadIO m) =>
Absolute -> Absolute -> m ()
copyFile Absolute
src Absolute
dest
            ExceptT CopyFileError m ()
-> (ExceptT CopyFileError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CopyFileError -> MoveFileError)
-> ExceptT CopyFileError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CopyFileError -> MoveFileError
FallbackCopyFileError
          Absolute -> ExceptT RemoveError m ()
forall (m :: * -> *).
(MonadError RemoveError m, MonadIO m) =>
Absolute -> m ()
remove Absolute
src
            ExceptT RemoveError m ()
-> (ExceptT RemoveError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (RemoveError -> MoveFileError) -> ExceptT RemoveError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError RemoveError -> MoveFileError
SourceFileRemoveError
        else MoveFileError -> m ()
forall a. MoveFileError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MoveFileError -> m ()) -> MoveFileError -> m ()
forall a b. (a -> b) -> a -> b
$ Absolute -> Absolute -> IOException -> MoveFileError
RenameFileError Absolute
src Absolute
dest IOException
cause

moveFileLink ::
     (MonadError MoveFileLinkError m, MonadIO m) => Absolute -> Absolute -> m ()
moveFileLink :: forall (m :: * -> *).
(MonadError MoveFileLinkError m, MonadIO m) =>
Absolute -> Absolute -> m ()
moveFileLink Absolute
src Absolute
dest = do
  Absolute -> ExceptT CreateParentError m ()
forall (m :: * -> *).
(MonadError CreateParentError m, MonadIO m) =>
Absolute -> m ()
createParent Absolute
dest
    ExceptT CreateParentError m ()
-> (ExceptT CreateParentError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CreateParentError -> MoveFileLinkError)
-> ExceptT CreateParentError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CreateParentError -> MoveFileLinkError
CreateParentInMoveFileLinkError
  IO () -> IO (Either IOException ())
forall a. IO a -> IO (Either IOException a)
tryIOError (Absolute -> Absolute -> IO ()
forall (m :: * -> *). MonadIO m => Absolute -> Absolute -> m ()
renameFile Absolute
src Absolute
dest) IO (Either IOException ())
-> (IO (Either IOException ()) -> m (Either IOException ()))
-> m (Either IOException ())
forall a b. a -> (a -> b) -> b
& IO (Either IOException ()) -> m (Either IOException ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    m (Either IOException ())
-> (Either IOException () -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((IOException -> m ())
 -> (() -> m ()) -> Either IOException () -> m ())
-> (() -> m ())
-> (IOException -> m ())
-> Either IOException ()
-> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (IOException -> m ())
-> (() -> m ()) -> Either IOException () -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (m () -> () -> m ()
forall a b. a -> b -> a
const (m () -> () -> m ()) -> m () -> () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) \IOException
cause ->
      if IOException -> Bool
isCrossDeviceLinkError IOException
cause
        then do
          Absolute -> Absolute -> ExceptT CopyLinkError m ()
forall (m :: * -> *).
(MonadError CopyLinkError m, MonadIO m) =>
Absolute -> Absolute -> m ()
copyFileLink Absolute
src Absolute
dest
            ExceptT CopyLinkError m ()
-> (ExceptT CopyLinkError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CopyLinkError -> MoveFileLinkError)
-> ExceptT CopyLinkError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CopyLinkError -> MoveFileLinkError
FallbackCopyFileLinkError
          Absolute -> ExceptT RemoveError m ()
forall (m :: * -> *).
(MonadError RemoveError m, MonadIO m) =>
Absolute -> m ()
remove Absolute
src
            ExceptT RemoveError m ()
-> (ExceptT RemoveError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (RemoveError -> MoveFileLinkError)
-> ExceptT RemoveError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError RemoveError -> MoveFileLinkError
SourceFileLinkRemoveError
        else MoveFileLinkError -> m ()
forall a. MoveFileLinkError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MoveFileLinkError -> m ()) -> MoveFileLinkError -> m ()
forall a b. (a -> b) -> a -> b
$ Absolute -> Absolute -> IOException -> MoveFileLinkError
RenameFileLinkError Absolute
src Absolute
dest IOException
cause

showMoveError :: MoveError -> Text
showMoveError :: MoveError -> Text
showMoveError = \case
  SourceTypeResolveMoveError Absolute
path
    -> Text
"Unable to resolve type of path: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
  MoveDirectoryError MoveDirectoryError
cause -> MoveDirectoryError -> Text
showMoveDirectoryError MoveDirectoryError
cause
  MoveDirectoryLinkError MoveDirectoryLinkError
cause -> MoveDirectoryLinkError -> Text
showMoveDirectoryLinkError MoveDirectoryLinkError
cause
  MoveFileError MoveFileError
cause -> MoveFileError -> Text
showMoveFileError MoveFileError
cause
  MoveFileLinkError MoveFileLinkError
cause -> MoveFileLinkError -> Text
showMoveFileLinkError MoveFileLinkError
cause

data MoveError
  = SourceTypeResolveMoveError !Absolute
  | MoveDirectoryError !MoveDirectoryError
  | MoveDirectoryLinkError !MoveDirectoryLinkError
  | MoveFileError !MoveFileError
  | MoveFileLinkError !MoveFileLinkError

showMoveDirectoryError :: MoveDirectoryError -> Text
showMoveDirectoryError :: MoveDirectoryError -> Text
showMoveDirectoryError = \case
  CreateParentInMoveDirectoryError CreateParentError
cause -> CreateParentError -> Text
showCreateParentError CreateParentError
cause
  FallbackCopyDirectoryError CopyError
cause -> CopyError -> Text
showCopyError CopyError
cause
  SourceDirectoryRemoveError RemoveError
cause
    -> Text
"Unable to remove source because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RemoveError -> Text
showRemoveError RemoveError
cause
  RenameDirectoryError Absolute
src Absolute
dest IOException
cause
    -> Text
"Unable to rename directory " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
src
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
dest
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a b. (Show a, StringConv FilePath b) => a -> b
show IOException
cause

data MoveDirectoryError
  = CreateParentInMoveDirectoryError !CreateParentError
  | FallbackCopyDirectoryError !CopyError
  | SourceDirectoryRemoveError !RemoveError
  | RenameDirectoryError !Absolute !Absolute !IOException

showMoveDirectoryLinkError :: MoveDirectoryLinkError -> Text
showMoveDirectoryLinkError :: MoveDirectoryLinkError -> Text
showMoveDirectoryLinkError = \case
  CreateParentInMoveDirectoryLinkError CreateParentError
cause -> CreateParentError -> Text
showCreateParentError CreateParentError
cause
  FallbackCopyDirectoryLinkError CopyLinkError
cause -> CopyLinkError -> Text
showCopyLinkError CopyLinkError
cause
  SourceDirectoryLinkRemoveError RemoveError
cause
    -> Text
"Unable to remove source because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RemoveError -> Text
showRemoveError RemoveError
cause
  RenameDirectoryLinkError Absolute
src Absolute
dest IOException
cause
    -> Text
"Unable to rename directory link " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
src
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
dest
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a b. (Show a, StringConv FilePath b) => a -> b
show IOException
cause

data MoveDirectoryLinkError
  = CreateParentInMoveDirectoryLinkError !CreateParentError
  | FallbackCopyDirectoryLinkError !CopyLinkError
  | SourceDirectoryLinkRemoveError !RemoveError
  | RenameDirectoryLinkError !Absolute !Absolute !IOException

showMoveFileError :: MoveFileError -> Text
showMoveFileError :: MoveFileError -> Text
showMoveFileError = \case
  CreateParentInMoveFileError CreateParentError
cause -> CreateParentError -> Text
showCreateParentError CreateParentError
cause
  FallbackCopyFileError CopyFileError
cause -> CopyFileError -> Text
showCopyFileError CopyFileError
cause
  SourceFileRemoveError RemoveError
cause
    -> Text
"Unable to remove source because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RemoveError -> Text
showRemoveError RemoveError
cause
  RenameFileError Absolute
src Absolute
dest IOException
cause
    -> Text
"Unable to rename file " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
src
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
dest
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a b. (Show a, StringConv FilePath b) => a -> b
show IOException
cause

data MoveFileError
  = CreateParentInMoveFileError !CreateParentError
  | FallbackCopyFileError !CopyFileError
  | SourceFileRemoveError !RemoveError
  | RenameFileError !Absolute !Absolute !IOException

showMoveFileLinkError :: MoveFileLinkError -> Text
showMoveFileLinkError :: MoveFileLinkError -> Text
showMoveFileLinkError = \case
  CreateParentInMoveFileLinkError CreateParentError
cause -> CreateParentError -> Text
showCreateParentError CreateParentError
cause
  FallbackCopyFileLinkError CopyLinkError
cause -> CopyLinkError -> Text
showCopyLinkError CopyLinkError
cause
  SourceFileLinkRemoveError RemoveError
cause
    -> Text
"Unable to remove source because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RemoveError -> Text
showRemoveError RemoveError
cause
  RenameFileLinkError Absolute
src Absolute
dest IOException
cause
    -> Text
"Unable to rename file link " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
src
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
dest
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a b. (Show a, StringConv FilePath b) => a -> b
show IOException
cause

data MoveFileLinkError
  = CreateParentInMoveFileLinkError !CreateParentError
  | FallbackCopyFileLinkError !CopyLinkError
  | SourceFileLinkRemoveError !RemoveError
  | RenameFileLinkError !Absolute !Absolute !IOException

isCrossDeviceLinkError :: IOException -> Bool
isCrossDeviceLinkError :: IOException -> Bool
isCrossDeviceLinkError IOException
e
  =  IOException -> IOErrorType
ioeGetErrorType IOException
e IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
== IOErrorType
UnsupportedOperation
  Bool -> Bool -> Bool
&& (Char -> Char
toLower (Char -> Char) -> FilePath -> FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
"Invalid cross-device link") FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` (Char -> Char
toLower (Char -> Char) -> FilePath -> FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOException -> FilePath
forall a b. (Show a, StringConv FilePath b) => a -> b
show IOException
e)

pathIsSymbolicLink :: MonadIO m => Absolute -> m Bool
pathIsSymbolicLink :: forall (m :: * -> *). MonadIO m => Absolute -> m Bool
pathIsSymbolicLink (Absolute -> Absolute
dropTrailingPathSeparator -> Absolute FilePath
path) =
  FilePath -> IO Bool
Directory.pathIsSymbolicLink FilePath
path IO Bool -> (IO Bool -> m Bool) -> m Bool
forall a b. a -> (a -> b) -> b
& IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- | 'remove' should be used instead of the 'Directory.removePathForcibly' to properly
-- remove a path without messing up permissions of a target in case of links
remove :: (MonadError RemoveError m, MonadIO m) => Absolute -> m ()
remove :: forall (m :: * -> *).
(MonadError RemoveError m, MonadIO m) =>
Absolute -> m ()
remove (Absolute -> Absolute
dropTrailingPathSeparator -> Absolute
path) =
  Absolute -> m (Maybe Type)
forall (m :: * -> *). MonadIO m => Absolute -> m (Maybe Type)
typeOf Absolute
path m (Maybe Type) -> (Maybe Type -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m () -> (Type -> m ()) -> Maybe Type -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) \case
    Type
Directory ->
      FilePath -> IO ()
Directory.removeDirectoryRecursive (Absolute -> FilePath
unAbsolute Absolute
path)
        IO () -> (IOException -> RemoveError) -> m ()
forall e (m :: * -> *) a.
(MonadError e m, MonadIO m) =>
IO a -> (IOException -> e) -> m a
`liftIOWithError` Absolute -> IOException -> RemoveError
RemoveDirectoryError Absolute
path
    Type
DirectoryLink ->
      FilePath -> IO ()
Directory.removeDirectoryLink (Absolute -> FilePath
unAbsolute Absolute
path)
        IO () -> (IOException -> RemoveError) -> m ()
forall e (m :: * -> *) a.
(MonadError e m, MonadIO m) =>
IO a -> (IOException -> e) -> m a
`liftIOWithError` Absolute -> IOException -> RemoveError
RemoveDirectoryLinkError Absolute
path
    Type
File ->
      FilePath -> IO ()
Directory.removeFile (Absolute -> FilePath
unAbsolute Absolute
path)
        IO () -> (IOException -> RemoveError) -> m ()
forall e (m :: * -> *) a.
(MonadError e m, MonadIO m) =>
IO a -> (IOException -> e) -> m a
`liftIOWithError` Absolute -> IOException -> RemoveError
RemoveFileError Absolute
path
    Type
FileLink ->
      FilePath -> IO ()
Directory.removeFile (Absolute -> FilePath
unAbsolute Absolute
path)
        IO () -> (IOException -> RemoveError) -> m ()
forall e (m :: * -> *) a.
(MonadError e m, MonadIO m) =>
IO a -> (IOException -> e) -> m a
`liftIOWithError` Absolute -> IOException -> RemoveError
RemoveFileLinkError Absolute
path

showRemoveError :: RemoveError -> Text
showRemoveError :: RemoveError -> Text
showRemoveError = \case
  RemoveDirectoryError Absolute
path IOException
cause
    -> Text
"Unable to remove directory " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
path
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a b. (Show a, StringConv FilePath b) => a -> b
show IOException
cause
  RemoveDirectoryLinkError Absolute
path IOException
cause
    -> Text
"Unable to remove directory link " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
path
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a b. (Show a, StringConv FilePath b) => a -> b
show IOException
cause
  RemoveFileError Absolute
path IOException
cause
    -> Text
"Unable to remove file " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
path
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a b. (Show a, StringConv FilePath b) => a -> b
show IOException
cause
  RemoveFileLinkError Absolute
path IOException
cause
    -> Text
"Unable to remove file link " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
path
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a b. (Show a, StringConv FilePath b) => a -> b
show IOException
cause

data RemoveError
  = RemoveDirectoryError !Absolute !IOException
  | RemoveDirectoryLinkError !Absolute !IOException
  | RemoveFileError !Absolute !IOException
  | RemoveFileLinkError !Absolute !IOException

renameDirectory :: MonadIO m => Absolute -> Absolute -> m ()
renameDirectory :: forall (m :: * -> *). MonadIO m => Absolute -> Absolute -> m ()
renameDirectory (Absolute FilePath
src) (Absolute FilePath
dest) =
  FilePath -> FilePath -> IO ()
Directory.renameDirectory FilePath
src FilePath
dest IO () -> (IO () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

renameFile :: MonadIO m => Absolute -> Absolute -> m ()
renameFile :: forall (m :: * -> *). MonadIO m => Absolute -> Absolute -> m ()
renameFile (Absolute FilePath
src) (Absolute FilePath
dest) =
  FilePath -> FilePath -> IO ()
Directory.renameFile FilePath
src FilePath
dest IO () -> (IO () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

takeBaseName :: Absolute -> FilePath
takeBaseName :: Absolute -> FilePath
takeBaseName (Absolute FilePath
path) = FilePath -> FilePath
FilePath.takeBaseName FilePath
path

typeOf :: MonadIO m => Absolute -> m (Maybe Type)
typeOf :: forall (m :: * -> *). MonadIO m => Absolute -> m (Maybe Type)
typeOf Absolute
path =
  m Bool -> m (Maybe Type) -> m (Maybe Type) -> m (Maybe Type)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Absolute -> m Bool
forall (m :: * -> *). MonadIO m => Absolute -> m Bool
doesFileExist Absolute
path)
    do
      IO Bool -> IO (Either IOException Bool)
forall a. IO a -> IO (Either IOException a)
tryIOError (Absolute -> IO Bool
forall (m :: * -> *). MonadIO m => Absolute -> m Bool
pathIsSymbolicLink Absolute
path) IO (Either IOException Bool)
-> (IO (Either IOException Bool) -> m (Either IOException Bool))
-> m (Either IOException Bool)
forall a b. a -> (a -> b) -> b
& IO (Either IOException Bool) -> m (Either IOException Bool)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        m (Either IOException Bool)
-> (Either IOException Bool -> Maybe Type) -> m (Maybe Type)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (IOException -> Maybe Type)
-> (Bool -> Maybe Type) -> Either IOException Bool -> Maybe Type
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Type -> IOException -> Maybe Type
forall a b. a -> b -> a
const Maybe Type
forall a. Maybe a
Nothing) (Type -> Maybe Type
forall a. a -> Maybe a
Just (Type -> Maybe Type) -> (Bool -> Type) -> Bool -> Maybe Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Type -> Bool -> Type
forall a. a -> a -> Bool -> a
bool Type
File Type
FileLink)
    do
      m Bool -> m (Maybe Type) -> m (Maybe Type) -> m (Maybe Type)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Absolute -> m Bool
forall (m :: * -> *). MonadIO m => Absolute -> m Bool
doesDirectoryExist Absolute
path)
        do
          IO Bool -> IO (Either IOException Bool)
forall a. IO a -> IO (Either IOException a)
tryIOError (Absolute -> IO Bool
forall (m :: * -> *). MonadIO m => Absolute -> m Bool
pathIsSymbolicLink Absolute
path) IO (Either IOException Bool)
-> (IO (Either IOException Bool) -> m (Either IOException Bool))
-> m (Either IOException Bool)
forall a b. a -> (a -> b) -> b
& IO (Either IOException Bool) -> m (Either IOException Bool)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
            m (Either IOException Bool)
-> (Either IOException Bool -> Maybe Type) -> m (Maybe Type)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (IOException -> Maybe Type)
-> (Bool -> Maybe Type) -> Either IOException Bool -> Maybe Type
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Type -> IOException -> Maybe Type
forall a b. a -> b -> a
const Maybe Type
forall a. Maybe a
Nothing) (Type -> Maybe Type
forall a. a -> Maybe a
Just (Type -> Maybe Type) -> (Bool -> Type) -> Bool -> Maybe Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Type -> Bool -> Type
forall a. a -> a -> Bool -> a
bool Type
Directory Type
DirectoryLink)
        do
          Maybe Type -> m (Maybe Type)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Type
forall a. Maybe a
Nothing

showType :: Type -> Text
showType :: Type -> Text
showType = \case
  Type
Directory     -> Text
"dir"
  Type
DirectoryLink -> Text
"dir link"
  Type
File          -> Text
"file"
  Type
FileLink      -> Text
"file link"

data Type
  = Directory
  | DirectoryLink
  | File
  | FileLink

writeFile ::
     (MonadError WriteFileError m, MonadIO m) => Absolute -> Text -> m ()
writeFile :: forall (m :: * -> *).
(MonadError WriteFileError m, MonadIO m) =>
Absolute -> Text -> m ()
writeFile Absolute
path Text
contents = do
  Absolute -> ExceptT CreateParentError m ()
forall (m :: * -> *).
(MonadError CreateParentError m, MonadIO m) =>
Absolute -> m ()
createParent Absolute
path
    ExceptT CreateParentError m ()
-> (ExceptT CreateParentError m () -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& (CreateParentError -> WriteFileError)
-> ExceptT CreateParentError m () -> m ()
forall e2 (m :: * -> *) e1 a.
MonadError e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
modifyError CreateParentError -> WriteFileError
CreateParentInWriteFileError
  FilePath -> Text -> IO ()
Protolude.writeFile (Absolute -> FilePath
unAbsolute Absolute
path) Text
contents
    IO () -> (IOException -> WriteFileError) -> m ()
forall e (m :: * -> *) a.
(MonadError e m, MonadIO m) =>
IO a -> (IOException -> e) -> m a
`liftIOWithError` Absolute -> IOException -> WriteFileError
WriteFileError Absolute
path

showWriteFileError :: WriteFileError -> Text
showWriteFileError :: WriteFileError -> Text
showWriteFileError = \case
  CreateParentInWriteFileError CreateParentError
cause -> CreateParentError -> Text
showCreateParentError CreateParentError
cause
  WriteFileError Absolute
path IOException
cause
    -> Text
"Unable to write to a file " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Absolute -> Text
showAbsolute Absolute
path
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" because of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a b. (Show a, StringConv FilePath b) => a -> b
show IOException
cause

data WriteFileError
  = CreateParentInWriteFileError !CreateParentError
  | WriteFileError !Absolute !IOException

showAbsolute :: Absolute -> Text
showAbsolute :: Absolute -> Text
showAbsolute (Absolute FilePath
path) = Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a b. ConvertText a b => a -> b
toS FilePath
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""

-- | Absolute 'FilePath' to a filesystem's object.
--
-- @since 0.1.0.0
newtype Absolute
  = Absolute { Absolute -> FilePath
unAbsolute :: FilePath }
  deriving (Absolute -> Absolute -> Bool
(Absolute -> Absolute -> Bool)
-> (Absolute -> Absolute -> Bool) -> Eq Absolute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Absolute -> Absolute -> Bool
== :: Absolute -> Absolute -> Bool
$c/= :: Absolute -> Absolute -> Bool
/= :: Absolute -> Absolute -> Bool
Eq)
  deriving newtype (Value -> Parser [Absolute]
Value -> Parser Absolute
(Value -> Parser Absolute)
-> (Value -> Parser [Absolute]) -> FromJSON Absolute
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Absolute
parseJSON :: Value -> Parser Absolute
$cparseJSONList :: Value -> Parser [Absolute]
parseJSONList :: Value -> Parser [Absolute]
FromJSON, Eq Absolute
Eq Absolute
-> (Int -> Absolute -> Int)
-> (Absolute -> Int)
-> Hashable Absolute
Int -> Absolute -> Int
Absolute -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Absolute -> Int
hashWithSalt :: Int -> Absolute -> Int
$chash :: Absolute -> Int
hash :: Absolute -> Int
Hashable, [Absolute] -> Value
[Absolute] -> Encoding
Absolute -> Value
Absolute -> Encoding
(Absolute -> Value)
-> (Absolute -> Encoding)
-> ([Absolute] -> Value)
-> ([Absolute] -> Encoding)
-> ToJSON Absolute
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Absolute -> Value
toJSON :: Absolute -> Value
$ctoEncoding :: Absolute -> Encoding
toEncoding :: Absolute -> Encoding
$ctoJSONList :: [Absolute] -> Value
toJSONList :: [Absolute] -> Value
$ctoEncodingList :: [Absolute] -> Encoding
toEncodingList :: [Absolute] -> Encoding
ToJSON)