{-# LANGUAGE TypeApplications #-}

module System.Directory.Funflow (moveDirectoryContent) where

import Control.Exception (catch, throw)
import Control.Monad (filterM)
import Data.Maybe (catMaybes)
import Foreign.C.Error (Errno (Errno), eXDEV)
import GHC.IO.Exception (IOException (ioe_errno))
import Path (Abs, Dir, Path, dirname, filename, parseRelDir, parseRelFile, toFilePath, (</>))
import System.Directory (copyFile, doesDirectoryExist, doesFileExist, listDirectory, removeFile, renamePath)

-- | Move all the directories and files from a source directory to a target directory
moveDirectoryContent :: Path Abs Dir -> Path Abs Dir -> IO ()
moveDirectoryContent :: Path Abs Dir -> Path Abs Dir -> IO ()
moveDirectoryContent Path Abs Dir
sourceDirectory Path Abs Dir
targetDirectory =
  do
    -- List of directories inside
    [Path Abs Dir]
dirPaths <-
      -- Get the list of children elements of @directory@
      (FilePath -> IO [FilePath]
listDirectory (FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs Dir
sourceDirectory)
        IO [FilePath]
-> ([FilePath] -> IO [Path Rel Dir]) -> IO [Path Rel Dir]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        -- Tries to parse the elements given by @listDirectory@ to relative directory paths
        -- and keep only successful entries
        [Path Rel Dir] -> IO [Path Rel Dir]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Path Rel Dir] -> IO [Path Rel Dir])
-> ([FilePath] -> [Path Rel Dir])
-> [FilePath]
-> IO [Path Rel Dir]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Path Rel Dir)] -> [Path Rel Dir]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Path Rel Dir)] -> [Path Rel Dir])
-> ([FilePath] -> [Maybe (Path Rel Dir)])
-> [FilePath]
-> [Path Rel Dir]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Maybe (Path Rel Dir))
-> [FilePath] -> [Maybe (Path Rel Dir)]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Maybe (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
parseRelDir
        IO [Path Rel Dir]
-> ([Path Rel Dir] -> IO [Path Abs Dir]) -> IO [Path Abs Dir]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        -- turn into absolute paths
        [Path Abs Dir] -> IO [Path Abs Dir]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Path Abs Dir] -> IO [Path Abs Dir])
-> ([Path Rel Dir] -> [Path Abs Dir])
-> [Path Rel Dir]
-> IO [Path Abs Dir]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Rel Dir -> Path Abs Dir) -> [Path Rel Dir] -> [Path Abs Dir]
forall a b. (a -> b) -> [a] -> [b]
map (Path Abs Dir
sourceDirectory Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</>)
        IO [Path Abs Dir]
-> ([Path Abs Dir] -> IO [Path Abs Dir]) -> IO [Path Abs Dir]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        -- keep only directories that exists
        -- this also ensures that this list comprises directories only, see doc of @doesDirectoryExist@
        (Path Abs Dir -> IO Bool) -> [Path Abs Dir] -> IO [Path Abs Dir]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> IO Bool
doesDirectoryExist (FilePath -> IO Bool)
-> (Path Abs Dir -> FilePath) -> Path Abs Dir -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> FilePath
forall b t. Path b t -> FilePath
toFilePath)

    -- List of files inside
    [Path Abs File]
filePaths <-
      -- Get the list of children elements of @sourceDirectory@
      (FilePath -> IO [FilePath]
listDirectory (FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs Dir
sourceDirectory)
        IO [FilePath]
-> ([FilePath] -> IO [Path Rel File]) -> IO [Path Rel File]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        -- Tries to parse the elements given by @listDirectory@ to relative directory paths
        -- and keep only successful entries
        [Path Rel File] -> IO [Path Rel File]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Path Rel File] -> IO [Path Rel File])
-> ([FilePath] -> [Path Rel File])
-> [FilePath]
-> IO [Path Rel File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Path Rel File)] -> [Path Rel File]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Path Rel File)] -> [Path Rel File])
-> ([FilePath] -> [Maybe (Path Rel File)])
-> [FilePath]
-> [Path Rel File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Maybe (Path Rel File))
-> [FilePath] -> [Maybe (Path Rel File)]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Maybe (Path Rel File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile
        IO [Path Rel File]
-> ([Path Rel File] -> IO [Path Abs File]) -> IO [Path Abs File]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        -- turn into absolute paths
        [Path Abs File] -> IO [Path Abs File]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Path Abs File] -> IO [Path Abs File])
-> ([Path Rel File] -> [Path Abs File])
-> [Path Rel File]
-> IO [Path Abs File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Rel File -> Path Abs File)
-> [Path Rel File] -> [Path Abs File]
forall a b. (a -> b) -> [a] -> [b]
map (Path Abs Dir
sourceDirectory Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</>)
        IO [Path Abs File]
-> ([Path Abs File] -> IO [Path Abs File]) -> IO [Path Abs File]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        -- keep only directories that exists
        -- this also ensures that this list comprises files only, see doc of @doesFileExist@
        (Path Abs File -> IO Bool) -> [Path Abs File] -> IO [Path Abs File]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool)
-> (Path Abs File -> FilePath) -> Path Abs File -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath)

    -- Move directories and files
    ((FilePath, FilePath) -> IO ()) -> [(FilePath, FilePath)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((FilePath -> FilePath -> IO ()) -> (FilePath, FilePath) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> FilePath -> IO ()
moveOrCopy) [(Path Abs Dir -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs Dir
dirPath, Path Abs Dir -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Path Abs Dir -> FilePath) -> Path Abs Dir -> FilePath
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
targetDirectory Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Abs Dir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
dirname Path Abs Dir
dirPath) | Path Abs Dir
dirPath <- [Path Abs Dir]
dirPaths]
    ((FilePath, FilePath) -> IO ()) -> [(FilePath, FilePath)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((FilePath -> FilePath -> IO ()) -> (FilePath, FilePath) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> FilePath -> IO ()
moveOrCopy) [(Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs File
filePath, Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Path Abs File -> FilePath) -> Path Abs File -> FilePath
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
targetDirectory Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
filename Path Abs File
filePath) | Path Abs File
filePath <- [Path Abs File]
filePaths]

    -- Finish
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    -- Need to handle cases where the source directory is on a different disk than the destination directory since
    -- rename will fail in these cases.
    moveOrCopy :: FilePath -> FilePath -> IO ()
moveOrCopy FilePath
srcFilePath FilePath
destFilePath = FilePath -> FilePath -> IO ()
renamePath FilePath
srcFilePath FilePath
destFilePath IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` FilePath -> FilePath -> IOException -> IO ()
exdev FilePath
srcFilePath FilePath
destFilePath
    -- Stolen from: https://github.com/mihaimaruseac/hindent/issues/170
    exdev :: FilePath -> FilePath -> IOException -> IO ()
exdev FilePath
srcFilePath FilePath
destFilePath IOException
e =
      if IOException -> Maybe CInt
ioe_errno IOException
e Maybe CInt -> Maybe CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt -> Maybe CInt
forall a. a -> Maybe a
Just ((\(Errno CInt
a) -> CInt
a) Errno
eXDEV)
        then FilePath -> FilePath -> IO ()
copyFile FilePath
srcFilePath FilePath
destFilePath IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO ()
removeFile FilePath
srcFilePath
        else IOException -> IO ()
forall a e. Exception e => e -> a
throw IOException
e