------------------------------------------------------------------------------
-- |
-- Module      : PhatSort.Cmd.SeqCp
-- Description : seqcp command implementation
-- Copyright   : Copyright (c) 2019-2022 Travis Cardwell
-- License     : MIT
------------------------------------------------------------------------------

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module PhatSort.Cmd.SeqCp
  ( -- * Options
    Options(..)
    -- * API
  , runIO
  , run
  ) where

-- https://hackage.haskell.org/package/base
import Control.Monad (forM, forM_, unless, when)
import Data.Char (toLower)
import Data.List (dropWhileEnd, isPrefixOf, partition, sortBy)
import qualified Data.List.NonEmpty as NonEmpty
import Data.List.NonEmpty (NonEmpty)
import Data.Ord (comparing)

-- https://hackage.haskell.org/package/filepath
import System.FilePath ((</>), splitDirectories, takeFileName)

-- https://hackage.haskell.org/package/MonadRandom
import Control.Monad.Random.Class (MonadRandom)

-- https://hackage.haskell.org/package/random-shuffle
import System.Random.Shuffle (shuffleM)

-- (phatsort)
import qualified PhatSort.Monad.FileSystem as FS
import PhatSort.Monad.FileSystem (MonadFileSystem)
import qualified PhatSort.Monad.Stdio as Stdio
import PhatSort.Monad.Stdio (MonadStdio)
import qualified PhatSort.Monad.Sync as Sync
import PhatSort.Monad.Sync (MonadSync)
import qualified PhatSort.Monad.Trans.Error as Error
import PhatSort.Monad.Trans.Error (ErrorT)
import qualified PhatSort.Script as Script
import PhatSort.SortOptions
  ( SortCase(CaseInsensitive, CaseSensitive)
  , SortFirst(FirstDirs, FirstFiles, FirstNone)
  , SortOrder(OrderName, OrderRandom, OrderTime)
  )

------------------------------------------------------------------------------
-- $Options

data Options
  = Options
    { Options -> SortCase
optCase        :: !SortCase
    , Options -> SortFirst
optFirst       :: !SortFirst
    , Options -> Bool
optSync        :: !Bool
    , Options -> SortOrder
optOrder       :: !SortOrder
    , Options -> Bool
optReverse     :: !Bool
    , Options -> Bool
optScript      :: !Bool
    , Options -> Bool
optVerbose     :: !Bool
    , Options -> NonEmpty FilePath
optSources     :: !(NonEmpty FilePath)
    , Options -> FilePath
optDestination :: !FilePath
    }
  deriving Int -> Options -> ShowS
[Options] -> ShowS
Options -> FilePath
(Int -> Options -> ShowS)
-> (Options -> FilePath) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> FilePath
$cshow :: Options -> FilePath
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> Options -> ShowS
Show

------------------------------------------------------------------------------
-- $API

