dirstream (empty) → 1.0.0

raw patch · 4 files changed

+241/−0 lines, 4 filesdep +Win32dep +basedep +directorysetup-changed

Dependencies added: Win32, base, directory, pipes, pipes-safe, system-fileio, system-filepath, unix

Files

LICENSE +24/−0
Setup.hs +2/−0
dirstream.cabal +42/−0
src/Data/DirStream.hs +173/−0

+ LICENSE view

@@ -0,0 +1,24 @@+Copyright (c) 2013 Gabriel Gonzalez+All rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:+    * Redistributions of source code must retain the above copyright notice,+      this list of conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above copyright notice,+      this list of conditions and the following disclaimer in the documentation+      and/or other materials provided with the distribution.+    * Neither the name of Gabriel Gonzalez nor the names of other contributors+      may be used to endorse or promote products derived from this software+      without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ dirstream.cabal view

@@ -0,0 +1,42 @@+Name: dirstream+Version: 1.0.0+Cabal-Version: >=1.8.0.2+Build-Type: Simple+License: BSD3+License-File: LICENSE+Copyright: 2013 Gabriel Gonzalez+Author: Gabriel Gonzalez+Maintainer: Gabriel439@gmail.com+Bug-Reports: https://github.com/Gabriel439/Haskell-Dirstream-Library/issues+Synopsis: Easily stream directory contents in constant memory+Description: Use this library to read large directories as streams:+  .+  * Use @ListT@ to assemble recursive directory traversals while still streaming+  .+  * Use @pipes@ to read out the stream of results+  .+  * Traversals only open directory streams lazily in response to demand+  .+  * Avoid directories with insufficient permissions+  .+  This library works on both Unix, OS X, and Windows.+Category: System, Pipes+Source-Repository head+    Type: git+    Location: https://github.com/Gabriel439/Haskell-Dirstream-Library++Library+    Hs-Source-Dirs: src+    Build-Depends:+        base            >= 4       && < 5  ,+        directory                     < 1.3,+        system-filepath >= 0.3.1   && < 0.5,+        system-fileio   >= 0.2.1   && < 0.4,+        pipes           >= 4.0     && < 4.2,+        pipes-safe      >= 2.0.0   && < 2.3+    if os(windows)+        Build-Depends: Win32 >= 2.2.0.1 && < 2.4+    else+        Build-Depends: unix  >= 2.5.1.0 && < 2.8+    Exposed-Modules: Data.DirStream+    GHC-Options: -O2 -Wall

+ src/Data/DirStream.hs view

