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

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

module PhatSort.Cmd.PhatSort
  ( -- * 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, isSuffixOf, 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 ((</>), takeDirectory)

-- 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

-- | Command 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
optTargets :: !(NonEmpty 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
NonEmpty FilePath
SortOrder
SortFirst
SortCase
optTargets :: NonEmpty FilePath
optVerbose :: Bool
optScript :: Bool
optReverse :: Bool
optOrder :: SortOrder
optSync :: Bool
optFirst :: SortFirst
optCase :: SortCase
optTargets :: Options -> NonEmpty FilePath
optVerbose :: Options -> Bool
optScript :: Options -> Bool
optReverse :: Options -> Bool
optOrder :: Options -> SortOrder
optSync :: Options -> Bool
optFirst :: Options -> SortFirst
optCase :: Options -> SortCase
..} = do
    [Target]
targets <- (FilePath -> ExceptT FilePath m Target)
-> [FilePath] -> ExceptT FilePath m [Target]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> ExceptT FilePath m Target
forall (m :: * -> *).
MonadFileSystem m =>
FilePath -> ErrorT m Target
getTarget ([FilePath] -> ExceptT FilePath m [Target])
-> [FilePath] -> ExceptT FilePath m [Target]
forall a b. (a -> b) -> a -> b
$ NonEmpty FilePath -> [FilePath]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty FilePath
optTargets
    [Target] -> (Target -> ErrorT m ()) -> ErrorT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Target]
targets ((Target -> ErrorT m ()) -> ErrorT m ())
-> (Target -> ErrorT m ()) -> ErrorT m ()
forall a b. (a -> b) -> a -> b
$ \Target{FilePath
targetDstPath :: Target -> FilePath
targetSrcPath :: Target -> FilePath
targetArgPath :: Target -> FilePath
targetDstPath :: FilePath
targetSrcPath :: FilePath
targetArgPath :: FilePath
..} -> do
      FilePath -> ErrorT m ()
putProgress FilePath
targetArgPath
      FilePath -> FilePath -> ErrorT m ()
mvDir FilePath
targetDstPath FilePath
targetSrcPath ErrorT m () -> ErrorT m () -> ErrorT m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ErrorT m ()
sync
      FilePath -> ErrorT m ()
mkDir FilePath
targetDstPath ErrorT m () -> ErrorT m () -> ErrorT m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ErrorT m ()
sync
      FilePath -> FilePath -> FilePath -> ErrorT m ()
processDir FilePath
targetArgPath FilePath
targetSrcPath FilePath
targetDstPath
      FilePath -> ErrorT m ()
rmDir FilePath
targetSrcPath ErrorT m () -> ErrorT m () -> ErrorT m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ErrorT m ()
sync
  where
    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

    mvDir :: FilePath -> FilePath -> ErrorT m ()
    mvDir :: FilePath -> FilePath -> ErrorT m ()
mvDir 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
"mv", 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.renameDirectory FilePath
srcPath FilePath
dstPath

    mvFile :: FilePath -> FilePath -> ErrorT m ()
    mvFile :: FilePath -> FilePath -> ErrorT m ()
mvFile 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
"mv", 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.renameFile FilePath
srcPath FilePath
dstPath

    processDir :: FilePath -> FilePath -> FilePath -> ErrorT m ()
    processDir :: FilePath -> FilePath -> FilePath -> ErrorT m ()
processDir FilePath
argPath FilePath
srcPath FilePath
dstPath = do
      let goDir :: Entry -> ErrorT m ()
goDir Entry{FilePath
FileStatus
entryStatus :: Entry -> FileStatus
entryDstPath :: Entry -> FilePath
entrySrcPath :: Entry -> FilePath
entryArgPath :: Entry -> FilePath
entryName :: Entry -> FilePath
entryStatus :: FileStatus
entryDstPath :: FilePath
entrySrcPath :: FilePath
entryArgPath :: FilePath
entryName :: FilePath
..} = do
            FilePath -> ErrorT m ()