-- | Run the command in the 'IO' monad
runIO :: Options -> IO (Either String ())
runIO :: Options -> IO (Either FilePath ())
runIO = ErrorT IO () -> IO (Either FilePath ())
forall (m :: * -> *) a.
Monad m =>
ErrorT m a -> m (Either FilePath a)
Error.run (ErrorT IO () -> IO (Either FilePath ()))
-> (Options -> ErrorT IO ()) -> Options -> IO (Either FilePath ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ErrorT IO ()
forall (m :: * -> *).
(MonadFileSystem m, MonadRandom m, MonadStdio m, MonadSync m) =>
Options -> ErrorT m ()
run

------------------------------------------------------------------------------

-- | Run the command
run
  :: forall m
   . (MonadFileSystem m, MonadRandom m, MonadStdio m, MonadSync m)
  => Options
  -> ErrorT m ()
run :: Options -> ErrorT m ()
run Options{Bool
FilePath
NonEmpty FilePath
SortOrder
SortFirst
SortCase
optDestination :: FilePath
optSources :: NonEmpty FilePath
optVerbose :: Bool
optScript :: Bool
optReverse :: Bool
optOrder :: SortOrder
optSync :: Bool
optFirst :: SortFirst
optCase :: SortCase
optDestination :: Options -> FilePath
optSources :: Options -> NonEmpty FilePath
optVerbose :: Options -> Bool
optScript :: Options -> Bool
optReverse :: Options -> Bool
optOrder :: Options -> SortOrder
optSync :: Options -> Bool
optFirst :: Options -> SortFirst
optCase :: Options -> SortCase
..} = [Target] -> ErrorT m ()
copyTargets ([Target] -> ErrorT m ())
-> ExceptT FilePath m [Target] -> ErrorT m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NonEmpty FilePath -> FilePath -> ExceptT FilePath m [Target]
forall (m :: * -> *).
MonadFileSystem m =>
NonEmpty FilePath -> FilePath -> ErrorT m [Target]
getArgTargets NonEmpty FilePath
optSources FilePath
optDestination
  where
    copyDir :: FilePath -> FilePath -> FilePath -> ErrorT m ()
    copyDir :: FilePath -> FilePath -> FilePath -> ErrorT m ()
copyDir FilePath
argPath FilePath
srcPath FilePath
dstPath = do
      FilePath -> ErrorT m ()
putProgress FilePath
argPath
      FilePath -> ErrorT m ()
mkDir FilePath
dstPath ErrorT m () -> ErrorT m () -> ErrorT m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ErrorT m ()
sync
      [Target] -> ErrorT m ()
copyTargets ([Target] -> ErrorT m ())
-> ExceptT FilePath m [Target] -> ErrorT m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> FilePath -> FilePath -> ExceptT FilePath m [Target]
forall (m :: * -> *).
MonadFileSystem m =>
FilePath -> FilePath -> FilePath -> ErrorT m [Target]
getDirTargets FilePath
argPath FilePath
srcPath FilePath
dstPath

    copyFile :: FilePath -> FilePath -> FilePath -> ErrorT m ()
    copyFile :: FilePath -> FilePath -> FilePath -> ErrorT m ()
copyFile FilePath
argPath FilePath
srcPath FilePath
dstPath = do
      FilePath -> ErrorT m ()
putProgress FilePath
argPath
      FilePath -> FilePath -> ErrorT m ()
cp FilePath
srcPath FilePath
dstPath ErrorT m () -> ErrorT m () -> ErrorT m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ErrorT m ()
sync

    copyTargets :: [Target] -> ErrorT m ()
    copyTargets :: [Target] -> ErrorT m ()
copyTargets [Target]
targets = do
      [Target]
sortedTargets <- [Target] -> ExceptT FilePath m [Target]
sortTargets [Target]
targets
      [Target] -> (Target -> ErrorT m ()) -> ErrorT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Target]
sortedTargets ((Target -> ErrorT m ()) -> ErrorT m ())
-> (Target -> ErrorT m ()) -> ErrorT m ()
forall a b. (a -> b) -> a -> b
$ \Target{FilePath
FileStatus
targetStatus :: Target -> FileStatus
targetName :: Target -> FilePath
targetDstPath :: Target -> FilePath
targetSrcPath :: Target -> FilePath
targetArgPath :: Target -> FilePath
targetStatus :: FileStatus
targetName :: FilePath
targetDstPath :: FilePath
targetSrcPath :: FilePath
targetArgPath :: FilePath
..} ->
        if FileStatus -> Bool
FS.isDirectory FileStatus
targetStatus
          then FilePath -> FilePath -> FilePath -> ErrorT m ()
copyDir FilePath
targetArgPath FilePath
targetSrcPath FilePath
targetDstPath
          else FilePath -> FilePath -> FilePath -> ErrorT m ()
copyFile FilePath
targetArgPath FilePath
targetSrcPath FilePath
targetDstPath

    cp :: FilePath -> FilePath -> ErrorT m ()
    cp :: FilePath -> FilePath -> ErrorT m ()
cp FilePath
srcPath FilePath
dstPath
      | Bool
optScript =
          FilePath -> ErrorT m ()
forall (m :: * -> *). MonadStdio m => FilePath -> m ()
Stdio.putStrLn (FilePath -> ErrorT m ()) -> FilePath -> ErrorT m ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
Script.formatCommand [FilePath
"cp", FilePath
srcPath, FilePath
dstPath]
      | Bool
