directory-ospath-streaming-0.2.2/0000755000000000000000000000000007346545000015173 5ustar0000000000000000directory-ospath-streaming-0.2.2/Changelog.md0000644000000000000000000000212007346545000017377 0ustar0000000000000000# 0.2.2 - Add `getDirectoryContentsWithFilterRecursive` for recursively listing directory contents with commonly needed filtering # 0.2.1 - Fix `listContentsRecFold` to not mask exceptions unnecessarily which could cause hangups. The `getDirectoryContentsRecursive` gets the fix as well - Make `closeDirStream` hold on to the stream so it’s not GC’ed prematurely causing errors on reads. # 0.2 - New function for listing directory contents recursively `getDirectoryContentsRecursive` - New function for defining custom recursive directory traversals `listContentsRecFold` - `readDirStream` now returns file type in addition to basename - `DirStream` is now safe to close multiple times and it will be automatically closed by GC when it becomes unreachable - The `FileType` type now has only 3 constructors, symlink status is now field of some of them # 0.1.0.3 - Lower `base` minimum required base to 4.12 (GHC 8.6). Minimum supported `unix` is still 2.8 because of `OsString` # 0.1.0.2 - Fix compatibility with `filepath-1.5` # 0.1.0.1 - Add missing test inputs # 0.1 Initial release directory-ospath-streaming-0.2.2/LICENSE0000644000000000000000000002612307346545000016204 0ustar0000000000000000 Apache License Version 2.0, January 2004 http://www.apache.org/licenses/ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 1. Definitions. "License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. "Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. "Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. "You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License. "Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files. "Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types. "Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below). "Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. "Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution." "Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. 2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. 3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed. 4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: (a) You must give any other recipients of the Work or Derivative Works a copy of this License; and (b) You must cause any modified files to carry prominent notices stating that You changed the files; and (c) You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and (d) If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License. You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License. 5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. 6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. 7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. 8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. 9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability. END OF TERMS AND CONDITIONS APPENDIX: How to apply the Apache License to your work. To apply the Apache License to your work, attach the following boilerplate notice, with the fields enclosed by brackets "[]" replaced with your own identifying information. (Don't include the brackets!) The text should be enclosed in the appropriate comment syntax for the file format. We also recommend that a file or class name and description of purpose be included on the same "printed page" as the copyright notice for easier identification within third-party archives. Copyright 2023 Sergey Vinokurov Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. directory-ospath-streaming-0.2.2/Readme.md0000644000000000000000000000106407346545000016713 0ustar0000000000000000[![build](https://github.com/sergv/directory-ospath-streaming/actions/workflows/haskell-ci.yaml/badge.svg)](https://github.com/sergv/directory-ospath-streaming/actions/workflows/haskell-ci.yaml) # Synopsis Reading of directory contents in constant memory, i.e. in an iterative fashion without storing all directory elements in memory. From another perspective, this reading interface allows stopping at any point without loading every directory element. Also defines general-purpose recursive directory traversals. Both Windows and Unix systems are supported. directory-ospath-streaming-0.2.2/directory-ospath-streaming.cabal0000644000000000000000000000652207346545000023453 0ustar0000000000000000cabal-version: 3.0 -- Created : 27 April 2023 name: directory-ospath-streaming version: 0.2.2 synopsis: Stream directory entries in constant memory in vanilla IO description: Reading of directory contents in constant memory, i.e. in an iterative fashion without storing all directory elements in memory. From another perspective, this reading interface allows stopping at any point without loading every directory element. Also defines general-purpose recursive directory traversals. Both Windows and Unix systems are supported. copyright: (c) Sergey Vinokurov 2023 license: Apache-2.0 license-file: LICENSE author: Sergey Vinokurov maintainer: Sergey Vinokurov category: File, Streaming tested-with: , GHC == 8.6 , GHC == 8.8 , GHC == 8.10 , GHC == 9.2 , GHC == 9.4 , GHC == 9.6 , GHC == 9.8 , GHC == 9.10 build-type: Simple extra-source-files: test/filesystem/*.txt test/filesystem/bin/*.txt extra-doc-files: Changelog.md Readme.md homepage: https://github.com/sergv/directory-ospath-streaming source-repository head type: git location: https://github.com/sergv/directory-ospath-streaming.git -- Cabal will pick this flag up automatically during solving. Default to true -- since that’s what should be picked up for all future filepath versions starting at 1.5. flag os-string description: Depend on os-string package, needed for filepath >= 1.5 default: True manual: False common ghc-options default-language: Haskell2010 ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missed-specialisations -Wno-missing-import-lists -Wno-missing-local-signatures -Wno-safe -Wno-unsafe if impl(ghc >= 8.8) ghc-options: -Wno-missing-deriving-strategies if impl(ghc >= 8.10) ghc-options: -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module if impl(ghc >= 9.2) ghc-options: -Wno-missing-kind-signatures if impl(ghc >= 9.8) ghc-options: -Wno-missing-role-annotations -Wno-missing-poly-kind-signatures common depends-on-filepath if flag(os-string) build-depends: , filepath >= 1.5 , os-string >= 2.0 else build-depends: , filepath >= 1.4.100 && < 1.5 library import: ghc-options, depends-on-filepath exposed-modules: System.Directory.OsPath.Streaming System.Directory.OsPath.Streaming.Internal System.Directory.OsPath.Streaming.Internal.Raw System.Directory.OsPath.Types other-modules: System.Directory.OsPath.Contents System.Directory.OsPath.FileType System.Directory.OsPath.Utils hs-source-dirs: src build-depends: , atomic-counter , base >= 4.12 && < 5 , deepseq >= 1.4 if os(windows) build-depends: , directory >= 1.3.8 , Win32 >= 2.13.3 else build-depends: -- Cannot use lower version because it doesn’t support OsStrings , unix >= 2.8 test-suite test import: ghc-options, depends-on-filepath type: exitcode-stdio-1.0 main-is: test/TestMain.hs hs-source-dirs: . test build-depends: , base >= 4.12 , directory-ospath-streaming , tasty , tasty-hunit if !os(windows) build-depends: , directory , random , unix >= 2.8 ghc-options: -rtsopts -main-is TestMain directory-ospath-streaming-0.2.2/src/System/Directory/OsPath/0000755000000000000000000000000007346545000022410 5ustar0000000000000000directory-ospath-streaming-0.2.2/src/System/Directory/OsPath/Contents.hs0000644000000000000000000002157707346545000024555 0ustar0000000000000000-- | -- Module: System.Directory.OsPath.Contents -- Copyright: (c) Sergey Vinokurov 2024 -- License: Apache-2.0 (see LICENSE) -- Maintainer: serg.foo@gmail.com {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} module System.Directory.OsPath.Contents ( getDirectoryContentsRecursive , getDirectoryContentsWithFilterRecursive , listContentsRecFold ) where import Control.Exception (onException) import Data.Coerce (coerce, Coercible) import System.IO.Unsafe (unsafeInterleaveIO) import System.OsPath import System.Directory.OsPath.Streaming.Internal (DirStream) import qualified System.Directory.OsPath.Streaming.Internal as Streaming import qualified System.Directory.OsPath.Streaming.Internal.Raw as Raw import System.Directory.OsPath.Types -- | Recursively list all the files and directories in a directory and all subdirectories. -- -- The directory structure is traversed depth-first. -- -- The result is generated lazily so is not well defined if the source -- directory structure changes before the list is fully consumed. -- -- Symlinks within directory structure may cause result to be infinitely long. getDirectoryContentsRecursive :: OsPath -> IO [(OsPath, FileType)] getDirectoryContentsRecursive root = listContentsRecFold' Nothing (\_ _ (Relative path) _ ft _ cons prependSubdir rest -> cons (path, ft) $ prependSubdir rest) (\_ _ (Relative path) _ ft -> pure (Just (path, ft))) (Just root) -- | Recursively list all the files and directories that satisfy given -- predicate in a directory and all subdirectories. Descending into -- some subdirectories may be avoided by filtering them out with a -- visiting predicate. -- -- Not visited directory entry may still be reported depending on the -- collection predicate. -- -- The directory structure is traversed depth-first. -- -- The result is generated lazily so is not well defined if the source -- directory structure changes before the list is fully consumed. -- -- Symlinks within directory structure may cause result to be infinitely long, but -- they can be filtered out with a suitable directory visiting predicate. getDirectoryContentsWithFilterRecursive :: (Basename OsPath -> SymlinkType -> Bool) -- ^ Whether to visit a directory -> (Basename OsPath -> Bool) -- ^ Whether to collect given directory element, either file or directory. -> OsPath -> IO [(OsPath, FileType)] getDirectoryContentsWithFilterRecursive visitPred collectPred root = listContentsRecFold' Nothing (\_ _ (Relative path) basename ft symlink cons prependSubdir rest -> (if collectPred basename then cons (path, ft) else id) $ if visitPred basename symlink then prependSubdir rest else rest) (\_ _ (Relative path) basename ft -> pure $ if collectPred basename then Just (path, ft) else Nothing) (Just root) {-# INLINE listContentsRecFold #-} -- | The most general form of gathering directory contents. -- -- Treats symlinks the same as regular files and directories. Folding functions can -- decide how to handle symlinks. -- -- Both directory and file actions can throw exceptions and this function -- will try to close finished directory streams promptly (they’ll be closed -- by GC in the worst case). listContentsRecFold :: forall f a b. (Foldable f, Coercible b OsPath) => Maybe Int -- ^ Depth limit if specified, negative values treated the same as positive ones. -> (forall c. OsPath -> b -> Relative OsPath -> Basename OsPath -> SymlinkType -> (a -> IO c -> IO c) -> (IO c -> IO c) -> IO c -> IO c) -- ^ Decide how to fold directory and its children given its path. -- -- Can do IO actions to plan what to do and typically should derive its -- result from last @IO c@ argument. -- -- Returns @IO c@ where @c@ is hidden from the user so the only way -- to make it is to construct from the passed @IO c@ action. -- -- Arguments: -- -- * @OsPath@ - absolute path to the visited directory -- * @b@ - root of the visited directory as passed originally in @f b@ to the bigger fold function -- * @Relative OsPath@ - path to the visited directory relative to the previous @b@ argument -- * @Basename OsPath@ - name of the visited directory without slashes -- * @SymlinkType@ - symlink status of the visited directory -- * @(a -> IO c -> IO c)@ - can be used to record some output (@a@) about the directory itself -- * @(IO c -> IO c)@ - traverse inside this directory, can be ignored to skip its children -- * @IO c@ - continue scanning not yet visited parts, must be used to construct return value (otherwise it won’t typecheck!) -- -- The passed @(IO c -> IO c)@ argument function should (but is not required to) -- be applied in the returned function and it will prepend results for subdirectories -- of the directory being analyzed. If not applied these subdirectories will be skipped, -- this way ignoring particular directory and all its children can be achieved. -> (OsPath -> b -> Relative OsPath -> Basename OsPath -> FileType -> IO (Maybe a)) -- ^ What to do with file -> f b -- ^ Roots to search in, either absolute or relative -> IO [a] listContentsRecFold = \depthLimit foldDir filePred input -> listContentsRecFold' depthLimit (\a b c d _f g h i j -> foldDir a b c d g h i j) filePred input {-# INLINE listContentsRecFold' #-} -- Actual worker with slightly worse type signature that we don’t want to expose to the users. -- But it’s better candidate for implementing getDirectoryContentsRecursive here than -- listContentsRecFold. listContentsRecFold' :: forall f a b. (Foldable f, Coercible b OsPath) => Maybe Int -> (forall c. OsPath -> b -> Relative OsPath -> Basename OsPath -> FileType -> SymlinkType -> (a -> IO c -> IO c) -> (IO c -> IO c) -> IO c -> IO c) -> (OsPath -> b -> Relative OsPath -> Basename OsPath -> FileType -> IO (Maybe a)) -> f b -> IO [a] listContentsRecFold' depthLimit foldDir filePred input = goCache =<< Raw.allocateDirReadCache where goCache cache = foldr (goNewDir initLimit) (Raw.releaseDirReadCache cache *> pure []) input where !initLimit = case depthLimit of Nothing -> -1 -- Loop until overflow, basically infinitely Just x -> abs x goNewDir :: Int -> b -> IO [a] -> IO [a] goNewDir !d root rest = do stream <- Streaming.openDirStream $ coerce root goDirStream root d (Streaming.closeDirStream stream *> rest) stream goDirStream :: b -> Int -> IO [a] -> DirStream -> IO [a] goDirStream _ 0 rest _ = rest goDirStream root depth rest stream = go where go :: IO [a] go = (`onException` Streaming.closeDirStream stream) $ do x <- Streaming.readDirStreamWithCache cache stream case x of Nothing -> rest Just (yAbs, yBase, ft) -> do let yRel :: Relative OsPath yRel = coerce yBase case ft of Other _ -> addLazy (filePred yAbs root yRel yBase ft) go File _ -> addLazy (filePred yAbs root yRel yBase ft) go Directory ft' -> foldDir yAbs root yRel yBase ft ft' cons (goNewDirAcc yRel (depth - 1) yAbs) go goNewDirAcc :: Relative OsPath -> Int -> OsPath -> IO [a] -> IO [a] goNewDirAcc rootAcc !d dir rest1 = do stream1 <- Streaming.openDirStream dir goDirStreamAcc rootAcc d (Streaming.closeDirStream stream1 *> rest1) stream1 goDirStreamAcc :: Relative OsPath -> Int -> IO [a] -> DirStream -> IO [a] goDirStreamAcc _ 0 rest1 _ = rest1 goDirStreamAcc rootAcc depth1 rest1 stream1 = go1 where go1 :: IO [a] go1 = (`onException` Streaming.closeDirStream stream1) $ do x <- Streaming.readDirStreamWithCache cache stream1 case x of Nothing -> rest1 Just (yAbs, yBase, ft) -> do let yRel :: Relative OsPath yRel = coerce () rootAcc yBase case ft of Other _ -> addLazy (filePred yAbs root yRel yBase ft) go1 File _ -> addLazy (filePred yAbs root yRel yBase ft) go1 Directory ft' -> foldDir yAbs root yRel yBase ft ft' cons (goNewDirAcc yRel (depth1 - 1) yAbs) go1 addLazy :: IO (Maybe a) -> IO [a] -> IO [a] addLazy x y = do x' <- x case x' of Nothing -> y Just x'' -> cons x'' y cons :: a -> IO [a] -> IO [a] cons x y = (x :) <$> unsafeInterleaveIO y directory-ospath-streaming-0.2.2/src/System/Directory/OsPath/FileType.hs0000644000000000000000000000427007346545000024470 0ustar0000000000000000-- | -- Module: System.Directory.OsPath.FileType -- Copyright: (c) Sergey Vinokurov 2024 -- License: Apache-2.0 (see LICENSE) -- Maintainer: serg.foo@gmail.com {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} module System.Directory.OsPath.FileType ( getFileType , regularFile , regularDirectory , regularOther , symlinkFile , symlinkDirectory , symlinkOther ) where import System.OsPath.Types (OsPath) import System.Directory.OsPath.Types #ifdef mingw32_HOST_OS import System.Directory.OsPath (doesFileExist, doesDirectoryExist) #endif #ifndef mingw32_HOST_OS import Control.Exception (try, IOException) import System.OsString.Internal.Types (getOsString) import qualified System.Posix.Files.PosixString as PosixF #endif getFileType :: OsPath -> IO FileType #ifdef mingw32_HOST_OS getFileType fp = do isFile <- doesFileExist fp if isFile then pure regularFile else do isDir <- doesDirectoryExist fp pure $ if isDir then regularDirectory else regularOther #endif #ifndef mingw32_HOST_OS getFileType fp = do s <- PosixF.getSymbolicLinkStatus $ getOsString fp case () of _ | PosixF.isRegularFile s -> pure regularFile | PosixF.isDirectory s -> pure regularDirectory | PosixF.isSymbolicLink s -> do es' <- try $ PosixF.getFileStatus $ getOsString fp case es' of Left (_ :: IOException) -> pure symlinkOther Right s' | PosixF.isRegularFile s' -> pure symlinkFile | PosixF.isDirectory s' -> pure symlinkDirectory | otherwise -> pure symlinkOther | otherwise -> pure regularOther #endif -- Avoid allocations with this one weird trick. {-# NOINLINE regularFile #-} {-# NOINLINE regularDirectory #-} {-# NOINLINE symlinkFile #-} {-# NOINLINE symlinkDirectory #-} -- | Auxiliary constants to refer to different file types without -- allocations. regularFile, regularDirectory, regularOther, symlinkFile, symlinkDirectory, symlinkOther :: FileType regularFile = File Regular regularDirectory = Directory Regular regularOther = Other Regular symlinkFile = File Symlink symlinkDirectory = Directory Symlink symlinkOther = Other Symlink directory-ospath-streaming-0.2.2/src/System/Directory/OsPath/Streaming.hs0000644000000000000000000000206007346545000024673 0ustar0000000000000000-- | -- Module: System.Directory.OsPath.SafeStreaming -- Copyright: (c) Sergey Vinokurov 2024 -- License: Apache-2.0 (see LICENSE) -- Maintainer: serg.foo@gmail.com -- -- You’ll most likely be interested in either -- -- * 'getDirectoryContentsRecursive' to search directory hierarchy recursively -- * 'DirStream', 'openDirStream', 'readDirStream', and 'closeDirStream' to traverse single directory efficiently module System.Directory.OsPath.Streaming ( DirStream , openDirStream , readDirStream , closeDirStream -- * File types , SymlinkType(..) , FileType(..) , Basename(..) , getFileType -- * Get directory contents , getDirectoryContentsRecursive , getDirectoryContentsWithFilterRecursive , listContentsRecFold -- * Utilities , regularFile , regularDirectory , regularOther , symlinkFile , symlinkDirectory , symlinkOther ) where import System.Directory.OsPath.Contents import System.Directory.OsPath.FileType import System.Directory.OsPath.Streaming.Internal as Streaming import System.Directory.OsPath.Types directory-ospath-streaming-0.2.2/src/System/Directory/OsPath/Streaming/0000755000000000000000000000000007346545000024341 5ustar0000000000000000directory-ospath-streaming-0.2.2/src/System/Directory/OsPath/Streaming/Internal.hs0000644000000000000000000000440507346545000026454 0ustar0000000000000000-- | -- Module: System.Directory.OsPath.Streaming.Internal -- Copyright: (c) Sergey Vinokurov 2024 -- License: Apache-2.0 (see LICENSE) -- Maintainer: serg.foo@gmail.com {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecursiveDo #-} {-# LANGUAGE UnboxedTuples #-} module System.Directory.OsPath.Streaming.Internal ( DirStream(..) , openDirStream , readDirStream , closeDirStream , readDirStreamWithCache ) where import Control.Concurrent.Counter (Counter) import qualified Control.Concurrent.Counter as Counter import Control.Monad (when) import System.Mem.Weak (Weak, mkWeak, finalize) import System.OsPath (OsPath) import qualified System.Directory.OsPath.Streaming.Internal.Raw as Raw import System.Directory.OsPath.Types import System.Directory.OsPath.Utils (touch) -- | Abstract handle to directory contents. -- -- May be closed multiple times and will be automatically closed by GC -- when it goes out of scope. data DirStream = DirStream { dsHandle :: !Raw.RawDirStream , dsIsClosed :: {-# UNPACK #-} !Counter , dsFin :: {-# UNPACK #-} !(Weak DirStream) } openDirStream :: OsPath -> IO DirStream openDirStream root = mdo dsHandle <- Raw.openRawDirStream root dsIsClosed <- Counter.new 0 let stream = DirStream{dsHandle, dsIsClosed, dsFin} dsFin <- mkWeak stream stream (Just (closeDirStreamInternal stream)) pure stream -- | Deallocate directory handle. It’s safe to close 'DirStream' multiple times, -- unlike the underlying OS-specific directory stream handle. closeDirStream :: DirStream -> IO () closeDirStream stream = do -- Finalize ourselves to do it only once instead of running finalizer -- in GC afterwards once more. finalize (dsFin stream) touch stream closeDirStreamInternal :: DirStream -> IO () closeDirStreamInternal DirStream{dsHandle, dsIsClosed} = do !oldVal <- Counter.cas dsIsClosed 0 1 when (oldVal == 0) $ Raw.closeRawDirStream dsHandle readDirStream :: DirStream -> IO (Maybe (OsPath, FileType)) readDirStream = Raw.readRawDirStream . dsHandle readDirStreamWithCache :: Raw.DirReadCache -> DirStream -> IO (Maybe (OsPath, Basename OsPath, FileType)) readDirStreamWithCache cache = Raw.readRawDirStreamWithCache cache . dsHandle directory-ospath-streaming-0.2.2/src/System/Directory/OsPath/Streaming/Internal/0000755000000000000000000000000007346545000026115 5ustar0000000000000000directory-ospath-streaming-0.2.2/src/System/Directory/OsPath/Streaming/Internal/Raw.hs0000644000000000000000000002156507346545000027213 0ustar0000000000000000-- | -- Module: System.Directory.OsPath.Streaming.Internal.Raw -- Copyright: (c) Sergey Vinokurov 2024 -- License: Apache-2.0 (see LICENSE) -- Maintainer: serg.foo@gmail.com -- -- Streaming functions for interacting with the filesystem. -- -- These do the basic job of reading directory entries but care must -- be taken to not close these streams more than once. {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE UnboxedTuples #-} #ifndef mingw32_HOST_OS # if MIN_VERSION_unix(2, 8, 6) && __GLASGOW_HASKELL__ >= 902 # define HAVE_UNIX_CACHE 1 # endif #endif module System.Directory.OsPath.Streaming.Internal.Raw ( RawDirStream(..) , openRawDirStream , readRawDirStream , closeRawDirStream , DirReadCache(..) , allocateDirReadCache , releaseDirReadCache , readRawDirStreamWithCache ) where import System.OsPath (osp, ()) import System.Directory.OsPath.FileType import System.Directory.OsPath.Types #ifdef mingw32_HOST_OS import Control.Concurrent.Counter (Counter) import qualified Control.Concurrent.Counter as Counter import Control.Monad (unless) import System.OsPath.Types (OsPath) import System.OsString.Internal.Types (OsString(OsString), getOsString) import System.OsString.Windows (pstr) import qualified System.Win32.Types as Win32 import qualified System.Win32.WindowsString.File as Win32 #endif -- Don’t use #else to make treesitter do better job - it parses #else part as comments. #ifndef mingw32_HOST_OS import System.OsPath.Types (OsPath) import System.OsString.Internal.Types (OsString(OsString), getOsString) import qualified System.Posix.Directory.PosixPath as Posix # ifdef HAVE_UNIX_CACHE import Data.Coerce (coerce) import Foreign.C (CString, CChar) import Foreign.Ptr (Ptr, nullPtr) import Foreign.Storable (sizeOf, alignment, peekElemOff) import qualified System.Posix.Directory.Internals as DirInternals import System.Posix.PosixPath.FilePath (peekFilePath) import GHC.Exts (MutableByteArray#, newAlignedPinnedByteArray#, mutableByteArrayContents#, RealWorld) import GHC.IO (IO(..)) import GHC.Int (Int(..)) import GHC.Ptr (Ptr(..)) import System.Directory.OsPath.Utils (touch) # endif #endif -- | Abstract handle to directory contents. -- -- Not thread safe and shouldn't be closed more than once. #ifdef mingw32_HOST_OS data RawDirStream = RawDirStream !Win32.HANDLE !Win32.FindData !Counter !OsPath #endif #ifndef mingw32_HOST_OS data RawDirStream = RawDirStream !Posix.DirStream !OsPath #endif openRawDirStream :: OsPath -> IO RawDirStream #ifdef mingw32_HOST_OS openRawDirStream fp = do (h, fdat) <- Win32.findFirstFile $ getOsString fp <> [pstr|\*|] hasMore <- Counter.new 1 -- always at least two records, "." and ".." pure $! RawDirStream h fdat hasMore fp #endif #ifndef mingw32_HOST_OS openRawDirStream root = do stream <- Posix.openDirStream (getOsString root) pure $ RawDirStream stream root #endif -- | Deallocate directory handle. It’s not safe to call multiple times -- on the same handle. closeRawDirStream :: RawDirStream -> IO () #ifdef mingw32_HOST_OS closeRawDirStream (RawDirStream h _ _ _) = Win32.findClose h #endif #ifndef mingw32_HOST_OS closeRawDirStream (RawDirStream stream _) = Posix.closeDirStream stream #endif readRawDirStream :: RawDirStream -> IO (Maybe (OsPath, FileType)) readRawDirStream stream = do cache <- allocateDirReadCache res <- readRawDirStreamWithCache cache stream -- Safe to don’t care about exceptions because we know that cache is -- just a byte vector so just touch# it for now. releaseDirReadCache cache pure $ (\(_, Basename x, typ) -> (x, typ)) <$> res #ifdef mingw32_HOST_OS -- No state on Windows newtype DirReadCache = DirReadCache () #endif #ifndef mingw32_HOST_OS # ifndef HAVE_UNIX_CACHE -- No state in early unix package newtype DirReadCache = DirReadCache () # endif # ifdef HAVE_UNIX_CACHE data DirReadCache = DirReadCache (MutableByteArray# RealWorld) # endif #endif allocateDirReadCache :: IO DirReadCache #ifdef mingw32_HOST_OS allocateDirReadCache = pure $ DirReadCache () #endif #ifndef mingw32_HOST_OS # ifndef HAVE_UNIX_CACHE allocateDirReadCache = pure $ DirReadCache () # endif # ifdef HAVE_UNIX_CACHE allocateDirReadCache = IO $ \s0 -> case newAlignedPinnedByteArray# size align s0 of (# s1, mbarr# #) -> (# s1, DirReadCache mbarr# #) where !(I# size) = sizeOf (undefined :: Ptr DirInternals.DirEnt) !(I# align) = alignment (undefined :: Ptr DirInternals.DirEnt) # endif #endif releaseDirReadCache :: DirReadCache -> IO () #ifdef mingw32_HOST_OS releaseDirReadCache _ = pure () #endif #ifndef mingw32_HOST_OS # ifndef HAVE_UNIX_CACHE releaseDirReadCache _ = pure () # endif # ifdef HAVE_UNIX_CACHE releaseDirReadCache = touch # endif #endif readRawDirStreamWithCache :: DirReadCache -> RawDirStream -> IO (Maybe (OsPath, Basename OsPath, FileType)) #ifdef mingw32_HOST_OS readRawDirStreamWithCache _ stream@(RawDirStream _ _ _ root) = do traverse (\x -> let full = root x in (full, Basename x,) <$> getFileType full) =<< _readRawDirStreamSimple stream #endif #ifndef mingw32_HOST_OS # ifndef HAVE_UNIX_CACHE readRawDirStreamWithCache _ stream@(RawDirStream _ root) = do traverse (\x -> let full = root x in (full, Basename x,) <$> getFileType full) =<< _readRawDirStreamSimple stream # endif # ifdef HAVE_UNIX_CACHE readRawDirStreamWithCache (DirReadCache barr#) (RawDirStream stream root) = go where cache :: Ptr DirInternals.DirEnt cache = Ptr (mutableByteArrayContents# barr#) shouldSkipDirEntry :: CString -> IO Bool shouldSkipDirEntry ptr | ptr == nullPtr = pure True shouldSkipDirEntry ptr = do (x1 :: CChar) <- peekElemOff ptr 0 case x1 of 0 -> pure False 46 -> do -- ASCII for ‘.’ (x2 :: CChar) <- peekElemOff ptr 1 case x2 of 0 -> pure True 46 -> do -- ASCII for ‘.’ (x3 :: CChar) <- peekElemOff ptr 2 pure $! x3 == 0 _ -> pure False _ -> pure False go :: IO (Maybe (OsPath, Basename OsPath, FileType)) go = do x <- DirInternals.readDirStreamWithPtr cache (\dirEnt -> do (namePtr :: CString) <- DirInternals.dirEntName dirEnt shouldSkip <- shouldSkipDirEntry namePtr if shouldSkip then pure Nothing else do !path <- peekFilePath namePtr let fullPath = root coerce path !typ <- DirInternals.dirEntType dirEnt typ' <- case typ of DirInternals.UnknownType -> getFileType fullPath DirInternals.NamedPipeType -> pure regularOther DirInternals.CharacterDeviceType -> pure regularOther DirInternals.DirectoryType -> pure regularDirectory DirInternals.BlockDeviceType -> pure regularOther DirInternals.RegularFileType -> pure regularFile DirInternals.SymbolicLinkType -> getFileType fullPath DirInternals.SocketType -> pure regularOther DirInternals.WhiteoutType -> pure regularOther -- Unaccounted type, probably should not happeen since the -- list above is exhaustive. _ -> getFileType fullPath pure (Just (fullPath, Basename $ coerce path, typ'))) stream case x of Nothing -> pure Nothing Just Nothing -> go Just res@(Just _) -> pure res # endif #endif _readRawDirStreamSimple :: RawDirStream -> IO (Maybe OsPath) #ifdef mingw32_HOST_OS _readRawDirStreamSimple (RawDirStream h fdat hasMore _) = go where go = do hasMore' <- Counter.get hasMore if hasMore' /= 0 then do filename <- Win32.getFindDataFileName fdat hasMore'' <- Win32.findNextFile h fdat unless hasMore'' $ Counter.set hasMore 0 if filename == getOsString [osp|.|] || filename == getOsString [osp|..|] then go else pure $ Just $ OsString filename else pure Nothing #endif #ifndef mingw32_HOST_OS _readRawDirStreamSimple (RawDirStream stream _) = go where # ifndef HAVE_UNIX_CACHE go = do fp <- Posix.readDirStream stream case () of _ | fp == mempty -> pure Nothing | fp == getOsString [osp|.|] || fp == getOsString [osp|..|] -> go | otherwise -> pure $ Just $ OsString fp # endif # ifdef HAVE_UNIX_CACHE go = do fp <- Posix.readDirStreamMaybe stream case fp of Nothing -> pure Nothing Just fp' | fp' == getOsString [osp|.|] || fp' == getOsString [osp|..|] -> go | otherwise -> pure $ Just $ OsString fp' # endif #endif directory-ospath-streaming-0.2.2/src/System/Directory/OsPath/Types.hs0000644000000000000000000000236207346545000024053 0ustar0000000000000000-- | -- Module: System.Directory.OsPath.Types -- Copyright: (c) Sergey Vinokurov 2024 -- License: Apache-2.0 (see LICENSE) -- Maintainer: serg.foo@gmail.com {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module System.Directory.OsPath.Types ( SymlinkType(..) , FileType(..) , Basename(..) , Relative(..) ) where import Control.DeepSeq (NFData) import GHC.Generics (Generic, Generic1) data SymlinkType = Regular | Symlink deriving (Show, Read, Eq, Ord, Generic) instance NFData SymlinkType data FileType = File {-# UNPACK #-} !SymlinkType | Directory {-# UNPACK #-} !SymlinkType | Other {-# UNPACK #-} !SymlinkType deriving (Show, Read, Eq, Ord, Generic) instance NFData FileType -- | Basename part of filename, without directory separators. newtype Basename a = Basename { unBasename :: a } deriving (Eq, Ord, Show, Generic, Generic1, NFData, Functor, Foldable, Traversable) -- | Filename relative to some other path. newtype Relative a = Relative { unRelative :: a } deriving (Eq, Ord, Show, Generic, Generic1, NFData, Functor, Foldable, Traversable) directory-ospath-streaming-0.2.2/src/System/Directory/OsPath/Utils.hs0000644000000000000000000000064107346545000024045 0ustar0000000000000000-- | -- Module: System.Directory.OsPath.Utils -- Copyright: (c) Sergey Vinokurov 2024 -- License: Apache-2.0 (see LICENSE) -- Maintainer: serg.foo@gmail.com {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} module System.Directory.OsPath.Utils ( touch ) where import GHC.Exts (touch#) import GHC.IO (IO(..)) touch :: x -> IO () touch x = IO $ \s0 -> case touch# x s0 of s1 -> (# s1, () #) directory-ospath-streaming-0.2.2/test/0000755000000000000000000000000007346545000016152 5ustar0000000000000000directory-ospath-streaming-0.2.2/test/TestMain.hs0000644000000000000000000001260707346545000020240 0ustar0000000000000000-- | -- Module: TestMain -- Copyright: (c) Sergey Vinokurov 2023 -- License: Apache-2.0 (see LICENSE) -- Maintainer: serg.foo@gmail.com {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} module TestMain (main) where import Control.Exception import qualified Data.List as L import System.OsPath import System.Directory.OsPath.Streaming import Test.Tasty import Test.Tasty.HUnit #ifndef mingw32_HOST_OS import Numeric (showHex) import System.Directory.OsPath import System.OsString.Internal.Types (getOsString) import System.Random import qualified System.Posix.Files.PosixString as Posix #endif main :: IO () main = defaultMain tests tests :: TestTree tests = testGroup "Tests" [ testCase "readDirStream" $ do res <- bracket (openDirStream [osp|test/filesystem|]) closeDirStream $ \ds -> do Just w <- readDirStream ds Just x <- readDirStream ds Just y <- readDirStream ds Just z <- readDirStream ds return $ L.sort [w, x, y, z] res @?= [([osp|bar.txt|], File Regular), ([osp|baz.txt|], File Regular), ([osp|bin|], Directory Regular), ([osp|foo.txt|], File Regular)] , testGroup "getFileType general" [ testCase "file" $ do getFileType [osp|directory-ospath-streaming.cabal|] >>= (@?= File Regular) , testCase "directory" $ do getFileType [osp|test|] >>= (@?= Directory Regular) ] , testGroup "contents" [ testCase "getDirectoryContentsRecursive" $ do res <- L.sort <$> getDirectoryContentsRecursive [osp|test/filesystem|] res @?= [([osp|bar.txt|], File Regular), ([osp|baz.txt|], File Regular), ([osp|bin|], Directory Regular), ([osp|bin|] [osp|bin.txt|], File Regular), ([osp|foo.txt|], File Regular)] , testCase "getDirectoryContentsWithFilterRecursive 1" $ do res <- L.sort <$> getDirectoryContentsWithFilterRecursive (\_ _ -> True) (const True) [osp|test/filesystem|] res @?= [([osp|bar.txt|], File Regular), ([osp|baz.txt|], File Regular), ([osp|bin|], Directory Regular), ([osp|bin|] [osp|bin.txt|], File Regular), ([osp|foo.txt|], File Regular)] , testCase "getDirectoryContentsWithFilterRecursive 2" $ do res <- L.sort <$> getDirectoryContentsWithFilterRecursive (\x _ -> x /= Basename [osp|bin|]) (const True) [osp|test/filesystem|] res @?= [([osp|bar.txt|], File Regular), ([osp|baz.txt|], File Regular), ([osp|bin|], Directory Regular), ([osp|foo.txt|], File Regular)] , testCase "getDirectoryContentsWithFilterRecursive 3" $ do res <- L.sort <$> getDirectoryContentsWithFilterRecursive (\_ _ -> True) (`elem` [Basename [osp|foo.txt|], Basename [osp|bin|], Basename [osp|bin.txt|]]) [osp|test/filesystem|] res @?= [([osp|bin|], Directory Regular), ([osp|bin|] [osp|bin.txt|], File Regular), ([osp|foo.txt|], File Regular)] ] #ifndef mingw32_HOST_OS , withResource (do tmp <- getTemporaryDirectory >>= canonicalizePath createFreshTempDir tmp [osp|test|]) removeDirectoryRecursive $ \mkTmpDir -> testGroup "getFileType unix" [ testCase "file symlink" $ do tmp <- mkTmpDir currDir <- getCurrentDirectory let dest = tmp [osp|tmp1|] Posix.createSymbolicLink (getOsString (currDir [osp|directory-ospath-streaming.cabal|])) (getOsString dest) ft <- getFileType dest ft @?= File Symlink , testCase "directory symlink" $ do tmp <- mkTmpDir currDir <- getCurrentDirectory let dest = tmp [osp|tmp2|] Posix.createSymbolicLink (getOsString (currDir [osp|src|])) (getOsString dest) ft <- getFileType dest ft @?= Directory Symlink , testCase "other" $ do tmp <- mkTmpDir let dest = tmp [osp|tmp3|] res <- tryIO $ Posix.createNamedPipe (getOsString dest) 0 case res of -- Creating named pipe might fail on some filesystems Left _ -> pure () Right _ -> do ft <- getFileType dest ft @?= Other Regular , testCase "recursive symlink is other" $ do tmp <- mkTmpDir let dest = tmp [osp|tmp4|] Posix.createSymbolicLink (getOsString dest) (getOsString dest) ft <- getFileType dest ft @?= Other Symlink , testCase "dangling symlink is other" $ do tmp <- mkTmpDir let dest = tmp [osp|tmp5|] Posix.createSymbolicLink (getOsString (tmp [osp|does-not-exist|])) (getOsString dest) ft <- getFileType dest ft @?= Other Symlink ] #endif ] #ifndef mingw32_HOST_OS tryIO :: IO a -> IO (Either IOException a) tryIO = try createFreshTempDir :: OsPath -> OsPath -> IO OsPath createFreshTempDir dir prefix = go where go = do (n :: Word) <- randomIO n' <- encodeUtf (showHex n []) let path = dir prefix <> [osp|-|] <> n' exists <- doesDirectoryExist path if exists then go else do createDirectory path pure path #endif directory-ospath-streaming-0.2.2/test/filesystem/0000755000000000000000000000000007346545000020336 5ustar0000000000000000directory-ospath-streaming-0.2.2/test/filesystem/bar.txt0000644000000000000000000000000007346545000021631 0ustar0000000000000000directory-ospath-streaming-0.2.2/test/filesystem/baz.txt0000644000000000000000000000000007346545000021641 0ustar0000000000000000directory-ospath-streaming-0.2.2/test/filesystem/bin/0000755000000000000000000000000007346545000021106 5ustar0000000000000000directory-ospath-streaming-0.2.2/test/filesystem/bin/bin.txt0000644000000000000000000000000007346545000022405 0ustar0000000000000000directory-ospath-streaming-0.2.2/test/filesystem/foo.txt0000644000000000000000000000000007346545000021650 0ustar0000000000000000