add move moveFile

Author: safareli

src/Pathy.purs

@@ -7,7 +7,7 @@ module Pathy
   , module Pathy.Sandboxed
   ) where
 
-import Pathy.Path (AbsDir, AbsFile, AbsPath, AnyPath, AnyDir, AnyFile, Path, RelDir, RelFile, RelPath, appendPath, currentDir, dir, dir', extendPath, file, file', in', fileName, foldPath, name, parentAppend, parentOf, peel, peelFile, refine, relativeTo, rename, renameTraverse, rootDir, setExtension, (<..>), (<.>), (</>))
+import Pathy.Path (AbsDir, AbsFile, AbsPath, AnyPath, AnyDir, AnyFile, Path, RelDir, RelFile, RelPath, appendPath, currentDir, dir, dir', extendPath, file, file', in', fileName, foldPath, name, parentAppend, move, moveFile, parentOf, peel, peelFile, refine, relativeTo, rename, renameTraverse, rootDir, setExtension, (<..>), (<.>), (</>))
 import Pathy.Name (Name(..), joinName, splitName, alterExtension, extension)
 import Pathy.Printer (Escaper(..), Printer, debugPrintPath, posixPrinter, printPath, unsafePrintPath, windowsPrinter)
 import Pathy.Parser (Parser(..), parseAbsDir, parseAbsFile, parsePath, parseRelDir, parseRelFile, posixParser)

src/Pathy/Gen.purs

@@ -6,6 +6,8 @@ module Pathy.Gen
   , genRelFilePath
   , genRelAnyPath
   , genName
+  , genDirName
+  , genFileName
   ) where
 
 import Prelude
@@ -20,14 +22,20 @@ import Data.List as L
 import Data.NonEmpty ((:|))
 import Data.String.Gen as SG
 import Data.String.NonEmpty (cons)
-import Pathy (AbsDir, AbsFile, AbsPath, Dir, RelDir, RelFile, RelPath, (</>))
+import Pathy (AbsDir, AbsFile, AbsPath, Dir, File, RelDir, RelFile, RelPath, (</>))
 import Pathy as P
 
 genName ∷ ∀ m a. MonadGen m ⇒ MonadRec m ⇒ m (P.Name a)
 genName = map P.Name $ cons <$> genChar <*> SG.genString genChar
   where
   genChar = Gen.oneOf $ CG.genDigitChar :| [CG.genAlpha]
 
+genDirName :: ∀ m. MonadGen m ⇒ MonadRec m ⇒ m (P.Name Dir)
+genDirName = genName
+
+genFileName :: ∀ m. MonadGen m ⇒ MonadRec m ⇒ m (P.Name File)
+genFileName = genName
+
 genAbsDirPath :: forall m. MonadGen m => MonadRec m => m AbsDir
 genAbsDirPath = Gen.sized \size → do
   newSize ← Gen.chooseInt 0 size

src/Pathy/Path.purs

@@ -20,6 +20,8 @@ module Pathy.Path
   , extendPath
   , appendPath, (</>)
   , parentAppend, (<..>)
+  , move
+  , moveFile
   , foldPath
   , peel
   , peelFile
@@ -179,6 +181,28 @@ parentAppend d p = parentOf d </> p
 
 infixl 6 parentAppend as <..>
 
+-- | Moves path by putting target path before the last segment
+-- |
+-- | ``` purescript
+-- | move (h </> in' n) target == Just (h </> target </> in' n)
+-- | ```
+-- | In case input is `rootDir` or `currentDir`, `Nothing` will be returned
+move ∷ ∀ a b. IsRelOrAbs a ⇒ IsDirOrFile b ⇒ Path a b → Path Rel Dir → Maybe (Path a b)
+move p t = onDirOrFile
+  (\coe dir → peel dir <#> \(Tuple root name) → coe $ root </> t </> in' name)
+  (\coe file → Just $ coe $ moveFile file t)
+  p
+
+-- | Moves file path by putting target path before the file segment
+-- |
+-- | ``` purescript
+-- | moveFile (h </> file' n) target == h </> target </> file' n
+-- | ```
+moveFile ∷ ∀ a. IsRelOrAbs a ⇒ Path a File → Path Rel Dir → Path a File
+moveFile p t =
+  let (Tuple root name) = peelFile p
+  in root </> t </> in' name
+
 -- | A fold over `Path`s. Since `Path` has private constructors, this allows for
 -- | functions to be written over its constructors, similar to a total pattern
 -- | match.

test/Main.purs

@@ -13,7 +13,8 @@ import Data.String.NonEmpty (NonEmptyString)
 import Data.String.NonEmpty as NES
 import Data.Symbol (SProxy(..))
 import Data.Tuple (Tuple(..))
-import Pathy (class IsDirOrFile, class IsRelOrAbs, Abs, Dir, Name(..), Path, Rel, alterExtension, currentDir, debugPrintPath, dir, extension, file, in', joinName, parentOf, parseAbsDir, parseAbsFile, parseRelDir, parseRelFile, peel, posixParser, posixPrinter, printPath, relativeTo, rename, rootDir, sandbox, sandboxAny, splitName, unsandbox, windowsPrinter, (<..>), (<.>), (</>))
+import Pathy (class IsDirOrFile, class IsRelOrAbs, Abs, Dir, File, Name(..), Path, Rel, alterExtension, currentDir, debugPrintPath, dir, extension, file, file', in', joinName, move, moveFile, parentOf, parseAbsDir, parseAbsFile, parseRelDir, parseRelFile, peel, posixParser, posixPrinter, printPath, relativeTo, rename, rootDir, sandbox, sandboxAny, splitName, unsandbox, windowsPrinter, (<..>), (<.>), (</>))
+import Pathy.Gen (genName)
 import Pathy.Gen as PG
 import Pathy.Name (reflectName)
 import Test.QuickCheck ((===))
@@ -101,6 +102,34 @@ checkPeelIn gen = do
   p <- gen
   pure $ p === maybe p (\(Tuple r n) -> r </> in' n) (peel p)
 
+checkMove
+  :: forall b a
+  . IsRelOrAbs a
+  => IsDirOrFile b
+  => Gen.Gen (Path a Dir)
+  -> Gen.Gen (Name b)
+  -> Gen.Gen (Path Rel Dir)
+  -> Gen.Gen QC.Result
+checkMove genRoot genName genTarget = do
+  h <- genRoot
+  n <- genName
+  target <- genTarget
+  pure $ move (h </> in' n) target === Just (h </> target </> in' n)
+
+checkMoveFile
+  :: forall a b
+  . IsRelOrAbs a
+  => Gen.Gen (Path a Dir)
+  -> Gen.Gen (Name File)
+  -> Gen.Gen (Path Rel Dir)
+  -> Gen.Gen QC.Result
+checkMoveFile genRoot genName genTarget = do
+  h <- genRoot
+  n <- genName
+  target <- genTarget
+  pure $ moveFile (h </> file' n) target === (h </> target </> file' n)
+
+
 checkRelative :: forall b. IsDirOrFile b => Gen.Gen (Path Abs b) -> Gen.Gen QC.Result
 checkRelative gen = do
   p1 <- gen
@@ -124,6 +153,12 @@ main = do
   info "checking `parse <<< print` for `AbsFile`" *> QC.quickCheck parsePrintAbsFilePath
   info "checking `parse <<< print` for `RelDir`" *> QC.quickCheck parsePrintRelDirPath
   info "checking `parse <<< print` for `RelFile`" *> QC.quickCheck parsePrintRelFilePath
+  info "checking `move (absPath </> file' n) target == Just (absPath </> target </> file' n)`" *> QC.quickCheck (checkMove PG.genAbsDirPath PG.genFileName PG.genRelDirPath)
+  info "checking `move (relPath </> file' n) target == Just (relPath </> target </> file' n)`" *> QC.quickCheck (checkMove PG.genRelDirPath PG.genFileName PG.genRelDirPath)
+  info "checking `move (absPath </> dir' n) target == Just (absPath </> target </> dir' n)`" *> QC.quickCheck (checkMove PG.genAbsDirPath PG.genDirName PG.genRelDirPath)
+  info "checking `move (relPath </> dir' n) target == Just (relPath </> target </> dir' n)`" *> QC.quickCheck (checkMove PG.genRelDirPath PG.genDirName PG.genRelDirPath)
+  info "checking `moveFile (absPath </> file' n) target == absPath </> target </> file' n`" *> QC.quickCheck (checkMoveFile PG.genAbsDirPath genName PG.genRelDirPath)
+  info "checking `moveFile (relPath </> file' n) target == relPath </> target </> file' n`" *> QC.quickCheck (checkMoveFile PG.genRelDirPath genName PG.genRelDirPath)
   info "checking `relativeTo` for `AbsDir`" *> QC.quickCheck (checkRelative PG.genAbsDirPath)
   info "checking `relativeTo` for `AbsFile`" *> QC.quickCheck (checkRelative PG.genAbsFilePath)
   info "checking `p === maybe p (\\(Tuple r n) -> r </> in' n) (peel p)` for `AbsDir`" *> QC.quickCheck (checkPeelIn PG.genAbsDirPath)