otherwise = m (Either IOError ()) -> ErrorT m ()
forall e (m :: * -> *) a.
(Exception e, Monad m) =>
m (Either e a) -> ErrorT m a
Error.errorTE (m (Either IOError ()) -> ErrorT m ())
-> m (Either IOError ()) -> ErrorT m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> m (Either IOError ())
forall (m :: * -> *).
MonadFileSystem m =>
FilePath -> FilePath -> m (Either IOError ())
FS.copyFile FilePath
srcPath FilePath
dstPath

    mkDir :: FilePath -> ErrorT m ()
    mkDir :: FilePath -> ErrorT m ()
mkDir FilePath
path
      | Bool
optScript = FilePath -> ErrorT m ()
forall (m :: * -> *). MonadStdio m => FilePath -> m ()
Stdio.putStrLn (FilePath -> ErrorT m ()) -> FilePath -> ErrorT m ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
Script.formatCommand [FilePath
"mkdir", FilePath
path]
      | Bool
otherwise = m (Either IOError ()) -> ErrorT m ()
forall e (m :: * -> *) a.
(Exception e, Monad m) =>
m (Either e a) -> ErrorT m a
Error.errorTE (m (Either IOError ()) -> ErrorT m ())
-> m (Either IOError ()) -> ErrorT m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m (Either IOError ())
forall (m :: * -> *).
MonadFileSystem m =>
FilePath -> m (Either IOError ())
FS.createDirectory FilePath
path

    putProgress :: FilePath -> ErrorT m ()
    putProgress :: FilePath -> ErrorT m ()
putProgress FilePath
path
      | Bool -> Bool
not Bool
optVerbose = () -> ErrorT m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      | Bool
optScript = FilePath -> ErrorT m ()
forall (m :: * -> *). MonadStdio m => FilePath -> m ()
Stdio.putStrLn (FilePath -> ErrorT m ()) -> FilePath -> ErrorT m ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
Script.formatCommand [FilePath
"echo", FilePath
path]
      | Bool
otherwise = FilePath -> ErrorT m ()
forall (m :: * -> *). MonadStdio m => FilePath -> m ()
Stdio.putStrLn FilePath
path

    sortTargets :: [Target] -> ErrorT m [Target]
    sortTargets :: [Target] -> ExceptT FilePath m [Target]
sortTargets [Target]
targets =
      let compareNames :: Target -> Target -> Ordering
compareNames = case SortCase
optCase of
            SortCase
CaseSensitive -> (Target -> FilePath) -> Target -> Target -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Target -> FilePath
targetName
            SortCase
CaseInsensitive -> (Target -> FilePath) -> Target -> Target -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> (Target -> FilePath) -> Target -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Target -> FilePath
targetName)
          compareTimes :: Target -> Target -> Ordering
compareTimes = (Target -> EpochTime) -> Target -> Target -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (FileStatus -> EpochTime
FS.modificationTime (FileStatus -> EpochTime)
-> (Target -> FileStatus) -> Target -> EpochTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Target -> FileStatus
targetStatus)
          reverse' :: [a] -> [a]
reverse' = if Bool
optReverse then [a] -> [a]
forall a. [a] -> [a]
reverse else [a] -> [a]
forall a. a -> a
id
          go :: [Target] -> m [Target]
go = case SortOrder
optOrder of
            SortOrder
OrderName -> [Target] -> m [Target]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Target] -> m [Target])
-> ([Target] -> [Target]) -> [Target] -> m [Target]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Target] -> [Target]
forall a. [a] -> [a]
reverse' ([Target] -> [Target])
-> ([Target] -> [Target]) -> [Target] -> [Target]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Target -> Target -> Ordering) -> [Target] -> [Target]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Target -> Target -> Ordering
compareNames
            SortOrder
OrderTime -> [Target] -> m [Target]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Target] -> m [Target])
-> ([Target] -> [Target]) -> [Target] -> m [Target]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Target] -> [Target]
forall a. [a] -> [a]
reverse' ([Target] -> [Target])
-> ([Target] -> [Target]) -> [Target] -> [Target]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Target -> Target -> Ordering) -> [Target] -> [Target]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Target -> Target -> Ordering
compareTimes
            SortOrder
OrderRandom -> [Target] -> m [Target]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM
          ([Target]
dirTargets, [Target]
fileTargets) =
            (Target -> Bool) -> [Target] -> ([Target], [Target])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (FileStatus -> Bool
FS.isDirectory (FileStatus -> Bool) -> (Target -> FileStatus) -> Target -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Target -> FileStatus
targetStatus) [Target]
targets
      in  m [Target] -> ExceptT FilePath m [Target]
