packages feed

pathwalk 0.2.0.0 → 0.2.1.0

raw patch · 5 files changed

+100/−30 lines, 5 filesdep +transformersdep ~basenew-component:exe:stoprecursingnew-uploader

Dependencies added: transformers

Dependency ranges changed: base

Files

− example/Main.hs 
@@ -1,16 +0,0 @@-module Main (main) where--import Control.Monad (forM_)-import Data.List (intercalate)-import System.Directory.PathWalk (pathWalk)-import System.Environment (getArgs)--main :: IO ()-main = do-  rawArgs <- getArgs-  let args = if rawArgs == [] then ["."] else rawArgs-  forM_ args $ \arg -> do-    pathWalk arg $ \root dirs files -> do-      putStrLn root-      putStrLn $ "  dirs: " ++ show dirs-      putStrLn $ "  files: " ++ show files
+ examples/example/Main.hs view
@@ -0,0 +1,15 @@+module Main (main) where++import Control.Monad (forM_)+import System.Directory.PathWalk (pathWalk)+import System.Environment (getArgs)++main :: IO ()+main = do+  rawArgs <- getArgs+  let args = if rawArgs == [] then ["."] else rawArgs+  forM_ args $ \arg -> do+    pathWalk arg $ \root dirs files -> do+      putStrLn root+      putStrLn $ "  dirs: " ++ show dirs+      putStrLn $ "  files: " ++ show files
+ examples/stoprecursing/Main.hs view
@@ -0,0 +1,20 @@+module Main (main) where++import Control.Monad (forM_)+import Data.List (isSuffixOf)+import System.Directory.PathWalk (pathWalkInterruptible, WalkStatus(..))+import System.Environment (getArgs)++main :: IO ()+main = do+  rawArgs <- getArgs+  let args = if rawArgs == [] then ["."] else rawArgs+  forM_ args $ \arg -> do+    pathWalkInterruptible arg $ \root dirs files -> do+      if ("/.git" `isSuffixOf` root) then do+        return StopRecursing+      else do+        putStrLn root+        putStrLn $ "  dirs: " ++ show dirs+        putStrLn $ "  files: " ++ show files+        return Continue
pathwalk.cabal view
@@ -1,5 +1,5 @@ name:                pathwalk-version:             0.2.0.0+version:             0.2.1.0 synopsis:            Path walking utilities for Haskell programs description:         Simple directory tree walking utilities. license:             MIT@@ -39,11 +39,21 @@       base >=3 && <5     , directory >=1.2     , filepath >=1.3+    , transformers >=0.4   hs-source-dirs: src   default-language: Haskell2010+  ghc-options: -Wall  executable example   main-is: Main.hs   build-depends: base, pathwalk-  hs-source-dirs: example+  hs-source-dirs: examples/example   default-language: Haskell2010+  ghc-options: -Wall++executable stoprecursing+  main-is: Main.hs+  build-depends: base, pathwalk+  hs-source-dirs: examples/stoprecursing+  default-language: Haskell2010+  ghc-options: -Wall
src/System/Directory/PathWalk.hs view
@@ -1,16 +1,29 @@+-- | Provides path traversal functions much like Python's os.walk.+ module System.Directory.PathWalk-    ( pathWalk+    ( Callback+    , pathWalk+    , WalkStatus(..)+    , pathWalkInterruptible     ) where  import Control.Monad (forM_, filterM)-import Data.IORef (newIORef, readIORef, writeIORef) import System.Directory (doesDirectoryExist, doesFileExist, getDirectoryContents) import System.FilePath ((</>))+import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT) +-- | Called with a directory, list of relative subdirectories, and a+-- list of file names.  If using 'pathWalk', the callback always+-- returns '()'.  If using 'pathWalkInterruptible', it returns whether+-- to continue, prevent recursing further, or stop traversal entirely.+type Callback a = FilePath -> [FilePath] -> [FilePath] -> IO a+ -- | 'pathWalk' recursively enumerates the given root directory,--- calling callback once per directory with the traversed directory name, a list of subdirectories, and a list of files.+-- calling callback once per directory with the traversed directory+-- name, a list of subdirectories, and a list of files. ----- The subdirectories and file names are always relative to the root given.+-- The subdirectories and file names are always relative to the root+-- given. -- -- @ -- pathWalk "src" $ \\dir subdirs files -> do@@ -18,15 +31,43 @@ --     when ("Test.hs" \`isSuffixOf\` file) $ do --       registerTestFile $ dir \</\> file -- @-pathWalk :: FilePath -> (FilePath -> [FilePath] -> [FilePath] -> IO ()) -> IO ()+pathWalk :: FilePath -> Callback () -> IO () pathWalk root callback = do-    names <- getDirectoryContents root-    let properNames = filter (`notElem` [".", ".."]) names+  pathWalkInterruptible root $ \dir dirs files -> do+    callback dir dirs files+    return Continue -    dirs <- filterM (\n -> doesDirectoryExist $ root </> n) names-    files <- filterM (\n -> doesFileExist $ root </> n) names+-- | The callback given to 'pathWalkInterruptible' returns a WalkStatus+-- which determines which subsequent directories are traversed.+data WalkStatus+  = Continue -- ^ Continue recursing all subdirectories.+  | StopRecursing -- ^ Do not traverse deeper.+  | Stop -- ^ Stop recursing entirely.+  deriving (Show, Eq) -    callback root dirs files+pathWalkInternal :: FilePath -> Callback WalkStatus -> IO (Maybe ())+pathWalkInternal root callback = do+  names <- getDirectoryContents root+  let properNames = filter (`notElem` [".", ".."]) names -    forM_ dirs $ \dir -> do-        pathWalk (root </> dir) callback+  dirs <- filterM (\n -> doesDirectoryExist $ root </> n) properNames+  files <- filterM (\n -> doesFileExist $ root </> n) properNames++  result <- callback root dirs files+  case result of+    Continue -> do+      runMaybeT $ do+        forM_ dirs $ \dir -> do+          MaybeT $ pathWalkInternal (root </> dir) callback+    StopRecursing -> do+      return $ Just ()+    Stop -> do+      return Nothing++-- | Traverses a directory tree, just like 'pathWalk', except that+-- the callback can determine whether to continue traversal.  See+-- 'WalkStatus'.+pathWalkInterruptible :: FilePath -> Callback WalkStatus -> IO ()+pathWalkInterruptible root callback = do+  _ <- pathWalkInternal root callback+  return ()