diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,115 @@ +# `phatsort-haskell` Changelog + +This project follows the [Haskell package versioning policy][PVP], with +versions in `A.B.C.D` format. `A` may be incremented arbitrarily for +non-technical reasons, but [semantic versioning][SemVer] is otherwise +followed, where `A.B` is the major version, `C` is the minor version, and `D` +is the patch version. Initial development uses versions `0.0.0.D`, for which +every version is considered breaking. + +[PVP]: +[SemVer]: + +The format of this changelog is based on [Keep a Changelog][KaC], with the +following conventions: + +* Level-two heading `Unreleased` is used to track changes that have not been + released. +* Other level-two headings specify the release in `A.B.C.D (YYYY-MM-DD)` + format, with newer versions above older versions. +* Level-three headings are used to categorize changes as follows: + 1. Breaking + 2. Non-Breaking +* Changes are listed in arbitrary order and present tense. + +[KaC]: + +## 0.5.0.1 (2022-03-02) + +### Non-Breaking + +* Bump `optparse-applicative` dependency version upper bound + +## 0.5.0.0 (2021-12-10) + +### Breaking + +* Add `seqcp` +* Check that each target directory is not a mount point +* Call `sync` system call via FFI instead of running the `sync` command + +### Non-Breaking + +* Add tests using mocking + +## 0.4.0.0 (2021-06-25) + +### Breaking + +* Fix `--help` when using `optparse-applicative` `0.16` + +### Non-Breaking + +* Refactor Nix configuration + +## 0.3.0.0 (2021-05-27) + +### Breaking + +* Add support for `optparse-applicative` `0.16` + +### Non-Breaking + +* Add `.deb` and `.rpm` packaging +* Add Cabal support to `Makefile` +* Add Cabal tests to GitHub Actions +* Add [stan](https://hackage.haskell.org/package/stan) static analysis + +## 0.2.0.2 (2020-11-23) + +### Non-Breaking + +* Use GitHub Actions instead of Travis CI + +## 0.2.0.1 (2020-11-08) + +### Non-Breaking + +* Rename Git default branch to `main` + +## 0.2.0.0 (2020-07-26) + +### Breaking + +* Add syncing, `--no-sync` option + +### Non-Breaking + +* Refactor `Makefile`, add `STACK_NIX_PATH` support +* Add `test-all` command to `Makefile` +* Add Nix configuration + +## 0.1.0.3 (2019-12-22) + +### Non-Breaking + +* Switch back to using `LibOA` instead of `optparse-applicative-supplement` + +## 0.1.0.2 (2019-12-22) + +### Non-Breaking + +* Use `optparse-applicative-supplement` + +## 0.1.0.1 (2019-12-22) + +### Non-Breaking + +* Add Travis CI +* Turn off threading + +## 0.1.0.0 (2019-12-21) + +### Breaking + +* Initial public release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +The MIT License + +Copyright (c) 2019-2022 Travis Cardwell + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,142 @@ +# PhatSort + +[![Project Status: Active – The project has reached a stable, usable state and is being actively developed.](https://www.repostatus.org/badges/latest/active.svg)](https://www.repostatus.org/#active) +[![GitHub CI](https://github.com/ExtremaIS/phatsort-haskell/workflows/CI/badge.svg?branch=main)](https://github.com/ExtremaIS/phatsort-haskell/actions) +[![Hackage](https://img.shields.io/hackage/v/phatsort.svg)](https://hackage.haskell.org/package/phatsort) +[![Stackage LTS](https://stackage.org/package/phatsort/badge/lts)](https://stackage.org/package/phatsort) +[![Stackage Nightly](https://stackage.org/package/phatsort/badge/nightly)](https://stackage.org/nightly/package/phatsort) + +* [Overview](#overview) +* [CLI](#cli) + * [Requirements](#requirements) + * [Installation](#installation) + * [`.deb` Package Installation](#deb-package-installation) + * [`.rpm` Package Installation](#rpm-package-installation) + * [Installation From Hackage](#installation-from-hackage) + * [Installation From Stackage](#installation-from-stackage) + * [Usage](#usage) +* [Related Software](#related-software) +* [Project](#project) + * [Links](#links) + * [Tags](#tags) + * [Contribution](#contribution) + * [License](#license) + +## Overview + +The PhatSort project provides two command-line utilities for sorting files +and directories on FAT filesystems. The `phatsort` utility sorts files and +directories that are already on the filesystem. The `seqcp` utility copies +files and directories to the filesystem in sorted order. + +There are many MP3 players that allow you to mount the device as external +storage and manage the media yourself. The storage generally uses a FAT +filesystem. When copying multiple files onto the storage, using the command +line (`cp`/`mv`) or a GUI, they are generally stored in an arbitrary order. +This is not a problem if the firmware of the MP3 player sorts by filename, but +many MP3 players use the order in the FAT filesystem without sorting, which +results in podcasts and album tracks being played out of order. + +There are some utilities that sort the FAT tables of an unmounted filesystem. +(See [Related Software](#related-software) for information and links.) +Unfortunately, there are many devices for which this does not work. PhatSort +takes a different approach to solving the problem. It works by creating new +directories and moving ("renaming") the files in the desired order, while the +filesystem is mounted. This method works on all devices that have been tried +so far. + +PhatSort also (optionally) forces the filesystem buffers to be written to the +storage media after each change. This helps avoid write failures when using +devices that have problems with writing large amounts of data. Note that the +`seqcp` utility helps with this issue even on non-FAT filesystems. + +## CLI + +### Requirements + +PhatSort has only been tested on Linux. It *might* work on other operating +systems. Scripts that are output use POSIX shell commands and therefore +require a POSIX shell to execute. + +### Installation + +#### `.deb` Package Installation + +Check the [Releases][] page for `.deb` packages. + +#### `.rpm` Package Installation + +[Releases]: + +Check the [Releases][] page for `.rpm` packages. + +#### Installation From Hackage + +Install PhatSort from [Hackage][] using [Cabal][] as follows: + +``` +$ cabal v2-install phatsort +``` + +[Hackage]: +[Cabal]: + +#### Installation From Stackage + +Install PhatSort from [Stackage][] using [Stack][] as follows: + +``` +$ stack install phatsort +``` + +[Stackage]: +[Stack]: + +### Usage + +See the [`phatsort`](doc/phatsort.1.md) and [`seqcp`](doc/seqcp.1.md) man +pages for usage information. + +## Related Software + +[`FATSort`](https://fatsort.sourceforge.io/) is a command-line utility that +sorts unmounted FAT filesystems by direct manipulation of the FAT tables. +Unfortunately, there are many devices for which this does not work. + +[`YAFS`](http://www.luisrios.eti.br/public/en_us/projects/yafs/) is a +command-line utility that sorts unmounted FAT filesystems by direct +manipulation of the FAT tables. +[`Visual YAFS`](http://www.luisrios.eti.br/public/en_us/projects/visual_yafs/) +provides a GUI. I have not tried either of these. + +[`DriveSort`](http://www.anerty.net/software/file/DriveSort/) is Windows GUI +software that sorts unmounted FAT filesystems by direct manipulation of the +FAT tables. I have not tried it. + +## Project + +### Links + +* Hackage: +* Stackage: +* GitHub: +* GitHub Actions CI: + +### Tags + +All releases are tagged in the `main` branch. Release tags are signed using +the +[`security@extrema.is` GPG key](http://keys.gnupg.net/pks/lookup?op=vindex&fingerprint=on&search=0x1D484E4B4705FADF). + +### Contribution + +Issues and feature requests are tracked on GitHub: + + +Issues may also be submitted via email to . + +### License + +This project is released under the +[MIT License](https://opensource.org/licenses/MIT) as specified in the +[`LICENSE`](LICENSE) file. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/LibOA.hs b/app/LibOA.hs new file mode 100644 --- /dev/null +++ b/app/LibOA.hs @@ -0,0 +1,141 @@ +------------------------------------------------------------------------------ +-- | +-- Module : LibOA +-- Description : supplementary functions for optparse-applicative +-- Copyright : Copyright (c) 2019-2022 Travis Cardwell +-- License : MIT +-- +-- This is a collection of functions that I often use with +-- @optparse-applicative@. I do not feel that it is worth maintaining yet +-- another helper package on Hackage, so I just copy the code to different +-- projects as required. If the library grows to a substantial size or others +-- with to use it, I will reconsider. +-- +-- Revision: 2022-01-02 +------------------------------------------------------------------------------ + +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TupleSections #-} + +module LibOA + ( -- * Options + -- $Options + helper + , versioner + -- * Utilities + , commands + -- * Help + , (<||>) + , section + , table + , table_ + , vspace + ) where + +-- https://hackage.haskell.org/package/ansi-wl-pprint +import qualified Text.PrettyPrint.ANSI.Leijen as Doc +import Text.PrettyPrint.ANSI.Leijen (Doc) + +-- https://hackage.haskell.org/package/base +import Data.List (intersperse, transpose) +import Data.Maybe (fromMaybe) +#if !MIN_VERSION_base (4,11,0) +import Data.Monoid ((<>)) +#endif + +-- https://hackage.haskell.org/package/optparse-applicative +import qualified Options.Applicative as OA +#if MIN_VERSION_optparse_applicative (0,16,0) +import qualified Options.Applicative.Builder.Internal as OABI +#endif +import qualified Options.Applicative.Common as OAC +import qualified Options.Applicative.Types as OAT + +------------------------------------------------------------------------------ +-- $Options +-- +-- Option descriptions are not capitalized. + +-- | A hidden @-h@ / @--help@ option that always fails, showing the help +-- +-- This is the same as 'OA.helper' except that it has a different help +-- message. +helper :: OA.Parser (a -> a) +#if MIN_VERSION_optparse_applicative (0,16,0) +helper = OA.option helpReader $ mconcat + [ OA.short 'h' + , OA.long "help" + , OA.value id + , OA.metavar "" + , OABI.noGlobal + , OA.noArgError (OA.ShowHelpText Nothing) + , OA.help "show this help text" + , OA.hidden + ] + where + helpReader = do + potentialCommand <- OAT.readerAsk + OA.readerAbort $ OA.ShowHelpText (Just potentialCommand) +#else +helper = OA.abortOption OA.ShowHelpText $ mconcat + [ OA.short 'h' + , OA.long "help" + , OA.help "show help and exit" + , OA.hidden + ] +#endif + +-- | A hidden @--version@ option that always fails, showing the version +versioner + :: String -- ^ version string + -> OA.Parser (a -> a) +versioner verStr = OA.infoOption verStr $ mconcat + [ OA.long "version" + , OA.help "show version and exit" + , OA.hidden + ] + +------------------------------------------------------------------------------ +-- $Utilities + +-- | Get a list of commands for a parser +commands :: OA.Parser a -> [String] +commands = + let go _ opt = case OAT.optMain opt of + OAT.CmdReader _ cmds _ -> reverse cmds + _otherReader -> [] + in concat . OAC.mapParser go + +------------------------------------------------------------------------------ +-- $Help + +-- | Insert a blank line between two documents +(<||>) :: Doc -> Doc -> Doc +d1 <||> d2 = d1 <> Doc.line <> Doc.line <> d2 +infixr 5 <||> + +-- | Create a section with a title and indented body +section :: String -> Doc -> Doc +section title = (Doc.text title Doc.<$$>) . Doc.indent 2 + +-- | Create a table, with formatting +table :: Int -> [[(String, Doc -> Doc)]] -> Doc +table sep rows = Doc.vcat $ + map (fromMaybe Doc.empty . foldr go Nothing . zip lengths) rows + where + lengths :: [Int] + lengths = map ((+) sep . maximum . map (length . fst)) $ transpose rows + + go :: (Int, (String, Doc -> Doc)) -> Maybe Doc -> Maybe Doc + go (len, (s, f)) = Just . \case + Just doc -> Doc.fill len (f $ Doc.string s) <> doc + Nothing -> f $ Doc.string s + +-- | Create a table, without formatting +table_ :: Int -> [[String]] -> Doc +table_ sep = table sep . (map . map) (, id) + +-- | Vertically space documents with blank lines between them +vspace :: [Doc] -> Doc +vspace = mconcat . intersperse (Doc.line <> Doc.line) diff --git a/app/Options.hs b/app/Options.hs new file mode 100644 --- /dev/null +++ b/app/Options.hs @@ -0,0 +1,133 @@ +------------------------------------------------------------------------------ +-- | +-- Module : Options +-- Description : CLI options and help documentation +-- Copyright : Copyright (c) 2019-2022 Travis Cardwell +-- License : MIT +------------------------------------------------------------------------------ + +module Options where + +-- https://hackage.haskell.org/package/ansi-wl-pprint +import Text.PrettyPrint.ANSI.Leijen (Doc) + +-- https://hackage.haskell.org/package/base +import Data.Bool (bool) + +-- https://hackage.haskell.org/package/optparse-applicative +import qualified Options.Applicative as OA + +-- (phatsort) +import PhatSort.SortOptions + ( SortCase(CaseInsensitive, CaseSensitive) + , SortFirst(FirstDirs, FirstFiles, FirstNone) + , SortOrder(OrderName, OrderRandom, OrderTime) + ) + +-- (phatsort:executable) +import qualified LibOA + +------------------------------------------------------------------------------ + +caseOption :: OA.Parser SortCase +caseOption = fmap (bool CaseSensitive CaseInsensitive) . OA.switch $ + mconcat + [ OA.long "case" + , OA.short 'c' + , OA.help "case-insensitive sort" + ] + +------------------------------------------------------------------------------ + +exitCodeHelp :: Doc +exitCodeHelp = LibOA.section "Exit codes:" $ LibOA.table_ 2 + [ ["0", "no error"] + , ["1", "execution error"] + , ["2", "command line error"] + ] + +------------------------------------------------------------------------------ + +firstOption :: OA.Parser SortFirst +firstOption = OA.option (OA.eitherReader parseFirst) $ mconcat + [ OA.long "first" + , OA.short 'f' + , OA.metavar "TYPE" + , OA.value FirstNone + , OA.help "sort certain directory entries first" + ] + where + parseFirst :: String -> Either String SortFirst + parseFirst "dirs" = Right FirstDirs + parseFirst "files" = Right FirstFiles + parseFirst _ = Left "unknown first option; \"dirs\" or \"files\" expected" + +------------------------------------------------------------------------------ + +firstTypeHelp :: Doc +firstTypeHelp = LibOA.section "TYPE choices:" $ LibOA.table_ 2 + [ ["dirs", "sort directories before files"] + , ["files", "sort files before directories"] + ] + +------------------------------------------------------------------------------ + +noSyncOption :: OA.Parser Bool +noSyncOption = fmap not . OA.switch $ mconcat + [ OA.long "no-sync" + , OA.short 'n' + , OA.help "do not sync after each command" + ] + +------------------------------------------------------------------------------ + +orderOption :: OA.Parser SortOrder +orderOption = OA.option (OA.eitherReader parseOrder) $ mconcat + [ OA.long "order" + , OA.short 'o' + , OA.metavar "ORDER" + , OA.value OrderName + , OA.help "desired order (default: name)" + ] + where + parseOrder :: String -> Either String SortOrder + parseOrder "name" = Right OrderName + parseOrder "time" = Right OrderTime + parseOrder "random" = Right OrderRandom + parseOrder _ = Left "unknown ORDER" + +------------------------------------------------------------------------------ + +orderHelp :: Doc +orderHelp = LibOA.section "ORDER choices:" $ LibOA.table_ 2 + [ ["name", "sort by filename"] + , ["time", "sort by modification time"] + , ["random", "random order"] + ] + +------------------------------------------------------------------------------ + +reverseOption :: OA.Parser Bool +reverseOption = OA.switch $ mconcat + [ OA.long "reverse" + , OA.short 'r' + , OA.help "reverse sort" + ] + +------------------------------------------------------------------------------ + +scriptOption :: OA.Parser Bool +scriptOption = OA.switch $ mconcat + [ OA.long "script" + , OA.short 's' + , OA.help "output script instead of executing" + ] + +------------------------------------------------------------------------------ + +verboseOption :: OA.Parser Bool +verboseOption = OA.switch $ mconcat + [ OA.long "verbose" + , OA.short 'v' + , OA.help "display progress" + ] diff --git a/app/phatsort.hs b/app/phatsort.hs new file mode 100644 --- /dev/null +++ b/app/phatsort.hs @@ -0,0 +1,79 @@ +------------------------------------------------------------------------------ +-- | +-- Module : Main +-- Description : phatsort CLI +-- Copyright : Copyright (c) 2019-2022 Travis Cardwell +-- License : MIT +------------------------------------------------------------------------------ + +module Main (main) where + +-- https://hackage.haskell.org/package/base +import Control.Applicative (some) +import qualified Data.List.NonEmpty as NonEmpty +import Data.List.NonEmpty (NonEmpty) +import System.Exit (ExitCode(ExitFailure), exitWith) +import System.IO (hPutStrLn, stderr) + +-- https://hackage.haskell.org/package/optparse-applicative +import qualified Options.Applicative as OA + +-- (phatsort) +import PhatSort (version) +import PhatSort.Cmd.PhatSort (Options(Options), runIO) + +-- (phatsort:executable) +import qualified LibOA +import Options + ( caseOption, exitCodeHelp, firstOption, firstTypeHelp, noSyncOption + , orderHelp, orderOption, reverseOption, scriptOption, verboseOption + ) + +------------------------------------------------------------------------------ + +options :: OA.Parser Options +options = Options + <$> caseOption + <*> firstOption + <*> noSyncOption + <*> orderOption + <*> reverseOption + <*> scriptOption + <*> verboseOption + <*> targetArguments + +------------------------------------------------------------------------------ + +targetArguments :: OA.Parser (NonEmpty FilePath) +targetArguments = fmap NonEmpty.fromList . some . OA.strArgument $ mconcat + [ OA.metavar "TARGET ..." + , OA.help "target directories" + ] + +------------------------------------------------------------------------------ + +parseOptions :: IO Options +parseOptions = OA.execParser + . OA.info (LibOA.helper <*> LibOA.versioner version <*> options) + $ mconcat + [ OA.fullDesc + , OA.progDesc "FAT filesystem sort utility" + , OA.failureCode 2 + , OA.footerDoc . Just $ LibOA.vspace + [ firstTypeHelp + , orderHelp + , exitCodeHelp + ] + ] + +------------------------------------------------------------------------------ + +errorExit :: String -> IO a +errorExit message = do + hPutStrLn stderr $ "error: " ++ message + exitWith $ ExitFailure 1 + +------------------------------------------------------------------------------ + +main :: IO () +main = either errorExit pure =<< runIO =<< parseOptions diff --git a/app/seqcp.hs b/app/seqcp.hs new file mode 100644 --- /dev/null +++ b/app/seqcp.hs @@ -0,0 +1,123 @@ +------------------------------------------------------------------------------ +-- | +-- Module : Main +-- Description : seqcp CLI +-- Copyright : Copyright (c) 2019-2022 Travis Cardwell +-- License : MIT +------------------------------------------------------------------------------ + +{-# LANGUAGE RecordWildCards #-} + +module Main (main) where + +-- https://hackage.haskell.org/package/base +import Control.Applicative (some) +import Data.Bifunctor (first) +import Data.List.NonEmpty (nonEmpty) +import System.Exit (ExitCode(ExitFailure), exitWith) +import System.IO (hPutStrLn, stderr) + +-- https://hackage.haskell.org/package/optparse-applicative +import qualified Options.Applicative as OA + +-- (phatsort) +import PhatSort (version) +import PhatSort.Cmd.SeqCp + ( Options + ( Options, optCase, optFirst, optSync, optOrder, optReverse, optScript + , optVerbose, optSources, optDestination + ) + , runIO + ) +import PhatSort.SortOptions (SortCase, SortFirst, SortOrder) + +-- (phatsort:executable) +import qualified LibOA +import Options + ( caseOption, exitCodeHelp, firstOption, firstTypeHelp, noSyncOption + , orderHelp, orderOption, reverseOption, scriptOption, verboseOption + ) + +------------------------------------------------------------------------------ + +data Options' + = Options' + { optCase :: !SortCase + , optFirst :: !SortFirst + , optSync :: !Bool + , optOrder :: !SortOrder + , optReverse :: !Bool + , optScript :: !Bool + , optVerbose :: !Bool + , optArgs :: ![FilePath] + } + deriving Show + +------------------------------------------------------------------------------ + +options :: OA.Parser Options' +options = Options' + <$> caseOption + <*> firstOption + <*> noSyncOption + <*> orderOption + <*> reverseOption + <*> scriptOption + <*> verboseOption + <*> arguments + +------------------------------------------------------------------------------ + +arguments :: OA.Parser [FilePath] +arguments = some . OA.strArgument $ mconcat + [ OA.metavar "SOURCE ... DESTINATION" + , OA.help "source directories/files and destination directory" + ] + +------------------------------------------------------------------------------ + +parseOptions :: IO Options +parseOptions = processOptions =<< OA.execParser info + where + info :: OA.ParserInfo Options' + info + = OA.info (LibOA.helper <*> LibOA.versioner version <*> options) + $ mconcat + [ OA.fullDesc + , OA.progDesc "sequentially copy files and directories" + , OA.failureCode 2 + , OA.footerDoc . Just $ LibOA.vspace + [ firstTypeHelp + , orderHelp + , exitCodeHelp + ] + ] + + processOptions :: Options' -> IO Options + processOptions Options'{..} = case first nonEmpty <$> unsnoc optArgs of + Just (Just optSources, optDestination) -> pure Options{..} + Just (Nothing, _destination) -> usageExit "Missing: DESTINATION" + Nothing -> usageExit "Missing: SOURCE ... DESTINATION" + + unsnoc :: [FilePath] -> Maybe ([FilePath], FilePath) + unsnoc (x:xs) + | null xs = Just ([], x) + | otherwise = first (x :) <$> unsnoc xs + unsnoc [] = Nothing + + usageExit :: String -> IO a + usageExit msg = OA.handleParseResult . OA.Failure $ + OA.parserFailure OA.defaultPrefs info (OA.ErrorMsg msg) [] + +------------------------------------------------------------------------------ + +errorExit :: String -> IO a +errorExit message = do + hPutStrLn stderr $ "error: " ++ message + exitWith $ ExitFailure 1 + +------------------------------------------------------------------------------ + +main :: IO () +main = either errorExit pure =<< runIO =<< parseOptions + diff --git a/phatsort.cabal b/phatsort.cabal new file mode 100644 --- /dev/null +++ b/phatsort.cabal @@ -0,0 +1,127 @@ +name: phatsort +version: 0.5.0.1 +category: Utils +synopsis: FAT filesystem sort utility +description: + This package provides a utility for sorting files and directories on a FAT + filesystem. Please see the README on GitHub at + . + +homepage: https://github.com/ExtremaIS/phatsort-haskell#readme +bug-reports: https://github.com/ExtremaIS/phatsort-haskell/issues +author: Travis Cardwell +maintainer: Travis Cardwell +copyright: Copyright (c) 2019-2022 Travis Cardwell +license: MIT +license-file: LICENSE + +cabal-version: 1.24 +build-type: Simple +tested-with: + GHC ==8.2.2 + || ==8.4.4 + || ==8.6.5 + || ==8.8.4 + || ==8.10.7 + || ==9.0.2 + || ==9.2.1 + +extra-source-files: + CHANGELOG.md + README.md + +source-repository head + type: git + location: https://github.com/ExtremaIS/phatsort-haskell.git + +flag write-hie + description: write .hie files + default: False + +library + hs-source-dirs: src + exposed-modules: + PhatSort + , PhatSort.Cmd.PhatSort + , PhatSort.Cmd.SeqCp + , PhatSort.Monad.FileSystem + , PhatSort.Monad.Stdio + , PhatSort.Monad.Sync + , PhatSort.Monad.Trans.Error + , PhatSort.Script + , PhatSort.SortOptions + other-modules: + Paths_phatsort + if !os(windows) + other-modules: + PhatSort.Monad.Sync.Unistd + build-depends: + base >=4.7 && <5 + , directory >=1.3 && <1.4 + , filepath >=1.4 && <1.5 + , MonadRandom >=0.5 && <0.6 + , random-shuffle >=0.0.4 && <0.1 + , transformers >=0.5 && <0.6 + , unix-compat >=0.5 && <0.6 + default-language: Haskell2010 + default-extensions: + OverloadedStrings + if flag(write-hie) + ghc-options: -Wall -fwrite-ide-info -hiedir=.hie + else + ghc-options: -Wall + +executable phatsort + hs-source-dirs: app + main-is: phatsort.hs + other-modules: + LibOA + , Options + build-depends: + ansi-wl-pprint >=0.6 && <0.7 + , base + , optparse-applicative >=0.14 && <0.18 + , phatsort + default-language: Haskell2010 + if flag(write-hie) + ghc-options: -Wall -fwrite-ide-info -hiedir=.hie + else + ghc-options: -Wall + +executable seqcp + hs-source-dirs: app + main-is: seqcp.hs + other-modules: + LibOA + , Options + build-depends: + ansi-wl-pprint >=0.6 && <0.7 + , base + , optparse-applicative >=0.14 && <0.18 + , phatsort + default-language: Haskell2010 + if flag(write-hie) + ghc-options: -Wall -fwrite-ide-info -hiedir=.hie + else + ghc-options: -Wall + +test-suite phatsort-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: + base + , MonadRandom + , phatsort + , tasty >=1.0 && <1.5 + , tasty-hunit >=0.10 && <0.11 + , transformers >=0.5 && <0.7 + if impl(ghc >= 8.6.1) + other-modules: + PhatSort.Cmd.PhatSort.Mock + , PhatSort.Cmd.SeqCp.Mock + , TestLib + build-depends: + HMock >=0.5.1 && <0.6 + default-language: Haskell2010 + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N diff --git a/src/PhatSort.hs b/src/PhatSort.hs new file mode 100644 --- /dev/null +++ b/src/PhatSort.hs @@ -0,0 +1,27 @@ +------------------------------------------------------------------------------ +-- | +-- Module : PhatSort +-- Description : metadata +-- Copyright : Copyright (c) 2019-2022 Travis Cardwell +-- License : MIT +------------------------------------------------------------------------------ + +module PhatSort + ( -- * Constants + version + ) where + +-- https://hackage.haskell.org/package/base +import Data.Version (showVersion) + +-- (phatsort:cabal) +import qualified Paths_phatsort as Project + +------------------------------------------------------------------------------ +-- $Constants + +-- | PhatSort version string (\"@phatsort-haskell X.X.X.X@\") +-- +-- @since 0.5.0.0 +version :: String +version = "phatsort-haskell " ++ showVersion Project.version diff --git a/src/PhatSort/Cmd/PhatSort.hs b/src/PhatSort/Cmd/PhatSort.hs new file mode 100644 --- /dev/null +++ b/src/PhatSort/Cmd/PhatSort.hs @@ -0,0 +1,231 @@ +------------------------------------------------------------------------------ +-- | +-- 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 + { optCase :: !SortCase + , optFirst :: !SortFirst + , optSync :: !Bool + , optOrder :: !SortOrder + , optReverse :: !Bool + , optScript :: !Bool + , optVerbose :: !Bool + , optTargets :: !(NonEmpty FilePath) + } + deriving Show + +------------------------------------------------------------------------------ +-- $API + +-- | Run the command in the 'IO' monad +runIO :: Options -> IO (Either String ()) +runIO = Error.run . run + +------------------------------------------------------------------------------ + +-- | Run the command +run + :: forall m + . (MonadFileSystem m, MonadRandom m, MonadStdio m, MonadSync m) + => Options + -> ErrorT m () +run Options{..} = do + targets <- mapM getTarget $ NonEmpty.toList optTargets + forM_ targets $ \Target{..} -> do + putProgress targetArgPath + mvDir targetDstPath targetSrcPath >> sync + mkDir targetDstPath >> sync + processDir targetArgPath targetSrcPath targetDstPath + rmDir targetSrcPath >> sync + where + mkDir :: FilePath -> ErrorT m () + mkDir path + | optScript = Stdio.putStrLn $ Script.formatCommand ["mkdir", path] + | otherwise = Error.errorTE $ FS.createDirectory path + + mvDir :: FilePath -> FilePath -> ErrorT m () + mvDir srcPath dstPath + | optScript = + Stdio.putStrLn $ Script.formatCommand ["mv", srcPath, dstPath] + | otherwise = Error.errorTE $ FS.renameDirectory srcPath dstPath + + mvFile :: FilePath -> FilePath -> ErrorT m () + mvFile srcPath dstPath + | optScript = + Stdio.putStrLn $ Script.formatCommand ["mv", srcPath, dstPath] + | otherwise = Error.errorTE $ FS.renameFile srcPath dstPath + + processDir :: FilePath -> FilePath -> FilePath -> ErrorT m () + processDir argPath srcPath dstPath = do + let goDir Entry{..} = do + putProgress entryArgPath + mkDir entryDstPath >> sync + processDir entryArgPath entrySrcPath entryDstPath + rmDir entrySrcPath >> sync + goFile Entry{..} = do + putProgress entryArgPath + mvFile entrySrcPath entryDstPath >> sync + go entry@Entry{..} + | FS.isDirectory entryStatus = goDir entry + | otherwise = goFile entry + allEntries <- getEntries optScript argPath srcPath dstPath + let (dirEntries, fileEntries) = + partition (FS.isDirectory . entryStatus) allEntries + case optFirst of + FirstNone -> mapM_ go =<< sortEntries allEntries + FirstDirs -> do + mapM_ goDir =<< sortEntries dirEntries + mapM_ goFile =<< sortEntries fileEntries + FirstFiles -> do + mapM_ goFile =<< sortEntries fileEntries + mapM_ goDir =<< sortEntries dirEntries + + putProgress :: FilePath -> ErrorT m () + putProgress path + | not optVerbose = pure () + | optScript = Stdio.putStrLn $ Script.formatCommand ["echo", path] + | otherwise = Stdio.putStrLn path + + rmDir :: FilePath -> ErrorT m () + rmDir path + | optScript = Stdio.putStrLn $ Script.formatCommand ["rmdir", path] + | otherwise = Error.errorTE $ FS.removeDirectory path + + sortEntries :: [Entry] -> ErrorT m [Entry] + sortEntries entries = Error.lift $ do + let compareNames = case optCase of + CaseSensitive -> comparing entryName + CaseInsensitive -> comparing (map toLower . entryName) + compareTimes = comparing (FS.modificationTime . entryStatus) + reverse' = if optReverse then reverse else id + case optOrder of + OrderName -> pure . reverse' $ sortBy compareNames entries + OrderTime -> pure . reverse' $ sortBy compareTimes entries + OrderRandom -> shuffleM entries + + sync :: ErrorT m () + sync + | not optSync = pure () + | optScript = Stdio.putStrLn $ Script.formatCommand ["sync"] + | otherwise = Sync.sync + +------------------------------------------------------------------------------ +-- $Internal + +-- | Target directory +data Target + = Target + { targetArgPath :: !FilePath -- ^ path for verbose and errors + , targetSrcPath :: !FilePath -- ^ absolute source path (@-phat@) + , targetDstPath :: !FilePath -- ^ absolute destination path + } + +------------------------------------------------------------------------------ + +-- | Create a 'Target' for a target argument, performing checks +getTarget + :: MonadFileSystem m + => FilePath -- ^ target argument + -> ErrorT m Target +getTarget targetArgPath = do + when ("-phat" `isSuffixOf` targetArgPath) . + Error.throw $ "-phat directory: " ++ targetArgPath + targetDstPath <- Error.errorTE . + FS.makeAbsolute $ dropWhileEnd (== '/') targetArgPath + tgtStatus <- Error.errorTE $ FS.getFileStatus targetDstPath + unless (FS.isDirectory tgtStatus) . + Error.throw $ "not a directory: " ++ targetArgPath + let parentDir = takeDirectory targetDstPath + parentStatus <- Error.errorTE $ FS.getFileStatus parentDir + unless (FS.deviceID tgtStatus == FS.deviceID parentStatus) . + Error.throw $ "mount point: " ++ targetArgPath + let targetSrcPath = targetDstPath ++ "-phat" + exists <- Error.errorTE $ FS.doesPathExist targetSrcPath + when exists . Error.throw $ "already exists: " ++ targetArgPath ++ "-phat" + pure Target{..} + +------------------------------------------------------------------------------ + +-- | Directory entry +data Entry + = Entry + { entryName :: !FilePath -- ^ filename + , entryArgPath :: !FilePath -- ^ path for verbose and errors + , entrySrcPath :: !FilePath -- ^ absolute source path + , entryDstPath :: !FilePath -- ^ absolute desination path + , 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 isScript argDir srcDir dstDir = do + names <- Error.errorTE $ + FS.listDirectory (if isScript then dstDir else srcDir) + forM names $ \entryName -> do + let entryArgPath = argDir entryName + entrySrcPath = srcDir entryName + entryDstPath = dstDir entryName + entryStatus <- Error.errorTE $ + FS.getFileStatus (if isScript then entryDstPath else entrySrcPath) + pure Entry{..} diff --git a/src/PhatSort/Cmd/SeqCp.hs b/src/PhatSort/Cmd/SeqCp.hs new file mode 100644 --- /dev/null +++ b/src/PhatSort/Cmd/SeqCp.hs @@ -0,0 +1,205 @@ +------------------------------------------------------------------------------ +-- | +-- 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 + { optCase :: !SortCase + , optFirst :: !SortFirst + , optSync :: !Bool + , optOrder :: !SortOrder + , optReverse :: !Bool + , optScript :: !Bool + , optVerbose :: !Bool + , optSources :: !(NonEmpty FilePath) + , optDestination :: !FilePath + } + deriving Show + +------------------------------------------------------------------------------ +-- $API + +-- | Run the command in the 'IO' monad +runIO :: Options -> IO (Either String ()) +runIO = Error.run . run + +------------------------------------------------------------------------------ + +-- | Run the command +run + :: forall m + . (MonadFileSystem m, MonadRandom m, MonadStdio m, MonadSync m) + => Options + -> ErrorT m () +run Options{..} = copyTargets =<< getArgTargets optSources optDestination + where + copyDir :: FilePath -> FilePath -> FilePath -> ErrorT m () + copyDir argPath srcPath dstPath = do + putProgress argPath + mkDir dstPath >> sync + copyTargets =<< getDirTargets argPath srcPath dstPath + + copyFile :: FilePath -> FilePath -> FilePath -> ErrorT m () + copyFile argPath srcPath dstPath = do + putProgress argPath + cp srcPath dstPath >> sync + + copyTargets :: [Target] -> ErrorT m () + copyTargets targets = do + sortedTargets <- sortTargets targets + forM_ sortedTargets $ \Target{..} -> + if FS.isDirectory targetStatus + then copyDir targetArgPath targetSrcPath targetDstPath + else copyFile targetArgPath targetSrcPath targetDstPath + + cp :: FilePath -> FilePath -> ErrorT m () + cp srcPath dstPath + | optScript = + Stdio.putStrLn $ Script.formatCommand ["cp", srcPath, dstPath] + | otherwise = Error.errorTE $ FS.copyFile srcPath dstPath + + mkDir :: FilePath -> ErrorT m () + mkDir path + | optScript = Stdio.putStrLn $ Script.formatCommand ["mkdir", path] + | otherwise = Error.errorTE $ FS.createDirectory path + + putProgress :: FilePath -> ErrorT m () + putProgress path + | not optVerbose = pure () + | optScript = Stdio.putStrLn $ Script.formatCommand ["echo", path] + | otherwise = Stdio.putStrLn path + + sortTargets :: [Target] -> ErrorT m [Target] + sortTargets targets = + let compareNames = case optCase of + CaseSensitive -> comparing targetName + CaseInsensitive -> comparing (map toLower . targetName) + compareTimes = comparing (FS.modificationTime . targetStatus) + reverse' = if optReverse then reverse else id + go = case optOrder of + OrderName -> pure . reverse' . sortBy compareNames + OrderTime -> pure . reverse' . sortBy compareTimes + OrderRandom -> shuffleM + (dirTargets, fileTargets) = + partition (FS.isDirectory . targetStatus) targets + in Error.lift $ case optFirst of + FirstNone -> go targets + FirstDirs -> (++) <$> go dirTargets <*> go fileTargets + FirstFiles -> (++) <$> go fileTargets <*> go dirTargets + + sync :: ErrorT m () + sync + | not optSync = pure () + | optScript = Stdio.putStrLn $ Script.formatCommand ["sync"] + | otherwise = Sync.sync + +------------------------------------------------------------------------------ +-- $Internal + +-- | Target file or directory +data Target + = Target + { targetArgPath :: !FilePath -- ^ path for verbose and errors + , targetSrcPath :: !FilePath -- ^ absolute source path + , targetDstPath :: !FilePath -- ^ absolute destination path + , targetName :: !FilePath -- ^ file or directory name + , targetStatus :: !FS.FileStatus + } + +------------------------------------------------------------------------------ + +-- | Create 'Target's for arguments, performing checks +getArgTargets + :: MonadFileSystem m + => NonEmpty FilePath -- ^ sources + -> FilePath -- ^ destination directory + -> ErrorT m [Target] +getArgTargets sources destDir = do + destPath <- Error.errorTE . + FS.makeAbsolute $ dropWhileEnd (== '/') destDir + destStatus <- Error.errorTE $ FS.getFileStatus destPath + unless (FS.isDirectory destStatus) . + Error.throw $ "not a directory: " ++ destDir + let destDirs = splitDirectories destPath + forM (NonEmpty.toList sources) $ \targetArgPath -> do + targetSrcPath <- Error.errorTE . + FS.makeAbsolute $ dropWhileEnd (== '/') targetArgPath + let targetName = takeFileName targetSrcPath + targetDstPath = destPath targetName + targetStatus <- Error.errorTE $ FS.getFileStatus targetSrcPath + when (FS.isDirectory targetStatus) . + when (splitDirectories targetSrcPath `isPrefixOf` destDirs) $ + Error.throw $ + "source directory above target directory: " ++ targetArgPath + exists <- Error.errorTE $ FS.doesPathExist targetDstPath + when exists . Error.throw $ "already exists: " ++ targetDstPath + pure Target{..} + +------------------------------------------------------------------------------ + +-- | 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 argDir srcDir dstDir = do + names <- Error.errorTE $ FS.listDirectory srcDir + forM names $ \targetName -> do + let targetArgPath = argDir targetName + targetSrcPath = srcDir targetName + targetDstPath = dstDir targetName + targetStatus <- Error.errorTE $ FS.getFileStatus targetSrcPath + pure Target{..} diff --git a/src/PhatSort/Monad/FileSystem.hs b/src/PhatSort/Monad/FileSystem.hs new file mode 100644 --- /dev/null +++ b/src/PhatSort/Monad/FileSystem.hs @@ -0,0 +1,150 @@ +------------------------------------------------------------------------------ +-- | +-- Module : PhatSort.Monad.FileSystem +-- Description : filesystem I/O +-- Copyright : Copyright (c) 2019-2022 Travis Cardwell +-- License : MIT +------------------------------------------------------------------------------ + +module PhatSort.Monad.FileSystem + ( -- * MonadFileSystem + MonadFileSystem(..) + -- * FileStatus + , FileStatus(..) + ) where + +-- https://hackage.haskell.org/package/base +import System.IO.Error (tryIOError) +import System.Posix.Types (DeviceID, EpochTime) + +-- https://hackage.haskell.org/package/directory +import qualified System.Directory as Dir + +-- https://hackage.haskell.org/package/transformers +import Control.Monad.Trans.Class (MonadTrans(lift)) +import Control.Monad.Trans.Except (ExceptT) + +-- https://hackage.haskell.org/package/unix-compat +import qualified System.PosixCompat.Files as Files + +------------------------------------------------------------------------------ +-- $MonadFileSystem + +-- | Filesystem I/O +-- +-- @since 0.5.0.0 +class Monad m => MonadFileSystem m where + -- | Copy a file + copyFile + :: FilePath -- ^ source + -> FilePath -- ^ destination + -> m (Either IOError ()) + + -- | Create a directory + createDirectory :: FilePath -> m (Either IOError ()) + + -- | Check if a path exists + doesPathExist :: FilePath -> m (Either IOError Bool) + + -- | Get file status information + getFileStatus :: FilePath -> m (Either IOError FileStatus) + + -- | Get a list of directory entries + listDirectory :: FilePath -> m (Either IOError [FilePath]) + + -- | Convert a path into an absolute path + makeAbsolute :: FilePath -> m (Either IOError FilePath) + + -- | Remove a directory + removeDirectory :: FilePath -> m (Either IOError ()) + + -- | Rename a directory + renameDirectory + :: FilePath -- ^ target directory + -> FilePath -- ^ new directory name + -> m (Either IOError ()) + + -- | Rename a file + renameFile + :: FilePath -- ^ target file + -> FilePath -- ^ new file name + -> m (Either IOError ()) + +instance MonadFileSystem IO where + copyFile = (tryIOError .) . Dir.copyFile + {-# INLINE copyFile #-} + + createDirectory = tryIOError . Dir.createDirectory + {-# INLINE createDirectory #-} + + doesPathExist = tryIOError . Dir.doesPathExist + {-# INLINE doesPathExist #-} + + getFileStatus = tryIOError . fmap toFileStatus . Files.getFileStatus + {-# INLINE getFileStatus #-} + + listDirectory = tryIOError . Dir.listDirectory + {-# INLINE listDirectory #-} + + makeAbsolute = tryIOError . Dir.makeAbsolute + {-# INLINE makeAbsolute #-} + + removeDirectory = tryIOError . Dir.removeDirectory + {-# INLINE removeDirectory #-} + + renameDirectory = (tryIOError .) . Dir.renameDirectory + {-# INLINE renameDirectory #-} + + renameFile = (tryIOError .) . Dir.renameFile + {-# INLINE renameFile #-} + +instance MonadFileSystem m => MonadFileSystem (ExceptT e m) where + copyFile = (lift .) . copyFile + {-# INLINE copyFile #-} + + createDirectory = lift . createDirectory + {-# INLINE createDirectory #-} + + doesPathExist = lift . doesPathExist + {-# INLINE doesPathExist #-} + + getFileStatus = lift . getFileStatus + {-# INLINE getFileStatus #-} + + listDirectory = lift . listDirectory + {-# INLINE listDirectory #-} + + makeAbsolute = lift . makeAbsolute + {-# INLINE makeAbsolute #-} + + removeDirectory = lift . removeDirectory + {-# INLINE removeDirectory #-} + + renameDirectory = (lift .) . renameDirectory + {-# INLINE renameDirectory #-} + + renameFile = (lift .) . renameFile + {-# INLINE renameFile #-} + +------------------------------------------------------------------------------ +-- $FileStatus + +-- | Mockable subset of 'Files.FileStatus' +-- +-- @since 0.5.0.0 +data FileStatus + = FileStatus + { deviceID :: !DeviceID + , isDirectory :: !Bool + , modificationTime :: !EpochTime + } + +-- | Convert from 'Files.FileStatus' to 'FileStatus' +-- +-- @since 0.5.0.0 +toFileStatus :: Files.FileStatus -> FileStatus +toFileStatus status = FileStatus + { deviceID = Files.deviceID status + , isDirectory = Files.isDirectory status + , modificationTime = Files.modificationTime status + } diff --git a/src/PhatSort/Monad/Stdio.hs b/src/PhatSort/Monad/Stdio.hs new file mode 100644 --- /dev/null +++ b/src/PhatSort/Monad/Stdio.hs @@ -0,0 +1,38 @@ +------------------------------------------------------------------------------ +-- | +-- Module : PhatSort.Monad.Stdio +-- Description : standard I/O +-- Copyright : Copyright (c) 2019-2022 Travis Cardwell +-- License : MIT +------------------------------------------------------------------------------ + +module PhatSort.Monad.Stdio + ( -- * MonadStdio + MonadStdio(..) + ) where + +-- https://hackage.haskell.org/package/base +import qualified Prelude +import Prelude hiding (putStrLn) + +-- https://hackage.haskell.org/package/transformers +import Control.Monad.Trans.Class (MonadTrans(lift)) +import Control.Monad.Trans.Except (ExceptT) + +------------------------------------------------------------------------------ +-- $MonadStdio + +-- | Standard I/O +-- +-- @since 0.5.0.0 +class Monad m => MonadStdio m where + -- | Write a 'String' to @STDOUT@, appending a newline + putStrLn :: String -> m () + +instance MonadStdio IO where + putStrLn = Prelude.putStrLn + {-# INLINE putStrLn #-} + +instance MonadStdio m => MonadStdio (ExceptT e m) where + putStrLn = lift . putStrLn + {-# INLINE putStrLn #-} diff --git a/src/PhatSort/Monad/Sync.hs b/src/PhatSort/Monad/Sync.hs new file mode 100644 --- /dev/null +++ b/src/PhatSort/Monad/Sync.hs @@ -0,0 +1,47 @@ +------------------------------------------------------------------------------ +-- | +-- Module : PhatSort.Monad.Sync +-- Description : commit all data in filesystem buffers +-- Copyright : Copyright (c) 2019-2022 Travis Cardwell +-- License : MIT +------------------------------------------------------------------------------ + +{-# LANGUAGE CPP #-} + +module PhatSort.Monad.Sync + ( -- * MonadSync + MonadSync(..) + ) where + +-- https://hackage.haskell.org/package/transformers +import Control.Monad.Trans.Class (MonadTrans(lift)) +import Control.Monad.Trans.Except (ExceptT) + +-- (phatsort) +#ifndef mingw32_HOST_OS +import PhatSort.Monad.Sync.Unistd (c_sync) +#endif + +------------------------------------------------------------------------------ +-- $MonadSync + +-- | Commit all data in filesystem buffers +-- +-- @since 0.5.0.0 +class Monad m => MonadSync m where + -- | Commit all data in filesystem buffers + -- + -- This method calls the @sync@ system call on POSIX systems. It does + -- nothing on Windows. + sync :: m () + +instance MonadSync IO where +#ifdef mingw32_HOST_OS + sync = pure () +#else + sync = c_sync +#endif + +instance MonadSync m => MonadSync (ExceptT e m) where + sync = lift sync + {-# INLINE sync #-} diff --git a/src/PhatSort/Monad/Sync/Unistd.hs b/src/PhatSort/Monad/Sync/Unistd.hs new file mode 100644 --- /dev/null +++ b/src/PhatSort/Monad/Sync/Unistd.hs @@ -0,0 +1,22 @@ +------------------------------------------------------------------------------ +-- | +-- Module : PhatSort.Monad.Sync.Unistd +-- Description : sync implementation for POSIX systems +-- Copyright : Copyright (c) 2019-2022 Travis Cardwell +-- License : MIT +------------------------------------------------------------------------------ + +{-# LANGUAGE ForeignFunctionInterface #-} + +module PhatSort.Monad.Sync.Unistd + ( -- * API + c_sync + ) where + +------------------------------------------------------------------------------ + +-- | Call the @sync@ system call +-- +-- @since 0.5.0.0 +foreign import ccall "unistd.h sync" + c_sync :: IO () diff --git a/src/PhatSort/Monad/Trans/Error.hs b/src/PhatSort/Monad/Trans/Error.hs new file mode 100644 --- /dev/null +++ b/src/PhatSort/Monad/Trans/Error.hs @@ -0,0 +1,135 @@ +------------------------------------------------------------------------------ +-- | +-- Module : PhatSort.Monad.Trans.Error +-- Description : error monad transformer +-- Copyright : Copyright (c) 2019-2022 Travis Cardwell +-- License : MIT +------------------------------------------------------------------------------ + +module PhatSort.Monad.Trans.Error + ( -- * ErrorT + ErrorT + -- * API + , errorT + , errorTE + , lift + , liftEither + , liftEitherE + , run + , throw + , throwE + ) where + +-- https://hackage.haskell.org/package/base +import Control.Exception (Exception(displayException)) +import Data.Bifunctor (first) + +-- https://hackage.haskell.org/package/transformers +import qualified Control.Monad.Trans.Except as Except +import Control.Monad.Trans.Except (ExceptT(ExceptT)) +import qualified Control.Monad.Trans.Class as Trans + +------------------------------------------------------------------------------ +-- $ErrorT + +-- | Transformer used to manage errors: 'ExceptT' 'String' +-- +-- @since 0.5.0.0 +type ErrorT = ExceptT String + +------------------------------------------------------------------------------ +-- $API + +-- | Manage 'String' errors of an action +-- +-- @since 0.5.0.0 +errorT + :: Monad m + => m (Either String a) + -> ErrorT m a +errorT = ExceptT +{-# INLINE errorT #-} + +------------------------------------------------------------------------------ + +-- | Manage 'Exception' errors of an action +-- +-- @since 0.5.0.0 +errorTE + :: (Exception e, Monad m) + => m (Either e a) + -> ErrorT m a +errorTE = ExceptT . fmap (first displayException) +{-# INLINE errorTE #-} + +------------------------------------------------------------------------------ + +-- | Lift an action without errors +-- +-- @since 0.5.0.0 +lift + :: Monad m + => m a + -> ErrorT m a +lift = Trans.lift +{-# INLINE lift #-} + +------------------------------------------------------------------------------ + +-- | Manage 'String' errors +-- +-- @since 0.5.0.0 +liftEither + :: Monad m + => Either String a + -> ErrorT m a +liftEither = ExceptT . pure +{-# INLINE liftEither #-} + +------------------------------------------------------------------------------ + +-- | Manage 'Exception' errors +-- +-- @since 0.5.0.0 +liftEitherE + :: (Exception e, Monad m) + => Either e a + -> ErrorT m a +liftEitherE = ExceptT . pure . first displayException +{-# INLINE liftEitherE #-} + +------------------------------------------------------------------------------ + +-- | Run the transformer +-- +-- @since 0.5.0.0 +run + :: Monad m + => ErrorT m a + -> m (Either String a) +run = Except.runExceptT +{-# INLINE run #-} + +------------------------------------------------------------------------------ + +-- | Throw a 'String' error +-- +-- @since 0.5.0.0 +throw + :: Monad m + => String + -> ErrorT m a +throw = Except.throwE +{-# INLINE throw #-} + +------------------------------------------------------------------------------ + +-- | Throw an 'Exception' error +-- +-- @since 0.5.0.0 +throwE + :: (Exception e, Monad m) + => e + -> ErrorT m a +throwE = Except.throwE . displayException +{-# INLINE throwE #-} diff --git a/src/PhatSort/Script.hs b/src/PhatSort/Script.hs new file mode 100644 --- /dev/null +++ b/src/PhatSort/Script.hs @@ -0,0 +1,45 @@ +------------------------------------------------------------------------------ +-- | +-- Module : PhatSort.Script +-- Description : script API +-- Copyright : Copyright (c) 2019-2022 Travis Cardwell +-- License : MIT +------------------------------------------------------------------------------ + +module PhatSort.Script + ( -- * API + formatCommand + ) where + +-- https://hackage.haskell.org/package/base +import Data.Char (ord) + +------------------------------------------------------------------------------ + +-- | Format a shell command, escaping when necessary +-- +-- @since 0.5.0.0 +formatCommand + :: [String] -- ^ command and arguments + -> String +formatCommand = unwords . map escape + where + escape :: String -> String + escape s + | all isOkChar s = s + | otherwise = "'" ++ concatMap tr s ++ "'" + + isOkChar :: Char -> Bool + isOkChar c = + let c' = ord c + in or + [ (c' - ord 'a') <= 25 + , (c' - ord 'A') <= 25 + , (c' - ord '0') <= 9 + , c `elem` (".-+_/" :: String) + ] + + tr :: Char -> String + tr '\'' = "'\"'\"'" + tr '\0' = "" + tr c = [c] diff --git a/src/PhatSort/SortOptions.hs b/src/PhatSort/SortOptions.hs new file mode 100644 --- /dev/null +++ b/src/PhatSort/SortOptions.hs @@ -0,0 +1,46 @@ +------------------------------------------------------------------------------ +-- | +-- Module : PhatSort.SortOptions +-- Description : sort options +-- Copyright : Copyright (c) 2019-2022 Travis Cardwell +-- License : MIT +------------------------------------------------------------------------------ + +module PhatSort.SortOptions + ( -- * Sort Options + SortCase(..) + , SortFirst(..) + , SortOrder(..) + ) where + +------------------------------------------------------------------------------ + +-- | Case sensitivity +-- +-- @since 0.5.0.0 +data SortCase + = CaseSensitive + | CaseInsensitive + deriving (Eq, Show) + +------------------------------------------------------------------------------ + +-- | Sorting certain directory entries first +-- +-- @since 0.5.0.0 +data SortFirst + = FirstNone + | FirstDirs + | FirstFiles + deriving (Eq, Show) + +------------------------------------------------------------------------------ + +-- | Sort order +-- +-- @since 0.5.0.0 +data SortOrder + = OrderName + | OrderTime + | OrderRandom + deriving (Eq, Show) diff --git a/test/PhatSort/Cmd/PhatSort/Mock.hs b/test/PhatSort/Cmd/PhatSort/Mock.hs new file mode 100644 --- /dev/null +++ b/test/PhatSort/Cmd/PhatSort/Mock.hs @@ -0,0 +1,1659 @@ +module PhatSort.Cmd.PhatSort.Mock (tests) where + +-- https://hackage.haskell.org/package/base +import Control.Monad ((<=<)) +import qualified Data.List.NonEmpty as NonEmpty + +-- https://hackage.haskell.org/package/HMock +import Test.HMock ((|->), expect, inAnyOrder, inSequence, runMockT) + +-- https://hackage.haskell.org/package/tasty +import Test.Tasty (TestTree, testGroup) + +-- https://hackage.haskell.org/package/tasty-hunit +import Test.Tasty.HUnit (testCase) + +-- (phatsort) +import PhatSort.Cmd.PhatSort + ( Options + ( Options, optCase, optFirst, optOrder, optReverse, optScript, optSync + , optTargets, optVerbose + ) + , run + ) +import PhatSort.Monad.FileSystem (FileStatus(FileStatus)) +import qualified PhatSort.Monad.Trans.Error as Error +import PhatSort.SortOptions + ( SortCase(CaseInsensitive, CaseSensitive) + , SortFirst(FirstDirs, FirstFiles, FirstNone) + , SortOrder(OrderName, OrderRandom, OrderTime) + ) + +-- (phatsort:test) +import TestLib + +------------------------------------------------------------------------------ + +defaultOptions :: Options +defaultOptions = Options + { optCase = CaseSensitive + , optFirst = FirstNone + , optSync = True + , optOrder = OrderName + , optReverse = False + , optScript = False + , optVerbose = False + , optTargets = NonEmpty.fromList ["one"] + } + +------------------------------------------------------------------------------ + +testCaseSensitive :: TestTree +testCaseSensitive = testCase "CaseSensitive" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ RenameDirectory "/a/b/one" "/a/b/one-phat" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/a/b/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat" |-> + Right ["Uno.mp3", "dos.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one-phat/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one-phat/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one-phat/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ RenameFile "/a/b/one-phat/Uno.mp3" "/a/b/one/Uno.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/one-phat/dos.mp3" "/a/b/one/dos.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/one-phat/tres.mp3" "/a/b/one/tres.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RemoveDirectory "/a/b/one-phat" |-> Right () + , expect $ Sync |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + +testCaseSensitiveScript :: TestTree +testCaseSensitiveScript = testCase "CaseSensitiveScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ PutStrLn "mv /a/b/one /a/b/one-phat" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /a/b/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["Uno.mp3", "dos.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "mv /a/b/one-phat/Uno.mp3 /a/b/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/dos.mp3 /a/b/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/tres.mp3 /a/b/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "rmdir /a/b/one-phat" |-> () + , expect $ PutStrLn "sync" |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optScript = True + } + +------------------------------------------------------------------------------ + +testCaseInsensitive :: TestTree +testCaseInsensitive = testCase "CaseInsensitive" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ RenameDirectory "/a/b/one" "/a/b/one-phat" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/a/b/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat" |-> + Right ["Uno.mp3", "dos.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one-phat/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one-phat/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one-phat/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ RenameFile "/a/b/one-phat/dos.mp3" "/a/b/one/dos.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/one-phat/tres.mp3" "/a/b/one/tres.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/one-phat/Uno.mp3" "/a/b/one/Uno.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RemoveDirectory "/a/b/one-phat" |-> Right () + , expect $ Sync |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optCase = CaseInsensitive + } + +testCaseInsensitiveScript :: TestTree +testCaseInsensitiveScript = testCase "CaseInsensitiveScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ PutStrLn "mv /a/b/one /a/b/one-phat" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /a/b/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["Uno.mp3", "dos.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "mv /a/b/one-phat/dos.mp3 /a/b/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/tres.mp3 /a/b/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/Uno.mp3 /a/b/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "rmdir /a/b/one-phat" |-> () + , expect $ PutStrLn "sync" |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optCase = CaseInsensitive + , optScript = True + } + +------------------------------------------------------------------------------ + +testFirstNone :: TestTree +testFirstNone = testCase "FirstNone" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ RenameDirectory "/a/b/one" "/a/b/one-phat" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/a/b/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat" |-> + Right ["Uno.mp3", "three", "dos.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one-phat/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one-phat/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one-phat/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one-phat/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one-phat/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ RenameFile "/a/b/one-phat/Uno.mp3" "/a/b/one/Uno.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/one-phat/dos.mp3" "/a/b/one/dos.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/a/b/one/three" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat/three" |-> Right [] + , expect $ RemoveDirectory "/a/b/one-phat/three" |-> Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/one-phat/tres.mp3" "/a/b/one/tres.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/a/b/one/two" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat/two" |-> Right [] + , expect $ RemoveDirectory "/a/b/one-phat/two" |-> Right () + , expect $ Sync |-> () + , expect $ RemoveDirectory "/a/b/one-phat" |-> Right () + , expect $ Sync |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + +testFirstNoneScript :: TestTree +testFirstNoneScript = testCase "FirstNoneScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ PutStrLn "mv /a/b/one /a/b/one-phat" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /a/b/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["Uno.mp3", "three", "dos.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "mv /a/b/one-phat/Uno.mp3 /a/b/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/dos.mp3 /a/b/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /a/b/one/three" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/three" |-> Right [] + , expect $ PutStrLn "rmdir /a/b/one-phat/three" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/tres.mp3 /a/b/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /a/b/one/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/two" |-> Right [] + , expect $ PutStrLn "rmdir /a/b/one-phat/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "rmdir /a/b/one-phat" |-> () + , expect $ PutStrLn "sync" |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optScript = True + } + +------------------------------------------------------------------------------ + +testFirstDirs :: TestTree +testFirstDirs = testCase "FirstDirs" . runMockT$ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ RenameDirectory "/a/b/one" "/a/b/one-phat" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/a/b/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat" |-> + Right ["Uno.mp3", "three", "dos.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one-phat/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one-phat/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one-phat/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one-phat/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one-phat/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ CreateDirectory "/a/b/one/three" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat/three" |-> Right [] + , expect $ RemoveDirectory "/a/b/one-phat/three" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/a/b/one/two" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat/two" |-> Right [] + , expect $ RemoveDirectory "/a/b/one-phat/two" |-> Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/one-phat/Uno.mp3" "/a/b/one/Uno.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/one-phat/dos.mp3" "/a/b/one/dos.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/one-phat/tres.mp3" "/a/b/one/tres.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RemoveDirectory "/a/b/one-phat" |-> Right () + , expect $ Sync |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstDirs + } + +testFirstDirsScript :: TestTree +testFirstDirsScript = testCase "FirstDirsScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ PutStrLn "mv /a/b/one /a/b/one-phat" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /a/b/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["Uno.mp3", "three", "dos.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "mkdir /a/b/one/three" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/three" |-> Right [] + , expect $ PutStrLn "rmdir /a/b/one-phat/three" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /a/b/one/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/two" |-> Right [] + , expect $ PutStrLn "rmdir /a/b/one-phat/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/Uno.mp3 /a/b/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/dos.mp3 /a/b/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/tres.mp3 /a/b/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "rmdir /a/b/one-phat" |-> () + , expect $ PutStrLn "sync" |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstDirs + , optScript = True + } + +------------------------------------------------------------------------------ + +testFirstFiles :: TestTree +testFirstFiles = testCase "FirstFiles" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ RenameDirectory "/a/b/one" "/a/b/one-phat" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/a/b/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat" |-> + Right ["Uno.mp3", "three", "dos.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one-phat/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one-phat/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one-phat/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one-phat/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one-phat/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ RenameFile "/a/b/one-phat/Uno.mp3" "/a/b/one/Uno.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/one-phat/dos.mp3" "/a/b/one/dos.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/one-phat/tres.mp3" "/a/b/one/tres.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/a/b/one/three" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat/three" |-> Right [] + , expect $ RemoveDirectory "/a/b/one-phat/three" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/a/b/one/two" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat/two" |-> Right [] + , expect $ RemoveDirectory "/a/b/one-phat/two" |-> Right () + , expect $ Sync |-> () + , expect $ RemoveDirectory "/a/b/one-phat" |-> Right () + , expect $ Sync |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstFiles + } + +testFirstFilesScript :: TestTree +testFirstFilesScript = testCase "FirstFilesScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ PutStrLn "mv /a/b/one /a/b/one-phat" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /a/b/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["Uno.mp3", "three", "dos.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "mv /a/b/one-phat/Uno.mp3 /a/b/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/dos.mp3 /a/b/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/tres.mp3 /a/b/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /a/b/one/three" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/three" |-> Right [] + , expect $ PutStrLn "rmdir /a/b/one-phat/three" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /a/b/one/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/two" |-> Right [] + , expect $ PutStrLn "rmdir /a/b/one-phat/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "rmdir /a/b/one-phat" |-> () + , expect $ PutStrLn "sync" |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstFiles + , optScript = True + } + +------------------------------------------------------------------------------ + +testNoSync :: TestTree +testNoSync = testCase "NoSync" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ RenameDirectory "/a/b/one" "/a/b/one-phat" |-> Right () + , expect $ CreateDirectory "/a/b/one" |-> Right () + , expect $ ListDirectory "/a/b/one-phat" |-> + Right ["Uno.mp3", "dos.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one-phat/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one-phat/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one-phat/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ RenameFile "/a/b/one-phat/Uno.mp3" "/a/b/one/Uno.mp3" |-> + Right () + , expect $ RenameFile "/a/b/one-phat/dos.mp3" "/a/b/one/dos.mp3" |-> + Right () + , expect $ RenameFile "/a/b/one-phat/tres.mp3" "/a/b/one/tres.mp3" |-> + Right () + , expect $ RemoveDirectory "/a/b/one-phat" |-> Right () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optSync = False + } + +testNoSyncScript :: TestTree +testNoSyncScript = testCase "NoSyncScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ PutStrLn "mv /a/b/one /a/b/one-phat" |-> () + , expect $ PutStrLn "mkdir /a/b/one" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["Uno.mp3", "dos.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "mv /a/b/one-phat/Uno.mp3 /a/b/one/Uno.mp3" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/dos.mp3 /a/b/one/dos.mp3" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/tres.mp3 /a/b/one/tres.mp3" |-> () + , expect $ PutStrLn "rmdir /a/b/one-phat" |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optSync = False + , optScript = True + } + +------------------------------------------------------------------------------ + +testOrderNameReverse :: TestTree +testOrderNameReverse = testCase "OrderNameReverse" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ RenameDirectory "/a/b/one" "/a/b/one-phat" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/a/b/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat" |-> + Right ["Uno.mp3", "three", "dos.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one-phat/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one-phat/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one-phat/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one-phat/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one-phat/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ CreateDirectory "/a/b/one/two" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat/two" |-> Right [] + , expect $ RemoveDirectory "/a/b/one-phat/two" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/a/b/one/three" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat/three" |-> Right [] + , expect $ RemoveDirectory "/a/b/one-phat/three" |-> Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/one-phat/tres.mp3" "/a/b/one/tres.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/one-phat/dos.mp3" "/a/b/one/dos.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/one-phat/Uno.mp3" "/a/b/one/Uno.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RemoveDirectory "/a/b/one-phat" |-> Right () + , expect $ Sync |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstDirs + , optReverse = True + } + +testOrderNameReverseScript :: TestTree +testOrderNameReverseScript = testCase "OrderNameReverseScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ PutStrLn "mv /a/b/one /a/b/one-phat" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /a/b/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["Uno.mp3", "three", "dos.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "mkdir /a/b/one/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/two" |-> Right [] + , expect $ PutStrLn "rmdir /a/b/one-phat/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /a/b/one/three" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/three" |-> Right [] + , expect $ PutStrLn "rmdir /a/b/one-phat/three" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/tres.mp3 /a/b/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/dos.mp3 /a/b/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/Uno.mp3 /a/b/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "rmdir /a/b/one-phat" |-> () + , expect $ PutStrLn "sync" |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstDirs + , optReverse = True + , optScript = True + } + +------------------------------------------------------------------------------ + +testOrderTime :: TestTree +testOrderTime = testCase "OrderTime" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ RenameDirectory "/a/b/one" "/a/b/one-phat" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/a/b/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat" |-> + Right ["Uno.mp3", "three", "dos.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one-phat/Uno.mp3" |-> + Right (FileStatus 11 False 10000) + , expect $ GetFileStatus "/a/b/one-phat/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one-phat/dos.mp3" |-> + Right (FileStatus 11 False 20000) + , expect $ GetFileStatus "/a/b/one-phat/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one-phat/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ CreateDirectory "/a/b/one/two" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat/two" |-> Right [] + , expect $ RemoveDirectory "/a/b/one-phat/two" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/a/b/one/three" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat/three" |-> Right [] + , expect $ RemoveDirectory "/a/b/one-phat/three" |-> Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/one-phat/tres.mp3" "/a/b/one/tres.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/one-phat/Uno.mp3" "/a/b/one/Uno.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/one-phat/dos.mp3" "/a/b/one/dos.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RemoveDirectory "/a/b/one-phat" |-> Right () + , expect $ Sync |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstDirs + , optOrder = OrderTime + } + +testOrderTimeScript :: TestTree +testOrderTimeScript = testCase "OrderTimeScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ PutStrLn "mv /a/b/one /a/b/one-phat" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /a/b/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["Uno.mp3", "three", "dos.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 10000) + , expect $ GetFileStatus "/a/b/one/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 20000) + , expect $ GetFileStatus "/a/b/one/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "mkdir /a/b/one/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/two" |-> Right [] + , expect $ PutStrLn "rmdir /a/b/one-phat/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /a/b/one/three" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/three" |-> Right [] + , expect $ PutStrLn "rmdir /a/b/one-phat/three" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/tres.mp3 /a/b/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/Uno.mp3 /a/b/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/dos.mp3 /a/b/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "rmdir /a/b/one-phat" |-> () + , expect $ PutStrLn "sync" |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstDirs + , optOrder = OrderTime + , optScript = True + } + +------------------------------------------------------------------------------ + +testOrderTimeReverse :: TestTree +testOrderTimeReverse = testCase "OrderTimeReverse" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ RenameDirectory "/a/b/one" "/a/b/one-phat" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/a/b/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat" |-> + Right ["Uno.mp3", "three", "dos.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one-phat/Uno.mp3" |-> + Right (FileStatus 11 False 10000) + , expect $ GetFileStatus "/a/b/one-phat/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one-phat/dos.mp3" |-> + Right (FileStatus 11 False 20000) + , expect $ GetFileStatus "/a/b/one-phat/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one-phat/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ CreateDirectory "/a/b/one/three" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat/three" |-> Right [] + , expect $ RemoveDirectory "/a/b/one-phat/three" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/a/b/one/two" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat/two" |-> Right [] + , expect $ RemoveDirectory "/a/b/one-phat/two" |-> Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/one-phat/dos.mp3" "/a/b/one/dos.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/one-phat/Uno.mp3" "/a/b/one/Uno.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/one-phat/tres.mp3" "/a/b/one/tres.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RemoveDirectory "/a/b/one-phat" |-> Right () + , expect $ Sync |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstDirs + , optOrder = OrderTime + , optReverse = True + } + +testOrderTimeReverseScript :: TestTree +testOrderTimeReverseScript = testCase "OrderTimeReverseScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ PutStrLn "mv /a/b/one /a/b/one-phat" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /a/b/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["Uno.mp3", "three", "dos.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 10000) + , expect $ GetFileStatus "/a/b/one/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 20000) + , expect $ GetFileStatus "/a/b/one/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "mkdir /a/b/one/three" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/three" |-> Right [] + , expect $ PutStrLn "rmdir /a/b/one-phat/three" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /a/b/one/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/two" |-> Right [] + , expect $ PutStrLn "rmdir /a/b/one-phat/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/dos.mp3 /a/b/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/Uno.mp3 /a/b/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/tres.mp3 /a/b/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "rmdir /a/b/one-phat" |-> () + , expect $ PutStrLn "sync" |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstDirs + , optOrder = OrderTime + , optReverse = True + , optScript = True + } + +------------------------------------------------------------------------------ + +testOrderRandom :: TestTree +testOrderRandom = testCase "OrderRandom" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ RenameDirectory "/a/b/one" "/a/b/one-phat" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/a/b/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat" |-> + Right ["x.mp3", "y.mp3", "z.mp3", "d1", "d2", "d3"] + , expect $ GetFileStatus "/a/b/one-phat/x.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one-phat/y.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one-phat/z.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ GetFileStatus "/a/b/one-phat/d1" |-> + Right (FileStatus 11 True 1000) + , expect $ GetFileStatus "/a/b/one-phat/d2" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one-phat/d3" |-> + Right (FileStatus 11 True 3000) + , inAnyOrder + [ inSequence + [ expect $ CreateDirectory "/a/b/one/d1" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat/d1" |-> Right [] + , expect $ RemoveDirectory "/a/b/one-phat/d1" |-> Right () + , expect $ Sync |-> () + ] + , inSequence + [ expect $ CreateDirectory "/a/b/one/d2" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat/d2" |-> Right [] + , expect $ RemoveDirectory "/a/b/one-phat/d2" |-> Right () + , expect $ Sync |-> () + ] + , inSequence + [ expect $ CreateDirectory "/a/b/one/d3" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat/d3" |-> Right [] + , expect $ RemoveDirectory "/a/b/one-phat/d3" |-> Right () + , expect $ Sync |-> () + ] + ] + , inAnyOrder + [ inSequence + [ expect $ + RenameFile "/a/b/one-phat/x.mp3" "/a/b/one/x.mp3" |-> + Right () + , expect $ Sync |-> () + ] + , inSequence + [ expect $ + RenameFile "/a/b/one-phat/y.mp3" "/a/b/one/y.mp3" |-> + Right () + , expect $ Sync |-> () + ] + , inSequence + [ expect $ + RenameFile "/a/b/one-phat/z.mp3" "/a/b/one/z.mp3" |-> + Right () + , expect $ Sync |-> () + ] + ] + , expect $ RemoveDirectory "/a/b/one-phat" |-> Right () + , expect $ Sync |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstDirs + , optOrder = OrderRandom + } + +testOrderRandomScript :: TestTree +testOrderRandomScript = testCase "OrderRandomScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ PutStrLn "mv /a/b/one /a/b/one-phat" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /a/b/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["x.mp3", "y.mp3", "z.mp3", "d1", "d2", "d3"] + , expect $ GetFileStatus "/a/b/one/x.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/y.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/z.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ GetFileStatus "/a/b/one/d1" |-> + Right (FileStatus 11 True 1000) + , expect $ GetFileStatus "/a/b/one/d2" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one/d3" |-> + Right (FileStatus 11 True 3000) + , inAnyOrder + [ inSequence + [ expect $ PutStrLn "mkdir /a/b/one/d1" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/d1" |-> Right [] + , expect $ PutStrLn "rmdir /a/b/one-phat/d1" |-> () + , expect $ PutStrLn "sync" |-> () + ] + , inSequence + [ expect $ PutStrLn "mkdir /a/b/one/d2" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/d2" |-> Right [] + , expect $ PutStrLn "rmdir /a/b/one-phat/d2" |-> () + , expect $ PutStrLn "sync" |-> () + ] + , inSequence + [ expect $ PutStrLn "mkdir /a/b/one/d3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/d3" |-> Right [] + , expect $ PutStrLn "rmdir /a/b/one-phat/d3" |-> () + , expect $ PutStrLn "sync" |-> () + ] + ] + , inAnyOrder + [ inSequence + [ expect $ PutStrLn "mv /a/b/one-phat/x.mp3 /a/b/one/x.mp3" |-> + () + , expect $ PutStrLn "sync" |-> () + ] + , inSequence + [ expect $ PutStrLn "mv /a/b/one-phat/y.mp3 /a/b/one/y.mp3" |-> + () + , expect $ PutStrLn "sync" |-> () + ] + , inSequence + [ expect $ PutStrLn "mv /a/b/one-phat/z.mp3 /a/b/one/z.mp3" |-> + () + , expect $ PutStrLn "sync" |-> () + ] + ] + , expect $ PutStrLn "rmdir /a/b/one-phat" |-> () + , expect $ PutStrLn "sync" |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstDirs + , optOrder = OrderRandom + , optScript = True + } + +------------------------------------------------------------------------------ + +testVerbose :: TestTree +testVerbose = testCase "Verbose" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ PutStrLn "one" |-> () + , expect $ RenameDirectory "/a/b/one" "/a/b/one-phat" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/a/b/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat" |-> + Right ["Uno.mp3", "dos.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one-phat/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one-phat/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one-phat/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "one/Uno.mp3" |-> () + , expect $ RenameFile "/a/b/one-phat/Uno.mp3" "/a/b/one/Uno.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ PutStrLn "one/dos.mp3" |-> () + , expect $ RenameFile "/a/b/one-phat/dos.mp3" "/a/b/one/dos.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ PutStrLn "one/tres.mp3" |-> () + , expect $ RenameFile "/a/b/one-phat/tres.mp3" "/a/b/one/tres.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RemoveDirectory "/a/b/one-phat" |-> Right () + , expect $ Sync |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optVerbose = True + } + +testVerboseScript :: TestTree +testVerboseScript = testCase "VerboseScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ PutStrLn "echo one" |-> () + , expect $ PutStrLn "mv /a/b/one /a/b/one-phat" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /a/b/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["Uno.mp3", "dos.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "echo one/Uno.mp3" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/Uno.mp3 /a/b/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "echo one/dos.mp3" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/dos.mp3 /a/b/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "echo one/tres.mp3" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/tres.mp3 /a/b/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "rmdir /a/b/one-phat" |-> () + , expect $ PutStrLn "sync" |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optScript = True + , optVerbose = True + } + +------------------------------------------------------------------------------ + +testMultipleTargets :: TestTree +testMultipleTargets = testCase "MultipleTargets" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ MakeAbsolute "two" |-> Right "/a/b/two" + , expect $ GetFileStatus "/a/b/two" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/two-phat" |-> Right False + , expect $ RenameDirectory "/a/b/one" "/a/b/one-phat" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/a/b/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one-phat" |-> + Right ["Uno.mp3", "dos.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one-phat/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one-phat/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one-phat/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ RenameFile "/a/b/one-phat/Uno.mp3" "/a/b/one/Uno.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/one-phat/dos.mp3" "/a/b/one/dos.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/one-phat/tres.mp3" "/a/b/one/tres.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RemoveDirectory "/a/b/one-phat" |-> Right () + , expect $ Sync |-> () + , expect $ RenameDirectory "/a/b/two" "/a/b/two-phat" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/a/b/two" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/two-phat" |-> + Right ["san.mp3", "ni.mp3", "ichi.mp3"] + , expect $ GetFileStatus "/a/b/two-phat/san.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ GetFileStatus "/a/b/two-phat/ni.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/two-phat/ichi.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ RenameFile "/a/b/two-phat/ichi.mp3" "/a/b/two/ichi.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/two-phat/ni.mp3" "/a/b/two/ni.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RenameFile "/a/b/two-phat/san.mp3" "/a/b/two/san.mp3" |-> + Right () + , expect $ Sync |-> () + , expect $ RemoveDirectory "/a/b/two-phat" |-> Right () + , expect $ Sync |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optTargets = NonEmpty.fromList ["one", "two"] + } + +testMultipleTargetsScript :: TestTree +testMultipleTargetsScript = testCase "MultipleTargetsScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right False + , expect $ MakeAbsolute "two" |-> Right "/a/b/two" + , expect $ GetFileStatus "/a/b/two" |-> Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/two-phat" |-> Right False + , expect $ PutStrLn "mv /a/b/one /a/b/one-phat" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /a/b/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["Uno.mp3", "dos.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "mv /a/b/one-phat/Uno.mp3 /a/b/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/dos.mp3 /a/b/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/one-phat/tres.mp3 /a/b/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "rmdir /a/b/one-phat" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/two /a/b/two-phat" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /a/b/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/two" |-> + Right ["san.mp3", "ni.mp3", "ichi.mp3"] + , expect $ GetFileStatus "/a/b/two/san.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ GetFileStatus "/a/b/two/ni.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/two/ichi.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ PutStrLn "mv /a/b/two-phat/ichi.mp3 /a/b/two/ichi.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/two-phat/ni.mp3 /a/b/two/ni.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mv /a/b/two-phat/san.mp3 /a/b/two/san.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "rmdir /a/b/two-phat" |-> () + , expect $ PutStrLn "sync" |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optScript = True + , optTargets = NonEmpty.fromList ["one", "two"] + } + +------------------------------------------------------------------------------ + +testTargetNotFound :: TestTree +testTargetNotFound = testCase "TargetNotFound" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> + Left (userError "file not found: one") + ] + assertError "user error (file not found: one)" <=< Error.run $ + run defaultOptions + +------------------------------------------------------------------------------ + +testPhatTarget :: TestTree +testPhatTarget = testCase "PhatTarget" . runMockT $ + assertError "-phat directory: one-phat" <=< Error.run $ + run defaultOptions + { optTargets = NonEmpty.fromList ["one-phat"] + } + +------------------------------------------------------------------------------ + +testTargetNotDirectory :: TestTree +testTargetNotDirectory = testCase "TargetNotDirectory" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> + Right (FileStatus 11 False 10000) + ] + assertError "not a directory: one" <=< Error.run $ run defaultOptions + +------------------------------------------------------------------------------ + +testTargetMountPoint :: TestTree +testTargetMountPoint = testCase "TargetMountPoint" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/one" + , expect $ GetFileStatus "/a/one" |-> + Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a" |-> Right (FileStatus 10 True 100) + ] + assertError "mount point: one" <=< Error.run $ run defaultOptions + +------------------------------------------------------------------------------ + +testTargetPhatExists :: TestTree +testTargetPhatExists = testCase "TargetPhatExists" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> + Right (FileStatus 11 True 10000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/one-phat" |-> Right True + ] + assertError "already exists: one-phat" <=< Error.run $ run defaultOptions + +------------------------------------------------------------------------------ + +testLarge :: TestTree +testLarge = testCase "Large" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "c" |-> Right "/a/b/c" + , expect $ GetFileStatus "/a/b/c" |-> Right (FileStatus 11 True 1000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/c-phat" |-> Right False + , expect $ MakeAbsolute "d" |-> Right "/a/b/d" + , expect $ GetFileStatus "/a/b/d" |-> Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/d-phat" |-> Right False + , expect $ RenameDirectory "/a/b/c" "/a/b/c-phat" |-> Right () + , expect $ CreateDirectory "/a/b/c" |-> Right () + , expect $ ListDirectory "/a/b/c-phat" |-> Right ["two", "one"] + , expect $ GetFileStatus "/a/b/c-phat/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/c-phat/one" |-> + Right (FileStatus 11 True 1000) + , expect $ CreateDirectory "/a/b/c/one" |-> Right () + , expect $ ListDirectory "/a/b/c-phat/one" |-> + Right ["11.mp3", "six", "13.mp3", "eight", "12.mp3", "14.mp3"] + , expect $ GetFileStatus "/a/b/c-phat/one/11.mp3" |-> + Right (FileStatus 11 False 1100) + , expect $ GetFileStatus "/a/b/c-phat/one/six" |-> + Right (FileStatus 11 True 6000) + , expect $ GetFileStatus "/a/b/c-phat/one/13.mp3" |-> + Right (FileStatus 11 False 1300) + , expect $ GetFileStatus "/a/b/c-phat/one/eight" |-> + Right (FileStatus 11 True 8000) + , expect $ GetFileStatus "/a/b/c-phat/one/12.mp3" |-> + Right (FileStatus 11 False 1200) + , expect $ GetFileStatus "/a/b/c-phat/one/14.mp3" |-> + Right (FileStatus 11 False 1400) + , expect $ RenameFile "/a/b/c-phat/one/11.mp3" "/a/b/c/one/11.mp3" |-> + Right () + , expect $ RenameFile "/a/b/c-phat/one/12.mp3" "/a/b/c/one/12.mp3" |-> + Right () + , expect $ RenameFile "/a/b/c-phat/one/13.mp3" "/a/b/c/one/13.mp3" |-> + Right () + , expect $ RenameFile "/a/b/c-phat/one/14.mp3" "/a/b/c/one/14.mp3" |-> + Right () + , expect $ CreateDirectory "/a/b/c/one/eight" |-> Right () + , expect $ ListDirectory "/a/b/c-phat/one/eight" |-> + Right ["83.mp3", "81.mp3", "82.mp3"] + , expect $ GetFileStatus "/a/b/c-phat/one/eight/83.mp3" |-> + Right (FileStatus 11 False 8300) + , expect $ GetFileStatus "/a/b/c-phat/one/eight/81.mp3" |-> + Right (FileStatus 11 False 8100) + , expect $ GetFileStatus "/a/b/c-phat/one/eight/82.mp3" |-> + Right (FileStatus 11 False 8200) + , expect $ + RenameFile + "/a/b/c-phat/one/eight/81.mp3" + "/a/b/c/one/eight/81.mp3" + |-> Right () + , expect $ + RenameFile + "/a/b/c-phat/one/eight/82.mp3" + "/a/b/c/one/eight/82.mp3" + |-> Right () + , expect $ + RenameFile + "/a/b/c-phat/one/eight/83.mp3" + "/a/b/c/one/eight/83.mp3" + |-> Right () + , expect $ RemoveDirectory "/a/b/c-phat/one/eight" |-> Right () + , expect $ CreateDirectory "/a/b/c/one/six" |-> Right () + , expect $ ListDirectory "/a/b/c-phat/one/six" |-> Right [] + , expect $ RemoveDirectory "/a/b/c-phat/one/six" |-> Right () + , expect $ RemoveDirectory "/a/b/c-phat/one" |-> Right () + , expect $ CreateDirectory "/a/b/c/two" |-> Right () + , expect $ ListDirectory "/a/b/c-phat/two" |-> + Right ["23.mp3", "22.mp3", "seven", "five", "21.mp3"] + , expect $ GetFileStatus "/a/b/c-phat/two/23.mp3" |-> + Right (FileStatus 11 False 2300) + , expect $ GetFileStatus "/a/b/c-phat/two/22.mp3" |-> + Right (FileStatus 11 False 2200) + , expect $ GetFileStatus "/a/b/c-phat/two/seven" |-> + Right (FileStatus 11 True 7000) + , expect $ GetFileStatus "/a/b/c-phat/two/five" |-> + Right (FileStatus 11 True 5000) + , expect $ GetFileStatus "/a/b/c-phat/two/21.mp3" |-> + Right (FileStatus 11 False 2100) + , expect $ RenameFile "/a/b/c-phat/two/21.mp3" "/a/b/c/two/21.mp3" |-> + Right () + , expect $ RenameFile "/a/b/c-phat/two/22.mp3" "/a/b/c/two/22.mp3" |-> + Right () + , expect $ RenameFile "/a/b/c-phat/two/23.mp3" "/a/b/c/two/23.mp3" |-> + Right () + , expect $ CreateDirectory "/a/b/c/two/five" |-> Right () + , expect $ ListDirectory "/a/b/c-phat/two/five" |-> Right ["51.mp3"] + , expect $ GetFileStatus "/a/b/c-phat/two/five/51.mp3" |-> + Right (FileStatus 11 False 5100) + , expect $ + RenameFile "/a/b/c-phat/two/five/51.mp3" "/a/b/c/two/five/51.mp3" + |-> Right () + , expect $ RemoveDirectory "/a/b/c-phat/two/five" |-> Right () + , expect $ CreateDirectory "/a/b/c/two/seven" |-> Right () + , expect $ ListDirectory "/a/b/c-phat/two/seven" |-> + Right ["72.mp3", "71.mp3"] + , expect $ GetFileStatus "/a/b/c-phat/two/seven/72.mp3" |-> + Right (FileStatus 11 False 7200) + , expect $ GetFileStatus "/a/b/c-phat/two/seven/71.mp3" |-> + Right (FileStatus 11 False 7100) + , expect $ + RenameFile + "/a/b/c-phat/two/seven/71.mp3" + "/a/b/c/two/seven/71.mp3" + |-> Right () + , expect $ + RenameFile + "/a/b/c-phat/two/seven/72.mp3" + "/a/b/c/two/seven/72.mp3" + |-> Right () + , expect $ RemoveDirectory "/a/b/c-phat/two/seven" |-> Right () + , expect $ RemoveDirectory "/a/b/c-phat/two" |-> Right () + , expect $ RemoveDirectory "/a/b/c-phat" |-> Right () + , expect $ RenameDirectory "/a/b/d" "/a/b/d-phat" |-> Right () + , expect $ CreateDirectory "/a/b/d" |-> Right () + , expect $ ListDirectory "/a/b/d-phat" |-> Right ["three"] + , expect $ GetFileStatus "/a/b/d-phat/three" |-> + Right (FileStatus 11 True 3000) + , expect $ CreateDirectory "/a/b/d/three" |-> Right () + , expect $ ListDirectory "/a/b/d-phat/three" |-> + Right ["32.mp3", "31.mp3", "four", "34.mp3", "nine", "33.mp3"] + , expect $ GetFileStatus "/a/b/d-phat/three/32.mp3" |-> + Right (FileStatus 11 False 3200) + , expect $ GetFileStatus "/a/b/d-phat/three/31.mp3" |-> + Right (FileStatus 11 False 3100) + , expect $ GetFileStatus "/a/b/d-phat/three/four" |-> + Right (FileStatus 11 True 4000) + , expect $ GetFileStatus "/a/b/d-phat/three/34.mp3" |-> + Right (FileStatus 11 False 3400) + , expect $ GetFileStatus "/a/b/d-phat/three/nine" |-> + Right (FileStatus 11 True 9000) + , expect $ GetFileStatus "/a/b/d-phat/three/33.mp3" |-> + Right (FileStatus 11 False 3300) + , expect $ + RenameFile "/a/b/d-phat/three/31.mp3" "/a/b/d/three/31.mp3" |-> + Right () + , expect $ + RenameFile "/a/b/d-phat/three/32.mp3" "/a/b/d/three/32.mp3" |-> + Right () + , expect $ + RenameFile "/a/b/d-phat/three/33.mp3" "/a/b/d/three/33.mp3" |-> + Right () + , expect $ + RenameFile "/a/b/d-phat/three/34.mp3" "/a/b/d/three/34.mp3" |-> + Right () + , expect $ CreateDirectory "/a/b/d/three/four" |-> Right () + , expect $ ListDirectory "/a/b/d-phat/three/four" |-> + Right ["41.mp3", "42.mp3"] + , expect $ GetFileStatus "/a/b/d-phat/three/four/41.mp3" |-> + Right (FileStatus 11 False 4100) + , expect $ GetFileStatus "/a/b/d-phat/three/four/42.mp3" |-> + Right (FileStatus 11 False 4200) + , expect $ + RenameFile + "/a/b/d-phat/three/four/41.mp3" + "/a/b/d/three/four/41.mp3" + |-> Right () + , expect $ + RenameFile + "/a/b/d-phat/three/four/42.mp3" + "/a/b/d/three/four/42.mp3" + |-> Right () + , expect $ RemoveDirectory "/a/b/d-phat/three/four" |-> Right () + , expect $ CreateDirectory "/a/b/d/three/nine" |-> Right () + , expect $ ListDirectory "/a/b/d-phat/three/nine" |-> Right ["ten"] + , expect $ GetFileStatus "/a/b/d-phat/three/nine/ten" |-> + Right (FileStatus 11 True 10000) + , expect $ CreateDirectory "/a/b/d/three/nine/ten" |-> Right () + , expect $ ListDirectory "/a/b/d-phat/three/nine/ten" |-> + Right ["102.mp3", "101.mp3"] + , expect $ GetFileStatus "/a/b/d-phat/three/nine/ten/102.mp3" |-> + Right (FileStatus 11 False 10200) + , expect $ GetFileStatus "/a/b/d-phat/three/nine/ten/101.mp3" |-> + Right (FileStatus 11 False 10100) + , expect $ + RenameFile + "/a/b/d-phat/three/nine/ten/101.mp3" + "/a/b/d/three/nine/ten/101.mp3" + |-> Right () + , expect $ + RenameFile + "/a/b/d-phat/three/nine/ten/102.mp3" + "/a/b/d/three/nine/ten/102.mp3" + |-> Right () + , expect $ RemoveDirectory "/a/b/d-phat/three/nine/ten" |-> Right () + , expect $ RemoveDirectory "/a/b/d-phat/three/nine" |-> Right () + , expect $ RemoveDirectory "/a/b/d-phat/three" |-> Right () + , expect $ RemoveDirectory "/a/b/d-phat" |-> Right () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optSync = False + , optTargets = NonEmpty.fromList ["c", "d"] + } + +testLargeScript :: TestTree +testLargeScript = testCase "LargeScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "c" |-> Right "/a/b/c" + , expect $ GetFileStatus "/a/b/c" |-> Right (FileStatus 11 True 1000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/c-phat" |-> Right False + , expect $ MakeAbsolute "d" |-> Right "/a/b/d" + , expect $ GetFileStatus "/a/b/d" |-> Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 100) + , expect $ DoesPathExist "/a/b/d-phat" |-> Right False + , expect $ PutStrLn "mv /a/b/c /a/b/c-phat" |-> () + , expect $ PutStrLn "mkdir /a/b/c" |-> () + , expect $ ListDirectory "/a/b/c" |-> Right ["two", "one"] + , expect $ GetFileStatus "/a/b/c/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/c/one" |-> + Right (FileStatus 11 True 1000) + , expect $ PutStrLn "mkdir /a/b/c/one" |-> () + , expect $ ListDirectory "/a/b/c/one" |-> + Right ["11.mp3", "six", "13.mp3", "eight", "12.mp3", "14.mp3"] + , expect $ GetFileStatus "/a/b/c/one/11.mp3" |-> + Right (FileStatus 11 False 1100) + , expect $ GetFileStatus "/a/b/c/one/six" |-> + Right (FileStatus 11 True 6000) + , expect $ GetFileStatus "/a/b/c/one/13.mp3" |-> + Right (FileStatus 11 False 1300) + , expect $ GetFileStatus "/a/b/c/one/eight" |-> + Right (FileStatus 11 True 8000) + , expect $ GetFileStatus "/a/b/c/one/12.mp3" |-> + Right (FileStatus 11 False 1200) + , expect $ GetFileStatus "/a/b/c/one/14.mp3" |-> + Right (FileStatus 11 False 1400) + , expect $ PutStrLn "mv /a/b/c-phat/one/11.mp3 /a/b/c/one/11.mp3" |-> () + , expect $ PutStrLn "mv /a/b/c-phat/one/12.mp3 /a/b/c/one/12.mp3" |-> () + , expect $ PutStrLn "mv /a/b/c-phat/one/13.mp3 /a/b/c/one/13.mp3" |-> () + , expect $ PutStrLn "mv /a/b/c-phat/one/14.mp3 /a/b/c/one/14.mp3" |-> () + , expect $ PutStrLn "mkdir /a/b/c/one/eight" |-> () + , expect $ ListDirectory "/a/b/c/one/eight" |-> + Right ["83.mp3", "81.mp3", "82.mp3"] + , expect $ GetFileStatus "/a/b/c/one/eight/83.mp3" |-> + Right (FileStatus 11 False 8300) + , expect $ GetFileStatus "/a/b/c/one/eight/81.mp3" |-> + Right (FileStatus 11 False 8100) + , expect $ GetFileStatus "/a/b/c/one/eight/82.mp3" |-> + Right (FileStatus 11 False 8200) + , expect $ + PutStrLn + "mv /a/b/c-phat/one/eight/81.mp3 /a/b/c/one/eight/81.mp3" + |-> () + , expect $ + PutStrLn + "mv /a/b/c-phat/one/eight/82.mp3 /a/b/c/one/eight/82.mp3" + |-> () + , expect $ + PutStrLn + "mv /a/b/c-phat/one/eight/83.mp3 /a/b/c/one/eight/83.mp3" + |-> () + , expect $ PutStrLn "rmdir /a/b/c-phat/one/eight" |-> () + , expect $ PutStrLn "mkdir /a/b/c/one/six" |-> () + , expect $ ListDirectory "/a/b/c/one/six" |-> Right [] + , expect $ PutStrLn "rmdir /a/b/c-phat/one/six" |-> () + , expect $ PutStrLn "rmdir /a/b/c-phat/one" |-> () + , expect $ PutStrLn "mkdir /a/b/c/two" |-> () + , expect $ ListDirectory "/a/b/c/two" |-> + Right ["23.mp3", "22.mp3", "seven", "five", "21.mp3"] + , expect $ GetFileStatus "/a/b/c/two/23.mp3" |-> + Right (FileStatus 11 False 2300) + , expect $ GetFileStatus "/a/b/c/two/22.mp3" |-> + Right (FileStatus 11 False 2200) + , expect $ GetFileStatus "/a/b/c/two/seven" |-> + Right (FileStatus 11 True 7000) + , expect $ GetFileStatus "/a/b/c/two/five" |-> + Right (FileStatus 11 True 5000) + , expect $ GetFileStatus "/a/b/c/two/21.mp3" |-> + Right (FileStatus 11 False 2100) + , expect $ PutStrLn "mv /a/b/c-phat/two/21.mp3 /a/b/c/two/21.mp3" |-> () + , expect $ PutStrLn "mv /a/b/c-phat/two/22.mp3 /a/b/c/two/22.mp3" |-> () + , expect $ PutStrLn "mv /a/b/c-phat/two/23.mp3 /a/b/c/two/23.mp3" |-> () + , expect $ PutStrLn "mkdir /a/b/c/two/five" |-> () + , expect $ ListDirectory "/a/b/c/two/five" |-> Right ["51.mp3"] + , expect $ GetFileStatus "/a/b/c/two/five/51.mp3" |-> + Right (FileStatus 11 False 5100) + , expect $ + PutStrLn "mv /a/b/c-phat/two/five/51.mp3 /a/b/c/two/five/51.mp3" |-> + () + , expect $ PutStrLn "rmdir /a/b/c-phat/two/five" |-> () + , expect $ PutStrLn "mkdir /a/b/c/two/seven" |-> () + , expect $ ListDirectory "/a/b/c/two/seven" |-> + Right ["72.mp3", "71.mp3"] + , expect $ GetFileStatus "/a/b/c/two/seven/72.mp3" |-> + Right (FileStatus 11 False 7200) + , expect $ GetFileStatus "/a/b/c/two/seven/71.mp3" |-> + Right (FileStatus 11 False 7100) + , expect $ + PutStrLn + "mv /a/b/c-phat/two/seven/71.mp3 /a/b/c/two/seven/71.mp3" + |-> () + , expect $ + PutStrLn + "mv /a/b/c-phat/two/seven/72.mp3 /a/b/c/two/seven/72.mp3" + |-> () + , expect $ PutStrLn "rmdir /a/b/c-phat/two/seven" |-> () + , expect $ PutStrLn "rmdir /a/b/c-phat/two" |-> () + , expect $ PutStrLn "rmdir /a/b/c-phat" |-> () + , expect $ PutStrLn "mv /a/b/d /a/b/d-phat" |-> () + , expect $ PutStrLn "mkdir /a/b/d" |-> () + , expect $ ListDirectory "/a/b/d" |-> Right ["three"] + , expect $ GetFileStatus "/a/b/d/three" |-> + Right (FileStatus 11 True 3000) + , expect $ PutStrLn "mkdir /a/b/d/three" |-> () + , expect $ ListDirectory "/a/b/d/three" |-> + Right ["32.mp3", "31.mp3", "four", "34.mp3", "nine", "33.mp3"] + , expect $ GetFileStatus "/a/b/d/three/32.mp3" |-> + Right (FileStatus 11 False 3200) + , expect $ GetFileStatus "/a/b/d/three/31.mp3" |-> + Right (FileStatus 11 False 3100) + , expect $ GetFileStatus "/a/b/d/three/four" |-> + Right (FileStatus 11 True 4000) + , expect $ GetFileStatus "/a/b/d/three/34.mp3" |-> + Right (FileStatus 11 False 3400) + , expect $ GetFileStatus "/a/b/d/three/nine" |-> + Right (FileStatus 11 True 9000) + , expect $ GetFileStatus "/a/b/d/three/33.mp3" |-> + Right (FileStatus 11 False 3300) + , expect $ + PutStrLn "mv /a/b/d-phat/three/31.mp3 /a/b/d/three/31.mp3" |-> () + , expect $ + PutStrLn "mv /a/b/d-phat/three/32.mp3 /a/b/d/three/32.mp3" |-> () + , expect $ + PutStrLn "mv /a/b/d-phat/three/33.mp3 /a/b/d/three/33.mp3" |-> () + , expect $ + PutStrLn "mv /a/b/d-phat/three/34.mp3 /a/b/d/three/34.mp3" |-> () + , expect $ PutStrLn "mkdir /a/b/d/three/four" |-> () + , expect $ ListDirectory "/a/b/d/three/four" |-> + Right ["41.mp3", "42.mp3"] + , expect $ GetFileStatus "/a/b/d/three/four/41.mp3" |-> + Right (FileStatus 11 False 4100) + , expect $ GetFileStatus "/a/b/d/three/four/42.mp3" |-> + Right (FileStatus 11 False 4200) + , expect $ + PutStrLn + "mv /a/b/d-phat/three/four/41.mp3 /a/b/d/three/four/41.mp3" + |-> () + , expect $ + PutStrLn + "mv /a/b/d-phat/three/four/42.mp3 /a/b/d/three/four/42.mp3" + |-> () + , expect $ PutStrLn "rmdir /a/b/d-phat/three/four" |-> () + , expect $ PutStrLn "mkdir /a/b/d/three/nine" |-> () + , expect $ ListDirectory "/a/b/d/three/nine" |-> Right ["ten"] + , expect $ GetFileStatus "/a/b/d/three/nine/ten" |-> + Right (FileStatus 11 True 10000) + , expect $ PutStrLn "mkdir /a/b/d/three/nine/ten" |-> () + , expect $ ListDirectory "/a/b/d/three/nine/ten" |-> + Right ["102.mp3", "101.mp3"] + , expect $ GetFileStatus "/a/b/d/three/nine/ten/102.mp3" |-> + Right (FileStatus 11 False 10200) + , expect $ GetFileStatus "/a/b/d/three/nine/ten/101.mp3" |-> + Right (FileStatus 11 False 10100) + , expect $ + PutStrLn + "mv /a/b/d-phat/three/nine/ten/101.mp3 /a/b/d/three/nine/ten/101.mp3" + |-> () + , expect $ + PutStrLn + "mv /a/b/d-phat/three/nine/ten/102.mp3 /a/b/d/three/nine/ten/102.mp3" + |-> () + , expect $ PutStrLn "rmdir /a/b/d-phat/three/nine/ten" |-> () + , expect $ PutStrLn "rmdir /a/b/d-phat/three/nine" |-> () + , expect $ PutStrLn "rmdir /a/b/d-phat/three" |-> () + , expect $ PutStrLn "rmdir /a/b/d-phat" |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optSync = False + , optScript = True + , optTargets = NonEmpty.fromList ["c", "d"] + } + +------------------------------------------------------------------------------ + +tests :: TestTree +tests = testGroup "phatsort:Mock" + [ testCaseSensitive + , testCaseSensitiveScript + , testCaseInsensitive + , testCaseInsensitiveScript + , testFirstNone + , testFirstNoneScript + , testFirstDirs + , testFirstDirsScript + , testFirstFiles + , testFirstFilesScript + , testNoSync + , testNoSyncScript + , testOrderNameReverse + , testOrderNameReverseScript + , testOrderTime + , testOrderTimeScript + , testOrderTimeReverse + , testOrderTimeReverseScript + , testOrderRandom + , testOrderRandomScript + , testVerbose + , testVerboseScript + , testMultipleTargets + , testMultipleTargetsScript + , testTargetNotFound + , testPhatTarget + , testTargetNotDirectory + , testTargetMountPoint + , testTargetPhatExists + , testLarge + , testLargeScript + ] diff --git a/test/PhatSort/Cmd/SeqCp/Mock.hs b/test/PhatSort/Cmd/SeqCp/Mock.hs new file mode 100644 --- /dev/null +++ b/test/PhatSort/Cmd/SeqCp/Mock.hs @@ -0,0 +1,2237 @@ +module PhatSort.Cmd.SeqCp.Mock (tests) where + +-- https://hackage.haskell.org/package/base +import Control.Monad ((<=<)) +import qualified Data.List.NonEmpty as NonEmpty + +-- https://hackage.haskell.org/package/HMock +import Test.HMock ((|->), expect, inAnyOrder, inSequence, runMockT) + +-- https://hackage.haskell.org/package/tasty +import Test.Tasty (TestTree, testGroup) + +-- https://hackage.haskell.org/package/tasty-hunit +import Test.Tasty.HUnit (testCase) + +-- (phatsort) +import PhatSort.Cmd.SeqCp + ( Options + ( Options, optCase, optDestination, optFirst, optOrder, optReverse + , optScript, optSources, optSync, optVerbose + ) + , run + ) +import PhatSort.Monad.FileSystem (FileStatus(FileStatus)) +import qualified PhatSort.Monad.Trans.Error as Error +import PhatSort.SortOptions + ( SortCase(CaseInsensitive, CaseSensitive) + , SortFirst(FirstDirs, FirstFiles, FirstNone) + , SortOrder(OrderName, OrderRandom, OrderTime) + ) + +-- (phatsort:test) +import TestLib + +------------------------------------------------------------------------------ + +defaultOptions :: Options +defaultOptions = Options + { optCase = CaseSensitive + , optFirst = FirstNone + , optSync = True + , optOrder = OrderName + , optReverse = False + , optScript = False + , optVerbose = False + , optSources = NonEmpty.fromList ["one"] + , optDestination = "/z" + } + +sourcesOptions :: Options +sourcesOptions = defaultOptions + { optSources = + NonEmpty.fromList ["python.mp4", "/a/b/two", "one", "c/Haskell.mp4"] + } + +------------------------------------------------------------------------------ + +testCaseSensitive :: TestTree +testCaseSensitive = testCase "CaseSensitive" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ CreateDirectory "/z/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ CopyFile "/a/b/one/Uno.mp3" "/z/one/Uno.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/dos.mp3" "/z/one/dos.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/tres.mp3" "/z/one/tres.mp3" |-> Right () + , expect $ Sync |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + +------------------------------------------------------------------------------ + +testCaseSensitiveScript :: TestTree +testCaseSensitiveScript = testCase "CaseSensitiveScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ PutStrLn "mkdir /z/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "cp /a/b/one/Uno.mp3 /z/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/dos.mp3 /z/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/tres.mp3 /z/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optScript = True + } + +------------------------------------------------------------------------------ + +testSourcesCaseSensitive :: TestTree +testSourcesCaseSensitive = testCase "SourcesCaseSensitive" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "python.mp4" |-> Right "/a/b/python.mp4" + , expect $ GetFileStatus "/a/b/python.mp4" |-> + Right (FileStatus 11 False 30000) + , expect $ DoesPathExist "/z/python.mp4" |-> Right False + , expect $ MakeAbsolute "/a/b/two" |-> Right "/a/b/two" + , expect $ GetFileStatus "/a/b/two" |-> Right (FileStatus 11 True 20000) + , expect $ DoesPathExist "/z/two" |-> Right False + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ MakeAbsolute "c/Haskell.mp4" |-> Right "/a/b/c/Haskell.mp4" + , expect $ GetFileStatus "/a/b/c/Haskell.mp4" |-> + Right (FileStatus 11 False 40000) + , expect $ DoesPathExist "/z/Haskell.mp4" |-> Right False + , expect $ CopyFile "/a/b/c/Haskell.mp4" "/z/Haskell.mp4" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/z/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ CopyFile "/a/b/one/Uno.mp3" "/z/one/Uno.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/dos.mp3" "/z/one/dos.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/tres.mp3" "/z/one/tres.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/python.mp4" "/z/python.mp4" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/z/two" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/two" |-> Right [] + ] + assertSuccess <=< Error.run $ run sourcesOptions + +------------------------------------------------------------------------------ + +testSourcesCaseSensitiveScript :: TestTree +testSourcesCaseSensitiveScript = + testCase "SourcesCaseSensitiveScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "python.mp4" |-> Right "/a/b/python.mp4" + , expect $ GetFileStatus "/a/b/python.mp4" |-> + Right (FileStatus 11 False 30000) + , expect $ DoesPathExist "/z/python.mp4" |-> Right False + , expect $ MakeAbsolute "/a/b/two" |-> Right "/a/b/two" + , expect $ GetFileStatus "/a/b/two" |-> + Right (FileStatus 11 True 20000) + , expect $ DoesPathExist "/z/two" |-> Right False + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> + Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ MakeAbsolute "c/Haskell.mp4" |-> Right "/a/b/c/Haskell.mp4" + , expect $ GetFileStatus "/a/b/c/Haskell.mp4" |-> + Right (FileStatus 11 False 40000) + , expect $ DoesPathExist "/z/Haskell.mp4" |-> Right False + , expect $ PutStrLn "cp /a/b/c/Haskell.mp4 /z/Haskell.mp4" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /z/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "cp /a/b/one/Uno.mp3 /z/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/dos.mp3 /z/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/tres.mp3 /z/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/python.mp4 /z/python.mp4" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /z/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/two" |-> Right [] + ] + assertSuccess <=< Error.run $ run sourcesOptions + { optScript = True + } + +------------------------------------------------------------------------------ + +testCaseInsensitive :: TestTree +testCaseInsensitive = testCase "CaseInsensitive" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ CreateDirectory "/z/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ CopyFile "/a/b/one/dos.mp3" "/z/one/dos.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/tres.mp3" "/z/one/tres.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/Uno.mp3" "/z/one/Uno.mp3" |-> Right () + , expect $ Sync |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optCase = CaseInsensitive + } + +------------------------------------------------------------------------------ + +testCaseInsensitiveScript :: TestTree +testCaseInsensitiveScript = testCase "CaseInsensitiveScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ PutStrLn "mkdir /z/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "cp /a/b/one/dos.mp3 /z/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/tres.mp3 /z/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/Uno.mp3 /z/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optCase = CaseInsensitive + , optScript = True + } + +------------------------------------------------------------------------------ + +testSourcesCaseInsensitive :: TestTree +testSourcesCaseInsensitive = testCase "SourcesCaseInsensitive" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "python.mp4" |-> Right "/a/b/python.mp4" + , expect $ GetFileStatus "/a/b/python.mp4" |-> + Right (FileStatus 11 False 30000) + , expect $ DoesPathExist "/z/python.mp4" |-> Right False + , expect $ MakeAbsolute "/a/b/two" |-> Right "/a/b/two" + , expect $ GetFileStatus "/a/b/two" |-> Right (FileStatus 11 True 20000) + , expect $ DoesPathExist "/z/two" |-> Right False + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ MakeAbsolute "c/Haskell.mp4" |-> Right "/a/b/c/Haskell.mp4" + , expect $ GetFileStatus "/a/b/c/Haskell.mp4" |-> + Right (FileStatus 11 False 40000) + , expect $ DoesPathExist "/z/Haskell.mp4" |-> Right False + , expect $ CopyFile "/a/b/c/Haskell.mp4" "/z/Haskell.mp4" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/z/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ CopyFile "/a/b/one/dos.mp3" "/z/one/dos.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/tres.mp3" "/z/one/tres.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/Uno.mp3" "/z/one/Uno.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/python.mp4" "/z/python.mp4" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/z/two" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/two" |-> Right [] + ] + assertSuccess <=< Error.run $ run sourcesOptions + { optCase = CaseInsensitive + } + +------------------------------------------------------------------------------ + +testSourcesCaseInsensitiveScript :: TestTree +testSourcesCaseInsensitiveScript = + testCase "SourcesCaseInsensitiveScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "python.mp4" |-> Right "/a/b/python.mp4" + , expect $ GetFileStatus "/a/b/python.mp4" |-> + Right (FileStatus 11 False 30000) + , expect $ DoesPathExist "/z/python.mp4" |-> Right False + , expect $ MakeAbsolute "/a/b/two" |-> Right "/a/b/two" + , expect $ GetFileStatus "/a/b/two" |-> + Right (FileStatus 11 True 20000) + , expect $ DoesPathExist "/z/two" |-> Right False + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> + Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ MakeAbsolute "c/Haskell.mp4" |-> Right "/a/b/c/Haskell.mp4" + , expect $ GetFileStatus "/a/b/c/Haskell.mp4" |-> + Right (FileStatus 11 False 40000) + , expect $ DoesPathExist "/z/Haskell.mp4" |-> Right False + , expect $ PutStrLn "cp /a/b/c/Haskell.mp4 /z/Haskell.mp4" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /z/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "cp /a/b/one/dos.mp3 /z/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/tres.mp3 /z/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/Uno.mp3 /z/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/python.mp4 /z/python.mp4" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /z/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/two" |-> Right [] + ] + assertSuccess <=< Error.run $ run sourcesOptions + { optCase = CaseInsensitive + , optScript = True + } + +------------------------------------------------------------------------------ + +testFirstNone :: TestTree +testFirstNone = testCase "FirstNone" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ CreateDirectory "/z/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "three", "Uno.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ CopyFile "/a/b/one/Uno.mp3" "/z/one/Uno.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/dos.mp3" "/z/one/dos.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/z/one/three" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one/three" |-> Right [] + , expect $ CopyFile "/a/b/one/tres.mp3" "/z/one/tres.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/z/one/two" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one/two" |-> Right [] + ] + assertSuccess <=< Error.run $ run defaultOptions + +------------------------------------------------------------------------------ + +testFirstNoneScript :: TestTree +testFirstNoneScript = testCase "FirstNoneScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ PutStrLn "mkdir /z/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "three", "Uno.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "cp /a/b/one/Uno.mp3 /z/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/dos.mp3 /z/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /z/one/three" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/three" |-> Right [] + , expect $ PutStrLn "cp /a/b/one/tres.mp3 /z/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /z/one/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/two" |-> Right [] + ] + assertSuccess <=< Error.run $ run defaultOptions + { optScript = True + } + +------------------------------------------------------------------------------ + +testFirstDirs :: TestTree +testFirstDirs = testCase "FirstDirs" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ CreateDirectory "/z/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "three", "Uno.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ CreateDirectory "/z/one/three" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one/three" |-> Right [] + , expect $ CreateDirectory "/z/one/two" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one/two" |-> Right [] + , expect $ CopyFile "/a/b/one/Uno.mp3" "/z/one/Uno.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/dos.mp3" "/z/one/dos.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/tres.mp3" "/z/one/tres.mp3" |-> Right () + , expect $ Sync |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstDirs + } + +------------------------------------------------------------------------------ + +testFirstDirsScript :: TestTree +testFirstDirsScript = testCase "FirstDirsScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ PutStrLn "mkdir /z/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "three", "Uno.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "mkdir /z/one/three" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/three" |-> Right [] + , expect $ PutStrLn "mkdir /z/one/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/two" |-> Right [] + , expect $ PutStrLn "cp /a/b/one/Uno.mp3 /z/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/dos.mp3 /z/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/tres.mp3 /z/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstDirs + , optScript = True + } + +------------------------------------------------------------------------------ + +testSourcesFirstDirs :: TestTree +testSourcesFirstDirs = testCase "SourcesFirstDirs" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "python.mp4" |-> Right "/a/b/python.mp4" + , expect $ GetFileStatus "/a/b/python.mp4" |-> + Right (FileStatus 11 False 30000) + , expect $ DoesPathExist "/z/python.mp4" |-> Right False + , expect $ MakeAbsolute "/a/b/two" |-> Right "/a/b/two" + , expect $ GetFileStatus "/a/b/two" |-> Right (FileStatus 11 True 20000) + , expect $ DoesPathExist "/z/two" |-> Right False + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ MakeAbsolute "c/Haskell.mp4" |-> Right "/a/b/c/Haskell.mp4" + , expect $ GetFileStatus "/a/b/c/Haskell.mp4" |-> + Right (FileStatus 11 False 40000) + , expect $ DoesPathExist "/z/Haskell.mp4" |-> Right False + , expect $ CreateDirectory "/z/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ CopyFile "/a/b/one/Uno.mp3" "/z/one/Uno.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/dos.mp3" "/z/one/dos.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/tres.mp3" "/z/one/tres.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/z/two" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/two" |-> Right [] + , expect $ CopyFile "/a/b/c/Haskell.mp4" "/z/Haskell.mp4" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/python.mp4" "/z/python.mp4" |-> Right () + , expect $ Sync |-> () + ] + assertSuccess <=< Error.run $ run sourcesOptions + { optFirst = FirstDirs + } + +------------------------------------------------------------------------------ + +testSourcesFirstDirsScript :: TestTree +testSourcesFirstDirsScript = testCase "SourcesFirstDirsScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "python.mp4" |-> Right "/a/b/python.mp4" + , expect $ GetFileStatus "/a/b/python.mp4" |-> + Right (FileStatus 11 False 30000) + , expect $ DoesPathExist "/z/python.mp4" |-> Right False + , expect $ MakeAbsolute "/a/b/two" |-> Right "/a/b/two" + , expect $ GetFileStatus "/a/b/two" |-> + Right (FileStatus 11 True 20000) + , expect $ DoesPathExist "/z/two" |-> Right False + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> + Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ MakeAbsolute "c/Haskell.mp4" |-> Right "/a/b/c/Haskell.mp4" + , expect $ GetFileStatus "/a/b/c/Haskell.mp4" |-> + Right (FileStatus 11 False 40000) + , expect $ DoesPathExist "/z/Haskell.mp4" |-> Right False + , expect $ PutStrLn "mkdir /z/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "cp /a/b/one/Uno.mp3 /z/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/dos.mp3 /z/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/tres.mp3 /z/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /z/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/two" |-> Right [] + , expect $ PutStrLn "cp /a/b/c/Haskell.mp4 /z/Haskell.mp4" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/python.mp4 /z/python.mp4" |-> () + , expect $ PutStrLn "sync" |-> () + ] + assertSuccess <=< Error.run $ run sourcesOptions + { optFirst = FirstDirs + , optScript = True + } + +------------------------------------------------------------------------------ + +testFirstFiles :: TestTree +testFirstFiles = testCase "FirstFiles" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ CreateDirectory "/z/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "three", "Uno.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ CopyFile "/a/b/one/Uno.mp3" "/z/one/Uno.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/dos.mp3" "/z/one/dos.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/tres.mp3" "/z/one/tres.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/z/one/three" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one/three" |-> Right [] + , expect $ CreateDirectory "/z/one/two" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one/two" |-> Right [] + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstFiles + } + +------------------------------------------------------------------------------ + +testFirstFilesScript :: TestTree +testFirstFilesScript = testCase "FirstFilesScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ PutStrLn "mkdir /z/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "three", "Uno.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "cp /a/b/one/Uno.mp3 /z/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/dos.mp3 /z/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/tres.mp3 /z/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /z/one/three" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/three" |-> Right [] + , expect $ PutStrLn "mkdir /z/one/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/two" |-> Right [] + + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstFiles + , optScript = True + } + +------------------------------------------------------------------------------ + +testSourcesFirstFiles :: TestTree +testSourcesFirstFiles = testCase "SourcesFirstFiles" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "python.mp4" |-> Right "/a/b/python.mp4" + , expect $ GetFileStatus "/a/b/python.mp4" |-> + Right (FileStatus 11 False 30000) + , expect $ DoesPathExist "/z/python.mp4" |-> Right False + , expect $ MakeAbsolute "/a/b/two" |-> Right "/a/b/two" + , expect $ GetFileStatus "/a/b/two" |-> Right (FileStatus 11 True 20000) + , expect $ DoesPathExist "/z/two" |-> Right False + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ MakeAbsolute "c/Haskell.mp4" |-> Right "/a/b/c/Haskell.mp4" + , expect $ GetFileStatus "/a/b/c/Haskell.mp4" |-> + Right (FileStatus 11 False 40000) + , expect $ DoesPathExist "/z/Haskell.mp4" |-> Right False + , expect $ CopyFile "/a/b/c/Haskell.mp4" "/z/Haskell.mp4" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/python.mp4" "/z/python.mp4" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/z/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ CopyFile "/a/b/one/Uno.mp3" "/z/one/Uno.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/dos.mp3" "/z/one/dos.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/tres.mp3" "/z/one/tres.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/z/two" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/two" |-> Right [] + ] + assertSuccess <=< Error.run $ run sourcesOptions + { optFirst = FirstFiles + } + +------------------------------------------------------------------------------ + +testSourcesFirstFilesScript :: TestTree +testSourcesFirstFilesScript = + testCase "SourcesFirstFilesScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "python.mp4" |-> Right "/a/b/python.mp4" + , expect $ GetFileStatus "/a/b/python.mp4" |-> + Right (FileStatus 11 False 30000) + , expect $ DoesPathExist "/z/python.mp4" |-> Right False + , expect $ MakeAbsolute "/a/b/two" |-> Right "/a/b/two" + , expect $ GetFileStatus "/a/b/two" |-> + Right (FileStatus 11 True 20000) + , expect $ DoesPathExist "/z/two" |-> Right False + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> + Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ MakeAbsolute "c/Haskell.mp4" |-> Right "/a/b/c/Haskell.mp4" + , expect $ GetFileStatus "/a/b/c/Haskell.mp4" |-> + Right (FileStatus 11 False 40000) + , expect $ DoesPathExist "/z/Haskell.mp4" |-> Right False + , expect $ PutStrLn "cp /a/b/c/Haskell.mp4 /z/Haskell.mp4" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/python.mp4 /z/python.mp4" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /z/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "cp /a/b/one/Uno.mp3 /z/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/dos.mp3 /z/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/tres.mp3 /z/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /z/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/two" |-> Right [] + ] + assertSuccess <=< Error.run $ run sourcesOptions + { optFirst = FirstFiles + , optScript = True + } + +------------------------------------------------------------------------------ + +testNoSync :: TestTree +testNoSync = testCase "NoSync" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ CreateDirectory "/z/one" |-> Right () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ CopyFile "/a/b/one/Uno.mp3" "/z/one/Uno.mp3" |-> Right () + , expect $ CopyFile "/a/b/one/dos.mp3" "/z/one/dos.mp3" |-> Right () + , expect $ CopyFile "/a/b/one/tres.mp3" "/z/one/tres.mp3" |-> Right () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optSync = False + } + +------------------------------------------------------------------------------ + +testNoSyncScript :: TestTree +testNoSyncScript = testCase "NoSyncScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ PutStrLn "mkdir /z/one" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "cp /a/b/one/Uno.mp3 /z/one/Uno.mp3" |-> () + , expect $ PutStrLn "cp /a/b/one/dos.mp3 /z/one/dos.mp3" |-> () + , expect $ PutStrLn "cp /a/b/one/tres.mp3 /z/one/tres.mp3" |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optSync = False + , optScript = True + } + +------------------------------------------------------------------------------ + +testOrderNameReverse :: TestTree +testOrderNameReverse = testCase "OrderNameReverse" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ CreateDirectory "/z/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "three", "Uno.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ CreateDirectory "/z/one/two" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one/two" |-> Right [] + , expect $ CreateDirectory "/z/one/three" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one/three" |-> Right [] + , expect $ CopyFile "/a/b/one/tres.mp3" "/z/one/tres.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/dos.mp3" "/z/one/dos.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/Uno.mp3" "/z/one/Uno.mp3" |-> Right () + , expect $ Sync |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstDirs + , optReverse = True + } + +------------------------------------------------------------------------------ + +testOrderNameReverseScript :: TestTree +testOrderNameReverseScript = testCase "OrderNameReverseScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ PutStrLn "mkdir /z/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "three", "Uno.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "mkdir /z/one/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/two" |-> Right [] + , expect $ PutStrLn "mkdir /z/one/three" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/three" |-> Right [] + , expect $ PutStrLn "cp /a/b/one/tres.mp3 /z/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/dos.mp3 /z/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/Uno.mp3 /z/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstDirs + , optReverse = True + , optScript = True + } + +------------------------------------------------------------------------------ + +testSourcesOrderNameReverse :: TestTree +testSourcesOrderNameReverse = + testCase "SourcesOrderNameReverse" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "python.mp4" |-> Right "/a/b/python.mp4" + , expect $ GetFileStatus "/a/b/python.mp4" |-> + Right (FileStatus 11 False 30000) + , expect $ DoesPathExist "/z/python.mp4" |-> Right False + , expect $ MakeAbsolute "/a/b/two" |-> Right "/a/b/two" + , expect $ GetFileStatus "/a/b/two" |-> + Right (FileStatus 11 True 20000) + , expect $ DoesPathExist "/z/two" |-> Right False + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> + Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ MakeAbsolute "c/Haskell.mp4" |-> Right "/a/b/c/Haskell.mp4" + , expect $ GetFileStatus "/a/b/c/Haskell.mp4" |-> + Right (FileStatus 11 False 40000) + , expect $ DoesPathExist "/z/Haskell.mp4" |-> Right False + , expect $ CreateDirectory "/z/two" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/two" |-> Right [] + , expect $ CreateDirectory "/z/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ CopyFile "/a/b/one/tres.mp3" "/z/one/tres.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/dos.mp3" "/z/one/dos.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/Uno.mp3" "/z/one/Uno.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/python.mp4" "/z/python.mp4" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/c/Haskell.mp4" "/z/Haskell.mp4" |-> Right () + , expect $ Sync |-> () + ] + assertSuccess <=< Error.run $ run sourcesOptions + { optFirst = FirstDirs + , optReverse = True + } + +------------------------------------------------------------------------------ + +testSourcesOrderNameReverseScript :: TestTree +testSourcesOrderNameReverseScript = + testCase "SourcesOrderNameReverseScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "python.mp4" |-> Right "/a/b/python.mp4" + , expect $ GetFileStatus "/a/b/python.mp4" |-> + Right (FileStatus 11 False 30000) + , expect $ DoesPathExist "/z/python.mp4" |-> Right False + , expect $ MakeAbsolute "/a/b/two" |-> Right "/a/b/two" + , expect $ GetFileStatus "/a/b/two" |-> + Right (FileStatus 11 True 20000) + , expect $ DoesPathExist "/z/two" |-> Right False + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> + Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ MakeAbsolute "c/Haskell.mp4" |-> Right "/a/b/c/Haskell.mp4" + , expect $ GetFileStatus "/a/b/c/Haskell.mp4" |-> + Right (FileStatus 11 False 40000) + , expect $ DoesPathExist "/z/Haskell.mp4" |-> Right False + , expect $ PutStrLn "mkdir /z/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/two" |-> Right [] + , expect $ PutStrLn "mkdir /z/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "cp /a/b/one/tres.mp3 /z/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/dos.mp3 /z/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/Uno.mp3 /z/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/python.mp4 /z/python.mp4" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/c/Haskell.mp4 /z/Haskell.mp4" |-> () + , expect $ PutStrLn "sync" |-> () + ] + assertSuccess <=< Error.run $ run sourcesOptions + { optFirst = FirstDirs + , optReverse = True + , optScript = True + } + +------------------------------------------------------------------------------ + +testOrderTime :: TestTree +testOrderTime = testCase "OrderTime" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ CreateDirectory "/z/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "three", "Uno.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 20000) + , expect $ GetFileStatus "/a/b/one/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 10000) + , expect $ GetFileStatus "/a/b/one/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ CreateDirectory "/z/one/two" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one/two" |-> Right [] + , expect $ CreateDirectory "/z/one/three" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one/three" |-> Right [] + , expect $ CopyFile "/a/b/one/tres.mp3" "/z/one/tres.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/Uno.mp3" "/z/one/Uno.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/dos.mp3" "/z/one/dos.mp3" |-> Right () + , expect $ Sync |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstDirs + , optOrder = OrderTime + } + +------------------------------------------------------------------------------ + +testOrderTimeScript :: TestTree +testOrderTimeScript = testCase "OrderTimeScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ PutStrLn "mkdir /z/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "three", "Uno.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 20000) + , expect $ GetFileStatus "/a/b/one/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 10000) + , expect $ GetFileStatus "/a/b/one/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "mkdir /z/one/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/two" |-> Right [] + , expect $ PutStrLn "mkdir /z/one/three" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/three" |-> Right [] + , expect $ PutStrLn "cp /a/b/one/tres.mp3 /z/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/Uno.mp3 /z/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/dos.mp3 /z/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstDirs + , optOrder = OrderTime + , optScript = True + } + +------------------------------------------------------------------------------ + +testSourcesOrderTime :: TestTree +testSourcesOrderTime = testCase "SourcesOrderTime" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "python.mp4" |-> Right "/a/b/python.mp4" + , expect $ GetFileStatus "/a/b/python.mp4" |-> + Right (FileStatus 11 False 30000) + , expect $ DoesPathExist "/z/python.mp4" |-> Right False + , expect $ MakeAbsolute "/a/b/two" |-> Right "/a/b/two" + , expect $ GetFileStatus "/a/b/two" |-> Right (FileStatus 11 True 32000) + , expect $ DoesPathExist "/z/two" |-> Right False + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 33000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ MakeAbsolute "c/Haskell.mp4" |-> Right "/a/b/c/Haskell.mp4" + , expect $ GetFileStatus "/a/b/c/Haskell.mp4" |-> + Right (FileStatus 11 False 40000) + , expect $ DoesPathExist "/z/Haskell.mp4" |-> Right False + , expect $ CreateDirectory "/z/two" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/two" |-> Right [] + , expect $ CreateDirectory "/z/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 20000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 10000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ CopyFile "/a/b/one/tres.mp3" "/z/one/tres.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/Uno.mp3" "/z/one/Uno.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/dos.mp3" "/z/one/dos.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/python.mp4" "/z/python.mp4" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/c/Haskell.mp4" "/z/Haskell.mp4" |-> Right () + , expect $ Sync |-> () + ] + assertSuccess <=< Error.run $ run sourcesOptions + { optFirst = FirstDirs + , optOrder = OrderTime + } + +------------------------------------------------------------------------------ + +testSourcesOrderTimeScript :: TestTree +testSourcesOrderTimeScript = testCase "SourcesOrderTimeScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "python.mp4" |-> Right "/a/b/python.mp4" + , expect $ GetFileStatus "/a/b/python.mp4" |-> + Right (FileStatus 11 False 30000) + , expect $ DoesPathExist "/z/python.mp4" |-> Right False + , expect $ MakeAbsolute "/a/b/two" |-> Right "/a/b/two" + , expect $ GetFileStatus "/a/b/two" |-> Right (FileStatus 11 True 32000) + , expect $ DoesPathExist "/z/two" |-> Right False + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 33000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ MakeAbsolute "c/Haskell.mp4" |-> Right "/a/b/c/Haskell.mp4" + , expect $ GetFileStatus "/a/b/c/Haskell.mp4" |-> + Right (FileStatus 11 False 40000) + , expect $ DoesPathExist "/z/Haskell.mp4" |-> Right False + , expect $ PutStrLn "mkdir /z/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/two" |-> Right [] + , expect $ PutStrLn "mkdir /z/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 20000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 10000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "cp /a/b/one/tres.mp3 /z/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/Uno.mp3 /z/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/dos.mp3 /z/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/python.mp4 /z/python.mp4" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/c/Haskell.mp4 /z/Haskell.mp4" |-> () + , expect $ PutStrLn "sync" |-> () + ] + assertSuccess <=< Error.run $ run sourcesOptions + { optFirst = FirstDirs + , optOrder = OrderTime + , optScript = True + } + +------------------------------------------------------------------------------ + +testOrderTimeReverse :: TestTree +testOrderTimeReverse = testCase "OrderTimeReverse" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ CreateDirectory "/z/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "three", "Uno.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 20000) + , expect $ GetFileStatus "/a/b/one/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 10000) + , expect $ GetFileStatus "/a/b/one/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ CreateDirectory "/z/one/three" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one/three" |-> Right [] + , expect $ CreateDirectory "/z/one/two" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one/two" |-> Right [] + , expect $ CopyFile "/a/b/one/dos.mp3" "/z/one/dos.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/Uno.mp3" "/z/one/Uno.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/tres.mp3" "/z/one/tres.mp3" |-> Right () + , expect $ Sync |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstDirs + , optOrder = OrderTime + , optReverse = True + } + +------------------------------------------------------------------------------ + +testOrderTimeReverseScript :: TestTree +testOrderTimeReverseScript = testCase "OrderTimeReverseScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ PutStrLn "mkdir /z/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "three", "Uno.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 20000) + , expect $ GetFileStatus "/a/b/one/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 10000) + , expect $ GetFileStatus "/a/b/one/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "mkdir /z/one/three" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/three" |-> Right [] + , expect $ PutStrLn "mkdir /z/one/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/two" |-> Right [] + , expect $ PutStrLn "cp /a/b/one/dos.mp3 /z/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/Uno.mp3 /z/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/tres.mp3 /z/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstDirs + , optOrder = OrderTime + , optReverse = True + , optScript = True + } + +------------------------------------------------------------------------------ + +testSourcesOrderTimeReverse :: TestTree +testSourcesOrderTimeReverse = + testCase "SourcesOrderTimeReverse" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "python.mp4" |-> Right "/a/b/python.mp4" + , expect $ GetFileStatus "/a/b/python.mp4" |-> + Right (FileStatus 11 False 30000) + , expect $ DoesPathExist "/z/python.mp4" |-> Right False + , expect $ MakeAbsolute "/a/b/two" |-> Right "/a/b/two" + , expect $ GetFileStatus "/a/b/two" |-> + Right (FileStatus 11 True 32000) + , expect $ DoesPathExist "/z/two" |-> Right False + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> + Right (FileStatus 11 True 33000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ MakeAbsolute "c/Haskell.mp4" |-> Right "/a/b/c/Haskell.mp4" + , expect $ GetFileStatus "/a/b/c/Haskell.mp4" |-> + Right (FileStatus 11 False 40000) + , expect $ DoesPathExist "/z/Haskell.mp4" |-> Right False + , expect $ CreateDirectory "/z/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 20000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 10000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ CopyFile "/a/b/one/dos.mp3" "/z/one/dos.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/Uno.mp3" "/z/one/Uno.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/one/tres.mp3" "/z/one/tres.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ CreateDirectory "/z/two" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/two" |-> Right [] + , expect $ CopyFile "/a/b/c/Haskell.mp4" "/z/Haskell.mp4" |-> Right () + , expect $ Sync |-> () + , expect $ CopyFile "/a/b/python.mp4" "/z/python.mp4" |-> Right () + , expect $ Sync |-> () + ] + assertSuccess <=< Error.run $ run sourcesOptions + { optFirst = FirstDirs + , optOrder = OrderTime + , optReverse = True + } + +------------------------------------------------------------------------------ + +testSourcesOrderTimeReverseScript :: TestTree +testSourcesOrderTimeReverseScript = + testCase "SourcesOrderTimeReverseScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "python.mp4" |-> Right "/a/b/python.mp4" + , expect $ GetFileStatus "/a/b/python.mp4" |-> + Right (FileStatus 11 False 30000) + , expect $ DoesPathExist "/z/python.mp4" |-> Right False + , expect $ MakeAbsolute "/a/b/two" |-> Right "/a/b/two" + , expect $ GetFileStatus "/a/b/two" |-> + Right (FileStatus 11 True 32000) + , expect $ DoesPathExist "/z/two" |-> Right False + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> + Right (FileStatus 11 True 33000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ MakeAbsolute "c/Haskell.mp4" |-> Right "/a/b/c/Haskell.mp4" + , expect $ GetFileStatus "/a/b/c/Haskell.mp4" |-> + Right (FileStatus 11 False 40000) + , expect $ DoesPathExist "/z/Haskell.mp4" |-> Right False + , expect $ PutStrLn "mkdir /z/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 20000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 10000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "cp /a/b/one/dos.mp3 /z/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/Uno.mp3 /z/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/one/tres.mp3 /z/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "mkdir /z/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/two" |-> Right [] + , expect $ PutStrLn "cp /a/b/c/Haskell.mp4 /z/Haskell.mp4" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "cp /a/b/python.mp4 /z/python.mp4" |-> () + , expect $ PutStrLn "sync" |-> () + ] + assertSuccess <=< Error.run $ run sourcesOptions + { optFirst = FirstDirs + , optOrder = OrderTime + , optReverse = True + , optScript = True + } + +------------------------------------------------------------------------------ + +testOrderRandom :: TestTree +testOrderRandom = testCase "OrderRandom" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ CreateDirectory "/z/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "three", "Uno.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , inAnyOrder + [ inSequence + [ expect $ CreateDirectory "/z/one/three" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one/three" |-> Right [] + ] + , inSequence + [ expect $ CreateDirectory "/z/one/two" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one/two" |-> Right [] + ] + ] + , inAnyOrder + [ inSequence + [ expect $ CopyFile "/a/b/one/Uno.mp3" "/z/one/Uno.mp3" |-> + Right () + , expect $ Sync |-> () + ] + , inSequence + [ expect $ CopyFile "/a/b/one/dos.mp3" "/z/one/dos.mp3" |-> + Right () + , expect $ Sync |-> () + ] + , inSequence + [ expect $ CopyFile "/a/b/one/tres.mp3" "/z/one/tres.mp3" |-> + Right () + , expect $ Sync |-> () + ] + ] + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstDirs + , optOrder = OrderRandom + } + +------------------------------------------------------------------------------ + +testOrderRandomScript :: TestTree +testOrderRandomScript = testCase "OrderRandomScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ PutStrLn "mkdir /z/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "three", "Uno.mp3", "two", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/three" |-> + Right (FileStatus 11 True 3000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , inAnyOrder + [ inSequence + [ expect $ PutStrLn "mkdir /z/one/three" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/three" |-> Right [] + ] + , inSequence + [ expect $ PutStrLn "mkdir /z/one/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one/two" |-> Right [] + ] + ] + , inAnyOrder + [ inSequence + [ expect $ PutStrLn "cp /a/b/one/Uno.mp3 /z/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + ] + , inSequence + [ expect $ PutStrLn "cp /a/b/one/dos.mp3 /z/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + ] + , inSequence + [ expect $ PutStrLn "cp /a/b/one/tres.mp3 /z/one/tres.mp3" |-> + () + , expect $ PutStrLn "sync" |-> () + ] + ] + ] + assertSuccess <=< Error.run $ run defaultOptions + { optFirst = FirstDirs + , optOrder = OrderRandom + , optScript = True + } + +------------------------------------------------------------------------------ + +testSourcesOrderRandom :: TestTree +testSourcesOrderRandom = testCase "SourcesOrderRandom" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "python.mp4" |-> Right "/a/b/python.mp4" + , expect $ GetFileStatus "/a/b/python.mp4" |-> + Right (FileStatus 11 False 30000) + , expect $ DoesPathExist "/z/python.mp4" |-> Right False + , expect $ MakeAbsolute "/a/b/two" |-> Right "/a/b/two" + , expect $ GetFileStatus "/a/b/two" |-> Right (FileStatus 11 True 20000) + , expect $ DoesPathExist "/z/two" |-> Right False + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ MakeAbsolute "c/Haskell.mp4" |-> Right "/a/b/c/Haskell.mp4" + , expect $ GetFileStatus "/a/b/c/Haskell.mp4" |-> + Right (FileStatus 11 False 40000) + , expect $ DoesPathExist "/z/Haskell.mp4" |-> Right False + , inAnyOrder + [ inSequence + [ expect $ CreateDirectory "/z/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , inAnyOrder + [ inSequence + [ expect $ + CopyFile "/a/b/one/Uno.mp3" "/z/one/Uno.mp3" |-> + Right () + , expect $ Sync |-> () + ] + , inSequence + [ expect $ + CopyFile "/a/b/one/dos.mp3" "/z/one/dos.mp3" |-> + Right () + , expect $ Sync |-> () + ] + , inSequence + [ expect $ + CopyFile "/a/b/one/tres.mp3" "/z/one/tres.mp3" |-> + Right () + , expect $ Sync |-> () + ] + ] + ] + , inSequence + [ expect $ CreateDirectory "/z/two" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/two" |-> Right [] + ] + ] + , inAnyOrder + [ inSequence + [ expect $ CopyFile "/a/b/c/Haskell.mp4" "/z/Haskell.mp4" |-> + Right () + , expect $ Sync |-> () + ] + , inSequence + [ expect $ CopyFile "/a/b/python.mp4" "/z/python.mp4" |-> + Right () + , expect $ Sync |-> () + ] + ] + ] + assertSuccess <=< Error.run $ run sourcesOptions + { optFirst = FirstDirs + , optOrder = OrderRandom + } + +------------------------------------------------------------------------------ + +testSourcesOrderRandomScript :: TestTree +testSourcesOrderRandomScript = + testCase "SourcesOrderRandomScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "python.mp4" |-> Right "/a/b/python.mp4" + , expect $ GetFileStatus "/a/b/python.mp4" |-> + Right (FileStatus 11 False 30000) + , expect $ DoesPathExist "/z/python.mp4" |-> Right False + , expect $ MakeAbsolute "/a/b/two" |-> Right "/a/b/two" + , expect $ GetFileStatus "/a/b/two" |-> + Right (FileStatus 11 True 20000) + , expect $ DoesPathExist "/z/two" |-> Right False + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> + Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ MakeAbsolute "c/Haskell.mp4" |-> Right "/a/b/c/Haskell.mp4" + , expect $ GetFileStatus "/a/b/c/Haskell.mp4" |-> + Right (FileStatus 11 False 40000) + , expect $ DoesPathExist "/z/Haskell.mp4" |-> Right False + , inAnyOrder + [ inSequence + [ expect $ PutStrLn "mkdir /z/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , inAnyOrder + [ inSequence + [ expect $ + PutStrLn "cp /a/b/one/Uno.mp3 /z/one/Uno.mp3" |-> + () + , expect $ PutStrLn "sync" |-> () + ] + , inSequence + [ expect $ + PutStrLn "cp /a/b/one/dos.mp3 /z/one/dos.mp3" |-> + () + , expect $ PutStrLn "sync" |-> () + ] + , inSequence + [ expect $ + PutStrLn "cp /a/b/one/tres.mp3 /z/one/tres.mp3" + |-> () + , expect $ PutStrLn "sync" |-> () + ] + ] + ] + , inSequence + [ expect $ PutStrLn "mkdir /z/two" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/two" |-> Right [] + ] + ] + , inAnyOrder + [ inSequence + [ expect $ PutStrLn "cp /a/b/c/Haskell.mp4 /z/Haskell.mp4" |-> + () + , expect $ PutStrLn "sync" |-> () + ] + , inSequence + [ expect $ PutStrLn "cp /a/b/python.mp4 /z/python.mp4" |-> () + , expect $ PutStrLn "sync" |-> () + ] + ] + ] + assertSuccess <=< Error.run $ run sourcesOptions + { optFirst = FirstDirs + , optOrder = OrderRandom + , optScript = True + } + +------------------------------------------------------------------------------ + +testVerbose :: TestTree +testVerbose = testCase "Verbose" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ PutStrLn "one" |-> () + , expect $ CreateDirectory "/z/one" |-> Right () + , expect $ Sync |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "one/Uno.mp3" |-> () + , expect $ CopyFile "/a/b/one/Uno.mp3" "/z/one/Uno.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ PutStrLn "one/dos.mp3" |-> () + , expect $ CopyFile "/a/b/one/dos.mp3" "/z/one/dos.mp3" |-> Right () + , expect $ Sync |-> () + , expect $ PutStrLn "one/tres.mp3" |-> () + , expect $ CopyFile "/a/b/one/tres.mp3" "/z/one/tres.mp3" |-> Right () + , expect $ Sync |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optVerbose = True + } + +------------------------------------------------------------------------------ + +testVerboseScript :: TestTree +testVerboseScript = testCase "VerboseScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right False + , expect $ PutStrLn "echo one" |-> () + , expect $ PutStrLn "mkdir /z/one" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ ListDirectory "/a/b/one" |-> + Right ["dos.mp3", "Uno.mp3", "tres.mp3"] + , expect $ GetFileStatus "/a/b/one/dos.mp3" |-> + Right (FileStatus 11 False 2000) + , expect $ GetFileStatus "/a/b/one/Uno.mp3" |-> + Right (FileStatus 11 False 1000) + , expect $ GetFileStatus "/a/b/one/tres.mp3" |-> + Right (FileStatus 11 False 3000) + , expect $ PutStrLn "echo one/Uno.mp3" |-> () + , expect $ PutStrLn "cp /a/b/one/Uno.mp3 /z/one/Uno.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "echo one/dos.mp3" |-> () + , expect $ PutStrLn "cp /a/b/one/dos.mp3 /z/one/dos.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + , expect $ PutStrLn "echo one/tres.mp3" |-> () + , expect $ PutStrLn "cp /a/b/one/tres.mp3 /z/one/tres.mp3" |-> () + , expect $ PutStrLn "sync" |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optScript = True + , optVerbose = True + } + +------------------------------------------------------------------------------ + +testDestinationNotFound :: TestTree +testDestinationNotFound = testCase "DestinationNotFound" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Left (userError "file not found: /z") + ] + assertError "user error (file not found: /z)" <=< Error.run $ + run defaultOptions + +------------------------------------------------------------------------------ + +testDestinationNotDirectory :: TestTree +testDestinationNotDirectory = + testCase "DestinationNotDirectory" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 False 90000) + ] + assertError "not a directory: /z" <=< Error.run $ run defaultOptions + +------------------------------------------------------------------------------ + +testSourceNotFound :: TestTree +testSourceNotFound = testCase "SourceNotFound" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> + Left (userError "file not found: /a/b/one") + ] + assertError "user error (file not found: /a/b/one)" <=< Error.run $ + run defaultOptions + +------------------------------------------------------------------------------ + +testSourceAbove :: TestTree +testSourceAbove = testCase "SourceAbove" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "b/c" |-> Right "/a/b/c" + , expect $ GetFileStatus "/a/b/c" |-> Right (FileStatus 11 True 1000) + , expect $ MakeAbsolute "e" |-> Right "/a/e" + , expect $ GetFileStatus "/a/e" |-> Right (FileStatus 11 True 2000) + , expect $ DoesPathExist "/a/b/c/e" |-> Right False + , expect $ MakeAbsolute "b/d" |-> Right "/a/b/d" + , expect $ GetFileStatus "/a/b/d" |-> Right (FileStatus 11 True 3000) + , expect $ DoesPathExist "/a/b/c/d" |-> Right False + , expect $ MakeAbsolute "b0" |-> Right "/a/b0" + , expect $ GetFileStatus "/a/b0" |-> Right (FileStatus 11 True 4000) + , expect $ DoesPathExist "/a/b/c/b0" |-> Right False + , expect $ MakeAbsolute "b" |-> Right "/a/b" + , expect $ GetFileStatus "/a/b" |-> Right (FileStatus 11 True 5000) + ] + assertError "source directory above target directory: b" <=< + Error.run $ run defaultOptions + { optSources = NonEmpty.fromList ["e", "b/d", "b0", "b", "f"] + , optDestination = "b/c" + } + +------------------------------------------------------------------------------ + +testSourceExists :: TestTree +testSourceExists = testCase "SourceExists" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "one" |-> Right "/a/b/one" + , expect $ GetFileStatus "/a/b/one" |-> Right (FileStatus 11 True 10000) + , expect $ DoesPathExist "/z/one" |-> Right True + ] + assertError "already exists: /z/one" <=< Error.run $ run defaultOptions + +------------------------------------------------------------------------------ + +testLarge :: TestTree +testLarge = testCase "Large" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "d" |-> Right "/a/b/d" + , expect $ GetFileStatus "/a/b/d" |-> Right (FileStatus 11 True 2000) + , expect $ DoesPathExist "/z/d" |-> Right False + , expect $ MakeAbsolute "c" |-> Right "/a/b/c" + , expect $ GetFileStatus "/a/b/c" |-> Right (FileStatus 11 True 1000) + , expect $ DoesPathExist "/z/c" |-> Right False + , expect $ CreateDirectory "/z/c" |-> Right () + , expect $ ListDirectory "/a/b/c" |-> Right ["two", "one"] + , expect $ GetFileStatus "/a/b/c/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/c/one" |-> + Right (FileStatus 11 True 1000) + , expect $ CreateDirectory "/z/c/one" |-> Right () + , expect $ ListDirectory "/a/b/c/one" |-> + Right ["11.mp3", "six", "13.mp3", "eight", "12.mp3", "14.mp3"] + , expect $ GetFileStatus "/a/b/c/one/11.mp3" |-> + Right (FileStatus 11 False 1100) + , expect $ GetFileStatus "/a/b/c/one/six" |-> + Right (FileStatus 11 True 6000) + , expect $ GetFileStatus "/a/b/c/one/13.mp3" |-> + Right (FileStatus 11 False 1300) + , expect $ GetFileStatus "/a/b/c/one/eight" |-> + Right (FileStatus 11 True 8000) + , expect $ GetFileStatus "/a/b/c/one/12.mp3" |-> + Right (FileStatus 11 False 1200) + , expect $ GetFileStatus "/a/b/c/one/14.mp3" |-> + Right (FileStatus 11 False 1400) + , expect $ CopyFile "/a/b/c/one/11.mp3" "/z/c/one/11.mp3" |-> Right () + , expect $ CopyFile "/a/b/c/one/12.mp3" "/z/c/one/12.mp3" |-> Right () + , expect $ CopyFile "/a/b/c/one/13.mp3" "/z/c/one/13.mp3" |-> Right () + , expect $ CopyFile "/a/b/c/one/14.mp3" "/z/c/one/14.mp3" |-> Right () + , expect $ CreateDirectory "/z/c/one/eight" |-> Right () + , expect $ ListDirectory "/a/b/c/one/eight" |-> + Right ["83.mp3", "81.mp3", "82.mp3"] + , expect $ GetFileStatus "/a/b/c/one/eight/83.mp3" |-> + Right (FileStatus 11 False 8300) + , expect $ GetFileStatus "/a/b/c/one/eight/81.mp3" |-> + Right (FileStatus 11 False 8100) + , expect $ GetFileStatus "/a/b/c/one/eight/82.mp3" |-> + Right (FileStatus 11 False 8200) + , expect $ + CopyFile "/a/b/c/one/eight/81.mp3" "/z/c/one/eight/81.mp3" |-> + Right () + , expect $ + CopyFile "/a/b/c/one/eight/82.mp3" "/z/c/one/eight/82.mp3" |-> + Right () + , expect $ + CopyFile "/a/b/c/one/eight/83.mp3" "/z/c/one/eight/83.mp3" |-> + Right () + , expect $ CreateDirectory "/z/c/one/six" |-> Right () + , expect $ ListDirectory "/a/b/c/one/six" |-> Right [] + , expect $ CreateDirectory "/z/c/two" |-> Right () + , expect $ ListDirectory "/a/b/c/two" |-> + Right ["23.mp3", "22.mp3", "seven", "five", "21.mp3"] + , expect $ GetFileStatus "/a/b/c/two/23.mp3" |-> + Right (FileStatus 11 False 2300) + , expect $ GetFileStatus "/a/b/c/two/22.mp3" |-> + Right (FileStatus 11 False 2200) + , expect $ GetFileStatus "/a/b/c/two/seven" |-> + Right (FileStatus 11 True 7000) + , expect $ GetFileStatus "/a/b/c/two/five" |-> + Right (FileStatus 11 True 5000) + , expect $ GetFileStatus "/a/b/c/two/21.mp3" |-> + Right (FileStatus 11 False 2100) + , expect $ CopyFile "/a/b/c/two/21.mp3" "/z/c/two/21.mp3" |-> Right () + , expect $ CopyFile "/a/b/c/two/22.mp3" "/z/c/two/22.mp3" |-> Right () + , expect $ CopyFile "/a/b/c/two/23.mp3" "/z/c/two/23.mp3" |-> Right () + , expect $ CreateDirectory "/z/c/two/five" |-> Right () + , expect $ ListDirectory "/a/b/c/two/five" |-> Right ["51.mp3"] + , expect $ GetFileStatus "/a/b/c/two/five/51.mp3" |-> + Right (FileStatus 11 False 5100) + , expect $ CopyFile "/a/b/c/two/five/51.mp3" "/z/c/two/five/51.mp3" |-> + Right () + , expect $ CreateDirectory "/z/c/two/seven" |-> Right () + , expect $ ListDirectory "/a/b/c/two/seven" |-> + Right ["72.mp3", "71.mp3"] + , expect $ GetFileStatus "/a/b/c/two/seven/72.mp3" |-> + Right (FileStatus 11 False 7200) + , expect $ GetFileStatus "/a/b/c/two/seven/71.mp3" |-> + Right (FileStatus 11 False 7100) + , expect $ + CopyFile "/a/b/c/two/seven/71.mp3" "/z/c/two/seven/71.mp3" |-> + Right () + , expect $ + CopyFile "/a/b/c/two/seven/72.mp3" "/z/c/two/seven/72.mp3" |-> + Right () + , expect $ CreateDirectory "/z/d" |-> Right () + , expect $ ListDirectory "/a/b/d" |-> Right ["three"] + , expect $ GetFileStatus "/a/b/d/three" |-> + Right (FileStatus 11 True 3000) + , expect $ CreateDirectory "/z/d/three" |-> Right () + , expect $ ListDirectory "/a/b/d/three" |-> + Right ["32.mp3", "31.mp3", "four", "34.mp3", "nine", "33.mp3"] + , expect $ GetFileStatus "/a/b/d/three/32.mp3" |-> + Right (FileStatus 11 False 3200) + , expect $ GetFileStatus "/a/b/d/three/31.mp3" |-> + Right (FileStatus 11 False 3100) + , expect $ GetFileStatus "/a/b/d/three/four" |-> + Right (FileStatus 11 True 4000) + , expect $ GetFileStatus "/a/b/d/three/34.mp3" |-> + Right (FileStatus 11 False 3400) + , expect $ GetFileStatus "/a/b/d/three/nine" |-> + Right (FileStatus 11 True 9000) + , expect $ GetFileStatus "/a/b/d/three/33.mp3" |-> + Right (FileStatus 11 False 3300) + , expect $ CopyFile "/a/b/d/three/31.mp3" "/z/d/three/31.mp3" |-> + Right () + , expect $ CopyFile "/a/b/d/three/32.mp3" "/z/d/three/32.mp3" |-> + Right () + , expect $ CopyFile "/a/b/d/three/33.mp3" "/z/d/three/33.mp3" |-> + Right () + , expect $ CopyFile "/a/b/d/three/34.mp3" "/z/d/three/34.mp3" |-> + Right () + , expect $ CreateDirectory "/z/d/three/four" |-> Right () + , expect $ ListDirectory "/a/b/d/three/four" |-> + Right ["41.mp3", "42.mp3"] + , expect $ GetFileStatus "/a/b/d/three/four/41.mp3" |-> + Right (FileStatus 11 False 4100) + , expect $ GetFileStatus "/a/b/d/three/four/42.mp3" |-> + Right (FileStatus 11 False 4200) + , expect $ + CopyFile "/a/b/d/three/four/41.mp3" "/z/d/three/four/41.mp3" |-> + Right () + , expect $ + CopyFile "/a/b/d/three/four/42.mp3" "/z/d/three/four/42.mp3" |-> + Right () + , expect $ CreateDirectory "/z/d/three/nine" |-> Right () + , expect $ ListDirectory "/a/b/d/three/nine" |-> Right ["ten"] + , expect $ GetFileStatus "/a/b/d/three/nine/ten" |-> + Right (FileStatus 11 True 10000) + , expect $ CreateDirectory "/z/d/three/nine/ten" |-> Right () + , expect $ ListDirectory "/a/b/d/three/nine/ten" |-> + Right ["102.mp3", "101.mp3"] + , expect $ GetFileStatus "/a/b/d/three/nine/ten/102.mp3" |-> + Right (FileStatus 11 False 10200) + , expect $ GetFileStatus "/a/b/d/three/nine/ten/101.mp3" |-> + Right (FileStatus 11 False 10100) + , expect $ + CopyFile + "/a/b/d/three/nine/ten/101.mp3" + "/z/d/three/nine/ten/101.mp3" + |-> Right () + , expect $ + CopyFile + "/a/b/d/three/nine/ten/102.mp3" + "/z/d/three/nine/ten/102.mp3" + |-> Right () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optSync = False + , optSources = NonEmpty.fromList ["d", "c"] + } + +------------------------------------------------------------------------------ + +testLargeScript :: TestTree +testLargeScript = testCase "LargeScript" . runMockT $ do + inSequence + [ expect $ MakeAbsolute "/z" |-> Right "/z" + , expect $ GetFileStatus "/z" |-> Right (FileStatus 10 True 90000) + , expect $ MakeAbsolute "d" |-> Right "/a/b/d" + , expect $ GetFileStatus "/a/b/d" |-> Right (FileStatus 11 True 2000) + , expect $ DoesPathExist "/z/d" |-> Right False + , expect $ MakeAbsolute "c" |-> Right "/a/b/c" + , expect $ GetFileStatus "/a/b/c" |-> Right (FileStatus 11 True 1000) + , expect $ DoesPathExist "/z/c" |-> Right False + , expect $ PutStrLn "mkdir /z/c" |-> () + , expect $ ListDirectory "/a/b/c" |-> Right ["two", "one"] + , expect $ GetFileStatus "/a/b/c/two" |-> + Right (FileStatus 11 True 2000) + , expect $ GetFileStatus "/a/b/c/one" |-> + Right (FileStatus 11 True 1000) + , expect $ PutStrLn "mkdir /z/c/one" |-> () + , expect $ ListDirectory "/a/b/c/one" |-> + Right ["11.mp3", "six", "13.mp3", "eight", "12.mp3", "14.mp3"] + , expect $ GetFileStatus "/a/b/c/one/11.mp3" |-> + Right (FileStatus 11 False 1100) + , expect $ GetFileStatus "/a/b/c/one/six" |-> + Right (FileStatus 11 True 6000) + , expect $ GetFileStatus "/a/b/c/one/13.mp3" |-> + Right (FileStatus 11 False 1300) + , expect $ GetFileStatus "/a/b/c/one/eight" |-> + Right (FileStatus 11 True 8000) + , expect $ GetFileStatus "/a/b/c/one/12.mp3" |-> + Right (FileStatus 11 False 1200) + , expect $ GetFileStatus "/a/b/c/one/14.mp3" |-> + Right (FileStatus 11 False 1400) + , expect $ PutStrLn "cp /a/b/c/one/11.mp3 /z/c/one/11.mp3" |-> () + , expect $ PutStrLn "cp /a/b/c/one/12.mp3 /z/c/one/12.mp3" |-> () + , expect $ PutStrLn "cp /a/b/c/one/13.mp3 /z/c/one/13.mp3" |-> () + , expect $ PutStrLn "cp /a/b/c/one/14.mp3 /z/c/one/14.mp3" |-> () + , expect $ PutStrLn "mkdir /z/c/one/eight" |-> () + , expect $ ListDirectory "/a/b/c/one/eight" |-> + Right ["83.mp3", "81.mp3", "82.mp3"] + , expect $ GetFileStatus "/a/b/c/one/eight/83.mp3" |-> + Right (FileStatus 11 False 8300) + , expect $ GetFileStatus "/a/b/c/one/eight/81.mp3" |-> + Right (FileStatus 11 False 8100) + , expect $ GetFileStatus "/a/b/c/one/eight/82.mp3" |-> + Right (FileStatus 11 False 8200) + , expect $ + PutStrLn "cp /a/b/c/one/eight/81.mp3 /z/c/one/eight/81.mp3" |-> () + , expect $ + PutStrLn "cp /a/b/c/one/eight/82.mp3 /z/c/one/eight/82.mp3" |-> () + , expect $ + PutStrLn "cp /a/b/c/one/eight/83.mp3 /z/c/one/eight/83.mp3" |-> () + , expect $ PutStrLn "mkdir /z/c/one/six" |-> () + , expect $ ListDirectory "/a/b/c/one/six" |-> Right [] + , expect $ PutStrLn "mkdir /z/c/two" |-> () + , expect $ ListDirectory "/a/b/c/two" |-> + Right ["23.mp3", "22.mp3", "seven", "five", "21.mp3"] + , expect $ GetFileStatus "/a/b/c/two/23.mp3" |-> + Right (FileStatus 11 False 2300) + , expect $ GetFileStatus "/a/b/c/two/22.mp3" |-> + Right (FileStatus 11 False 2200) + , expect $ GetFileStatus "/a/b/c/two/seven" |-> + Right (FileStatus 11 True 7000) + , expect $ GetFileStatus "/a/b/c/two/five" |-> + Right (FileStatus 11 True 5000) + , expect $ GetFileStatus "/a/b/c/two/21.mp3" |-> + Right (FileStatus 11 False 2100) + , expect $ PutStrLn "cp /a/b/c/two/21.mp3 /z/c/two/21.mp3" |-> () + , expect $ PutStrLn "cp /a/b/c/two/22.mp3 /z/c/two/22.mp3" |-> () + , expect $ PutStrLn "cp /a/b/c/two/23.mp3 /z/c/two/23.mp3" |-> () + , expect $ PutStrLn "mkdir /z/c/two/five" |-> () + , expect $ ListDirectory "/a/b/c/two/five" |-> Right ["51.mp3"] + , expect $ GetFileStatus "/a/b/c/two/five/51.mp3" |-> + Right (FileStatus 11 False 5100) + , expect $ PutStrLn "cp /a/b/c/two/five/51.mp3 /z/c/two/five/51.mp3" |-> + () + , expect $ PutStrLn "mkdir /z/c/two/seven" |-> () + , expect $ ListDirectory "/a/b/c/two/seven" |-> + Right ["72.mp3", "71.mp3"] + , expect $ GetFileStatus "/a/b/c/two/seven/72.mp3" |-> + Right (FileStatus 11 False 7200) + , expect $ GetFileStatus "/a/b/c/two/seven/71.mp3" |-> + Right (FileStatus 11 False 7100) + , expect $ + PutStrLn "cp /a/b/c/two/seven/71.mp3 /z/c/two/seven/71.mp3" |-> () + , expect $ + PutStrLn "cp /a/b/c/two/seven/72.mp3 /z/c/two/seven/72.mp3" |-> () + , expect $ PutStrLn "mkdir /z/d" |-> () + , expect $ ListDirectory "/a/b/d" |-> Right ["three"] + , expect $ GetFileStatus "/a/b/d/three" |-> + Right (FileStatus 11 True 3000) + , expect $ PutStrLn "mkdir /z/d/three" |-> () + , expect $ ListDirectory "/a/b/d/three" |-> + Right ["32.mp3", "31.mp3", "four", "34.mp3", "nine", "33.mp3"] + , expect $ GetFileStatus "/a/b/d/three/32.mp3" |-> + Right (FileStatus 11 False 3200) + , expect $ GetFileStatus "/a/b/d/three/31.mp3" |-> + Right (FileStatus 11 False 3100) + , expect $ GetFileStatus "/a/b/d/three/four" |-> + Right (FileStatus 11 True 4000) + , expect $ GetFileStatus "/a/b/d/three/34.mp3" |-> + Right (FileStatus 11 False 3400) + , expect $ GetFileStatus "/a/b/d/three/nine" |-> + Right (FileStatus 11 True 9000) + , expect $ GetFileStatus "/a/b/d/three/33.mp3" |-> + Right (FileStatus 11 False 3300) + , expect $ PutStrLn "cp /a/b/d/three/31.mp3 /z/d/three/31.mp3" |-> () + , expect $ PutStrLn "cp /a/b/d/three/32.mp3 /z/d/three/32.mp3" |-> () + , expect $ PutStrLn "cp /a/b/d/three/33.mp3 /z/d/three/33.mp3" |-> () + , expect $ PutStrLn "cp /a/b/d/three/34.mp3 /z/d/three/34.mp3" |-> () + , expect $ PutStrLn "mkdir /z/d/three/four" |-> () + , expect $ ListDirectory "/a/b/d/three/four" |-> + Right ["41.mp3", "42.mp3"] + , expect $ GetFileStatus "/a/b/d/three/four/41.mp3" |-> + Right (FileStatus 11 False 4100) + , expect $ GetFileStatus "/a/b/d/three/four/42.mp3" |-> + Right (FileStatus 11 False 4200) + , expect $ + PutStrLn "cp /a/b/d/three/four/41.mp3 /z/d/three/four/41.mp3" |-> () + , expect $ + PutStrLn "cp /a/b/d/three/four/42.mp3 /z/d/three/four/42.mp3" |-> () + , expect $ PutStrLn "mkdir /z/d/three/nine" |-> () + , expect $ ListDirectory "/a/b/d/three/nine" |-> Right ["ten"] + , expect $ GetFileStatus "/a/b/d/three/nine/ten" |-> + Right (FileStatus 11 True 10000) + , expect $ PutStrLn "mkdir /z/d/three/nine/ten" |-> () + , expect $ ListDirectory "/a/b/d/three/nine/ten" |-> + Right ["102.mp3", "101.mp3"] + , expect $ GetFileStatus "/a/b/d/three/nine/ten/102.mp3" |-> + Right (FileStatus 11 False 10200) + , expect $ GetFileStatus "/a/b/d/three/nine/ten/101.mp3" |-> + Right (FileStatus 11 False 10100) + , expect $ + PutStrLn + "cp /a/b/d/three/nine/ten/101.mp3 /z/d/three/nine/ten/101.mp3" + |-> () + , expect $ + PutStrLn + "cp /a/b/d/three/nine/ten/102.mp3 /z/d/three/nine/ten/102.mp3" + |-> () + ] + assertSuccess <=< Error.run $ run defaultOptions + { optSync = False + , optScript = True + , optSources = NonEmpty.fromList ["d", "c"] + } + +------------------------------------------------------------------------------ + +tests :: TestTree +tests = testGroup "seqcp:Mock" + [ testCaseSensitive + , testCaseSensitiveScript + , testSourcesCaseSensitive + , testSourcesCaseSensitiveScript + , testCaseInsensitive + , testCaseInsensitiveScript + , testSourcesCaseInsensitive + , testSourcesCaseInsensitiveScript + , testFirstNone + , testFirstNoneScript + , testFirstDirs + , testFirstDirsScript + , testSourcesFirstDirs + , testSourcesFirstDirsScript + , testFirstFiles + , testFirstFilesScript + , testSourcesFirstFiles + , testSourcesFirstFilesScript + , testNoSync + , testNoSyncScript + , testOrderNameReverse + , testOrderNameReverseScript + , testSourcesOrderNameReverse + , testSourcesOrderNameReverseScript + , testOrderTime + , testOrderTimeScript + , testSourcesOrderTime + , testSourcesOrderTimeScript + , testOrderTimeReverse + , testOrderTimeReverseScript + , testSourcesOrderTimeReverse + , testSourcesOrderTimeReverseScript + , testOrderRandom + , testOrderRandomScript + , testSourcesOrderRandom + , testSourcesOrderRandomScript + , testVerbose + , testVerboseScript + , testDestinationNotFound + , testDestinationNotDirectory + , testSourceNotFound + , testSourceAbove + , testSourceExists + , testLarge + , testLargeScript + ] diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE CPP #-} + +module Main (main) where + +-- https://hackage.haskell.org/package/tasty +import Test.Tasty (defaultMain, testGroup) + +-- (phatsort:test) +#if __GLASGOW_HASKELL__ >= 806 +import qualified PhatSort.Cmd.PhatSort.Mock +import qualified PhatSort.Cmd.SeqCp.Mock +#endif + +------------------------------------------------------------------------------ + +main :: IO () +main = defaultMain $ testGroup "test" + [ +#if __GLASGOW_HASKELL__ >= 806 + PhatSort.Cmd.PhatSort.Mock.tests + , PhatSort.Cmd.SeqCp.Mock.tests +#endif + ] diff --git a/test/TestLib.hs b/test/TestLib.hs new file mode 100644 --- /dev/null +++ b/test/TestLib.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module TestLib where + +-- https://hackage.haskell.org/package/base +import Control.Monad.IO.Class (MonadIO(liftIO)) +import GHC.Stack (HasCallStack) + +-- https://hackage.haskell.org/package/HMock +import Test.HMock (MockT, makeMockable) + +-- https://hackage.haskell.org/package/MonadRandom +import qualified Control.Monad.Random.Lazy as Rand +import Control.Monad.Random.Lazy (MonadRandom) + +-- https://hackage.haskell.org/package/tasty-hunit +import qualified Test.Tasty.HUnit as HUnit + +-- https://hackage.haskell.org/package/transformers +import Control.Monad.Trans.Class (lift) + +-- (phatsort) +import PhatSort.Monad.FileSystem (MonadFileSystem) +import PhatSort.Monad.Stdio (MonadStdio) +import PhatSort.Monad.Sync (MonadSync) + +------------------------------------------------------------------------------ + +makeMockable [t|MonadFileSystem|] + +makeMockable [t|MonadStdio|] + +makeMockable [t|MonadSync|] + +------------------------------------------------------------------------------ + +instance MonadRandom m => MonadRandom (MockT m) where + getRandomR = lift . Rand.getRandomR + getRandom = lift Rand.getRandom + getRandomRs = lift . Rand.getRandomRs + getRandoms = lift Rand.getRandoms + +------------------------------------------------------------------------------ + +assertSuccess + :: (HasCallStack, MonadIO m) + => Either String () + -> m () +assertSuccess = \case + Right () -> pure () + Left err -> liftIO . HUnit.assertFailure $ "unexpected error: " ++ err + +------------------------------------------------------------------------------ + +assertError + :: (HasCallStack, MonadIO m) + => String -- ^ expected error message + -> Either String () + -> m () +assertError expected = \case + Left err + | err == expected -> pure () + | otherwise -> liftIO . HUnit.assertFailure $ unlines + [ "unexpected error message" + , " expected: " ++ expected + , " but got: " ++ err + ] + Right () -> liftIO . HUnit.assertFailure $ unlines + [ "unexpected success" + , " expected error message: " ++ expected + ]