forall (m :: * -> *) a. Monad m => m a -> ErrorT m a
Error.lift (m [Target] -> ExceptT FilePath m [Target])
-> m [Target] -> ExceptT FilePath m [Target]
forall a b. (a -> b) -> a -> b
$ case SortFirst
optFirst of
            SortFirst
FirstNone -> [Target] -> m [Target]
go [Target]
targets
            SortFirst
FirstDirs -> [Target] -> [Target] -> [Target]
forall a. [a] -> [a] -> [a]
(++) ([Target] -> [Target] -> [Target])
-> m [Target] -> m ([Target] -> [Target])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Target] -> m [Target]
go [Target]
dirTargets m ([Target] -> [Target]) -> m [Target] -> m [Target]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Target] -> m [Target]
go [Target]
fileTargets
            SortFirst
FirstFiles -> [Target] -> [Target] -> [Target]
forall a. [a] -> [a] -> [a]
(++) ([Target] -> [Target] -> [Target])
-> m [Target] -> m ([Target] -> [Target])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Target] -> m [Target]
go [Target]
fileTargets m ([Target] -> [Target]) -> m [Target] -> m [Target]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Target] -> m [Target]
go [Target]
dirTargets

    sync :: ErrorT m ()
    sync :: ErrorT m ()
sync
      | Bool -> Bool
not Bool
optSync = () -> ErrorT m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      | Bool
optScript = FilePath -> ErrorT m ()
forall (m :: * -> *). MonadStdio m => FilePath -> m ()
Stdio.putStrLn (FilePath -> ErrorT m ()) -> FilePath -> ErrorT m ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
Script.formatCommand [FilePath
"sync"]
      | Bool
otherwise = ErrorT m ()
forall (m :: * -> *). MonadSync m => m ()
Sync.sync

------------------------------------------------------------------------------
-- $Internal

-- | Target file or directory
data Target
  = Target
    { Target -> FilePath
targetArgPath :: !FilePath  -- ^ path for verbose and errors
    , Target -> FilePath
targetSrcPath :: !FilePath  -- ^ absolute source path
    , Target -> FilePath
targetDstPath :: !FilePath  -- ^ absolute destination path
    , Target -> FilePath
targetName    :: !FilePath  -- ^ file or directory name
    , Target -> FileStatus
targetStatus  :: !FS.FileStatus
    }

------------------------------------------------------------------------------

-- | Create 'Target's for arguments, performing checks
getArgTargets
  :: MonadFileSystem m
  => NonEmpty FilePath  -- ^ sources
  -> FilePath           -- ^ destination directory
  -> ErrorT m [Target]
getArgTargets :: NonEmpty FilePath -> FilePath -> ErrorT m [Target]
getArgTargets NonEmpty FilePath
sources FilePath
destDir = do
    FilePath
destPath <- m (Either IOError FilePath) -> ErrorT m FilePath
forall e (m :: * -> *) a.
(Exception e, Monad m) =>
m (Either e a) -> ErrorT m a
Error.errorTE (m (Either IOError FilePath) -> ErrorT m FilePath)
-> (FilePath -> m (Either IOError FilePath))
-> FilePath
-> ErrorT m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      FilePath -> m (Either IOError FilePath)
forall (m :: * -> *).
MonadFileSystem m =>
FilePath -> m (Either IOError FilePath)
FS.makeAbsolute (FilePath -> ErrorT m FilePath) -> FilePath -> ErrorT m FilePath
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') FilePath
destDir
    FileStatus
destStatus <- m (Either IOError FileStatus) -> ErrorT m FileStatus
forall e (m :: * -> *) a.
(Exception e, Monad m) =>
m (Either e a) -> ErrorT m a
Error.errorTE (m (Either IOError FileStatus) -> ErrorT m FileStatus)
-> m (Either IOError FileStatus) -> ErrorT m FileStatus
forall a b. (a -> b) -> a -> b
$ FilePath -> m (Either IOError FileStatus)
forall (m :: * -> *).
MonadFileSystem m =>
FilePath -> m (Either IOError FileStatus)
FS.getFileStatus FilePath
destPath
    Bool -> ExceptT FilePath m () -> ExceptT FilePath m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FileStatus -> Bool
