directory-contents 0.2.0.0 → 0.2.0.1

raw patch · 4 files changed

+75/−6 lines, 4 filesdep +coquinadep +heredep +processdep ~directorydep ~textdep ~witherablePVP ok

version bump matches the API change (PVP)

Dependencies added: coquina, here, process

Dependency ranges changed: directory, text, witherable

API changes (from Hackage documentation)

Files

CHANGELOG.md +5/−0
directory-contents.cabal +3/−3
src/System/Directory/Contents.hs +3/−2
test/Test.hs +64/−1

CHANGELOG.md view

@@ -1,11 +1,16 @@ # Revision history for directory-contents +## 0.2.0.1++* Create test data rather than relying on fixtures, since it's hard to include these fixtures when using cabal sdist.+ ## 0.2.0.0  * Add `Data.Data` instance for `DirTree` and `Symlink` * Add `System.Directory.Contents.Zipper` for convenient navigation and modification of directory contents * Add more examples to readme * Breaking change: `DirTree_Dir` and `Symlink_External` child nodes are now stored as a `Map`+* Fix: buildDirTree fails as a file gets deleted quickly.  ## 0.1.0.0

directory-contents.cabal view

@@ -1,6 +1,6 @@ cabal-version:      >=1.10 name:               directory-contents-version:            0.2.0.0+version:            0.2.0.1 synopsis:           Recursively build, navigate, and operate on a tree of directory contents. description:   Like the linux tree command, this library recursively constructs a tree of directory contents while detecting and avoiding symlink cycles. It also provides functions for operating on and navigating the contents.@@ -30,7 +30,7 @@     , filepath     >=1.4  && <1.5     , text         >=1.2  && <1.3     , transformers >=0.5  && <0.6-    , witherable   >=0.3  && <0.4+    , witherable   >=0.3  && <0.5    hs-source-dirs:   src   default-language: Haskell2010@@ -48,7 +48,7 @@  test-suite directory-contents-test   type: exitcode-stdio-1.0-  build-depends: base, directory-contents, filepath+  build-depends: base, directory-contents, filepath, process, coquina, directory, text, here   default-language: Haskell2010   hs-source-dirs: test   main-is: Test.hs

src/System/Directory/Contents.hs view

@@ -128,7 +128,8 @@       canon <- canonicalizePath path       isPath <- doesPathExist path       isDir <- doesDirectoryExist path-      isSym <- pathIsSymbolicLink path+      let pathExists = isPath || isDir+      isSym <- if pathExists then fmap Just (pathIsSymbolicLink path) else pure Nothing       subpaths <- if isDir then listDirectory path else pure []       subcanons <- mapM canonicalizePath <=<         filterM (fmap not . pathIsSymbolicLink) $ (path </>) <$> subpaths@@ -136,7 +137,7 @@           buildSubpaths = catMaybes <$> mapM             (build (Map.insert canon path seen') . (path </>)) subpaths       if | not isPath -> pure Nothing-         | isSym -> case Map.lookup canon seen' of+         | isSym == Just True -> case Map.lookup canon seen' of              Nothing -> do                s <- getSymbolicLinkTarget path                Just . DirTree_Symlink path . Symlink_External s . fileNameMap <$> buildSubpaths

test/Test.hs view

@@ -1,14 +1,77 @@+{-# Language QuasiQuotes #-}+import Control.Monad.IO.Class+import Coquina import Data.Maybe+import Data.String.Here+import Data.Text (Text)+import System.Directory import System.Directory.Contents import System.Directory.Contents.Zipper import System.Exit import System.FilePath+import System.Process  main :: IO () main = do+  _ <- setup test1+  return ()++readme_md = [here|+This test directory tree has the following structure:+```+.+├── a -> A/a+├── A+│   ├── a+│   ├── A -> ../A  [recursive, not followed]+│   └── B -> ../B+│       ├── A -> ../A  [recursive, not followed]+│       └── b+├── B+│   ├── A -> ../A  [recursive, not followed]+│   └── b+└── README.md++6 directories, 5 files+```+|]++-- | Annoying that we have to set it up this way, but there doesn't seem+-- to be any good way to include the symlinks we want as test fixtures+-- in cabal.+--+-- This function will manually recreate the contents of test/fixtures+setup :: (FilePath -> IO ()) -> IO (Text, Text, Either Int ())+setup testRunner = runShell $ do+  inTempDirectory "directory-contents-test" $ \fp -> do+    let fixtures = fp </> "test" </> "fixtures"+        test1 = fixtures </> "test-1"+        test2 = fixtures </> "test-2"+    run $ proc "mkdir" ["-p", fixtures]+    run $ proc "mkdir" ["-p", test1]+    run $ proc "mkdir" ["-p", test2]+    liftIO $ do+      writeFile (fixtures </> "test-1" </> "README.md") readme_md+      writeFile (fixtures </> "test-2" </> "rocket") "🚀"+    run $ proc "mkdir" ["-p", test1 </> "A"]+    run $ proc "touch" [test1 </> "A" </> "a"]+    run $ proc "mkdir" ["-p", test1 </> "B"]+    run $ proc "touch" [test1 </> "B" </> "b"]+    run $ proc "mkdir" ["-p", test1 </> "C"]+    run $ proc "ln" ["-s", "../A", test1 </> "A" </> "A"]+    run $ proc "ln" ["-s", "../B", test1 </> "A" </> "B"]+    run $ proc "ln" ["-s", "../A", test1 </> "B" </> "A"]+    run $ proc "ln" ["-s", "../README.md", test1 </> "C" </> "info.md"]+    run $ proc "ln" ["-s", "../test-2", test1 </> "D"]+    run $ proc "ln" ["-s", "D/rocket", test1 </> "d_rocket"]+    run $ proc "ln" ["-s", "../test-2/rocket", test1 </> "rocket"]+    liftIO $ testRunner test1++test1 :: FilePath -> IO ()+test1 fp = do   p <- test     "Build DirTree in the presence of recursive symlinks"-    (buildDirTree "test/fixtures/test-1")+    (buildDirTree fp)   test     "Navigate to a directory that should exist"     (pure $ walkContents "C" p)