putProgress FilePath
entryArgPath
            FilePath -> ErrorT m ()
mkDir FilePath
entryDstPath ErrorT m () -> ErrorT m () -> ErrorT m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ErrorT m ()
sync
            FilePath -> FilePath -> FilePath -> ErrorT m ()
processDir FilePath
entryArgPath FilePath
entrySrcPath FilePath
entryDstPath
            FilePath -> ErrorT m ()
rmDir FilePath
entrySrcPath ErrorT m () -> ErrorT m () -> ErrorT m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ErrorT m ()
sync
          goFile :: Entry -> ErrorT m ()
goFile Entry{FilePath
FileStatus
entryStatus :: FileStatus
entryDstPath :: FilePath
entrySrcPath :: FilePath
entryArgPath :: FilePath
entryName :: FilePath
entryStatus :: Entry -> FileStatus
entryDstPath :: Entry -> FilePath
entrySrcPath :: Entry -> FilePath
entryArgPath :: Entry -> FilePath
entryName :: Entry -> FilePath
..} = do
            FilePath -> ErrorT m ()
putProgress FilePath
entryArgPath
            FilePath -> FilePath -> ErrorT m ()
mvFile FilePath
entrySrcPath FilePath
entryDstPath ErrorT m () -> ErrorT m () -> ErrorT m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ErrorT m ()
sync
          go :: Entry -> ErrorT m ()
go entry :: Entry
entry@Entry{FilePath
FileStatus
entryStatus :: FileStatus
entryDstPath :: FilePath
entrySrcPath :: FilePath
entryArgPath :: FilePath
entryName :: FilePath
entryStatus :: Entry -> FileStatus
entryDstPath :: Entry -> FilePath
entrySrcPath :: Entry -> FilePath
entryArgPath :: Entry -> FilePath
entryName :: Entry -> FilePath
..}
            | FileStatus -> Bool
FS.isDirectory FileStatus
entryStatus = Entry -> ErrorT m ()
goDir Entry
entry
            | Bool
otherwise = Entry -> ErrorT m ()
goFile Entry
entry
      [Entry]
allEntries <- Bool -> FilePath -> FilePath -> FilePath -> ErrorT m [Entry]
forall (m :: * -> *).
MonadFileSystem m =>
Bool -> FilePath -> FilePath -> FilePath -> ErrorT m [Entry]
getEntries Bool
optScript FilePath
argPath FilePath
srcPath FilePath
dstPath
      let ([Entry]
dirEntries, [Entry]
fileEntries) =
            (Entry -> Bool) -> [Entry] -> ([Entry], [Entry])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (FileStatus -> Bool
FS.isDirectory (FileStatus -> Bool) -> (Entry -> FileStatus) -> Entry -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> FileStatus
entryStatus) [Entry]
allEntries
      case SortFirst
optFirst of
        SortFirst
FirstNone -> (Entry -> ErrorT m ()) -> [Entry] -> ErrorT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Entry -> ErrorT m ()
go ([Entry] -> ErrorT m ()) -> ErrorT m [Entry] -> ErrorT m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Entry] -> ErrorT m [Entry]
sortEntries [Entry]
allEntries
        SortFirst
FirstDirs -> do
          (Entry -> ErrorT m ()) -> [Entry] -> ErrorT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Entry -> ErrorT m ()
goDir ([Entry] -> ErrorT m ()) -> ErrorT m [Entry] -> ErrorT m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Entry] -> ErrorT m [Entry]
sortEntries [Entry]
dirEntries
          (Entry -> ErrorT m ()) -> [Entry] -> ErrorT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Entry -> ErrorT m ()
goFile ([Entry] -> ErrorT m ()) -> ErrorT m [Entry] -> ErrorT m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Entry] -> ErrorT m [Entry]
sortEntries [Entry]
fileEntries
        SortFirst
FirstFiles -> do
          (Entry -> ErrorT m ()) -> [Entry] -> ErrorT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Entry -> ErrorT m ()