FS.isDirectory FileStatus
destStatus) (ExceptT FilePath m () -> ExceptT FilePath m ())
-> (FilePath -> ExceptT FilePath m ())
-> FilePath
-> ExceptT FilePath m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      FilePath -> ExceptT FilePath m ()
forall (m :: * -> *) a. Monad m => FilePath -> ErrorT m a
Error.throw (FilePath -> ExceptT FilePath m ())
-> FilePath -> ExceptT FilePath m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"not a directory: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
destDir
    let destDirs :: [FilePath]
destDirs = FilePath -> [FilePath]
splitDirectories FilePath
destPath
    [FilePath]
-> (FilePath -> ExceptT FilePath m Target) -> ErrorT m [Target]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (NonEmpty FilePath -> [FilePath]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty FilePath
sources) ((FilePath -> ExceptT FilePath m Target) -> ErrorT m [Target])
-> (FilePath -> ExceptT FilePath m Target) -> ErrorT m [Target]
forall a b. (a -> b) -> a -> b
$ \FilePath
targetArgPath -> do
      FilePath
targetSrcPath <- m (Either IOError FilePath) -> ErrorT m FilePath
forall e (m :: * -> *) a.
(Exception e, Monad m) =>
m (Either e a) -> ErrorT m a
Error.errorTE (m (Either IOError FilePath) -> ErrorT m FilePath)
-> (FilePath -> m (Either IOError FilePath))
-> FilePath
-> ErrorT m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        FilePath -> m (Either IOError FilePath)
forall (m :: * -> *).
MonadFileSystem m =>
FilePath -> m (Either IOError FilePath)
FS.makeAbsolute (FilePath -> ErrorT m FilePath) -> FilePath -> ErrorT m FilePath
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') FilePath
targetArgPath
      let targetName :: FilePath
targetName = ShowS
takeFileName FilePath
targetSrcPath
          targetDstPath :: FilePath
targetDstPath = FilePath
destPath FilePath -> ShowS
</> FilePath
targetName
      FileStatus
targetStatus <- m (Either IOError FileStatus) -> ErrorT m FileStatus
forall e (m :: * -> *) a.
(Exception e, Monad m) =>
m (Either e a) -> ErrorT m a
Error.errorTE (m (Either IOError FileStatus) -> ErrorT m FileStatus)
-> m (Either IOError FileStatus) -> ErrorT m FileStatus
forall a b. (a -> b) -> a -> b
$ FilePath -> m (Either IOError FileStatus)
forall (m :: * -> *).
MonadFileSystem m =>
FilePath -> m (Either IOError FileStatus)
FS.getFileStatus FilePath
targetSrcPath
      Bool -> ExceptT FilePath m () -> ExceptT FilePath m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FileStatus -> Bool
FS.isDirectory FileStatus
targetStatus) (ExceptT FilePath m () -> ExceptT FilePath m ())
-> (ExceptT FilePath m () -> ExceptT FilePath m ())
-> ExceptT FilePath m ()
-> ExceptT FilePath m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Bool -> ExceptT FilePath m () -> ExceptT FilePath m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePath -> [FilePath]
splitDirectories FilePath
targetSrcPath [FilePath] -> [FilePath] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [FilePath]
destDirs) (ExceptT FilePath m () -> ExceptT FilePath m ())
-> ExceptT FilePath m () -> ExceptT FilePath m ()
forall a b. (a -> b) -> a -> b
$
          FilePath -> ExceptT FilePath m ()
forall (m :: * -> *) a. Monad m => FilePath -> ErrorT m a
Error.throw (FilePath -> ExceptT FilePath m ())
-> FilePath -> ExceptT FilePath m ()
forall a b. (a -> b) -> a -> b
$
            FilePath
"source directory above target directory: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
targetArgPath
      Bool
exists <- m (Either IOError Bool) -> ErrorT m Bool
forall e (m :: * -> *) a.
(Exception e, Monad m) =>
m (Either e a) -> ErrorT m a
Error.errorTE (m (Either IOError Bool) -> ErrorT m Bool)
-> m (Either IOError Bool) -> ErrorT m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> m (Either IOError Bool)
forall (m :: * -> *).
MonadFileSystem m =>
FilePath -> m (Either IOError Bool)
FS.doesPathExist FilePath
targetDstPath
      Bool -> ExceptT FilePath m () -> ExceptT FilePath m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (ExceptT FilePath m () -> ExceptT FilePath m ())