@@ -0,0 +1,173 @@+{-# LANGUAGE CPP, OverloadedStrings, FlexibleContexts #-}++{-| Use this module to stream directory contents lazily in constant memory in+    conjunction with @pipes@+-}++module Data.DirStream+    ( -- * Directory Traversals+      -- $traversals+      childOf+    , descendentOf++    -- * Utilities+    , unixVisible+    , isDirectory++    -- * Tutorial+    -- $tutorial+    ) where++import Control.Applicative ((<|>))+import Control.Monad (when)+#ifdef mingw32_HOST_OS+import Data.Bits ((.&.))+#endif+import Data.List (isPrefixOf)+import Pipes (ListT(Select), yield, liftIO, MonadIO)+import Pipes.Safe (bracket, MonadSafe, Base)+import System.Directory (readable, getPermissions)+import qualified Filesystem.Path.CurrentOS as F+import Filesystem.Path ((</>))+import Filesystem (isDirectory)+#ifdef mingw32_HOST_OS+import qualified System.Win32 as Win32+#else+import System.Posix (openDirStream, readDirStream, closeDirStream)+#endif++{- $traversals+    There many possible recursion schemes for traversing directories.  Rather+    than provide them all, I prefer that you learn to assemble your own+    recursion schemes, using the source code for 'descendentOf' as a starting+    point.+-}++#ifdef mingw32_HOST_OS+fILE_ATTRIBUTE_REPARSE_POINT :: Win32.FileAttributeOrFlag+fILE_ATTRIBUTE_REPARSE_POINT = 1024++reparsePoint :: Win32.FileAttributeOrFlag -> Bool+reparsePoint attr = fILE_ATTRIBUTE_REPARSE_POINT .&. attr /= 0+#endif++{-| Select all immediate children of the given directory, ignoring @\".\"@ and+    @\"..\"@.++    Returns zero children if the directory is not readable or (on Windows) if+    the directory is actually a reparse point.+-}+childOf :: MonadSafe m => F.FilePath -> ListT m F.FilePath+childOf path = Select $ do+    let path' = F.encodeString path+    canRead <- liftIO $ fmap readable $ getPermissions path'+#ifdef mingw32_HOST_OS+    reparse <- liftIO $ fmap reparsePoint $ Win32.getFileAttributes path'+    when (canRead && not reparse) $+        bracket+            (liftIO $ Win32.findFirstFile (F.encodeString (path </> "*")))+            (\(h, _) -> liftIO $ Win32.findClose h)+            $ \(h, fdat) -> do+                let loop = do+                        file' <- liftIO $ Win32.getFindDataFileName fdat+                        let file = F.decodeString file'+                        when (file' /= "." && file' /= "..") $+                            yield (path </> file)+                        more  <- liftIO $ Win32.findNextFile h fdat+                        when more loop+                loop+#else+    when (canRead) $+        bracket (liftIO $ openDirStream path') (liftIO . closeDirStream) $+            \dirp -> do+            let loop = do+                    file' <- liftIO $ readDirStream dirp+                    case file' of+                        [] -> return ()+                        _  -> do+                            let file = F.decodeString file'+                            when (file' /= "." && file' /= "..") $+                                yield (path </> file)+                            loop+            loop+#endif+{-# INLINABLE childOf #-}++-- | Select all recursive descendents of the given directory+descendentOf :: MonadSafe m => F.FilePath -> ListT m F.FilePath+descendentOf path = do+    child <- childOf path+    isDir <- liftIO $ isDirectory child+    if isDir+        then return child <|> descendentOf child+        else return child+{-# INLINABLE descendentOf #-}++{-| Determine if a file is visible according to Unix conventions, defined as the+    base name not beginning with a @\'.\'@+-}+unixVisible :: F.FilePath -> Bool+unixVisible path = not $ "." `isPrefixOf` F.encodeString (F.basename path)+{-# INLINABLE unixVisible #-}++-- $tutorial+--  The following example shows a simple program that enumerates the contents of+--  a single directory:+-- +-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > import Data.DirStream+-- > import Pipes+-- > import Pipes.Safe+-- >+-- > main1 = runSafeT $ runEffect $+-- >     for (every (childOf "/tmp")) (liftIO . print)+--+-- >>> main1+-- FilePath "/tmp"+-- FilePath "/tmp/dir1"+-- FilePath "/tmp/dir2"+-- FilePath "/tmp/fileE"+--+--  The 'childOf' function streams the list of files in constant memory,+--  allowing you to traverse very large directory lists.+--+--  You can use 'ListT' to assemble more sophisticated traversals, such as the+--  recursive 'descendentOf' traversal, which has the following definition:+--+-- > descendentOf :: F.FilePath -> ListT (SafeT IO) F.FilePath+-- > descendentOf path = do+-- >     child <- childOf path+-- >     isDir <- liftIO $ isDirectory child+-- >     if isDir+-- >         then return child <|> descendentOf child+-- >         else return child+--+--  These recursive traversals will promptly open and close nested directory+--  streams as they traverse the directory tree:+--+-- > main2 = runSafeT $ runEffect $+-- >     for (every (descendentOf "/tmp")) (liftIO . print)+--+-- >>> main2+-- FilePath "/tmp"+-- FilePath "/tmp/dir1"+-- FilePath "/tmp/dir1/fileA"+-- FilePath "/tmp/dir1/fileB"+-- FilePath "/tmp/dir2"+-- FilePath "/tmp/dir2/fileC"+-- FilePath "/tmp/dir2/fileD"+-- FilePath "/tmp/fileE"+--+--  These traverals are lazy and will open the minimal number of directories+--  necessary to satisfy downstream demand:+--+-- > import qualified Pipes.Prelude as P+-- >+-- > main3 = runSafeT $ runEffect $+-- >     for (every (descendentOf "/tmp") >-> P.take 3) (liftIO . print)+--+-- >>> main3  -- This never opens the "/tmp/dir2" directory+-- FilePath "/tmp"+-- FilePath "/tmp/dir1"+-- FilePath "/tmp/dir1/fileA"