hpath-posix (empty) → 0.13.0
raw patch · 9 files changed
+506/−0 lines, 9 filesdep +IfElsedep +basedep +bytestringsetup-changed
Dependencies added: IfElse, base, bytestring, exceptions, fail, hpath-filepath, safe-exceptions, streamly, streamly-bytestring, time, unbuildable, unix, unix-bytestring, utf8-string
Files
- CHANGELOG.md +5/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- cbits/dirutils.c +7/−0
- cbits/dirutils.h +13/−0
- hpath-posix.cabal +56/−0
- src/System/Posix/FD.hs +75/−0
- src/System/Posix/Foreign.hsc +55/−0
- src/System/Posix/RawFilePath/Directory/Traversals.hs +263/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for hpath-posix++## 0.1.0.0 -- 2020-01-29++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2020, Julian Ospald++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 Julian Ospald 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
+ cbits/dirutils.c view
@@ -0,0 +1,7 @@+#include "dirutils.h"+unsigned int+ __posixdir_d_type(struct dirent* d)+ {+ return(d -> d_type);+ }+
+ cbits/dirutils.h view
@@ -0,0 +1,13 @@+#ifndef POSIXPATHS_CBITS_DIRUTILS_H+#define POSIXPATHS_CBITS_DIRUTILS_H++#include <stdlib.h>+#include <dirent.h>+#include <sys/types.h>+#include <sys/stat.h>+#include <fcntl.h>++extern unsigned int+ __posixdir_d_type(struct dirent* d)+ ;+#endif
+ hpath-posix.cabal view
@@ -0,0 +1,56 @@+cabal-version: >=1.10++name: hpath-posix+version: 0.13.0+synopsis: Some low-level POSIX glue code, that is not in 'unix'+homepage: https://github.com/hasufell/hpath+bug-reports: https://github.com/hasufell/hpath/issues+license: BSD3+license-file: LICENSE+author: Julian Ospald <hasufell@posteo.de>+maintainer: Julian Ospald <hasufell@posteo.de>+copyright: Julian Ospald <hasufell@posteo.de> 2020+category: Filesystem+build-type: Simple+extra-source-files: CHANGELOG.md+ cbits/dirutils.h+tested-with: GHC==7.10.3+ , GHC==8.0.2+ , GHC==8.2.2+ , GHC==8.4.4+ , GHC==8.6.5+ , GHC==8.8.1++library+ if os(windows)+ build-depends: unbuildable<0+ buildable: False+ exposed-modules: System.Posix.RawFilePath.Directory.Traversals+ System.Posix.Foreign+ System.Posix.FD+ -- other-modules:+ -- other-extensions:+ c-sources: cbits/dirutils.c+ build-depends: base >= 4.8 && <5+ , IfElse+ , bytestring >= 0.10+ , exceptions >= 0.10+ , hpath-filepath >= 0.10.3+ , safe-exceptions >= 0.1+ , streamly >= 0.7+ , streamly-bytestring >= 0.1.0.1+ , time >= 1.8+ , unix >= 2.5+ , unix-bytestring >= 0.3+ , utf8-string+ if impl(ghc < 8.0)+ build-depends:+ fail >= 4.9++ hs-source-dirs: src+ default-language: Haskell2010+ default-extensions: PackageImports++source-repository head+ type: git+ location: https://github.com/hasufell/hpath
+ src/System/Posix/FD.hs view
@@ -0,0 +1,75 @@+-- |+-- Module : System.Posix.FD+-- Copyright : © 2016 Julian Ospald+-- License : BSD3+--+-- Maintainer : Julian Ospald <hasufell@posteo.de>+-- Stability : experimental+-- Portability : portable+--+-- Provides an alternative for `System.Posix.IO.ByteString.openFd`+-- which gives us more control on what status flags to pass to the+-- low-level @open(2)@ call, in contrast to the unix package.+++{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}++{-# OPTIONS_GHC -Wall #-}+++module System.Posix.FD (+ openFd+) where+++import Foreign.C.String+import Foreign.C.Types+import System.Posix.Foreign+import qualified System.Posix as Posix+import System.Posix.ByteString.FilePath+++foreign import ccall unsafe "open"+ c_open :: CString -> CInt -> Posix.CMode -> IO CInt+++open_ :: CString+ -> Posix.OpenMode+ -> [Flags]+ -> Maybe Posix.FileMode+ -> IO Posix.Fd+open_ str how optional_flags maybe_mode = do+ fd <- c_open str all_flags mode_w+ return (Posix.Fd fd)+ where+ all_flags = unionFlags $ optional_flags ++ [open_mode] ++ creat+++ (creat, mode_w) = case maybe_mode of+ Nothing -> ([],0)+ Just x -> ([oCreat], x)++ open_mode = case how of+ Posix.ReadOnly -> oRdonly+ Posix.WriteOnly -> oWronly+ Posix.ReadWrite -> oRdwr+++-- |Open and optionally create this file. See 'System.Posix.Files'+-- for information on how to use the 'FileMode' type.+--+-- Note that passing @Just x@ as the 4th argument triggers the+-- `oCreat` status flag, which must be set when you pass in `oExcl`+-- to the status flags. Also see the manpage for @open(2)@.+openFd :: RawFilePath+ -> Posix.OpenMode+ -> [Flags] -- ^ status flags of @open(2)@+ -> Maybe Posix.FileMode -- ^ @Just x@ => creates the file with the given modes, Nothing => the file must exist.+ -> IO Posix.Fd+openFd name how optional_flags maybe_mode =+ withFilePath name $ \str ->+ throwErrnoPathIfMinus1Retry "openFd" name $+ open_ str how optional_flags maybe_mode+
+ src/System/Posix/Foreign.hsc view
@@ -0,0 +1,55 @@+module System.Posix.Foreign where++import Data.Bits+import Data.List (foldl')+import Foreign.C.Types++#include <limits.h>+#include <stdlib.h>+#include <dirent.h>+#include <sys/types.h>+#include <sys/stat.h>+#include <fcntl.h>++newtype DirType = DirType Int deriving (Eq, Show)+data Flags = Flags Int | UnsupportedFlag String deriving (Eq, Show)++unFlags :: Flags -> Int+unFlags (Flags i) = i+unFlags (UnsupportedFlag name) = error (name ++ " is not supported on this platform")++-- |Returns @True@ if posix-paths was compiled with support for the provided+-- flag. (As of this writing, the only flag for which this check may be+-- necessary is 'oCloexec'; all other flags will always yield @True@.)+isSupported :: Flags -> Bool+isSupported (Flags _) = True+isSupported _ = False++-- |@O_CLOEXEC@ is not supported on every POSIX platform. Use+-- @'isSupported' oCloexec@ to determine if support for @O_CLOEXEC@ was+-- compiled into your version of posix-paths. (If not, using @oCloexec@ will+-- throw an exception.)+oCloexec :: Flags+#ifdef O_CLOEXEC+oCloexec = Flags #{const O_CLOEXEC}+#else+{-# WARNING oCloexec+ "This version of posix-paths was compiled without @O_CLOEXEC@ support." #-}+oCloexec = UnsupportedFlag "O_CLOEXEC"+#endif++++-- If these enum declarations occur earlier in the file, haddock+-- gets royally confused about the above doc comments.+-- Probably http://trac.haskell.org/haddock/ticket/138++#{enum DirType, DirType, DT_BLK, DT_CHR, DT_DIR, DT_FIFO, DT_LNK, DT_REG, DT_SOCK, DT_UNKNOWN}++#{enum Flags, Flags, O_APPEND, O_ASYNC, O_CREAT, O_DIRECTORY, O_EXCL, O_NOCTTY, O_NOFOLLOW, O_NONBLOCK, O_RDONLY, O_WRONLY, O_RDWR, O_SYNC, O_TRUNC}++pathMax :: Int+pathMax = #{const PATH_MAX}++unionFlags :: [Flags] -> CInt+unionFlags = fromIntegral . foldl' ((. unFlags) . (.|.)) 0
+ src/System/Posix/RawFilePath/Directory/Traversals.hs view
@@ -0,0 +1,263 @@+-- |+-- Module : System.Posix.RawFilePath.Directory.Traversals+-- Copyright : © 2016 Julian Ospald+-- License : BSD3+--+-- Maintainer : Julian Ospald <hasufell@posteo.de>+-- Stability : experimental+-- Portability : portable+--+-- Traversal and read operations on directories.+++{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ViewPatterns #-}++{-# OPTIONS_GHC -Wall #-}+++module System.Posix.RawFilePath.Directory.Traversals (++ getDirectoryContents+, getDirectoryContents'++, allDirectoryContents+, allDirectoryContents'+, traverseDirectory++-- lower-level stuff+, readDirEnt+, packDirStream+, unpackDirStream+, fdOpendir++, realpath+) where+++#if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<$>))+#endif+import Control.Monad+import System.Posix.FilePath ((</>))+import System.Posix.Foreign++import qualified System.Posix as Posix+import System.IO.Error+import Control.Exception+import qualified Data.ByteString.Char8 as BS+import System.Posix.ByteString.FilePath+import System.Posix.Directory.ByteString as PosixBS+import System.Posix.Files.ByteString++import System.IO.Unsafe+import "unix" System.Posix.IO.ByteString (closeFd)+import Unsafe.Coerce (unsafeCoerce)+import Foreign.C.Error+import Foreign.C.String+import Foreign.C.Types+import Foreign.Marshal.Alloc (alloca,allocaBytes)+import Foreign.Ptr+import Foreign.Storable+++++----------------------------------------------------------++-- | Get all files from a directory and its subdirectories.+--+-- Upon entering a directory, 'allDirectoryContents' will get all entries+-- strictly. However the returned list is lazy in that directories will only+-- be accessed on demand.+--+-- Follows symbolic links for the input dir.+allDirectoryContents :: RawFilePath -> IO [RawFilePath]+allDirectoryContents topdir = do+ namesAndTypes <- getDirectoryContents topdir+ let properNames = filter ((`notElem` [".", ".."]) . snd) namesAndTypes+ paths <- forM properNames $ \(typ,name) -> unsafeInterleaveIO $ do+ let path = topdir </> name+ case () of+ () | typ == dtDir -> allDirectoryContents path+ | typ == dtUnknown -> do+ isDir <- isDirectory <$> getFileStatus path+ if isDir+ then allDirectoryContents path+ else return [path]+ | otherwise -> return [path]+ return (topdir : concat paths)++-- | Get all files from a directory and its subdirectories strictly.+--+-- Follows symbolic links for the input dir.+allDirectoryContents' :: RawFilePath -> IO [RawFilePath]+allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp:acc)) []+-- this uses traverseDirectory because it's more efficient than forcing the+-- lazy version.++-- | Recursively apply the 'action' to the parent directory and all+-- files/subdirectories.+--+-- This function allows for memory-efficient traversals.+--+-- Follows symbolic links for the input dir.+traverseDirectory :: (s -> RawFilePath -> IO s) -> s -> RawFilePath -> IO s+traverseDirectory act s0 topdir = toploop+ where+ toploop = do+ isDir <- isDirectory <$> getFileStatus topdir+ s' <- act s0 topdir+ if isDir then actOnDirContents topdir s' loop+ else return s'+ loop typ path acc = do+ isDir <- case () of+ () | typ == dtDir -> return True+ | typ == dtUnknown -> isDirectory <$> getFileStatus path+ | otherwise -> return False+ if isDir+ then act acc path >>= \acc' -> actOnDirContents path acc' loop+ else act acc path++actOnDirContents :: RawFilePath+ -> b+ -> (DirType -> RawFilePath -> b -> IO b)+ -> IO b+actOnDirContents pathRelToTop b f =+ modifyIOError ((`ioeSetFileName` (BS.unpack pathRelToTop)) .+ (`ioeSetLocation` "findBSTypRel")) $+ bracket+ (openDirStream pathRelToTop)+ Posix.closeDirStream+ (\dirp -> loop dirp b)+ where+ loop dirp b' = do+ (typ,e) <- readDirEnt dirp+ if (e == "")+ then return b'+ else+ if (e == "." || e == "..")+ then loop dirp b'+ else f typ (pathRelToTop </> e) b' >>= loop dirp+++----------------------------------------------------------+-- dodgy stuff++type CDir = ()+type CDirent = ()++-- Posix doesn't export DirStream, so to re-use that type we need to use+-- unsafeCoerce. It's just a newtype, so this is a legitimate usage.+-- ugly trick.+unpackDirStream :: DirStream -> Ptr CDir+unpackDirStream = unsafeCoerce++packDirStream :: Ptr CDir -> DirStream+packDirStream = unsafeCoerce++-- the __hscore_* functions are defined in the unix package. We can import them and let+-- the linker figure it out.+foreign import ccall unsafe "__hscore_readdir"+ c_readdir :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt++foreign import ccall unsafe "__hscore_free_dirent"+ c_freeDirEnt :: Ptr CDirent -> IO ()++foreign import ccall unsafe "__hscore_d_name"+ c_name :: Ptr CDirent -> IO CString++foreign import ccall unsafe "__posixdir_d_type"+ c_type :: Ptr CDirent -> IO DirType++foreign import ccall "realpath"+ c_realpath :: CString -> CString -> IO CString++foreign import ccall unsafe "fdopendir"+ c_fdopendir :: Posix.Fd -> IO (Ptr ())++----------------------------------------------------------+-- less dodgy but still lower-level+++readDirEnt :: DirStream -> IO (DirType, RawFilePath)+readDirEnt (unpackDirStream -> dirp) =+ alloca $ \ptr_dEnt -> loop ptr_dEnt+ where+ loop ptr_dEnt = do+ resetErrno+ r <- c_readdir dirp ptr_dEnt+ if (r == 0)+ then do+ dEnt <- peek ptr_dEnt+ if (dEnt == nullPtr)+ then return (dtUnknown,BS.empty)+ else do+ dName <- c_name dEnt >>= peekFilePath+ dType <- c_type dEnt+ c_freeDirEnt dEnt+ return (dType, dName)+ else do+ errno <- getErrno+ if (errno == eINTR)+ then loop ptr_dEnt+ else do+ let (Errno eo) = errno+ if (eo == 0)+ then return (dtUnknown,BS.empty)+ else throwErrno "readDirEnt"+++-- |Gets all directory contents (not recursively).+getDirectoryContents :: RawFilePath -> IO [(DirType, RawFilePath)]+getDirectoryContents path =+ modifyIOError ((`ioeSetFileName` (BS.unpack path)) .+ (`ioeSetLocation` "System.Posix.RawFilePath.Directory.Traversals.getDirectoryContents")) $+ bracket+ (PosixBS.openDirStream path)+ PosixBS.closeDirStream+ _dirloop+++-- |Binding to @fdopendir(3)@.+fdOpendir :: Posix.Fd -> IO DirStream+fdOpendir fd =+ packDirStream <$> throwErrnoIfNull "fdOpendir" (c_fdopendir fd)+++-- |Like `getDirectoryContents` except for a file descriptor.+--+-- To avoid complicated error checks, the file descriptor is+-- __always__ closed, even if `fdOpendir` fails. Usually, this+-- only happens on successful `fdOpendir` and after the directory+-- stream is closed. Also see the manpage of @fdopendir(3)@ for+-- more details.+getDirectoryContents' :: Posix.Fd -> IO [(DirType, RawFilePath)]+getDirectoryContents' fd = do+ dirstream <- fdOpendir fd `catchIOError` \e -> do+ closeFd fd+ ioError e+ -- closeDirStream closes the filedescriptor+ finally (_dirloop dirstream) (PosixBS.closeDirStream dirstream)+++_dirloop :: DirStream -> IO [(DirType, RawFilePath)]+{-# INLINE _dirloop #-}+_dirloop dirp = do+ t@(_typ,e) <- readDirEnt dirp+ if BS.null e then return [] else do+ es <- _dirloop dirp+ return (t:es)+++-- | return the canonicalized absolute pathname+--+-- like canonicalizePath, but uses @realpath(3)@+realpath :: RawFilePath -> IO RawFilePath+realpath inp =+ allocaBytes pathMax $ \tmp -> do+ void $ BS.useAsCString inp $ \cstr -> throwErrnoIfNull "realpath" $ c_realpath cstr tmp+ BS.packCString tmp