-> (FilePath -> ExceptT FilePath m ())
-> FilePath
-> ExceptT FilePath m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ExceptT FilePath m ()
forall (m :: * -> *) a. Monad m => FilePath -> ErrorT m a
Error.throw (FilePath -> ExceptT FilePath m ())
-> FilePath -> ExceptT FilePath m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"already exists: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
targetDstPath
      Target -> ExceptT FilePath m Target
forall (f :: * -> *) a. Applicative f => a -> f a
pure Target :: FilePath
-> FilePath -> FilePath -> FilePath -> FileStatus -> Target
Target{FilePath
FileStatus
targetStatus :: FileStatus
targetDstPath :: FilePath
targetName :: FilePath
targetSrcPath :: FilePath
targetArgPath :: FilePath
targetStatus :: FileStatus
targetName :: FilePath
targetDstPath :: FilePath
targetSrcPath :: FilePath
targetArgPath :: FilePath
..}

------------------------------------------------------------------------------

-- | Get 'Target's for entries in a directory
getDirTargets
  :: MonadFileSystem m
  => FilePath  -- ^ path for verbose and errors
  -> FilePath  -- ^ absolute source path
  -> FilePath  -- ^ absolute destination path
  -> ErrorT m [Target]
getDirTargets :: FilePath -> FilePath -> FilePath -> ErrorT m [Target]
getDirTargets FilePath
argDir FilePath
srcDir FilePath
dstDir = do
    [FilePath]
names <- m (Either IOError [FilePath]) -> ErrorT m [FilePath]
forall e (m :: * -> *) a.
(Exception e, Monad m) =>
m (Either e a) -> ErrorT m a
Error.errorTE (m (Either IOError [FilePath]) -> ErrorT m [FilePath])
-> m (Either IOError [FilePath]) -> ErrorT m [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> m (Either IOError [FilePath])
forall (m :: * -> *).
MonadFileSystem m =>
FilePath -> m (Either IOError [FilePath])
FS.listDirectory FilePath
srcDir
    [FilePath]
-> (FilePath -> ExceptT FilePath m Target) -> ErrorT m [Target]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
names ((FilePath -> ExceptT FilePath m Target) -> ErrorT m [Target])
-> (FilePath -> ExceptT FilePath m Target) -> ErrorT m [Target]
forall a b. (a -> b) -> a -> b
$ \FilePath
targetName -> do
      let targetArgPath :: FilePath
targetArgPath = FilePath
argDir FilePath -> ShowS
</> FilePath
targetName
          targetSrcPath :: FilePath
targetSrcPath = FilePath
srcDir FilePath -> ShowS
</> FilePath
targetName
          targetDstPath :: FilePath
targetDstPath = FilePath
dstDir FilePath -> ShowS
</> FilePath
targetName
      FileStatus
targetStatus <- m (Either IOError FileStatus) -> ErrorT m FileStatus
forall e (m :: * -> *) a.
(Exception e, Monad m) =>
m (Either e a) -> ErrorT m a
Error.errorTE (m (Either IOError FileStatus) -> ErrorT m FileStatus)
-> m (Either IOError FileStatus) -> ErrorT m FileStatus
forall a b. (a -> b) -> a -> b
$ FilePath -> m (Either IOError FileStatus)
forall (m :: * -> *).
MonadFileSystem m =>
FilePath -> m (Either IOError FileStatus)
FS.getFileStatus FilePath
targetSrcPath
      Target -> ExceptT FilePath m Target
forall (f :: * -> *) a. Applicative f => a -> f a
pure Target :: FilePath
-> FilePath -> FilePath -> FilePath -> FileStatus -> Target
Target{FilePath
FileStatus
targetStatus :: FileStatus
targetDstPath :: FilePath
targetSrcPath :: FilePath
targetArgPath :: FilePath
targetName :: FilePath
targetStatus :: FileStatus
targetName :: FilePath
targetDstPath :: FilePath
targetSrcPath :: FilePath
targetArgPath :: FilePath
..}