directory-contents 0.1.0.0 → 0.2.0.0

raw patch · 8 files changed

+494/−98 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• README.lhs +48/−1
• README.md +48/−1
• directory-contents.cabal +18/−21
• src/System/Directory/Contents.hs +88/−74
• src/System/Directory/Contents/Types.hs +82/−0
• src/System/Directory/Contents/Zipper.hs +190/−0
• test/Test.hs +13/−1

@@ -1,5 +1,12 @@ # Revision history for directory-contents +## 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`+ ## 0.1.0.0  * Build recursive directory trees and try to avoid symlink cycles. Includes functions to walk a directory tree, filter it, and display it.

@@ -2,7 +2,8 @@ ================== [![Haskell](https://img.shields.io/badge/language-Haskell-orange.svg)](https://haskell.org) [![Hackage](https://img.shields.io/hackage/v/directory-contents.svg)](https://hackage.haskell.org/package/directory-contents) [![Hackage CI](https://matrix.hackage.haskell.org/api/v2/packages/directory-contents/badge)](https://matrix.hackage.haskell.org/#/package/directory-contents) [![Github CI](https://github.com/obsidiansystems/directory-contents/workflows/github-action/badge.svg)](https://github.com/obsidiansystems/directory-contents/actions) [![BSD3 License](https://img.shields.io/badge/license-BSD3-blue.svg)](https://github.com/obsidiansystems/directory-contents/blob/master/LICENSE) -Recursively list the contents of a directory while avoiding symlink loops.+Recursively list, operate on, and navigate the contents of a directory while+avoiding symlink loops.  Description -----------@@ -26,14 +27,36 @@ > import Data.List > import qualified Data.Text as T > import System.Directory.Contents+> import System.Directory.Contents.Zipper > import System.FilePath > > main :: IO () > main = do++```+Building a directory tree is easy. Just call `buildDirTree` on a path of your+choice. It'll recursively enumerate the contents of the directories. If it+encounters symlinks, it'll follow those symlinks if it hasn't yet encountered+the target of the symlink. If it has, it'll store a reference to that+already-seen target.++```haskell+ >   mp <- buildDirTree "." >   case mp of >     Nothing -> putStrLn "Couldn't find that path." >     Just p -> do++```+Once you've got a `DirTree` you can fmap, traverse, filter, or+[wither](https://hackage.haskell.org/package/witherable-class) it to transform+it however you like.++Note that the filtering operations generally do not remove empty directories.+You have to call `pruneDirTree` to do that.++```haskell+ >       let f = pruneDirTree =<< filterDirTree ((`elem` [".hs", ".lhs"]) . takeExtension) p >       putStrLn $ case f of >         Nothing -> "No haskell source files found."@@ -44,6 +67,30 @@ >           , "Haskell source files:" >           , intercalate ", " $ F.toList hs >           ]++```++You can also use the provided `DirZipper` to browse your directory hierarchy and make+changes wherever you like.++```haskell++>       let printFocused =  maybe+>             (putStrLn "Couldn't find navigation target")+>             (printDirTree . focused)+>+>       putStrLn "Navigating down to src/System/Directory:"+>       printFocused $+>         downTo "Directory" =<< downTo "System" =<< downTo "src" (zipped p)+>+>       putStrLn "Navigating using a path containing \"..\":"+>       printFocused $+>           followRelative "./src/../src/System/Directory" (zipped p)+>+>       putStrLn "Removing the src/System directory. The src folder is now empty"+>       putStrLn "(note that this doesn't change the actual files):"+>       printFocused $+>         remove =<< followRelative "./src/System" (zipped p) >  ```

@@ -2,7 +2,8 @@ ================== [![Haskell](https://img.shields.io/badge/language-Haskell-orange.svg)](https://haskell.org) [![Hackage](https://img.shields.io/hackage/v/directory-contents.svg)](https://hackage.haskell.org/package/directory-contents) [![Hackage CI](https://matrix.hackage.haskell.org/api/v2/packages/directory-contents/badge)](https://matrix.hackage.haskell.org/#/package/directory-contents) [![Github CI](https://github.com/obsidiansystems/directory-contents/workflows/github-action/badge.svg)](https://github.com/obsidiansystems/directory-contents/actions) [![BSD3 License](https://img.shields.io/badge/license-BSD3-blue.svg)](https://github.com/obsidiansystems/directory-contents/blob/master/LICENSE) -Recursively list the contents of a directory while avoiding symlink loops.+Recursively list, operate on, and navigate the contents of a directory while+avoiding symlink loops.  Description -----------@@ -26,14 +27,36 @@ > import Data.List > import qualified Data.Text as T > import System.Directory.Contents+> import System.Directory.Contents.Zipper > import System.FilePath > > main :: IO () > main = do++```+Building a directory tree is easy. Just call `buildDirTree` on a path of your+choice. It'll recursively enumerate the contents of the directories. If it+encounters symlinks, it'll follow those symlinks if it hasn't yet encountered+the target of the symlink. If it has, it'll store a reference to that+already-seen target.++```haskell+ >   mp <- buildDirTree "." >   case mp of >     Nothing -> putStrLn "Couldn't find that path." >     Just p -> do++```+Once you've got a `DirTree` you can fmap, traverse, filter, or+[wither](https://hackage.haskell.org/package/witherable-class) it to transform+it however you like.++Note that the filtering operations generally do not remove empty directories.+You have to call `pruneDirTree` to do that.++```haskell+ >       let f = pruneDirTree =<< filterDirTree ((`elem` [".hs", ".lhs"]) . takeExtension) p >       putStrLn $ case f of >         Nothing -> "No haskell source files found."@@ -44,6 +67,30 @@ >           , "Haskell source files:" >           , intercalate ", " $ F.toList hs >           ]++```++You can also use the provided `DirZipper` to browse your directory hierarchy and make+changes wherever you like.++```haskell++>       let printFocused =  maybe+>             (putStrLn "Couldn't find navigation target")+>             (printDirTree . focused)+>+>       putStrLn "Navigating down to src/System/Directory:"+>       printFocused $+>         downTo "Directory" =<< downTo "System" =<< downTo "src" (zipped p)+>+>       putStrLn "Navigating using a path containing \"..\":"+>       printFocused $+>           followRelative "./src/../src/System/Directory" (zipped p)+>+>       putStrLn "Removing the src/System directory. The src folder is now empty"+>       putStrLn "(note that this doesn't change the actual files):"+>       printFocused $+>         remove =<< followRelative "./src/System" (zipped p) >  ```

@@ -1,9 +1,9 @@ cabal-version:      >=1.10 name:               directory-contents-version:            0.1.0.0-synopsis:           Recursively build a tree of directory contents.+version:            0.2.0.0+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.+  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.  bug-reports:   https://github.com/obsidiansystems/directory-contents/issues@@ -21,14 +21,16 @@  library   exposed-modules:  System.Directory.Contents+                    System.Directory.Contents.Types+                    System.Directory.Contents.Zipper   build-depends:-      base          >=4.12 && <4.15-    , containers    >=0.6  && <0.7-    , directory     >=1.3  && <1.4-    , filepath      >=1.4  && <1.5-    , text          >=1.2  && <1.3-    , transformers  >=0.5  && <0.6-    , witherable    >=0.3  && <0.4+      base         >=4.12 && <4.15+    , containers   >=0.6  && <0.7+    , directory    >=1.3  && <1.4+    , filepath     >=1.4  && <1.5+    , text         >=1.2  && <1.3+    , transformers >=0.5  && <0.6+    , witherable   >=0.3  && <0.4    hs-source-dirs:   src   default-language: Haskell2010@@ -40,21 +42,16 @@     , directory-contents     , filepath     , text--  main-is:          README.lhs+  main-is: README.lhs   default-language: Haskell2010-  ghc-options:      -Wall -optL -q+  ghc-options: -Wall -optL -q  test-suite directory-contents-test-  type:             exitcode-stdio-1.0-  build-depends:-      base-    , directory-contents-    , filepath-+  type: exitcode-stdio-1.0+  build-depends: base, directory-contents, filepath   default-language: Haskell2010-  hs-source-dirs:   test-  main-is:          Test.hs+  hs-source-dirs: test+  main-is: Test.hs  source-repository head   type:     git

@@ -1,11 +1,9 @@-{-# language DeriveFoldable #-}-{-# language DeriveFunctor #-}-{-# language DeriveGeneric #-}-{-# language DeriveTraversable #-}-{-# language LambdaCase #-}-{-# language MultiWayIf #-}-{-# language ScopedTypeVariables #-}-+{-# Language DeriveFoldable #-}+{-# Language DeriveFunctor #-}+{-# Language DeriveTraversable #-}+{-# Language FlexibleContexts #-}+{-# Language LambdaCase #-}+{-# Language MultiWayIf #-} {-| Description:   Recursively list the contents of a directory while avoiding@@ -18,8 +16,48 @@ In addition to building the directory-contents tree, this module provides facilities for filtering, displaying, and navigating the directory hierarchy. +See 'System.Directory.Contents.Zipper.DirZipper' for zipper-based navigation.+ -}-module System.Directory.Contents where+module System.Directory.Contents +  (+  -- * Directory hierarchy tree+    DirTree(..)+  , Symlink(..)+  , FileName+  -- ** Constructing directory trees+  , buildDirTree+  , dereferenceSymlinks+  -- ** Lower level tree construction+  -- *** Extracting basic file information+  , filePath+  , fileName+  -- *** Building and manipulating a map of sibling files+  , fileNameMap+  , insertSibling+  , removeSibling+  , withFirstChild+  -- * Basic directory tree navigation+  , walkDirTree+  , walkContents+  -- * Filtering a directory tree+  , pruneDirTree+  , DirTreeMaybe(..)+  , withDirTreeMaybe+  , withDirTreeMaybeF+  , witherDirTree+  , filterADirTree+  , mapMaybeDirTree+  , catMaybesDirTree+  , filterDirTree+  -- * Displaying a directory tree+  , drawDirTree+  , drawDirTreeWith+  , printDirTree+  -- * Miscellaneous+  , mkRelative+  , alternative+  ) where  import Control.Applicative import Control.Monad@@ -27,40 +65,20 @@ import Data.List import qualified Data.Map as Map import Data.Monoid+import Data.Set (Set)+import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T import Data.Tree as DataTree import Data.Witherable-import GHC.Generics import System.Directory import System.FilePath --- | The contents of a directory, represented as a tree. See 'Symlink' for--- special handling of symlinks.-data DirTree a-  = DirTree_Dir FilePath [DirTree a]-  | DirTree_File FilePath a-  | DirTree_Symlink FilePath (Symlink a)-  deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable, Generic)+import System.Directory.Contents.Types+import System.Directory.Contents.Zipper --- | Symlink cycles are prevented by separating symlinks into two categories:--- those that point to paths already within the directory hierarchy being--- recursively listed, and those that are not. In the former case, rather than--- following the symlink and listing the target redundantly, we simply store--- the symlink reference itself. In the latter case, we treat the symlink as we--- would any other folder and produce a list of its contents.------ The 'String' argument represents the symlink reference (e.g., "../somefile").--- In the 'Symlink_Internal' case, the second ('FilePath') argument is the path--- to the symlink target.--- In the 'Symlink_External' case, the second (@[DirTree a]@) argument contains--- the contents of the symlink target.-data Symlink a-  = Symlink_Internal String FilePath-  | Symlink_External String [DirTree a]-  deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable, Generic)+-- * Construct --- * Constructing a tree -- | Recursively list the contents of a 'FilePath', representing the results as -- a hierarchical 'DirTree'. This function should produce results similar to -- the linux command @tree -l@.@@ -81,7 +99,7 @@ -- > └── C -> ../C -- >     └── c ----- this function will produce the following (as rendererd by 'drawDirTree'):+-- this function will produce the following (as rendered by 'drawDirTree'): -- -- > test -- > |@@ -121,7 +139,7 @@          | isSym -> case Map.lookup canon seen' of              Nothing -> do                s <- getSymbolicLinkTarget path-               Just . DirTree_Symlink path . Symlink_External s <$> buildSubpaths+               Just . DirTree_Symlink path . Symlink_External s . fileNameMap <$> buildSubpaths              Just _ -> do                target <- getSymbolicLinkTarget path                canonRoot <- canonicalizePath root@@ -129,7 +147,7 @@                canonSym <- canonicalizePath $ takeDirectory path </> target                pure $ Just $ DirTree_Symlink path $ Symlink_Internal target $                 startingPoint </> mkRelative canonRoot canonSym-         | isDir -> Just . DirTree_Dir path <$> buildSubpaths+         | isDir -> Just . DirTree_Dir path . fileNameMap <$> buildSubpaths          | otherwise -> pure $ Just $ DirTree_File path path  -- | De-reference one layer of symlinks@@ -174,13 +192,14 @@       DirTree_Dir p xs -> DirTree_Dir p <$> mapM (deref top) xs       DirTree_File p x -> pure $ DirTree_File p x       DirTree_Symlink p sym -> case sym of-        Symlink_External _ paths -> case paths of-          [] -> do-            isDir <- doesDirectoryExist p-            pure $ if isDir-              then DirTree_Dir p []-              else DirTree_File p p-          ps -> pure $ DirTree_Dir p ps+        Symlink_External _ paths ->+          if Map.null paths+            then do+              isDir <- doesDirectoryExist p+              pure $ if isDir+                then DirTree_Dir p Map.empty+                else DirTree_File p p+            else pure $ DirTree_Dir p paths         Symlink_Internal _ r -> do           let startingPoint = takeFileName $ filePath top           let target = walkDirTree (startingPoint </> r) top@@ -204,7 +223,8 @@ -- > `- Contents.hs -- -- This function does not dereference symlinks, nor does it handle the special--- paths @.@ and @..@.+-- paths @.@ and @..@. For more advanced navigation, including handling of special+-- paths, see 'System.Directory.Contents.Zipper.DirZipper'. walkDirTree :: FilePath -> DirTree a -> Maybe (DirTree a) walkDirTree target p =   let pathSegments = splitDirectories target@@ -212,14 +232,14 @@       walk [] path = Just path       walk (c : gc) path = case path of         DirTree_Dir a xs-          | takeFileName a == c -> alternative $ walk gc <$> xs+          | takeFileName a == c -> alternative $ walk gc <$> Map.elems xs         DirTree_File a f           | takeFileName a == c && null gc -> Just $ DirTree_File a f         DirTree_Symlink a (Symlink_Internal s t)           | takeFileName a == c && null gc -> Just $ DirTree_Symlink a             (Symlink_Internal s t)         DirTree_Symlink a (Symlink_External _ xs)-          | takeFileName a == c -> alternative $ walk gc <$> xs+          | takeFileName a == c -> alternative $ walk gc <$> Map.elems xs         _ -> Nothing   in walk pathSegments p @@ -238,15 +258,11 @@ -- > Directory -- > | -- > `- Contents.hs+--+--For more advanced navigation, see+--'System.Directory.Contents.Zipper.DirZipper'. walkContents :: FilePath -> DirTree a -> Maybe (DirTree a)-walkContents p = \case-  DirTree_Dir _ xs -> walkSub xs-  DirTree_File _ _ -> Nothing-  DirTree_Symlink _ (Symlink_External _ xs) -> walkSub xs-  DirTree_Symlink _ (Symlink_Internal _ _) -> Nothing-  where-    walkSub :: [DirTree a] -> Maybe (DirTree a)-    walkSub xs = getAlt $ mconcat $ Alt . walkDirTree p <$> xs+walkContents p = fmap focused . followRelative p . zipped  -- * Filter -- | This wrapper really just represents the no-path/empty case so that@@ -257,28 +273,33 @@ instance Filterable DirTreeMaybe where   catMaybes (DirTreeMaybe Nothing) = DirTreeMaybe Nothing   catMaybes (DirTreeMaybe (Just x)) = DirTreeMaybe $ do-    let go :: DirTree (Maybe a) -> Writer [FilePath] (Maybe (DirTree a))+    let go :: DirTree (Maybe a) -> Writer (Set FilePath) (Maybe (DirTree a))         go = \case           DirTree_Dir p xs -> do             out <- mapM go xs             pure $ Just $ DirTree_Dir p $ catMaybes out           DirTree_File p f -> case f of-            Nothing -> tell [p] >> pure Nothing+            Nothing -> tell (Set.singleton p) >> pure Nothing             Just f' -> pure $ Just $ DirTree_File p f'           DirTree_Symlink p (Symlink_External s xs) -> do             out <- mapM go xs             pure $ Just $ DirTree_Symlink p (Symlink_External s $ catMaybes out)           DirTree_Symlink p (Symlink_Internal s r) -> pure $              Just $ DirTree_Symlink p (Symlink_Internal s r)-        removeStaleSymlinks :: [FilePath] -> DirTree a -> Maybe (DirTree a)-        removeStaleSymlinks xs = \case+        removeStaleSymlinks :: Set FilePath -> DirTree a -> Maybe (DirTree a)+        removeStaleSymlinks xs d = case d of           DirTree_Symlink p (Symlink_Internal s r) ->-            let startingPoint = takeDirectory $ filePath x+            let startingPoint = case takeDirectory $ filePath x of+                  "." -> ""+                  a -> a             in-              if (startingPoint </> r) `elem` xs+              if (startingPoint </> r) `Set.member` xs               then Nothing               else Just $ DirTree_Symlink p (Symlink_Internal s r)-          DirTree_Symlink p s -> Just $ DirTree_Symlink p s+          DirTree_Symlink p (Symlink_External s cs) ->+            if Map.null cs && Set.member (filePath x </> s) xs+            then Nothing+            else Just $ DirTree_Symlink p (Symlink_External s cs)           DirTree_File p f -> Just $ DirTree_File p f           DirTree_Dir p fs -> Just $ DirTree_Dir p $             catMaybes $ removeStaleSymlinks xs <$> fs@@ -346,9 +367,9 @@   DirTree_Symlink a (Symlink_Internal s t) ->     Just $ DirTree_Symlink a (Symlink_Internal s t)   where-    sub c xs = case mapMaybe pruneDirTree xs of-      [] -> Nothing-      ys -> Just $ c ys+    sub c xs =+      let ys = mapMaybe pruneDirTree xs+      in if Map.null ys then Nothing else Just $ c ys  -- * Display -- | Produces a tree drawing (using only text) of a 'DirTree' hierarchy.@@ -363,11 +384,11 @@       DirTree_File p a ->         DataTree.Node (f (takeFileName p) a) []       DirTree_Dir p ps ->-        DataTree.Node (takeFileName p) $ pathToTree <$> ps+        DataTree.Node (takeFileName p) $ pathToTree <$> Map.elems ps       DirTree_Symlink p (Symlink_Internal s _) ->         DataTree.Node (showSym p s) []       DirTree_Symlink p (Symlink_External s xs) ->-        DataTree.Node (showSym p s) $ pathToTree <$> xs+        DataTree.Node (showSym p s) $ pathToTree <$> Map.elems xs     showSym p s = takeFileName p <> " -> " <> s  -- | Print the 'DirTree' as a tree. For example:@@ -398,10 +419,3 @@ -- | Get the first 'Alternative' alternative :: Alternative f => [f a] -> f a alternative = getAlt . mconcat . fmap Alt---- | Extract the 'FilePath' from a 'DirTree' node-filePath :: DirTree a -> FilePath-filePath = \case-  DirTree_Dir f _ -> f-  DirTree_File f _ -> f-  DirTree_Symlink f _ -> f

@@ -0,0 +1,82 @@+{-# language DeriveDataTypeable #-}+{-# language DeriveFoldable #-}+{-# language DeriveFunctor #-}+{-# language DeriveGeneric #-}+{-# language DeriveTraversable #-}+{-# language LambdaCase #-}+{-|+Description:+  Contains the tree data structure used to store directory hierarchies+-}+module System.Directory.Contents.Types where++import Data.Data+import Data.Map (Map)+import qualified Data.Map as Map+import GHC.Generics+import System.FilePath++-- | The contents of a directory, represented as a tree. See 'Symlink' for+-- special handling of symlinks.+data DirTree a+  = DirTree_Dir FilePath (Map FileName (DirTree a))+  | DirTree_File FilePath a+  | DirTree_Symlink FilePath (Symlink a)+  deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable, Generic, Data)++-- | Symlink cycles are prevented by separating symlinks into two categories:+-- those that point to paths already within the directory hierarchy being+-- recursively listed, and those that are not. In the former case, rather than+-- following the symlink and listing the target redundantly, we simply store+-- the symlink reference itself. In the latter case, we treat the symlink as we+-- would any other folder and produce a list of its contents.+--+-- The 'String' argument represents the symlink reference (e.g., "../somefile").+-- In the 'Symlink_Internal' case, the second ('FilePath') argument is the path+-- to the symlink target.+-- In the 'Symlink_External' case, the second (@[DirTree a]@) argument contains+-- the contents of the symlink target.+data Symlink a+  = Symlink_Internal String FilePath+  | Symlink_External String (Map FileName (DirTree a))+  deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable, Generic, Data)++-- * Utilities++-- | Extract the 'FilePath' from a 'DirTree' node+filePath :: DirTree a -> FilePath+filePath = \case+  DirTree_Dir f _ -> f+  DirTree_File f _ -> f+  DirTree_Symlink f _ -> f++-- | File names, as opposed to file paths, are used to uniquely identify+-- siblings at each level+type FileName = String++-- | Generate the key used to identify siblings+fileName :: DirTree a -> FileName+fileName = takeFileName . filePath++-- | Construct a map of files indexed by filename. Should only be used for a+-- particular generation or level in the directory hierarchy (since that's the+-- only time we can be sure that names are unique)+fileNameMap :: [DirTree a] -> Map FileName (DirTree a)+fileNameMap xs = Map.fromList $ zip (fileName <$> xs) xs++-- | Add a sibling to a map of files+insertSibling :: DirTree a -> Map FileName (DirTree a) -> Map FileName (DirTree a)+insertSibling a = Map.insert (fileName a) a++-- | Remove sibling from a map of files+removeSibling :: DirTree a -> Map FileName (DirTree a) -> Map FileName (DirTree a)+removeSibling a = Map.delete (fileName a)++-- | Map a function over the first child and the rest of the children+withFirstChild+  :: Map FileName (DirTree a)+  -> (DirTree a -> Map FileName (DirTree a) -> x)+  -> Maybe x+withFirstChild m f = case Map.minView m of+  Nothing -> Nothing+  Just (firstChild, children) -> Just $ f firstChild children

@@ -0,0 +1,190 @@+{-# Language LambdaCase #-}+{-|+Description:+  Cursor-based navigation and modification of 'DirTree's.++This module should be imported qualified due to the very short names it exports.+-}+module System.Directory.Contents.Zipper where++import Control.Applicative+import Data.Map (Map)+import qualified Data.Map as Map+import System.FilePath++import System.Directory.Contents.Types++-- * Zipper++-- | A zipper for a 'DirTree'. As you navigate the tree, this keeps track of where+-- you are (which node is "focused" under your cursor) and how to reach parent, child,+-- and sibling nodes.+data DirZipper a = DirZipper+  { _dirZipper_cursor :: DirTree a -- ^ Cursor position+  , _dirZipper_siblings :: Map FilePath (DirTree a) -- ^ Siblings+  , _dirZipper_elders :: [(DirTree a, Map FilePath (DirTree a))]+  -- ^ Parents and aunts/uncles, in reverse order (i.e., immediate ancestors first)+  }+  deriving (Show, Read, Eq, Ord)++-- | Construct a zipper out of a 'DirTree'. Use 'focused' or 'unzipped' to get back+-- a 'DirTree'+zipped :: DirTree a -> DirZipper a+zipped a = DirZipper a Map.empty []++-- | The currently focused/selected node (and its children).  In other words,+-- where you are in the directory hierarchy.+focused :: DirZipper a -> DirTree a+focused = _dirZipper_cursor++-- | Throws away your current cursor information and returns the entire 'DirTree'+-- contained by the 'DirZipper'.+--+-- > unzipped . zipped == id+--+unzipped :: DirZipper a -> DirTree a+unzipped = focused . home++-- | Move down a level in the directory hierarchy. To move down to a specific child,+-- use 'downTo'.+down :: DirZipper a -> Maybe (DirZipper a)+down dz = case dz of+  DirZipper p@(DirTree_Dir _ xs) siblings parents ->+    withFirstChild xs $ \firstChild children ->+      DirZipper firstChild children $ (p, siblings) : parents+  DirZipper p@(DirTree_Symlink _ (Symlink_External _ xs)) siblings parents ->+    withFirstChild xs $ \firstChild children ->+      DirZipper firstChild children $ (p, siblings) : parents+  DirZipper (DirTree_Symlink _ (Symlink_Internal _ ref)) _ _ ->+    followRelative ref $ home dz+  _ -> Nothing++-- | Move up a level in the directory hierarchy, back to the parent that you+-- previously moved 'down' through.+up :: DirZipper a -> Maybe (DirZipper a)+up = \case+  DirZipper c s ((parent, uncles):ps) ->+    Just $ DirZipper (update c s parent) uncles ps+  _ -> Nothing+  where+    update :: DirTree a -> Map FilePath (DirTree a) -> DirTree a -> DirTree a+    update child siblings parent = case parent of+      DirTree_Dir f _ -> DirTree_Dir f $ insertSibling child siblings+      DirTree_Symlink f (Symlink_External s _) ->+        DirTree_Symlink f $ Symlink_External s $ insertSibling child siblings+      _ -> parent++-- | Go to the top of the directory hierarchy.+home :: DirZipper a -> DirZipper a+home dz =+  let upmost z = maybe z upmost $ up z+  in upmost dz++-- | Navigation directions for sibling nodes+data NavSibling = NavLeft | NavRight++-- | Move to the sibling next to the focused node+nextSibling :: NavSibling -> DirZipper a -> Maybe (DirZipper a)+nextSibling nav (DirZipper cursor siblings parents) =+  let kids = insertSibling cursor siblings+      next = case nav of+        NavRight -> Map.lookupGT (fileName cursor) kids+        NavLeft -> Map.lookupLT (fileName cursor) kids+  in case next of+      Nothing -> Nothing+      Just (_, sibling) -> Just $+        DirZipper sibling (removeSibling sibling kids) parents++-- | Move to the sibling to the left of the focused node+left :: DirZipper a -> Maybe (DirZipper a)+left = nextSibling NavLeft++-- | Move to the sibling to the right of the focused node+right :: DirZipper a -> Maybe (DirZipper a)+right = nextSibling NavRight++-- | Go to a particular sibling+toSibling :: FileName -> DirZipper a -> Maybe (DirZipper a)+toSibling name (DirZipper cursor siblings parents) =+  case Map.lookup name siblings of+    Nothing -> Nothing+    Just sibling ->+      let otherSiblings = insertSibling cursor $+            removeSibling sibling siblings+      in Just $ DirZipper sibling otherSiblings parents++-- | Move down in the directory hierarchy to a particular child+downTo :: FileName -> DirZipper a -> Maybe (DirZipper a)+downTo name z = do+  d <- down z+  if fileName (focused d) == name+    then pure d+    else toSibling name d++-- | Modify the focused node+mapCursor+  :: (DirTree a -> DirTree a)+  -> DirZipper a+  -> DirZipper a+mapCursor f (DirZipper cursor siblings parents) =+  DirZipper (f cursor) siblings parents++-- | Replace the focused node+replaceCursor+  :: DirTree a+  -> DirZipper a+  -> DirZipper a+replaceCursor = mapCursor . const++-- | Add a new sibling to the focused node's generation and focus on it+insert+  :: DirTree a+  -> DirZipper a+  -> DirZipper a+insert d (DirZipper cursor siblings parents) =+  DirZipper+    d+    (insertSibling cursor siblings)+    parents++-- | Remove the focused node+remove+  :: DirZipper a+  -> Maybe (DirZipper a)+remove z@(DirZipper cursor _ _) =+  let rm (DirZipper c s p) =+        DirZipper c (removeSibling cursor s) p+  in case rm <$> (left z <|> right z) of+    Just s -> Just s+    Nothing -> case up z of+      Nothing -> Nothing+      Just dz -> Just $ flip replaceCursor dz $+        case _dirZipper_cursor dz of+          DirTree_Dir f _ -> DirTree_Dir f Map.empty+          DirTree_Symlink f (Symlink_External s _) ->+            DirTree_Symlink f (Symlink_External s Map.empty)+          x -> x++-- | Try to navigate the provided (possibly relative) path.+followRelative+  :: FilePath+  -> DirZipper a+  -> Maybe (DirZipper a)+followRelative path dz =+  let follow r z = case r of+        "." -> Just z+        ".." -> up z+        _ -> downTo r z <|> toSibling r z+      go rs z = case rs of+        [] -> Just z+        (r:more) -> go more =<< follow r z+  in go (splitDirectories path) dz++-- | If the focused node is an internal symlink (see 'Symlink'), try to get+-- to the target.+followLink+  :: DirZipper a+  -> Maybe (DirZipper a)+followLink z = case z of+  DirZipper (DirTree_Symlink _ (Symlink_Internal s _)) _ _ -> followRelative s z+  _ -> Nothing

@@ -1,5 +1,6 @@ import Data.Maybe import System.Directory.Contents+import System.Directory.Contents.Zipper import System.Exit import System.FilePath @@ -19,13 +20,21 @@     pure $ expectNothing $ walkContents "C" =<< pruneDirTree filtered   rocket <- test "Check that symlink can be traversed" $     pure (walkContents "D/rocket" filtered)+  test "Check that filtering removes internal symlinks to filtered files" $+    pure $ expectNothing $+      walkContents "C/info.md" filtered   let filterRockets = filterDirTree ((/="rocket") . takeFileName)-  test "Check that filtering removes symlinks to filtered files" $+  test "Check that filtering removes external symlinks to filtered files" $     pure $ expectNothing $       walkContents "d_rocket" =<< filterRockets p   test "Check that dereferenced symlinks to filtered files are not removed" $ do     deref <- dereferenceSymlinks p     pure $ walkContents "d_rocket" =<< filterRockets deref+  test "Zipper down then up from root == id" $+    pure $ expectTrue $ fmap focused (up =<< down (zipped p)) == Just p+  test "Use zipper to remove a node" $ do+    let a = up =<< remove =<< downTo "info.md" =<< downTo "C" (zipped p)+    pure $ expectNothing $ walkContents "C/info.md" . focused =<< a   readFile (filePath rocket) >>=     putStr >> putStrLn " All systems go!" @@ -42,3 +51,6 @@ expectNothing x = case x of   Nothing -> Just ()   Just _ -> Nothing++expectTrue :: Bool -> Maybe ()+expectTrue x = if x then Just () else Nothing