goFile ([Entry] -> ErrorT m ()) -> ErrorT m [Entry] -> ErrorT m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Entry] -> ErrorT m [Entry]
sortEntries [Entry]
fileEntries
          (Entry -> ErrorT m ()) -> [Entry] -> ErrorT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Entry -> ErrorT m ()
goDir ([Entry] -> ErrorT m ()) -> ErrorT m [Entry] -> ErrorT m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Entry] -> ErrorT m [Entry]
sortEntries [Entry]
dirEntries

    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

    rmDir :: FilePath -> ErrorT m ()
    rmDir :: FilePath -> ErrorT m ()
rmDir 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
"rmdir", 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.removeDirectory FilePath
path

    sortEntries :: [Entry] -> ErrorT m [Entry]
    sortEntries :: [Entry] -> ErrorT m [Entry]
sortEntries [Entry]
entries = m [Entry] -> ErrorT m [Entry]
forall (m :: * -> *) a. Monad m => m a -> ErrorT m a
Error.lift (m [Entry] -> ErrorT m [Entry]) -> m [Entry] -> ErrorT m [Entry]
forall a b. (a -> b) -> a -> b
$ do
      let compareNames :: Entry -> Entry -> Ordering
compareNames = case SortCase
optCase of
            SortCase
CaseSensitive -> (Entry -> FilePath) -> Entry -> Entry -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Entry -> FilePath
entryName
            SortCase
CaseInsensitive -> (Entry -> FilePath) -> Entry -> Entry -> 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 -> (Entry -> FilePath) -> Entry -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> FilePath
entryName)
          compareTimes :: Entry -> Entry -> Ordering
compareTimes = (Entry -> EpochTime) -> Entry -> Entry -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (FileStatus -> EpochTime
FS.modificationTime (FileStatus -> EpochTime)
-> (Entry -> FileStatus) -> Entry -> EpochTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> FileStatus
entryStatus)
          reverse' :: [a] -> [a]
reverse' = if Bool
optReverse then [a] -> [a]
forall a. [a] -> [a]
reverse else [a] -> [a]
forall a. a -> a
id
      case SortOrder
optOrder of
        SortOrder
OrderName -> [Entry] -> m [Entry]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Entry] -> m [Entry])
-> ([Entry] -> [Entry]) -> [Entry] -> m [Entry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Entry] -> [Entry]
forall a. [a] -> [a]
reverse' ([Entry] -> m [Entry]) -> [Entry] -> m [Entry]
forall a b. (a -> b) -> a -> b
$ (Entry -> Entry -> Ordering) -> [Entry] -> [Entry]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Entry -> Entry -> Ordering
compareNames [Entry]
entries
        SortOrder
OrderTime -> [Entry] -> m [Entry]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Entry] -> m [Entry])
-> ([Entry] -> [Entry]) -> [Entry] -> m [Entry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Entry] -> [Entry]
forall a. [a] -> [a]
reverse' ([Entry] -> m [Entry]) -> [Entry] -> m [Entry]
forall a b. (a -> b) -> a -> b
$ (Entry -> Entry -> Ordering) -> [Entry] -> [Entry]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Entry -> Entry -> Ordering
compareTimes [Entry]
entries
        SortOrder
OrderRandom -> [Entry] -> m [Entry]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [Entry]
entries

    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 directory
data Target
  = Target
    { Target -> FilePath
targetArgPath :: !FilePath  -- ^ path for verbose and errors
    , Target -> FilePath
targetSrcPath :: !FilePath  -- ^ absolute source path (@-phat@)
    , Target -> FilePath
targetDstPath :: !FilePath  -- ^ absolute destination path
    }

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

-- | Create a 'Target' for a target argument, performing checks
getTarget
  :: MonadFileSystem m
  => FilePath  -- ^ target argument
  -> ErrorT m Target
getTarget :: FilePath -> ErrorT m Target
getTarget FilePath
targetArgPath = do
    Bool -> ExceptT FilePath m () -> ExceptT FilePath m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePath
"-phat" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
targetArgPath) (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
"-phat directory: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
targetArgPath
    FilePath
targetDstPath <- 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
    FileStatus
tgtStatus <- 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
targetDstPath
    Bool -> ExceptT FilePath m () -> ExceptT FilePath m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FileStatus -> Bool
FS.isDirectory FileStatus
tgtStatus) (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
targetArgPath
    let parentDir :: FilePath
parentDir = ShowS
takeDirectory FilePath
targetDstPath
    FileStatus
parentStatus <- 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
parentDir
    Bool -> ExceptT FilePath m () -> ExceptT FilePath m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FileStatus -> DeviceID
FS.deviceID FileStatus
tgtStatus DeviceID -> DeviceID -> Bool
forall a. Eq a => a -> a -> Bool
== FileStatus -> DeviceID
FS.deviceID FileStatus
parentStatus) (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
"mount point: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
targetArgPath
    let targetSrcPath :: FilePath
targetSrcPath = FilePath
targetDstPath FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"-phat"
    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
targetSrcPath
    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
targetArgPath FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"-phat"
    Target -> ErrorT m Target
forall (f :: * -> *) a. Applicative f => a -> f a
pure Target :: FilePath -> FilePath -> FilePath -> Target
Target{FilePath
targetSrcPath :: FilePath
targetDstPath :: FilePath
targetArgPath :: FilePath
targetDstPath :: FilePath
targetSrcPath :: FilePath
targetArgPath :: FilePath
..}

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

-- | Directory entry
data Entry
  = Entry
    { Entry -> FilePath
entryName    :: !FilePath  -- ^ filename
    , Entry -> FilePath
entryArgPath :: !FilePath  -- ^ path for verbose and errors
    , Entry -> FilePath
entrySrcPath :: !FilePath  -- ^ absolute source path
    , Entry -> FilePath
entryDstPath :: !FilePath  -- ^ absolute desination path
    , Entry -> FileStatus
entryStatus  :: !FS.FileStatus
    }

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

-- | Get entries in the specified directory
getEntries
  :: MonadFileSystem m
  => Bool      -- ^ script?
  -> FilePath  -- ^ path for verbose and errors
  -> FilePath  -- ^ absolute source path
  -> FilePath  -- ^ absolute destination path
  -> ErrorT m [Entry]
getEntries :: Bool -> FilePath -> FilePath -> FilePath -> ErrorT m [Entry]
getEntries Bool
isScript 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 (if Bool
isScript then FilePath
dstDir else FilePath
srcDir)
    [FilePath]
-> (FilePath -> ExceptT FilePath m Entry) -> ErrorT m [Entry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
names ((FilePath -> ExceptT FilePath m Entry) -> ErrorT m [Entry])
-> (FilePath -> ExceptT FilePath m Entry) -> ErrorT m [Entry]
forall a b. (a -> b) -> a -> b
$ \FilePath
entryName -> do
      let entryArgPath :: FilePath
entryArgPath = FilePath
argDir FilePath -> ShowS
</> FilePath
entryName
          entrySrcPath :: FilePath
entrySrcPath = FilePath
srcDir FilePath -> ShowS
</> FilePath
entryName
          entryDstPath :: FilePath
entryDstPath = FilePath
dstDir FilePath -> ShowS
</> FilePath
entryName
      FileStatus
entryStatus <- 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 (if Bool
isScript then FilePath
entryDstPath else FilePath
entrySrcPath)
      Entry -> ExceptT FilePath m Entry
forall (f :: * -> *) a. Applicative f => a -> f a
pure Entry :: FilePath -> FilePath -> FilePath -> FilePath -> FileStatus -> Entry
Entry{FilePath
FileStatus
entryStatus :: FileStatus
entryDstPath :: FilePath
entrySrcPath :: FilePath
entryArgPath :: FilePath
entryName :: FilePath
entryStatus :: FileStatus
entryDstPath :: FilePath
entrySrcPath :: FilePath
entryArgPath :: FilePath
entryName :: FilePath
..}