From 63dda1da7f6d5f9ab526a1fac2754aa2d123d0d6 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Fri, 29 Oct 2021 14:10:46 +0200 Subject: [PATCH 01/17] Migrate hpath to abstractfilepath --- cabal.project | 9 +++ hpath/hpath.cabal | 5 +- hpath/src/HPath.hs | 106 ++++++++++++++++++------------------ hpath/src/HPath/Internal.hs | 23 ++++++-- 4 files changed, 84 insertions(+), 59 deletions(-) diff --git a/cabal.project b/cabal.project index 48842ae..0db59d4 100644 --- a/cabal.project +++ b/cabal.project @@ -4,6 +4,15 @@ packages: ./hpath ./hpath-io ./hpath-posix +source-repository-package + type: git + location: https://github.com/hasufell/abstract-filepath.git + tag: 7fafc70f37cdde9244cf3e3dab22228fa4e490b7 + subdir: abstract-filepath + abstract-filepath-types + abstract-filepath-unix + abstract-filepath-Win32 + package hpath-io ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 diff --git a/hpath/hpath.cabal b/hpath/hpath.cabal index e1373d1..423ba53 100644 --- a/hpath/hpath.cabal +++ b/hpath/hpath.cabal @@ -31,8 +31,9 @@ library ghc-options: -Wall exposed-modules: HPath other-modules: HPath.Internal - build-depends: base >= 4.8 && <5 - , bytestring >= 0.10.0.0 + build-depends: abstract-filepath + , base >= 4.8 && <5 + , bytestring >= 0.10.0.0 , deepseq , exceptions , hpath-filepath >= 0.10 && < 0.11 diff --git a/hpath/src/HPath.hs b/hpath/src/HPath.hs index 7ec8bd8..b3b6201 100644 --- a/hpath/src/HPath.hs +++ b/hpath/src/HPath.hs @@ -34,8 +34,11 @@ module HPath #endif -- * Path Construction ,parseAbs + ,parseAbs' ,parseRel + ,parseRel' ,parseAny + ,parseAny' ,rootPath ,pwdPath -- * Path Conversion @@ -65,26 +68,24 @@ module HPath ) where +import AFP.AbstractFilePath hiding (()) +import qualified AFP.AbstractFilePath as AFP import Control.Exception (Exception) import Control.Monad.Catch (MonadThrow(..)) -#if MIN_VERSION_bytestring(0,10,8) -import Data.ByteString(ByteString, stripPrefix) -#else -import Data.ByteString(ByteString) import qualified Data.List as L -#endif -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 import Data.Data import Data.Maybe -import Data.Word8 import HPath.Internal import Language.Haskell.TH import Language.Haskell.TH.Syntax (Lift(..), lift) -import qualified Language.Haskell.TH.Syntax as TH import Language.Haskell.TH.Quote (QuasiQuoter(..)) import Prelude hiding (abs, any) -import System.Posix.FilePath hiding (()) + +-- $setup +-- >>> :set -XQuasiQuotes +-- >>> :set -XOverloadedStrings +-- >>> import Prelude hiding (abs, any) +-- >>> import HPath -------------------------------------------------------------------------------- @@ -98,9 +99,9 @@ data Rel deriving (Typeable) -- | Exception when parsing a location. data PathParseException - = InvalidAbs ByteString - | InvalidRel ByteString - | Couldn'tStripPrefixTPS ByteString ByteString + = InvalidAbs AbstractFilePath + | InvalidRel AbstractFilePath + | Couldn'tStripPrefixTPS AbstractFilePath AbstractFilePath deriving (Show,Typeable) instance Exception PathParseException @@ -113,7 +114,7 @@ instance Exception PathException -- PatternSynonyms #if __GLASGOW_HASKELL__ >= 710 -pattern Path :: ByteString -> Path a +pattern Path :: AbstractFilePath -> Path a #endif #if __GLASGOW_HASKELL__ >= 708 pattern Path x <- (MkPath x) @@ -143,14 +144,18 @@ pattern Path x <- (MkPath x) -- >>> parseAbs "/abc/../foo" -- *** Exception: InvalidAbs "/abc/../foo" parseAbs :: MonadThrow m - => ByteString -> m (Path Abs) -parseAbs filepath = + => AbstractFilePath -> m (Path Abs) +parseAbs filepath = do if isAbsolute filepath && isValid filepath && not (hasParentDir filepath) - then return (MkPath . dropTrailingPathSeparator . normalise $ filepath) + then pure . MkPath . dropTrailingPathSeparator . normalise $ filepath else throwM (InvalidAbs filepath) +parseAbs' :: MonadThrow m + => String -> m (Path Abs) +parseAbs' = parseAbs . toAbstractFilePath + -- | Get a location for a relative path. Produces a normalised -- path. @@ -183,15 +188,18 @@ parseAbs filepath = -- >>> parseRel ".." -- *** Exception: InvalidRel ".." parseRel :: MonadThrow m - => ByteString -> m (Path Rel) -parseRel filepath = + => AbstractFilePath -> m (Path Rel) +parseRel filepath = do if not (isAbsolute filepath) && - filepath /= BS.pack [_period, _period] && + filepath /= [afp|..|] && not (hasParentDir filepath) && isValid filepath - then return (MkPath . dropTrailingPathSeparator . normalise $ filepath) + then return . MkPath . dropTrailingPathSeparator . normalise $ filepath else throwM (InvalidRel filepath) +parseRel' :: MonadThrow m + => String -> m (Path Rel) +parseRel' = parseRel . toAbstractFilePath -- | Parses a path, whether it's relative or absolute. @@ -216,39 +224,43 @@ parseRel filepath = -- Right "." -- >>> parseAny ".." -- *** Exception: InvalidRel ".." -parseAny :: MonadThrow m => ByteString -> m (Either (Path Abs) (Path Rel)) +parseAny :: MonadThrow m => AbstractFilePath -> m (Either (Path Abs) (Path Rel)) parseAny filepath = case parseAbs filepath of Just p -> pure $ Left p Nothing -> case parseRel filepath of Just p -> pure $ Right p Nothing -> throwM (InvalidRel filepath) +parseAny' :: MonadThrow m + => String -> m (Either (Path Abs) (Path Rel)) +parseAny' = parseAny . toAbstractFilePath + -- | The @"/"@ root path. rootPath :: Path Abs -rootPath = (MkPath (BS.singleton _slash)) +rootPath = MkPath [afp|/|] -- | The @"."@ pwd path. pwdPath :: Path Rel -pwdPath = (MkPath (BS.singleton _period)) +pwdPath = MkPath [afp|.|] -------------------------------------------------------------------------------- -- Path Conversion --- | Convert any Path to a ByteString type. -toFilePath :: Path b -> ByteString +-- | Convert any Path to an AbstractFilePath type. +toFilePath :: Path b -> AbstractFilePath toFilePath (MkPath l) = l --- | Convert an absolute Path to a ByteString type. -fromAbs :: Path Abs -> ByteString +-- | Convert an absolute Path to a AbstractFilePath type. +fromAbs :: Path Abs -> AbstractFilePath fromAbs = toFilePath --- | Convert a relative Path to a ByteString type. -fromRel :: Path Rel -> ByteString +-- | Convert a relative Path to a AbstractFilePath type. +fromRel :: Path Rel -> AbstractFilePath fromRel = toFilePath -fromAny :: Either (Path Abs) (Path Rel) -> ByteString +fromAny :: Either (Path Abs) (Path Rel) -> AbstractFilePath fromAny = either toFilePath toFilePath @@ -276,7 +288,7 @@ fromAny = either toFilePath toFilePath -- "." () :: Path b -> Path Rel -> Path b () (MkPath a) (MkPath b) = - MkPath (dropTrailingPathSeparator $ normalise (addTrailingPathSeparator a `BS.append` b)) + MkPath (dropTrailingPathSeparator $ normalise (a AFP. b)) -- | Strip directory from path, making it relative to that directory. @@ -303,9 +315,9 @@ fromAny = either toFilePath toFilePath stripDir :: MonadThrow m => Path b -> Path b -> m (Path Rel) stripDir (MkPath p) (MkPath l) | p == l = return pwdPath - | otherwise = case stripPrefix (addTrailingPathSeparator p) l of - Nothing -> throwM (Couldn'tStripPrefixTPS p l) - Just ok -> return (MkPath ok) + | otherwise = case L.stripPrefix (unpackAFP $ addTrailingPathSeparator p) (unpackAFP l) of + Nothing -> throwM (Couldn'tStripPrefixTPS p l) + Just ok -> return (MkPath $ packAFP ok) -- |Get all parents of a path. @@ -318,7 +330,7 @@ stripDir (MkPath p) (MkPath l) -- [] getAllParents :: Path Abs -> [Path Abs] getAllParents (MkPath p) - | np == BS.singleton pathSeparator = [] + | np == [afp|/|] = [] | otherwise = dirname (MkPath np) : getAllParents (dirname $ MkPath np) where np = normalise p @@ -446,11 +458,11 @@ isPwdPath = (== pwdPath) -- Path IO helpers -withAbsPath :: Path Abs -> (ByteString -> IO a) -> IO a +withAbsPath :: Path Abs -> (AbstractFilePath -> IO a) -> IO a withAbsPath (MkPath p) action = action p -withRelPath :: Path Rel -> (ByteString -> IO a) -> IO a +withRelPath :: Path Rel -> (AbstractFilePath -> IO a) -> IO a withRelPath (MkPath p) action = action p @@ -468,20 +480,10 @@ stripPrefix a b = BS.pack `fmap` L.stripPrefix (BS.unpack a) (BS.unpack b) ------------------------ -- QuasiQuoters -instance Typeable a => Lift (Path a) where - lift (MkPath bs) = [| MkPath (BS.pack $(lift $ BS.unpack bs)) :: Path $(pure a) |] - where - a = TH.ConT $ TH.Name occ flav - where - tc = typeRepTyCon (typeRep (Proxy :: Proxy a)) - occ = TH.OccName (tyConName tc) - flav = TH.NameG TH.TcClsName (TH.PkgName (tyConPackage tc)) (TH.ModName (tyConModule tc)) - - -qq :: (ByteString -> Q Exp) -> QuasiQuoter +qq :: (AbstractFilePath -> Q Exp) -> QuasiQuoter qq quoteExp' = QuasiQuoter - { quoteExp = (\s -> quoteExp' . fromString $ s) + { quoteExp = (\s -> quoteExp' . toAbstractFilePath $ s) , quotePat = \_ -> fail "illegal QuasiQuote (allowed as expression only, used as a pattern)" , quoteType = \_ -> @@ -490,10 +492,10 @@ qq quoteExp' = fail "illegal QuasiQuote (allowed as expression only, used as a declaration)" } -mkAbs :: ByteString -> Q Exp +mkAbs :: AbstractFilePath -> Q Exp mkAbs = either (error . show) lift . parseAbs -mkRel :: ByteString -> Q Exp +mkRel :: AbstractFilePath -> Q Exp mkRel = either (error . show) lift . parseRel -- | Quasiquote an absolute Path. This accepts Unicode Chars and will encode as UTF-8. diff --git a/hpath/src/HPath/Internal.hs b/hpath/src/HPath/Internal.hs index 2d5077e..789e6ea 100644 --- a/hpath/src/HPath/Internal.hs +++ b/hpath/src/HPath/Internal.hs @@ -1,4 +1,8 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | Internal types and functions. @@ -6,9 +10,12 @@ module HPath.Internal (Path(..)) where +import AFP.AbstractFilePath import Control.DeepSeq (NFData (..)) -import Data.ByteString (ByteString) import Data.Data +import GHC.Generics (Generic) +import Language.Haskell.TH.Syntax (Lift(..), lift) +import qualified Language.Haskell.TH.Syntax as TH -- | The main Path type. -- @@ -31,8 +38,8 @@ import Data.Data -- -- The constructor is not exposed. Instead, use the smart constructors -- 'HPath.parseAbs', 'HPath.parseRel' and 'HPath.parseAny'. -data Path b = MkPath ByteString - deriving (Typeable) +data Path b = MkPath AbstractFilePath + deriving (Typeable, Generic, NFData) -- | ByteString equality. -- @@ -58,6 +65,12 @@ instance Ord (Path b) where instance Show (Path b) where show (MkPath x) = show x -instance NFData (Path b) where - rnf (MkPath x) = rnf x +instance Typeable a => Lift (Path a) where + lift (MkPath bs) = [| MkPath bs :: Path $(pure a) |] + where + a = TH.ConT $ TH.Name occ flav + where + tc = typeRepTyCon (typeRep (Proxy :: Proxy a)) + occ = TH.OccName (tyConName tc) + flav = TH.NameG TH.TcClsName (TH.PkgName (tyConPackage tc)) (TH.ModName (tyConModule tc)) From e1036d3581d2bc7be4735df526f2b55f8a125de5 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Fri, 29 Oct 2021 15:36:10 +0200 Subject: [PATCH 02/17] Migrate hpath-posix to abstract-filepath --- cabal.project | 3 +- hpath-posix/hpath-posix.cabal | 11 ++-- hpath-posix/src/System/Posix/FD.hs | 5 +- .../Posix/RawFilePath/Directory/Traversals.hs | 59 +++++++++++-------- 4 files changed, 45 insertions(+), 33 deletions(-) diff --git a/cabal.project b/cabal.project index 0db59d4..c67deb2 100644 --- a/cabal.project +++ b/cabal.project @@ -4,10 +4,11 @@ packages: ./hpath ./hpath-io ./hpath-posix + source-repository-package type: git location: https://github.com/hasufell/abstract-filepath.git - tag: 7fafc70f37cdde9244cf3e3dab22228fa4e490b7 + tag: 78ddb6aa24a785d14807ceaa78652f3b41dddd39 subdir: abstract-filepath abstract-filepath-types abstract-filepath-unix diff --git a/hpath-posix/hpath-posix.cabal b/hpath-posix/hpath-posix.cabal index e3524e2..c7bf0c5 100644 --- a/hpath-posix/hpath-posix.cabal +++ b/hpath-posix/hpath-posix.cabal @@ -31,10 +31,13 @@ library -- other-modules: -- other-extensions: c-sources: cbits/dirutils.c - build-depends: base >= 4.8 && <5 - , bytestring >= 0.10 - , hpath-filepath >= 0.10.4 - , unix >= 2.5 + build-depends: abstract-filepath-unix >= 2.5 + , abstract-filepath + , abstract-filepath-types + , base >= 4.8 && <5 + , bytestring >= 0.10 + , hpath-filepath >= 0.10.4 + , unix >= 2.5 if impl(ghc < 8.0) build-depends: fail >= 4.9 diff --git a/hpath-posix/src/System/Posix/FD.hs b/hpath-posix/src/System/Posix/FD.hs index 6dbc458..bb5746c 100644 --- a/hpath-posix/src/System/Posix/FD.hs +++ b/hpath-posix/src/System/Posix/FD.hs @@ -28,7 +28,8 @@ import Foreign.C.String import Foreign.C.Types import System.Posix.Foreign import qualified System.Posix as Posix -import System.Posix.ByteString.FilePath +import System.Posix.PosixFilePath.FilePath +import AFP.AbstractFilePath.Types foreign import ccall unsafe "open" @@ -63,7 +64,7 @@ open_ str how optional_flags maybe_mode = do -- 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 +openFd :: PosixFilePath -> 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. diff --git a/hpath-posix/src/System/Posix/RawFilePath/Directory/Traversals.hs b/hpath-posix/src/System/Posix/RawFilePath/Directory/Traversals.hs index bdb3ece..2b6e6da 100644 --- a/hpath-posix/src/System/Posix/RawFilePath/Directory/Traversals.hs +++ b/hpath-posix/src/System/Posix/RawFilePath/Directory/Traversals.hs @@ -43,16 +43,15 @@ module System.Posix.RawFilePath.Directory.Traversals ( import Control.Applicative ((<$>)) #endif import Control.Monad -import System.Posix.FilePath (()) +import AFP.AbstractFilePath.Posix ((), fromPlatformString) 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.Posix.PosixFilePath.FilePath +import System.Posix.Directory.PosixFilePath as PosixBS +import System.Posix.Files.PosixString import System.IO.Unsafe import "unix" System.Posix.IO.ByteString (closeFd) @@ -64,6 +63,12 @@ import Foreign.Marshal.Alloc (alloca,allocaBytes) import Foreign.Ptr import Foreign.Storable +import AFP.AbstractFilePath.Types +import qualified AFP.OsString.Internal.Types as T + +import qualified Data.ByteString.Short as SBS + + @@ -76,7 +81,7 @@ import Foreign.Storable -- be accessed on demand. -- -- Follows symbolic links for the input dir. -allDirectoryContents :: RawFilePath -> IO [RawFilePath] +allDirectoryContents :: PosixFilePath -> IO [PosixFilePath] allDirectoryContents topdir = do namesAndTypes <- getDirectoryContents topdir let properNames = filter ((`notElem` [".", ".."]) . snd) namesAndTypes @@ -95,7 +100,7 @@ allDirectoryContents topdir = do -- | Get all files from a directory and its subdirectories strictly. -- -- Follows symbolic links for the input dir. -allDirectoryContents' :: RawFilePath -> IO [RawFilePath] +allDirectoryContents' :: PosixFilePath -> IO [PosixFilePath] allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp:acc)) [] -- this uses traverseDirectory because it's more efficient than forcing the -- lazy version. @@ -106,7 +111,7 @@ allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp: -- This function allows for memory-efficient traversals. -- -- Follows symbolic links for the input dir. -traverseDirectory :: (s -> RawFilePath -> IO s) -> s -> RawFilePath -> IO s +traverseDirectory :: (s -> PosixFilePath -> IO s) -> s -> PosixFilePath -> IO s traverseDirectory act s0 topdir = toploop where toploop = do @@ -123,12 +128,13 @@ traverseDirectory act s0 topdir = toploop then act acc path >>= \acc' -> actOnDirContents path acc' loop else act acc path -actOnDirContents :: RawFilePath +actOnDirContents :: PosixFilePath -> b - -> (DirType -> RawFilePath -> b -> IO b) + -> (DirType -> PosixFilePath -> b -> IO b) -> IO b -actOnDirContents pathRelToTop b f = - modifyIOError ((`ioeSetFileName` (BS.unpack pathRelToTop)) . +actOnDirContents pathRelToTop b f = do + locstr <- fromPlatformString pathRelToTop + modifyIOError ((`ioeSetFileName` locstr) . (`ioeSetLocation` "findBSTypRel")) $ bracket (openDirStream pathRelToTop) @@ -188,7 +194,7 @@ foreign import capi unsafe "dirent.h fdopendir" -- less dodgy but still lower-level -readDirEnt :: DirStream -> IO (DirType, RawFilePath) +readDirEnt :: DirStream -> IO (DirType, PosixFilePath) readDirEnt (unpackDirStream -> dirp) = alloca $ \ptr_dEnt -> loop ptr_dEnt where @@ -199,7 +205,7 @@ readDirEnt (unpackDirStream -> dirp) = then do dEnt <- peek ptr_dEnt if (dEnt == nullPtr) - then return (dtUnknown,BS.empty) + then return (dtUnknown, mempty) else do dName <- c_name dEnt >>= peekFilePath dType <- c_type dEnt @@ -212,14 +218,15 @@ readDirEnt (unpackDirStream -> dirp) = else do let (Errno eo) = errno if (eo == 0) - then return (dtUnknown,BS.empty) + then return (dtUnknown, mempty) else throwErrno "readDirEnt" -- |Gets all directory contents (not recursively). -getDirectoryContents :: RawFilePath -> IO [(DirType, RawFilePath)] -getDirectoryContents path = - modifyIOError ((`ioeSetFileName` (BS.unpack path)) . +getDirectoryContents :: PosixFilePath -> IO [(DirType, PosixFilePath)] +getDirectoryContents path = do + locstr <- fromPlatformString path + modifyIOError ((`ioeSetFileName` locstr) . (`ioeSetLocation` "System.Posix.RawFilePath.Directory.Traversals.getDirectoryContents")) $ bracket (PosixBS.openDirStream path) @@ -240,7 +247,7 @@ fdOpendir fd = -- 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' :: Posix.Fd -> IO [(DirType, PosixFilePath)] getDirectoryContents' fd = do dirstream <- fdOpendir fd `catchIOError` \e -> do closeFd fd @@ -249,11 +256,11 @@ getDirectoryContents' fd = do finally (_dirloop dirstream) (PosixBS.closeDirStream dirstream) -_dirloop :: DirStream -> IO [(DirType, RawFilePath)] +_dirloop :: DirStream -> IO [(DirType, PosixFilePath)] {-# INLINE _dirloop #-} _dirloop dirp = do - t@(_typ,e) <- readDirEnt dirp - if BS.null e then return [] else do + t@(_typ, e) <- readDirEnt dirp + if e == mempty then return [] else do es <- _dirloop dirp return (t:es) @@ -261,8 +268,8 @@ _dirloop dirp = do -- | return the canonicalized absolute pathname -- -- like canonicalizePath, but uses @realpath(3)@ -realpath :: RawFilePath -> IO RawFilePath -realpath inp = +realpath :: PosixFilePath -> IO PosixFilePath +realpath (T.PS inp) = fmap T.PS $ allocaBytes pathMax $ \tmp -> do - void $ BS.useAsCString inp $ \cstr -> throwErrnoIfNull "realpath" $ c_realpath cstr tmp - BS.packCString tmp + void $ SBS.useAsCString inp $ \cstr -> throwErrnoIfNull "realpath" $ c_realpath cstr tmp + SBS.packCString tmp From 3054ce1351a26187679a7b40f5f6f23d7b9df90f Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Fri, 29 Oct 2021 15:37:40 +0200 Subject: [PATCH 03/17] Drop hpath-filepath This is now provided by abstract-filepath. --- README.md | 1 - cabal.project | 1 - hpath-filepath/CHANGELOG.md | 14 - hpath-filepath/LICENSE | 30 - hpath-filepath/README.md | 29 - hpath-filepath/Setup.hs | 2 - hpath-filepath/hpath-filepath.cabal | 39 - hpath-filepath/run-doctests.sh | 23 - hpath-filepath/src/System/Posix/FilePath.hs | 859 -------------------- 9 files changed, 998 deletions(-) delete mode 100644 hpath-filepath/CHANGELOG.md delete mode 100644 hpath-filepath/LICENSE delete mode 100644 hpath-filepath/README.md delete mode 100644 hpath-filepath/Setup.hs delete mode 100644 hpath-filepath/hpath-filepath.cabal delete mode 100755 hpath-filepath/run-doctests.sh delete mode 100644 hpath-filepath/src/System/Posix/FilePath.hs diff --git a/README.md b/README.md index 1c5022a..1284abb 100644 --- a/README.md +++ b/README.md @@ -13,7 +13,6 @@ Set of libraries to deal with filepaths and files. ## Projects * [![Hackage version](https://img.shields.io/hackage/v/hpath.svg?label=Hackage)](https://hackage.haskell.org/package/hpath) [hpath](./hpath): Support for well-typed paths -* [![Hackage version](https://img.shields.io/hackage/v/hpath-filepath.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-filepath) [hpath-filepath](./hpath-filepath): ByteString based filepath manipulation (can be used without hpath) * [![Hackage version](https://img.shields.io/hackage/v/hpath-directory.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-directory) [hpath-directory](./hpath-directory): High-level IO operations for files/directories on raw ByteString filepaths (use hpath-io for the type-safe path version) * [![Hackage version](https://img.shields.io/hackage/v/hpath-io.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-io) [hpath-io](./hpath-io): High-level IO operations for files/directories utilizing type-safe Path * [![Hackage version](https://img.shields.io/hackage/v/hpath-posix.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-posix) [hpath-posix](./hpath-posix): Some low-level POSIX glue code that is not in 'unix' diff --git a/cabal.project b/cabal.project index c67deb2..661a0d0 100644 --- a/cabal.project +++ b/cabal.project @@ -1,6 +1,5 @@ packages: ./hpath ./hpath-directory - ./hpath-filepath ./hpath-io ./hpath-posix diff --git a/hpath-filepath/CHANGELOG.md b/hpath-filepath/CHANGELOG.md deleted file mode 100644 index e37eb7f..0000000 --- a/hpath-filepath/CHANGELOG.md +++ /dev/null @@ -1,14 +0,0 @@ -# Revision history for hpath-filepath - -## 0.10.4 -- 2020-01-26 - -* Add `takeAllParents` - - -## 0.10.2 -- 2020-01-18 - -* Add `isSpecialDirectoryEntry` - -## 0.10.0 -- 2020-01-04 - -* First version. Split from 'hpath', contains only the filepath ByteString manipulation parts. diff --git a/hpath-filepath/LICENSE b/hpath-filepath/LICENSE deleted file mode 100644 index 7ecfe24..0000000 --- a/hpath-filepath/LICENSE +++ /dev/null @@ -1,30 +0,0 @@ -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. diff --git a/hpath-filepath/README.md b/hpath-filepath/README.md deleted file mode 100644 index 81ea1ee..0000000 --- a/hpath-filepath/README.md +++ /dev/null @@ -1,29 +0,0 @@ -# HPath-filepath - -[![Gitter chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/hasufell/hpath?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Hackage version](https://img.shields.io/hackage/v/hpath-filepath.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-filepath) [![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/hpath-filepath.svg)](http://packdeps.haskellers.com/feed?needle=hpath-filepath) - -Support for bytestring based filepath manipulation, similar to 'filepath'. - -This package is part of the HPath suite, also check out: - -* [hpath](https://hackage.haskell.org/package/hpath) -* [hpath-directory](https://hackage.haskell.org/package/hpath-directory) -* [hpath-io](https://hackage.haskell.org/package/hpath-io) - -## Motivation - -This is basically a fork of [posix-paths](https://github.com/JohnLato/posix-paths), which seemed to have stalled development. - -There is also a similar library [filepath-bytestring](https://hackage.haskell.org/package/filepath-bytestring), but it doesn't follow an open development model and is cross-platform, which this library is not interested in. - -## Differences to 'posix-paths' - -* uses the `word8` package for save word8 literals instead of `OverloadedStrings` -* `hasTrailingPathSeparator` and `dropTrailingPathSeparator` behave in the same way as their `System.FilePath` counterpart -* has some additional functions - -## Differences to 'filepath-bytestring' - -* uses the `word8` package for save word8 literals instead of `OverloadedStrings` -* is not cross-platform (less odd code to maintain) -* has some additional functions diff --git a/hpath-filepath/Setup.hs b/hpath-filepath/Setup.hs deleted file mode 100644 index 9a994af..0000000 --- a/hpath-filepath/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/hpath-filepath/hpath-filepath.cabal b/hpath-filepath/hpath-filepath.cabal deleted file mode 100644 index a971c94..0000000 --- a/hpath-filepath/hpath-filepath.cabal +++ /dev/null @@ -1,39 +0,0 @@ -name: hpath-filepath -version: 0.10.4 -synopsis: ByteString based filepath manipulation -description: ByteString based filepath manipulation, similar to 'filepath' package. This is POSIX only. --- bug-reports: -license: BSD3 -license-file: LICENSE -author: Julian Ospald -maintainer: Julian Ospald -copyright: Julian Ospald 2016 -category: Filesystem -build-type: Simple -cabal-version: 1.14 -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 -extra-source-files: README.md - CHANGELOG.md - -library - if os(windows) - build-depends: unbuildable<0 - buildable: False - exposed-modules: System.Posix.FilePath - -- other-modules: - -- other-extensions: - build-depends: base >=4.8 && <5 - , bytestring >= 0.10.0.0 - , unix >= 2.5 - , word8 - hs-source-dirs: src - default-language: Haskell2010 - -source-repository head - type: git - location: https://github.com/hasufell/hpath diff --git a/hpath-filepath/run-doctests.sh b/hpath-filepath/run-doctests.sh deleted file mode 100755 index ad714f8..0000000 --- a/hpath-filepath/run-doctests.sh +++ /dev/null @@ -1,23 +0,0 @@ -#!/bin/sh - -set -e - -if [ -n "${SKIP_DOCTESTS}" ] ; then - echo "Skipping doctests" - exit 0 -fi - -if ! command -v doctest >/dev/null ; then - tempdir="$(mktemp -d)" - ( - cd "${tempdir}" - cabal install --installdir="${tempdir}" doctest - ) - export PATH="${tempdir}:$PATH" -fi - -set -x - -cd "$(CDPATH= cd -- "$(dirname -- "$0")" && pwd -P)" - -cabal exec doctest -- -isrc -XOverloadedStrings System.Posix.FilePath diff --git a/hpath-filepath/src/System/Posix/FilePath.hs b/hpath-filepath/src/System/Posix/FilePath.hs deleted file mode 100644 index 9a41802..0000000 --- a/hpath-filepath/src/System/Posix/FilePath.hs +++ /dev/null @@ -1,859 +0,0 @@ --- | --- Module : System.Posix.FilePath --- Copyright : © 2016 Julian Ospald --- License : BSD3 --- --- Maintainer : Julian Ospald --- Stability : experimental --- Portability : portable --- --- The equivalent of "System.FilePath" on raw (byte string) file paths. --- --- Not all functions of "System.FilePath" are implemented yet. Feel free to contribute! - - -{-# LANGUAGE CPP #-} -{-# LANGUAGE TupleSections #-} - -{-# OPTIONS_GHC -Wall #-} - - -module System.Posix.FilePath ( - - -- * Separator predicates - pathSeparator -, isPathSeparator -, searchPathSeparator -, isSearchPathSeparator -, extSeparator -, isExtSeparator - - -- * $PATH methods -, splitSearchPath -, getSearchPath - - -- * Extension functions -, splitExtension -, takeExtension -, replaceExtension -, dropExtension -, addExtension -, hasExtension -, (<.>) -, splitExtensions -, dropExtensions -, takeExtensions -, stripExtension - - -- * Filename\/directory functions -, splitFileName -, takeFileName -, replaceFileName -, dropFileName -, takeBaseName -, replaceBaseName -, takeDirectory -, replaceDirectory -, combine -, () -, splitPath -, joinPath -, splitDirectories -, takeAllParents - - -- * Trailing slash functions -, hasTrailingPathSeparator -, addTrailingPathSeparator -, dropTrailingPathSeparator - - -- * File name manipulations -, normalise -, makeRelative -, equalFilePath -, isRelative -, isAbsolute -, isValid -, makeValid -, isSpecialDirectoryEntry -, isFileName -, hasParentDir -, hiddenFile - -, module System.Posix.ByteString.FilePath -) where - -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import Data.String (fromString) -import System.Posix.ByteString.FilePath -import qualified System.Posix.Env.ByteString as PE - -import Data.Maybe (isJust) -import Data.Word8 -#if !MIN_VERSION_bytestring(0,10,8) -import qualified Data.List as L -#endif -import Control.Arrow (second) - --- $setup --- >>> import Data.Char --- >>> import Data.Maybe --- >>> import Data.Word8 --- >>> import Test.QuickCheck --- >>> import Control.Applicative --- >>> import qualified Data.ByteString as BS --- >>> instance Arbitrary ByteString where arbitrary = BS.pack <$> arbitrary --- >>> instance CoArbitrary ByteString where coarbitrary = coarbitrary . BS.unpack --- --- >>> let _chr :: Word8 -> Char; _chr = chr . fromIntegral - - - ------------------------- --- Separator predicates - - --- | Path separator character -pathSeparator :: Word8 -pathSeparator = _slash - - --- | Check if a character is the path separator --- --- prop> \n -> (_chr n == '/') == isPathSeparator n -isPathSeparator :: Word8 -> Bool -isPathSeparator = (== pathSeparator) - - --- | Search path separator -searchPathSeparator :: Word8 -searchPathSeparator = _colon - - --- | Check if a character is the search path separator --- --- prop> \n -> (_chr n == ':') == isSearchPathSeparator n -isSearchPathSeparator :: Word8 -> Bool -isSearchPathSeparator = (== searchPathSeparator) - - --- | File extension separator -extSeparator :: Word8 -extSeparator = _period - - --- | Check if a character is the file extension separator --- --- prop> \n -> (_chr n == '.') == isExtSeparator n -isExtSeparator :: Word8 -> Bool -isExtSeparator = (== extSeparator) - - - ------------------------- --- $PATH methods - - --- | Take a ByteString, split it on the 'searchPathSeparator'. --- Blank items are converted to @.@. --- --- Follows the recommendations in --- --- --- >>> splitSearchPath "File1:File2:File3" --- ["File1","File2","File3"] --- >>> splitSearchPath "File1::File2:File3" --- ["File1",".","File2","File3"] --- >>> splitSearchPath "" --- ["."] -splitSearchPath :: ByteString -> [RawFilePath] -splitSearchPath = f - where - f bs = let (pre, post) = BS.break isSearchPathSeparator bs - in if BS.null post - then g pre - else g pre ++ f (BS.tail post) - g x - | BS.null x = [BS.singleton _period] - | otherwise = [x] - - --- | Get a list of 'RawFilePath's in the $PATH variable. -getSearchPath :: IO [RawFilePath] -getSearchPath = fmap (maybe [] splitSearchPath) (PE.getEnv $ fromString "PATH") - - - ------------------------- --- Extension functions - --- | Split a 'RawFilePath' into a path+filename and extension --- --- >>> splitExtension "file.exe" --- ("file",".exe") --- >>> splitExtension "file" --- ("file","") --- >>> splitExtension "/path/file.tar.gz" --- ("/path/file.tar",".gz") --- --- prop> \path -> uncurry (BS.append) (splitExtension path) == path -splitExtension :: RawFilePath -> (RawFilePath, ByteString) -splitExtension x = if BS.null basename - then (x,BS.empty) - else (BS.append path (BS.init basename),BS.cons extSeparator fileExt) - where - (path,file) = splitFileNameRaw x - (basename,fileExt) = BS.breakEnd isExtSeparator file - - --- | Get the final extension from a 'RawFilePath' --- --- >>> takeExtension "file.exe" --- ".exe" --- >>> takeExtension "file" --- "" --- >>> takeExtension "/path/file.tar.gz" --- ".gz" -takeExtension :: RawFilePath -> ByteString -takeExtension = snd . splitExtension - - --- | Change a file's extension --- --- prop> \path -> let ext = takeExtension path in replaceExtension path ext == path -replaceExtension :: RawFilePath -> ByteString -> RawFilePath -replaceExtension path ext = dropExtension path <.> ext - - --- | Drop the final extension from a 'RawFilePath' --- --- >>> dropExtension "file.exe" --- "file" --- >>> dropExtension "file" --- "file" --- >>> dropExtension "/path/file.tar.gz" --- "/path/file.tar" -dropExtension :: RawFilePath -> RawFilePath -dropExtension = fst . splitExtension - - --- | Add an extension to a 'RawFilePath' --- --- >>> addExtension "file" ".exe" --- "file.exe" --- >>> addExtension "file.tar" ".gz" --- "file.tar.gz" --- >>> addExtension "/path/" ".ext" --- "/path/.ext" -addExtension :: RawFilePath -> ByteString -> RawFilePath -addExtension file ext - | BS.null ext = file - | isExtSeparator (BS.head ext) = BS.append file ext - | otherwise = BS.intercalate (BS.singleton extSeparator) [file, ext] - - --- | Check if a 'RawFilePath' has an extension --- --- >>> hasExtension "file" --- False --- >>> hasExtension "file.tar" --- True --- >>> hasExtension "/path.part1/" --- False -hasExtension :: RawFilePath -> Bool -hasExtension = isJust . BS.elemIndex extSeparator . takeFileName - - --- | Operator version of 'addExtension' -(<.>) :: RawFilePath -> ByteString -> RawFilePath -(<.>) = addExtension - - --- | Split a 'RawFilePath' on the first extension. --- --- >>> splitExtensions "/path/file.tar.gz" --- ("/path/file",".tar.gz") --- --- prop> \path -> uncurry addExtension (splitExtensions path) == path -splitExtensions :: RawFilePath -> (RawFilePath, ByteString) -splitExtensions x = if BS.null basename - then (path,fileExt) - else (BS.append path basename,fileExt) - where - (path,file) = splitFileNameRaw x - (basename,fileExt) = BS.break isExtSeparator file - - --- | Remove all extensions from a 'RawFilePath' --- --- >>> dropExtensions "/path/file.tar.gz" --- "/path/file" -dropExtensions :: RawFilePath -> RawFilePath -dropExtensions = fst . splitExtensions - - --- | Take all extensions from a 'RawFilePath' --- --- >>> takeExtensions "/path/file.tar.gz" --- ".tar.gz" -takeExtensions :: RawFilePath -> ByteString -takeExtensions = snd . splitExtensions - - --- | Drop the given extension from a FilePath, and the @\".\"@ preceding it. --- Returns 'Nothing' if the FilePath does not have the given extension, or --- 'Just' and the part before the extension if it does. --- --- This function can be more predictable than 'dropExtensions', --- especially if the filename might itself contain @.@ characters. --- --- >>> stripExtension "hs.o" "foo.x.hs.o" --- Just "foo.x" --- >>> stripExtension "hi.o" "foo.x.hs.o" --- Nothing --- >>> stripExtension ".c.d" "a.b.c.d" --- Just "a.b" --- >>> stripExtension ".c.d" "a.b..c.d" --- Just "a.b." --- >>> stripExtension "baz" "foo.bar" --- Nothing --- >>> stripExtension "bar" "foobar" --- Nothing --- --- prop> \path -> stripExtension "" path == Just path --- prop> \path -> dropExtension path == fromJust (stripExtension (takeExtension path) path) --- prop> \path -> dropExtensions path == fromJust (stripExtension (takeExtensions path) path) -stripExtension :: ByteString -> RawFilePath -> Maybe RawFilePath -stripExtension bs path - | BS.null bs = Just path - | otherwise = stripSuffix' dotExt path - where - dotExt = if isExtSeparator $ BS.head bs - then bs - else extSeparator `BS.cons` bs -#if MIN_VERSION_bytestring(0,10,8) - stripSuffix' = BS.stripSuffix -#else - stripSuffix' xs ys = fmap (BS.pack . reverse) $ L.stripPrefix (reverse $ BS.unpack xs) (reverse $ BS.unpack ys) -#endif - - ------------------------- --- Filename/directory functions - - --- | Split a 'RawFilePath' into (path,file). 'combine' is the inverse --- --- >>> splitFileName "path/file.txt" --- ("path/","file.txt") --- >>> splitFileName "path/" --- ("path/","") --- >>> splitFileName "file.txt" --- ("./","file.txt") --- --- prop> \path -> uncurry combine (splitFileName path) == path || fst (splitFileName path) == "./" -splitFileName :: RawFilePath -> (RawFilePath, RawFilePath) -splitFileName x = if BS.null path - then (dotSlash, file) - else (path,file) - where - (path,file) = splitFileNameRaw x - dotSlash = _period `BS.cons` (BS.singleton pathSeparator) - - --- | Get the file name --- --- >>> takeFileName "path/file.txt" --- "file.txt" --- >>> takeFileName "path/" --- "" -takeFileName :: RawFilePath -> RawFilePath -takeFileName = snd . splitFileName - - --- | Change the file name --- --- prop> \path -> replaceFileName path (takeFileName path) == path -replaceFileName :: RawFilePath -> ByteString -> RawFilePath -replaceFileName x y = fst (splitFileNameRaw x) y - - --- | Drop the file name --- --- >>> dropFileName "path/file.txt" --- "path/" --- >>> dropFileName "file.txt" --- "./" -dropFileName :: RawFilePath -> RawFilePath -dropFileName = fst . splitFileName - - --- | Get the file name, without a trailing extension --- --- >>> takeBaseName "path/file.tar.gz" --- "file.tar" --- >>> takeBaseName "" --- "" -takeBaseName :: RawFilePath -> ByteString -takeBaseName = dropExtension . takeFileName - - --- | Change the base name --- --- >>> replaceBaseName "path/file.tar.gz" "bob" --- "path/bob.gz" --- --- prop> \path -> replaceBaseName path (takeBaseName path) == path -replaceBaseName :: RawFilePath -> ByteString -> RawFilePath -replaceBaseName path name = combineRaw dir (name <.> ext) - where - (dir,file) = splitFileNameRaw path - ext = takeExtension file - - --- | Get the directory, moving up one level if it's already a directory --- --- >>> takeDirectory "path/file.txt" --- "path" --- >>> takeDirectory "file" --- "." --- >>> takeDirectory "/path/to/" --- "/path/to" --- >>> takeDirectory "/path/to" --- "/path" -takeDirectory :: RawFilePath -> RawFilePath -takeDirectory x = case () of - () | x == BS.singleton pathSeparator -> x - | BS.null res && not (BS.null file) -> file - | otherwise -> res - where - res = fst $ BS.spanEnd isPathSeparator file - file = dropFileName x - - --- | Change the directory component of a 'RawFilePath' --- --- prop> \path -> replaceDirectory path (takeDirectory path) `equalFilePath` path || takeDirectory path == "." -replaceDirectory :: RawFilePath -> ByteString -> RawFilePath -replaceDirectory file dir = combineRaw dir (takeFileName file) - - --- | Join two paths together --- --- >>> combine "/" "file" --- "/file" --- >>> combine "/path/to" "file" --- "/path/to/file" --- >>> combine "file" "/absolute/path" --- "/absolute/path" -combine :: RawFilePath -> RawFilePath -> RawFilePath -combine a b | not (BS.null b) && isPathSeparator (BS.head b) = b - | otherwise = combineRaw a b - - --- | Operator version of combine -() :: RawFilePath -> RawFilePath -> RawFilePath -() = combine - --- | Split a path into a list of components: --- --- >>> splitPath "/path/to/file.txt" --- ["/","path/","to/","file.txt"] --- --- prop> \path -> BS.concat (splitPath path) == path -splitPath :: RawFilePath -> [RawFilePath] -splitPath = splitter - where - splitter x - | BS.null x = [] - | otherwise = case BS.elemIndex pathSeparator x of - Nothing -> [x] - Just ix -> case BS.findIndex (not . isPathSeparator) $ BS.drop (ix+1) x of - Nothing -> [x] - Just runlen -> uncurry (:) . second splitter $ BS.splitAt (ix+1+runlen) x - - --- | Join a split path back together --- --- prop> \path -> joinPath (splitPath path) == path --- --- >>> joinPath ["path","to","file.txt"] --- "path/to/file.txt" -joinPath :: [RawFilePath] -> RawFilePath -joinPath = foldr () BS.empty - - --- | Like 'splitPath', but without trailing slashes --- --- >>> splitDirectories "/path/to/file.txt" --- ["/","path","to","file.txt"] --- >>> splitDirectories "path/to/file.txt" --- ["path","to","file.txt"] --- >>> splitDirectories "" --- [] -splitDirectories :: RawFilePath -> [RawFilePath] -splitDirectories x - | BS.null x = [] - | isPathSeparator (BS.head x) = let (root,rest) = BS.splitAt 1 x - in root : splitter rest - | otherwise = splitter x - where - splitter = filter (not . BS.null) . BS.split pathSeparator - - --- |Get all parents of a path. --- --- >>> takeAllParents "/abs/def/dod" --- ["/abs/def","/abs","/"] --- >>> takeAllParents "/foo" --- ["/"] --- >>> takeAllParents "/" --- [] -takeAllParents :: RawFilePath -> [RawFilePath] -takeAllParents p - | np == BS.singleton pathSeparator = [] - | otherwise = takeDirectory np : takeAllParents (takeDirectory np) - where - np = normalise p - - ------------------------- --- Trailing slash functions - --- | Check if the last character of a 'RawFilePath' is '/'. --- --- >>> hasTrailingPathSeparator "/path/" --- True --- >>> hasTrailingPathSeparator "/" --- True --- >>> hasTrailingPathSeparator "/path" --- False -hasTrailingPathSeparator :: RawFilePath -> Bool -hasTrailingPathSeparator x - | BS.null x = False - | otherwise = isPathSeparator $ BS.last x - - --- | Add a trailing path separator. --- --- >>> addTrailingPathSeparator "/path" --- "/path/" --- >>> addTrailingPathSeparator "/path/" --- "/path/" --- >>> addTrailingPathSeparator "/" --- "/" -addTrailingPathSeparator :: RawFilePath -> RawFilePath -addTrailingPathSeparator x = if hasTrailingPathSeparator x - then x - else x `BS.snoc` pathSeparator - - --- | Remove a trailing path separator --- --- >>> dropTrailingPathSeparator "/path/" --- "/path" --- >>> dropTrailingPathSeparator "/path////" --- "/path" --- >>> dropTrailingPathSeparator "/" --- "/" --- >>> dropTrailingPathSeparator "//" --- "/" -dropTrailingPathSeparator :: RawFilePath -> RawFilePath -dropTrailingPathSeparator x - | x == BS.singleton pathSeparator = x - | otherwise = if hasTrailingPathSeparator x - then dropTrailingPathSeparator $ BS.init x - else x - - - ------------------------- --- File name manipulations - - --- |Normalise a file. --- --- >>> normalise "/file/\\test////" --- "/file/\\test/" --- >>> normalise "/file/./test" --- "/file/test" --- >>> normalise "/test/file/../bob/fred/" --- "/test/file/../bob/fred/" --- >>> normalise "../bob/fred/" --- "../bob/fred/" --- >>> normalise "./bob/fred/" --- "bob/fred/" --- >>> normalise "./bob////.fred/./...///./..///#." --- "bob/.fred/.../../#." --- >>> normalise "." --- "." --- >>> normalise "./" --- "./" --- >>> normalise "./." --- "./" --- >>> normalise "/./" --- "/" --- >>> normalise "/" --- "/" --- >>> normalise "bob/fred/." --- "bob/fred/" --- >>> normalise "//home" --- "/home" -normalise :: RawFilePath -> RawFilePath -normalise filepath = - result `BS.append` - (if addPathSeparator - then BS.singleton pathSeparator - else BS.empty) - where - result = let n = f filepath - in if BS.null n - then BS.singleton _period - else n - addPathSeparator = isDirPath filepath && - not (hasTrailingPathSeparator result) - isDirPath xs = hasTrailingPathSeparator xs - || not (BS.null xs) && BS.last xs == _period - && hasTrailingPathSeparator (BS.init xs) - f = joinPath . dropDots . propSep . splitDirectories - propSep :: [ByteString] -> [ByteString] - propSep (x:xs) - | BS.all (== pathSeparator) x = BS.singleton pathSeparator : xs - | otherwise = x : xs - propSep [] = [] - dropDots :: [ByteString] -> [ByteString] - dropDots = filter (BS.singleton _period /=) - - - --- | Contract a filename, based on a relative path. Note that the resulting --- path will never introduce @..@ paths, as the presence of symlinks --- means @..\/b@ may not reach @a\/b@ if it starts from @a\/c@. For a --- worked example see --- . --- --- >>> makeRelative "/directory" "/directory/file.ext" --- "file.ext" --- >>> makeRelative "/Home" "/home/bob" --- "/home/bob" --- >>> makeRelative "/home/" "/home/bob/foo/bar" --- "bob/foo/bar" --- >>> makeRelative "/fred" "bob" --- "bob" --- >>> makeRelative "/file/test" "/file/test/fred" --- "fred" --- >>> makeRelative "/file/test" "/file/test/fred/" --- "fred/" --- >>> makeRelative "some/path" "some/path/a/b/c" --- "a/b/c" --- --- prop> \p -> makeRelative p p == "." --- prop> \p -> makeRelative (takeDirectory p) p `equalFilePath` takeFileName p --- prop \x y -> equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y makeRelative y x) x -makeRelative :: RawFilePath -> RawFilePath -> RawFilePath -makeRelative root path - | equalFilePath root path = BS.singleton _period - | takeAbs root /= takeAbs path = path - | otherwise = f (dropAbs root) (dropAbs path) - where - f x y - | BS.null x = BS.dropWhile isPathSeparator y - | otherwise = let (x1,x2) = g x - (y1,y2) = g y - in if equalFilePath x1 y1 then f x2 y2 else path - g x = (BS.dropWhile isPathSeparator a, BS.dropWhile isPathSeparator b) - where (a, b) = BS.break isPathSeparator $ BS.dropWhile isPathSeparator x - dropAbs x = snd $ BS.span (== _slash) x - takeAbs x = fst $ BS.span (== _slash) x - - --- |Equality of two filepaths. The filepaths are normalised --- and trailing path separators are dropped. --- --- >>> equalFilePath "foo" "foo" --- True --- >>> equalFilePath "foo" "foo/" --- True --- >>> equalFilePath "foo" "./foo" --- True --- >>> equalFilePath "" "" --- True --- >>> equalFilePath "foo" "/foo" --- False --- >>> equalFilePath "foo" "FOO" --- False --- >>> equalFilePath "foo" "../foo" --- False --- --- prop> \p -> equalFilePath p p -equalFilePath :: RawFilePath -> RawFilePath -> Bool -equalFilePath p1 p2 = f p1 == f p2 - where - f x = dropTrailingPathSeparator $ normalise x - - --- | Check if a path is relative --- --- prop> \path -> isRelative path /= isAbsolute path -isRelative :: RawFilePath -> Bool -isRelative = not . isAbsolute - - --- | Check if a path is absolute --- --- >>> isAbsolute "/path" --- True --- >>> isAbsolute "path" --- False --- >>> isAbsolute "" --- False -isAbsolute :: RawFilePath -> Bool -isAbsolute x - | BS.length x > 0 = isPathSeparator (BS.head x) - | otherwise = False - - --- | Is a FilePath valid, i.e. could you create a file like it? --- --- >>> isValid "" --- False --- >>> isValid "\0" --- False --- >>> isValid "/random_ path:*" --- True -isValid :: RawFilePath -> Bool -isValid filepath - | BS.null filepath = False - | _nul `BS.elem` filepath = False - | otherwise = True - - --- | Take a FilePath and make it valid; does not change already valid FilePaths. --- --- >>> makeValid "" --- "_" --- >>> makeValid "file\0name" --- "file_name" --- --- prop> \p -> if isValid p then makeValid p == p else makeValid p /= p --- prop> \p -> isValid (makeValid p) -makeValid :: RawFilePath -> RawFilePath -makeValid path - | BS.null path = BS.singleton _underscore - | otherwise = BS.map (\x -> if x == _nul then _underscore else x) path - - --- | Whether the filename is a special directory entry --- (. and ..). Does not normalise filepaths. --- --- >>> isSpecialDirectoryEntry "." --- True --- >>> isSpecialDirectoryEntry ".." --- True --- >>> isSpecialDirectoryEntry "/random_ path:*" --- False -isSpecialDirectoryEntry :: RawFilePath -> Bool -isSpecialDirectoryEntry filepath - | BS.pack [_period, _period] == filepath = True - | BS.pack [_period] == filepath = True - | otherwise = False - - --- | Is the given path a valid filename? This includes --- "." and "..". --- --- >>> isFileName "lal" --- True --- >>> isFileName "." --- True --- >>> isFileName ".." --- True --- >>> isFileName "" --- False --- >>> isFileName "\0" --- False --- >>> isFileName "/random_ path:*" --- False -isFileName :: RawFilePath -> Bool -isFileName filepath = - not (BS.singleton pathSeparator `BS.isInfixOf` filepath) && - not (BS.null filepath) && - not (_nul `BS.elem` filepath) - - --- | Check if the filepath has any parent directories in it. --- --- >>> hasParentDir "/.." --- True --- >>> hasParentDir "foo/bar/.." --- True --- >>> hasParentDir "foo/../bar/." --- True --- >>> hasParentDir "foo/bar" --- False --- >>> hasParentDir "foo" --- False --- >>> hasParentDir "" --- False --- >>> hasParentDir ".." --- False -hasParentDir :: RawFilePath -> Bool -hasParentDir filepath = - (pathSeparator `BS.cons` pathDoubleDot) - `BS.isSuffixOf` filepath - || - (BS.singleton pathSeparator - `BS.append` pathDoubleDot - `BS.append` BS.singleton pathSeparator) - `BS.isInfixOf` filepath - || - (pathDoubleDot `BS.append` BS.singleton pathSeparator) - `BS.isPrefixOf` filepath - where - pathDoubleDot = BS.pack [_period, _period] - - --- | Whether the file is a hidden file. --- --- >>> hiddenFile ".foo" --- True --- >>> hiddenFile "..foo.bar" --- True --- >>> hiddenFile "some/path/.bar" --- True --- >>> hiddenFile "..." --- True --- >>> hiddenFile "dod.bar" --- False --- >>> hiddenFile "." --- False --- >>> hiddenFile ".." --- False --- >>> hiddenFile "" --- False -hiddenFile :: RawFilePath -> Bool -hiddenFile fp - | fn == BS.pack [_period, _period] = False - | fn == BS.pack [_period] = False - | otherwise = BS.pack [extSeparator] - `BS.isPrefixOf` fn - where - fn = takeFileName fp - - - ------------------------- --- internal stuff - --- Just split the input FileName without adding/normalizing or changing --- anything. -splitFileNameRaw :: RawFilePath -> (RawFilePath, RawFilePath) -splitFileNameRaw = BS.breakEnd isPathSeparator - --- | Combine two paths, assuming rhs is NOT absolute. -combineRaw :: RawFilePath -> RawFilePath -> RawFilePath -combineRaw a b | BS.null a = b - | BS.null b = a - | isPathSeparator (BS.last a) = BS.append a b - | otherwise = BS.intercalate (BS.singleton pathSeparator) [a, b] - From 4523a438838bcfca1cd7f25f8e3caf37032e71f1 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Fri, 29 Oct 2021 16:36:24 +0200 Subject: [PATCH 04/17] Bump versions --- hpath-posix/hpath-posix.cabal | 4 ++-- .../{RawFilePath => PosixFilePath}/Directory/Traversals.hs | 4 ++-- hpath/hpath.cabal | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) rename hpath-posix/src/System/Posix/{RawFilePath => PosixFilePath}/Directory/Traversals.hs (98%) diff --git a/hpath-posix/hpath-posix.cabal b/hpath-posix/hpath-posix.cabal index c7bf0c5..3532ccc 100644 --- a/hpath-posix/hpath-posix.cabal +++ b/hpath-posix/hpath-posix.cabal @@ -1,7 +1,7 @@ cabal-version: >=1.10 name: hpath-posix -version: 0.13.3 +version: 0.14.3 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 @@ -25,7 +25,7 @@ library if os(windows) build-depends: unbuildable<0 buildable: False - exposed-modules: System.Posix.RawFilePath.Directory.Traversals + exposed-modules: System.Posix.PosixFilePath.Directory.Traversals System.Posix.Foreign System.Posix.FD -- other-modules: diff --git a/hpath-posix/src/System/Posix/RawFilePath/Directory/Traversals.hs b/hpath-posix/src/System/Posix/PosixFilePath/Directory/Traversals.hs similarity index 98% rename from hpath-posix/src/System/Posix/RawFilePath/Directory/Traversals.hs rename to hpath-posix/src/System/Posix/PosixFilePath/Directory/Traversals.hs index 2b6e6da..10cca8c 100644 --- a/hpath-posix/src/System/Posix/RawFilePath/Directory/Traversals.hs +++ b/hpath-posix/src/System/Posix/PosixFilePath/Directory/Traversals.hs @@ -1,5 +1,5 @@ -- | --- Module : System.Posix.RawFilePath.Directory.Traversals +-- Module : System.Posix.PosixFilePath.Directory.Traversals -- Copyright : © 2016 Julian Ospald -- License : BSD3 -- @@ -20,7 +20,7 @@ {-# OPTIONS_GHC -Wall #-} -module System.Posix.RawFilePath.Directory.Traversals ( +module System.Posix.PosixFilePath.Directory.Traversals ( getDirectoryContents , getDirectoryContents' diff --git a/hpath/hpath.cabal b/hpath/hpath.cabal index 423ba53..7adc370 100644 --- a/hpath/hpath.cabal +++ b/hpath/hpath.cabal @@ -1,5 +1,5 @@ name: hpath -version: 0.12.1 +version: 0.13.1 synopsis: Support for well-typed paths description: Support for well-typed paths, utilizing ByteString under the hood. license: BSD3 From 01cf6e0c7c32ae4428b9577c00555e76f5861bea Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Fri, 29 Oct 2021 17:03:02 +0200 Subject: [PATCH 05/17] Migrate hpath-directory --- cabal.project | 4 + hpath-directory/hpath-directory.cabal | 82 +- hpath-directory/src/System/Directory/AFP.hs | 822 ++++++++++++++++++ hpath-directory/src/System/Directory/Types.hs | 70 ++ .../Directory.hs | 221 +++-- .../Posix/PosixFilePath/Directory.hs-boot | 15 + .../Directory/Errors.hs | 83 +- .../Posix/RawFilePath/Directory.hs-boot | 15 - hpath-directory/test/Main.hs | 11 +- .../Directory/AppendFileSpec.hs | 4 +- .../Directory/CanonicalizePathSpec.hs | 4 +- .../CopyDirRecursiveCollectFailuresSpec.hs | 18 +- .../CopyDirRecursiveOverwriteSpec.hs | 24 +- .../Directory/CopyDirRecursiveSpec.hs | 15 +- .../Directory/CopyFileOverwriteSpec.hs | 20 +- .../Directory/CopyFileSpec.hs | 15 +- .../Directory/CreateDirIfMissingSpec.hs | 4 +- .../Directory/CreateDirRecursiveSpec.hs | 4 +- .../Directory/CreateDirSpec.hs | 4 +- .../Directory/CreateRegularFileSpec.hs | 4 +- .../Directory/CreateSymlinkSpec.hs | 4 +- .../Directory/DeleteDirRecursiveSpec.hs | 4 +- .../Directory/DeleteDirSpec.hs | 4 +- .../Directory/DeleteFileSpec.hs | 6 +- .../Directory/GetDirsFilesSpec.hs | 8 +- .../Directory/GetFileTypeSpec.hs | 6 +- .../Directory/MoveFileOverwriteSpec.hs | 8 +- .../Directory/MoveFileSpec.hs | 8 +- .../Directory/ReadFileSpec.hs | 4 +- .../Directory/RecreateSymlinkOverwriteSpec.hs | 8 +- .../Directory/RecreateSymlinkSpec.hs | 8 +- .../Directory/RenameFileSpec.hs | 6 +- .../Directory/ToAbsSpec.hs | 6 +- .../Directory/WriteFileLSpec.hs | 4 +- .../Directory/WriteFileSpec.hs | 4 +- hpath-directory/test/Utils.hs | 90 +- 36 files changed, 1234 insertions(+), 383 deletions(-) create mode 100644 hpath-directory/src/System/Directory/AFP.hs create mode 100644 hpath-directory/src/System/Directory/Types.hs rename hpath-directory/src/System/Posix/{RawFilePath => PosixFilePath}/Directory.hs (87%) create mode 100644 hpath-directory/src/System/Posix/PosixFilePath/Directory.hs-boot rename hpath-directory/src/System/Posix/{RawFilePath => PosixFilePath}/Directory/Errors.hs (77%) delete mode 100644 hpath-directory/src/System/Posix/RawFilePath/Directory.hs-boot rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/AppendFileSpec.hs (95%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/CanonicalizePathSpec.hs (91%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/CopyDirRecursiveCollectFailuresSpec.hs (93%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/CopyDirRecursiveOverwriteSpec.hs (88%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/CopyDirRecursiveSpec.hs (92%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/CopyFileOverwriteSpec.hs (86%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/CopyFileSpec.hs (89%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/CreateDirIfMissingSpec.hs (91%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/CreateDirRecursiveSpec.hs (93%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/CreateDirSpec.hs (92%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/CreateRegularFileSpec.hs (91%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/CreateSymlinkSpec.hs (92%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/DeleteDirRecursiveSpec.hs (95%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/DeleteDirSpec.hs (95%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/DeleteFileSpec.hs (90%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/GetDirsFilesSpec.hs (89%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/GetFileTypeSpec.hs (90%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/MoveFileOverwriteSpec.hs (92%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/MoveFileSpec.hs (92%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/ReadFileSpec.hs (96%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/RecreateSymlinkOverwriteSpec.hs (93%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/RecreateSymlinkSpec.hs (92%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/RenameFileSpec.hs (93%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/ToAbsSpec.hs (65%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/WriteFileLSpec.hs (95%) rename hpath-directory/test/System/Posix/{RawFilePath => PosixFilePath}/Directory/WriteFileSpec.hs (95%) diff --git a/cabal.project b/cabal.project index 661a0d0..3a23a16 100644 --- a/cabal.project +++ b/cabal.project @@ -3,6 +3,10 @@ packages: ./hpath ./hpath-io ./hpath-posix +source-repository-package + type: git + location: https://github.com/hasufell/streamly-posix.git + tag: e14e5e877c584f7d7bf2fb10cb80bc331126fd5d source-repository-package type: git diff --git a/hpath-directory/hpath-directory.cabal b/hpath-directory/hpath-directory.cabal index fbb073c..66f20a0 100644 --- a/hpath-directory/hpath-directory.cabal +++ b/hpath-directory/hpath-directory.cabal @@ -1,11 +1,10 @@ cabal-version: >=1.10 name: hpath-directory -version: 0.14.2.2 -synopsis: Alternative to 'directory' package with ByteString based filepaths +version: 0.15.2.2 +synopsis: Alternative to 'directory' package with AbstractFilePath based filepaths description: This provides a safer alternative to the 'directory' - package. FilePaths are ByteString based, so this - package only works on POSIX systems. + package. For a more high-level version of this with proper Path type, use 'hpath-io', which makes @@ -20,6 +19,7 @@ copyright: Julian Ospald 2020 category: Filesystem build-type: Simple extra-source-files: CHANGELOG.md + ./src/System/Directory/AFP.hs tested-with: GHC==7.10.3 , GHC==8.0.2 , GHC==8.2.2 @@ -29,18 +29,21 @@ tested-with: GHC==7.10.3 library if os(windows) - build-depends: unbuildable<0 - buildable: False - exposed-modules: System.Posix.RawFilePath.Directory - System.Posix.RawFilePath.Directory.Errors + cpp-options: -DWINDOWS + exposed-modules: System.Directory.AFP + System.Directory.Types + System.Posix.PosixFilePath.Directory + System.Posix.PosixFilePath.Directory.Errors -- other-modules: -- other-extensions: build-depends: base >= 4.8 && <5 , IfElse + , abstract-filepath + , abstract-filepath-types + , abstract-filepath-unix , bytestring >= 0.10 , exceptions >= 0.10 - , hpath-filepath >= 0.10.4 - , hpath-posix >= 0.13.3 + , hpath-posix >= 0.14.0 , safe-exceptions >= 0.1 , streamly >= 0.7 , streamly-bytestring >= 0.1.2 @@ -61,43 +64,44 @@ library test-suite spec if os(windows) - build-depends: unbuildable<0 - buildable: False + cpp-options: -DWINDOWS Type: exitcode-stdio-1.0 Default-Language: Haskell2010 Hs-Source-Dirs: test Main-Is: Main.hs other-modules: - System.Posix.RawFilePath.Directory.AppendFileSpec - System.Posix.RawFilePath.Directory.CanonicalizePathSpec - System.Posix.RawFilePath.Directory.CopyDirRecursiveCollectFailuresSpec - System.Posix.RawFilePath.Directory.CopyDirRecursiveOverwriteSpec - System.Posix.RawFilePath.Directory.CopyDirRecursiveSpec - System.Posix.RawFilePath.Directory.CopyFileOverwriteSpec - System.Posix.RawFilePath.Directory.CopyFileSpec - System.Posix.RawFilePath.Directory.CreateDirIfMissingSpec - System.Posix.RawFilePath.Directory.CreateDirRecursiveSpec - System.Posix.RawFilePath.Directory.CreateDirSpec - System.Posix.RawFilePath.Directory.CreateRegularFileSpec - System.Posix.RawFilePath.Directory.CreateSymlinkSpec - System.Posix.RawFilePath.Directory.DeleteDirRecursiveSpec - System.Posix.RawFilePath.Directory.DeleteDirSpec - System.Posix.RawFilePath.Directory.DeleteFileSpec - System.Posix.RawFilePath.Directory.GetDirsFilesSpec - System.Posix.RawFilePath.Directory.GetFileTypeSpec - System.Posix.RawFilePath.Directory.MoveFileOverwriteSpec - System.Posix.RawFilePath.Directory.MoveFileSpec - System.Posix.RawFilePath.Directory.ReadFileSpec - System.Posix.RawFilePath.Directory.RecreateSymlinkOverwriteSpec - System.Posix.RawFilePath.Directory.RecreateSymlinkSpec - System.Posix.RawFilePath.Directory.RenameFileSpec - System.Posix.RawFilePath.Directory.ToAbsSpec - System.Posix.RawFilePath.Directory.WriteFileLSpec - System.Posix.RawFilePath.Directory.WriteFileSpec + System.Posix.PosixFilePath.Directory.AppendFileSpec + System.Posix.PosixFilePath.Directory.CanonicalizePathSpec + System.Posix.PosixFilePath.Directory.CopyDirRecursiveCollectFailuresSpec + System.Posix.PosixFilePath.Directory.CopyDirRecursiveOverwriteSpec + System.Posix.PosixFilePath.Directory.CopyDirRecursiveSpec + System.Posix.PosixFilePath.Directory.CopyFileOverwriteSpec + System.Posix.PosixFilePath.Directory.CopyFileSpec + System.Posix.PosixFilePath.Directory.CreateDirIfMissingSpec + System.Posix.PosixFilePath.Directory.CreateDirRecursiveSpec + System.Posix.PosixFilePath.Directory.CreateDirSpec + System.Posix.PosixFilePath.Directory.CreateRegularFileSpec + System.Posix.PosixFilePath.Directory.CreateSymlinkSpec + System.Posix.PosixFilePath.Directory.DeleteDirRecursiveSpec + System.Posix.PosixFilePath.Directory.DeleteDirSpec + System.Posix.PosixFilePath.Directory.DeleteFileSpec + System.Posix.PosixFilePath.Directory.GetDirsFilesSpec + System.Posix.PosixFilePath.Directory.GetFileTypeSpec + System.Posix.PosixFilePath.Directory.MoveFileOverwriteSpec + System.Posix.PosixFilePath.Directory.MoveFileSpec + System.Posix.PosixFilePath.Directory.ReadFileSpec + System.Posix.PosixFilePath.Directory.RecreateSymlinkOverwriteSpec + System.Posix.PosixFilePath.Directory.RecreateSymlinkSpec + System.Posix.PosixFilePath.Directory.RenameFileSpec + System.Posix.PosixFilePath.Directory.ToAbsSpec + System.Posix.PosixFilePath.Directory.WriteFileLSpec + System.Posix.PosixFilePath.Directory.WriteFileSpec Spec Utils GHC-Options: -Wall - Build-Depends: base + Build-Depends: abstract-filepath + , abstract-filepath-unix + , base , HUnit , IfElse , bytestring >= 0.10.0.0 diff --git a/hpath-directory/src/System/Directory/AFP.hs b/hpath-directory/src/System/Directory/AFP.hs new file mode 100644 index 0000000..1bafb6e --- /dev/null +++ b/hpath-directory/src/System/Directory/AFP.hs @@ -0,0 +1,822 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} + +module System.Directory.AFP + ( + -- * Types + module System.Directory.Types + , Permissions + -- * File copying + , copyDirRecursive + , recreateSymlink + , copyFile + , easyCopy + -- * File deletion + , deleteFile + , deleteDir + , deleteDirRecursive + , easyDelete + -- * File creation + , createRegularFile + , createDir + , createDirIfMissing + , createDirRecursive + , createSymlink + -- * File renaming/moving + , renameFile + , moveFile + -- * File reading + , readFile + , readFileStrict + , readFileStream + -- * File writing + , writeFile + , writeFileL + , appendFile + -- * File checks + , doesExist + , doesFileExist + , doesDirectoryExist + , isReadable + , isWritable + , isExecutable + , canOpenDirectory + -- * File times + , getModificationTime + , setModificationTime + , setModificationTimeHiRes + -- * Directory reading + , getDirsFiles + , getDirsFiles' + , getDirsFilesStream + -- * CWD + , getCurrentDirectory + , setCurrentDirectory + -- * Filetype operations + , getFileType + -- * Permissions + , getPermissions + , setPermissions + , emptyPermissions + , setOwnerReadable + , setOwnerWritable + , setOwnerExecutable + , setOwnerSearchable + , newFilePerms + , newDirPerms + -- * Others + , canonicalizePath + , toAbs + ) + where + +import Prelude hiding ( appendFile + , readFile + , writeFile + ) +import Data.Bits +import System.Directory.Types +#ifdef WINDOWS +import qualified System.Win32.WindowsFilePath.Directory as Dir +#else +import qualified System.Posix.PosixFilePath.Directory as Dir +import qualified System.Posix as Posix (FileMode) +import qualified System.Posix.Files.ByteString as Posix +import qualified Data.ByteString.Short as SBS +#endif +import AFP.AbstractFilePath.Types +import AFP.OsString.Internal.Types +import Data.Time.Clock +import Data.Time.Clock.POSIX +import Streamly.Prelude ( SerialT, MonadAsync ) +import Streamly.Data.Array.Foreign +import Data.Word ( Word8 ) + +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString as BS +import Control.Exception.Safe ( MonadCatch + , MonadMask + ) + + + ------------------------ + --[ File Permissions ]-- + ------------------------ + + + +data Permissions + = Permissions + { readable :: Bool + , writable :: Bool + , executable :: Bool + , searchable :: Bool + } deriving (Eq, Ord, Read, Show) + + +emptyPermissions :: Permissions +emptyPermissions = Permissions { + readable = False, + writable = False, + executable = False, + searchable = False + } + +setOwnerReadable :: Bool -> Permissions -> Permissions +setOwnerReadable b p = p { readable = b } + +setOwnerWritable :: Bool -> Permissions -> Permissions +setOwnerWritable b p = p { writable = b } + +setOwnerExecutable :: Bool -> Permissions -> Permissions +setOwnerExecutable b p = p { executable = b } + +setOwnerSearchable :: Bool -> Permissions -> Permissions +setOwnerSearchable b p = p { searchable = b } + + +-- |Default permissions for a new file. +newFilePerms :: Permissions +newFilePerms = Permissions { + readable = True, + writable = True, + executable = False, + searchable = False + } + + +-- |Default permissions for a new directory. +newDirPerms :: Permissions +newDirPerms = Permissions { + readable = True, + writable = True, + executable = False, + searchable = True + } + + +-- | Get the permissions of a file or directory. +-- +-- On Windows, the 'writable' permission corresponds to the "read-only" +-- attribute. The 'executable' permission is set if the file extension is of +-- an executable file type. The 'readable' permission is always set. +-- +-- On POSIX systems, this returns the result of @access@. +-- +-- The operation may fail with: +-- +-- * 'isPermissionError' if the user is not permitted to access the +-- permissions, or +-- +-- * 'isDoesNotExistError' if the file or directory does not exist. +getPermissions :: AbstractFilePath -> IO Permissions +#ifdef WINDOWS +getPermissions _ = + undefined +#else +getPermissions (OsString (PS path')) = do + let path = SBS.fromShort path' + m <- Posix.getFileStatus path + let isDir = Posix.isDirectory m + r <- Posix.fileAccess path True False False + w <- Posix.fileAccess path False True False + x <- Posix.fileAccess path False False True + pure Permissions + { readable = r + , writable = w + , executable = x && not isDir + , searchable = x && isDir + } +#endif + +setPermissions :: AbstractFilePath -> Permissions -> IO () +#ifdef WINDOWS +setPermissions = undefined +#else +setPermissions (OsString (PS path')) (Permissions r w e s) = do + let path = SBS.fromShort path' + m <- Posix.getFileStatus path + Posix.setFileMode path (modifyBit (e || s) Posix.ownerExecuteMode . + modifyBit w Posix.ownerWriteMode . + modifyBit r Posix.ownerReadMode . + Posix.fileMode $ m) + where + modifyBit :: Bool -> Posix.FileMode -> Posix.FileMode -> Posix.FileMode + modifyBit False b m = m .&. complement b + modifyBit True b m = m .|. b +#endif + + + + -------------------- + --[ File Copying ]-- + -------------------- + + +copyDirRecursive :: AbstractFilePath -- ^ source dir + -> AbstractFilePath -- ^ destination (parent dirs + -- are not automatically created) + -> CopyMode + -> RecursiveErrorMode + -> IO () +copyDirRecursive (OsString fromp) (OsString destdirp) cm rm = + Dir.copyDirRecursive fromp destdirp cm rm + + +-- |Recreate a symlink. +-- +-- In `Overwrite` copy mode only files and empty directories are deleted. +-- +-- Safety/reliability concerns: +-- +-- * `Overwrite` mode is inherently non-atomic +-- +-- Throws: +-- +-- - `InvalidArgument` if source file is wrong type (not a symlink) +-- - `PermissionDenied` if output directory cannot be written to +-- - `PermissionDenied` if source directory cannot be opened +-- - `SameFile` if source and destination are the same file +-- (`HPathIOException`) +-- +-- +-- Throws in `Strict` mode only: +-- +-- - `AlreadyExists` if destination already exists +-- +-- Throws in `Overwrite` mode only: +-- +-- - `UnsatisfiedConstraints` if destination file is non-empty directory +-- +-- Notes: +-- +-- - calls `symlink` +recreateSymlink :: AbstractFilePath -- ^ the old symlink file + -> AbstractFilePath -- ^ destination file + -> CopyMode + -> IO () +recreateSymlink (OsString symsource) (OsString newsym) cm = + Dir.recreateSymlink symsource newsym cm + + +-- |Copies the given regular file to the given destination. +-- Neither follows symbolic links, nor accepts them. +-- For "copying" symbolic links, use `recreateSymlink` instead. +-- +-- Note that this is still sort of a low-level function and doesn't +-- examine file types. For a more high-level version, use `easyCopy` +-- instead. +-- +-- In `Overwrite` copy mode only overwrites actual files, not directories. +-- In `Strict` mode the destination file must not exist. +-- +-- Safety/reliability concerns: +-- +-- * `Overwrite` mode is not atomic +-- * when used on `CharacterDevice`, reads the "contents" and copies +-- them to a regular file, which might take indefinitely +-- * when used on `BlockDevice`, may either read the "contents" +-- and copy them to a regular file (potentially hanging indefinitely) +-- or may create a regular empty destination file +-- * when used on `NamedPipe`, will hang indefinitely +-- +-- Throws: +-- +-- - `NoSuchThing` if source file does not exist +-- - `NoSuchThing` if source file is a a `Socket` +-- - `PermissionDenied` if output directory is not writable +-- - `PermissionDenied` if source directory can't be opened +-- - `InvalidArgument` if source file is wrong type (symlink or directory) +-- - `SameFile` if source and destination are the same file +-- (`HPathIOException`) +-- +-- Throws in `Strict` mode only: +-- +-- - `AlreadyExists` if destination already exists +copyFile :: AbstractFilePath -- ^ source file + -> AbstractFilePath -- ^ destination file + -> CopyMode + -> IO () +copyFile (OsString from) (OsString to) cm = + Dir.copyFile from to cm + + +-- |Copies a regular file, directory or symbolic link. In case of a +-- symbolic link it is just recreated, even if it points to a directory. +-- Any other file type is ignored. +-- +-- Safety/reliability concerns: +-- +-- * examines filetypes explicitly +-- * calls `copyDirRecursive` for directories +easyCopy :: AbstractFilePath + -> AbstractFilePath + -> CopyMode + -> RecursiveErrorMode + -> IO () +easyCopy (OsString from) (OsString to) cm rm = + Dir.easyCopy from to cm rm + + + + + + --------------------- + --[ File Deletion ]-- + --------------------- + + +-- |Deletes the given file. Raises `eISDIR` +-- if run on a directory. Does not follow symbolic links. +-- +-- Throws: +-- +-- - `InappropriateType` for wrong file type (directory) +-- - `NoSuchThing` if the file does not exist +-- - `PermissionDenied` if the directory cannot be read +-- +-- Notes: calls `unlink` +deleteFile :: AbstractFilePath -> IO () +deleteFile (OsString fp) = + Dir.deleteFile fp + + +-- |Deletes the given directory, which must be empty, never symlinks. +-- +-- Throws: +-- +-- - `InappropriateType` for wrong file type (symlink to directory) +-- - `InappropriateType` for wrong file type (regular file) +-- - `NoSuchThing` if directory does not exist +-- - `UnsatisfiedConstraints` if directory is not empty +-- - `PermissionDenied` if we can't open or write to parent directory +-- +-- Notes: calls `rmdir` +deleteDir :: AbstractFilePath -> IO () +deleteDir (OsString fp) = Dir.deleteDir fp + + +-- |Deletes the given directory recursively. Does not follow symbolic +-- links. Tries `deleteDir` first before attemtping a recursive +-- deletion. +-- +-- On directory contents this behaves like `easyDelete` +-- and thus will ignore any file type that is not `RegularFile`, +-- `SymbolicLink` or `Directory`. +-- +-- Safety/reliability concerns: +-- +-- * not atomic +-- * examines filetypes explicitly +-- +-- Throws: +-- +-- - `InappropriateType` for wrong file type (symlink to directory) +-- - `InappropriateType` for wrong file type (regular file) +-- - `NoSuchThing` if directory does not exist +-- - `PermissionDenied` if we can't open or write to parent directory +deleteDirRecursive :: AbstractFilePath -> IO () +deleteDirRecursive (OsString p) = Dir.deleteDirRecursive p + + +-- |Deletes a file, directory or symlink. +-- In case of directory, performs recursive deletion. In case of +-- a symlink, the symlink file is deleted. +-- Any other file type is ignored. +-- +-- Safety/reliability concerns: +-- +-- * examines filetypes explicitly +-- * calls `deleteDirRecursive` for directories +easyDelete :: AbstractFilePath -> IO () +easyDelete (OsString p) = Dir.easyDelete p + + + + + --------------------- + --[ File Creation ]-- + --------------------- + + +-- |Create an empty regular file at the given directory with the given +-- filename. +-- +-- Throws: +-- +-- - `PermissionDenied` if output directory cannot be written to +-- - `AlreadyExists` if destination already exists +-- - `NoSuchThing` if any of the parent components of the path +-- do not exist +createRegularFile :: AbstractFilePath -> IO () +createRegularFile (OsString destBS) = Dir.createRegularFile Dir.newFilePerms destBS + + +-- |Create an empty directory at the given directory with the given filename. +-- +-- Throws: +-- +-- - `PermissionDenied` if output directory cannot be written to +-- - `AlreadyExists` if destination already exists +-- - `NoSuchThing` if any of the parent components of the path +-- do not exist +createDir :: AbstractFilePath -> IO () +createDir (OsString destBS) = Dir.createDir Dir.newDirPerms destBS + +-- |Create an empty directory at the given directory with the given filename. +-- +-- Throws: +-- +-- - `PermissionDenied` if output directory cannot be written to +-- - `NoSuchThing` if any of the parent components of the path +-- do not exist +createDirIfMissing :: AbstractFilePath -> IO () +createDirIfMissing (OsString destBS) = Dir.createDirIfMissing Dir.newDirPerms destBS + + +-- |Create an empty directory at the given directory with the given filename. +-- All parent directories are created with the same filemode. This +-- basically behaves like: +-- +-- @ +-- mkdir -p \/some\/dir +-- @ +-- +-- Safety/reliability concerns: +-- +-- * not atomic +-- +-- Throws: +-- +-- - `PermissionDenied` if any part of the path components do not +-- exist and cannot be written to +-- - `AlreadyExists` if destination already exists and +-- is *not* a directory +createDirRecursive :: AbstractFilePath -> IO () +createDirRecursive (OsString p) = Dir.createDirRecursive Dir.newDirPerms p + + +-- |Create a symlink. +-- +-- Throws: +-- +-- - `PermissionDenied` if output directory cannot be written to +-- - `AlreadyExists` if destination file already exists +-- - `NoSuchThing` if any of the parent components of the path +-- do not exist +-- +-- Note: calls `symlink` +createSymlink :: AbstractFilePath -- ^ destination file + -> AbstractFilePath -- ^ path the symlink points to + -> IO () +createSymlink (OsString destBS) (OsString sympoint) = Dir.createSymlink destBS sympoint + + + + ---------------------------- + --[ File Renaming/Moving ]-- + ---------------------------- + + +-- |Rename a given file with the provided filename. Destination and source +-- must be on the same device, otherwise `eXDEV` will be raised. +-- +-- Does not follow symbolic links, but renames the symbolic link file. +-- +-- Safety/reliability concerns: +-- +-- * has a separate set of exception handling, apart from the syscall +-- +-- Throws: +-- +-- - `NoSuchThing` if source file does not exist +-- - `PermissionDenied` if output directory cannot be written to +-- - `PermissionDenied` if source directory cannot be opened +-- - `UnsupportedOperation` if source and destination are on different +-- devices +-- - `AlreadyExists` if destination already exists +-- - `SameFile` if destination and source are the same file +-- (`HPathIOException`) +-- +-- Note: calls `rename` (but does not allow to rename over existing files) +renameFile :: AbstractFilePath -> AbstractFilePath -> IO () +renameFile (OsString fromf) (OsString tof) = Dir.renameFile fromf tof + + +-- |Move a file. This also works across devices by copy-delete fallback. +-- And also works on directories. +-- +-- Does not follow symbolic links, but renames the symbolic link file. +-- +-- +-- Safety/reliability concerns: +-- +-- * `Overwrite` mode is not atomic +-- * copy-delete fallback is inherently non-atomic +-- * since this function calls `easyCopy` and `easyDelete` as a fallback +-- to `renameFile`, file types that are not `RegularFile`, `SymbolicLink` +-- or `Directory` may be ignored +-- * for `Overwrite` mode, the destination will be deleted (not recursively) +-- before moving +-- +-- Throws: +-- +-- - `NoSuchThing` if source file does not exist +-- - `PermissionDenied` if output directory cannot be written to +-- - `PermissionDenied` if source directory cannot be opened +-- - `SameFile` if destination and source are the same file +-- (`HPathIOException`) +-- +-- Throws in `Strict` mode only: +-- +-- - `AlreadyExists` if destination already exists +-- +-- Notes: +-- +-- - calls `rename` (but does not allow to rename over existing files) +moveFile :: AbstractFilePath -- ^ file to move + -> AbstractFilePath -- ^ destination + -> CopyMode + -> IO () +moveFile (OsString from) (OsString to) cm = Dir.moveFile from to cm + + + + + + -------------------- + --[ File Reading ]-- + -------------------- + + +-- |Read the given file lazily. +-- +-- Symbolic links are followed. File must exist. +-- +-- Throws: +-- +-- - `InappropriateType` if file is not a regular file or a symlink +-- - `PermissionDenied` if we cannot read the file or the directory +-- containting it +-- - `NoSuchThing` if the file does not exist +readFile :: AbstractFilePath -> IO L.ByteString +readFile (OsString path) = Dir.readFile path + + +-- |Read the given file strictly into memory. +-- +-- Symbolic links are followed. File must exist. +-- +-- Throws: +-- +-- - `InappropriateType` if file is not a regular file or a symlink +-- - `PermissionDenied` if we cannot read the file or the directory +-- containting it +-- - `NoSuchThing` if the file does not exist +readFileStrict :: AbstractFilePath -> IO BS.ByteString +readFileStrict (OsString path) = Dir.readFileStrict path + + +-- | Open the given file as a filestream. Once the filestream +-- exits, the filehandle is cleaned up. +-- +-- Throws: +-- +-- - `InappropriateType` if file is not a regular file or a symlink +-- - `PermissionDenied` if we cannot read the file or the directory +-- containting it +-- - `NoSuchThing` if the file does not exist +readFileStream :: AbstractFilePath -> IO (SerialT IO (Array Word8)) +readFileStream (OsString fp) = Dir.readFileStream fp + + + + + -------------------- + --[ File Writing ]-- + -------------------- + + +-- |Write a given ByteString to a file, truncating the file beforehand. +-- Follows symlinks. +-- +-- Throws: +-- +-- - `InappropriateType` if file is not a regular file or a symlink +-- - `PermissionDenied` if we cannot read the file or the directory +-- containting it +-- - `NoSuchThing` if the file does not exist +writeFile :: AbstractFilePath + -> Bool -- ^ True if file must exist + -> BS.ByteString + -> IO () +writeFile (OsString fp) nocreat bs = Dir.writeFile fp (if nocreat then Nothing else Just Dir.newFilePerms) bs + + +-- |Write a given lazy ByteString to a file, truncating the file beforehand. +-- Follows symlinks. +-- +-- Throws: +-- +-- - `InappropriateType` if file is not a regular file or a symlink +-- - `PermissionDenied` if we cannot read the file or the directory +-- containting it +-- - `NoSuchThing` if the file does not exist +-- +-- Note: uses streamly under the hood +writeFileL :: AbstractFilePath + -> Bool -- ^ True if file must exist + -> L.ByteString + -> IO () +writeFileL (OsString fp) nocreat lbs = Dir.writeFileL fp (if nocreat then Nothing else Just Dir.newFilePerms) lbs + + +-- |Append a given ByteString to a file. +-- The file must exist. Follows symlinks. +-- +-- Throws: +-- +-- - `InappropriateType` if file is not a regular file or a symlink +-- - `PermissionDenied` if we cannot read the file or the directory +-- containting it +-- - `NoSuchThing` if the file does not exist +appendFile :: AbstractFilePath -> BS.ByteString -> IO () +appendFile (OsString fp) bs = Dir.appendFile fp bs + + + + ------------------- + --[ File checks ]-- + ------------------- + + +-- |Checks if the given file exists. +-- Does not follow symlinks. +-- +-- Only eNOENT is catched (and returns False). +doesExist :: AbstractFilePath -> IO Bool +doesExist (OsString bs) = Dir.doesExist bs + + +-- |Checks if the given file exists and is not a directory. +-- Does not follow symlinks. +-- +-- Only eNOENT is catched (and returns False). +doesFileExist :: AbstractFilePath -> IO Bool +doesFileExist (OsString bs) = Dir.doesFileExist bs + + +-- |Checks if the given file exists and is a directory. +-- Does not follow symlinks. +-- +-- Only eNOENT is catched (and returns False). +doesDirectoryExist :: AbstractFilePath -> IO Bool +doesDirectoryExist (OsString bs) = Dir.doesDirectoryExist bs + + +-- |Checks whether a file or folder is readable. +-- +-- Only eACCES, eROFS, eTXTBSY, ePERM are catched (and return False). +-- +-- Throws: +-- +-- - `NoSuchThing` if the file does not exist +isReadable :: AbstractFilePath -> IO Bool +isReadable (OsString bs) = Dir.isReadable bs + +-- |Checks whether a file or folder is writable. +-- +-- Only eACCES, eROFS, eTXTBSY, ePERM are catched (and return False). +-- +-- Throws: +-- +-- - `NoSuchThing` if the file does not exist +isWritable :: AbstractFilePath -> IO Bool +isWritable (OsString bs) = Dir.isWritable bs + + +-- |Checks whether a file or folder is executable. +-- +-- Only eACCES, eROFS, eTXTBSY, ePERM are catched (and return False). +-- +-- Throws: +-- +-- - `NoSuchThing` if the file does not exist +isExecutable :: AbstractFilePath -> IO Bool +isExecutable (OsString bs) = Dir.isExecutable bs + + + +-- |Checks whether the directory at the given path exists and can be +-- opened. This invokes `openDirStream` which follows symlinks. +canOpenDirectory :: AbstractFilePath -> IO Bool +canOpenDirectory (OsString bs) = Dir.canOpenDirectory bs + + + + + ------------------ + --[ File times ]-- + ------------------ + + +getModificationTime :: AbstractFilePath -> IO UTCTime +getModificationTime (OsString bs) = Dir.getModificationTime bs + +setModificationTime :: AbstractFilePath -> UTCTime -> IO () +setModificationTime (OsString bs) t = Dir.setModificationTime bs t + +setModificationTimeHiRes :: AbstractFilePath -> POSIXTime -> IO () +setModificationTimeHiRes (OsString bs) t = Dir.setModificationTimeHiRes bs t + + + + ------------------------- + --[ Directory reading ]-- + ------------------------- + + +-- |Gets all filenames of the given directory. This excludes "." and "..". +-- This version does not follow symbolic links. +-- +-- The contents are not sorted and there is no guarantee on the ordering. +-- +-- Throws: +-- +-- - `NoSuchThing` if directory does not exist +-- - `InappropriateType` if file type is wrong (file) +-- - `InappropriateType` if file type is wrong (symlink to file) +-- - `InappropriateType` if file type is wrong (symlink to dir) +-- - `PermissionDenied` if directory cannot be opened +getDirsFiles :: AbstractFilePath -- ^ dir to read + -> IO [AbstractFilePath] +getDirsFiles (OsString p) = fmap OsString <$> Dir.getDirsFiles p + + +-- | Like 'getDirsFiles', but returns the filename only, instead +-- of prepending the base path. +getDirsFiles' :: AbstractFilePath -- ^ dir to read + -> IO [AbstractFilePath] +getDirsFiles' (OsString fp) = fmap OsString <$> Dir.getDirsFiles' fp + + +-- | Like 'getDirsFiles'', except returning a Stream. +getDirsFilesStream :: (MonadCatch m, MonadAsync m, MonadMask m) + => AbstractFilePath + -> IO (SerialT m AbstractFilePath) +getDirsFilesStream (OsString fp) = fmap OsString <$> Dir.getDirsFilesStream fp + + + ----------- + --[ CWD ]-- + ----------- + +getCurrentDirectory :: IO AbstractFilePath +getCurrentDirectory = OsString <$> Dir.getCurrentDirectory + +setCurrentDirectory :: AbstractFilePath -> IO () +setCurrentDirectory (OsString fp) = Dir.setCurrentDirectory fp + + + + --------------------------- + --[ FileType operations ]-- + --------------------------- + + +-- |Get the file type of the file located at the given path. Does +-- not follow symbolic links. +-- +-- Throws: +-- +-- - `NoSuchThing` if the file does not exist +-- - `PermissionDenied` if any part of the path is not accessible +getFileType :: AbstractFilePath -> IO FileType +getFileType (OsString fp) = Dir.getFileType fp + + + + -------------- + --[ Others ]-- + -------------- + + + +-- |Applies `realpath` on the given path. +-- +-- Throws: +-- +-- - `NoSuchThing` if the file at the given path does not exist +-- - `NoSuchThing` if the symlink is broken +canonicalizePath :: AbstractFilePath -> IO AbstractFilePath +canonicalizePath (OsString fp) = OsString <$> Dir.canonicalizePath fp + + +-- |Converts any path to an absolute path. +-- This is done in the following way: +-- +-- - if the path is already an absolute one, just return it +-- - if it's a relative path, prepend the current directory to it +toAbs :: AbstractFilePath -> IO AbstractFilePath +toAbs (OsString bs) = OsString <$> Dir.toAbs bs + diff --git a/hpath-directory/src/System/Directory/Types.hs b/hpath-directory/src/System/Directory/Types.hs new file mode 100644 index 0000000..9f6da23 --- /dev/null +++ b/hpath-directory/src/System/Directory/Types.hs @@ -0,0 +1,70 @@ +module System.Directory.Types where + +import Control.Exception (Exception, IOException) +import Data.Typeable (Typeable) +import AFP.AbstractFilePath.Types + + + + + + ------------- + --[ Types ]-- + ------------- + +-- |Additional generic IO exceptions that the posix functions +-- do not provide. +data HPathIOException = SameFile AbstractFilePath AbstractFilePath + | DestinationInSource AbstractFilePath AbstractFilePath + | RecursiveFailure [(RecursiveFailureHint, IOException)] + deriving (Eq, Show, Typeable) + + +-- |A type for giving failure hints on recursive failure, which allows +-- to programmatically make choices without examining +-- the weakly typed I/O error attributes (like `ioeGetFileName`). +-- +-- The first argument to the data constructor is always the +-- source and the second the destination. +data RecursiveFailureHint = ReadContentsFailed AbstractFilePath AbstractFilePath + | CreateDirFailed AbstractFilePath AbstractFilePath + | CopyFileFailed AbstractFilePath AbstractFilePath + | RecreateSymlinkFailed AbstractFilePath AbstractFilePath + deriving (Eq, Show) + + + +instance Exception HPathIOException + +data FileType = Directory + | RegularFile + | SymbolicLink + | BlockDevice + | CharacterDevice + | NamedPipe + | Socket + deriving (Eq, Show) + + + +-- |The error mode for recursive operations. +-- +-- On `FailEarly` the whole operation fails immediately if any of the +-- recursive sub-operations fail, which is sort of the default +-- for IO operations. +-- +-- On `CollectFailures` skips errors in the recursion and keeps on recursing. +-- However all errors are collected in the `RecursiveFailure` error type, +-- which is raised finally if there was any error. Also note that +-- `RecursiveFailure` does not give any guarantees on the ordering +-- of the collected exceptions. +data RecursiveErrorMode = FailEarly + | CollectFailures + + +-- |The mode for copy and file moves. +-- Overwrite mode is usually not very well defined, but is a convenience +-- shortcut. +data CopyMode = Strict -- ^ fail if any target exists + | Overwrite -- ^ overwrite targets + diff --git a/hpath-directory/src/System/Posix/RawFilePath/Directory.hs b/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs similarity index 87% rename from hpath-directory/src/System/Posix/RawFilePath/Directory.hs rename to hpath-directory/src/System/Posix/PosixFilePath/Directory.hs index e8dae84..b3c0917 100644 --- a/hpath-directory/src/System/Posix/RawFilePath/Directory.hs +++ b/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs @@ -1,5 +1,5 @@ -- | --- Module : System.Posix.RawFilePath.Directory +-- Module : System.Posix.PosixFilePath.Directory -- Copyright : © 2020 Julian Ospald -- License : BSD3 -- @@ -25,12 +25,13 @@ -- unreliable/unsafe. Check the documentation of those functions for details. -- -- Import as: --- > import System.Posix.RawFilePath.Directory +-- > import System.Posix.PosixFilePath.Directory {-# LANGUAGE CPP #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE FlexibleContexts #-} -- streamly -module System.Posix.RawFilePath.Directory +module System.Posix.PosixFilePath.Directory ( -- * Types FileType(..) @@ -85,6 +86,9 @@ module System.Posix.RawFilePath.Directory , getDirsFiles , getDirsFiles' , getDirsFilesStream + -- * CWD + , getCurrentDirectory + , setCurrentDirectory -- * Filetype operations , getFileType -- * Others @@ -113,12 +117,11 @@ import Control.Monad ( unless , when ) import Control.Monad.IfElse ( unlessM ) -import Control.Monad.IO.Class ( liftIO ) import qualified Data.ByteString as BS import Data.ByteString ( ByteString ) import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString.UTF8 as UTF8 import Data.Foldable ( for_ ) +import Data.String import Data.IORef ( IORef , modifyIORef , newIORef @@ -127,6 +130,7 @@ import Data.IORef ( IORef import Data.Time.Clock import Data.Time.Clock.POSIX ( getPOSIXTime , posixSecondsToUTCTime + , utcTimeToPOSIXSeconds , POSIXTime ) import Data.Word ( Word8 ) @@ -141,13 +145,13 @@ import Prelude hiding ( appendFile , readFile , writeFile ) -import Streamly +import Streamly.Prelude ( SerialT, MonadAsync ) +import Streamly.Data.Array.Foreign import Streamly.External.ByteString import qualified Streamly.External.ByteString.Lazy as SL import qualified Streamly.External.Posix.DirStream as SD -import Streamly.Memory.Array import qualified Streamly.FileSystem.Handle as FH import qualified Streamly.Internal.Data.Unfold as SU import qualified Streamly.Internal.FileSystem.Handle @@ -164,17 +168,17 @@ import qualified System.IO as SIO import System.IO.Error ( catchIOError , ioeGetErrorType ) -import System.Posix.FilePath import System.Posix.ByteString ( exclusive ) -import System.Posix.RawFilePath.Directory.Errors -import System.Posix.Directory.ByteString +import System.Posix.PosixFilePath.Directory.Errors +import System.Posix.Directory.PosixFilePath ( createDirectory , closeDirStream , getWorkingDirectory , openDirStream , removeDirectory + , changeWorkingDirectory ) -import System.Posix.Files.ByteString ( createSymbolicLink +import System.Posix.Files.PosixString ( createSymbolicLink , fileAccess , fileMode , getFdStatus @@ -193,66 +197,29 @@ import System.Posix.Files.ByteString ( createSymbolicLink , setFileMode , unionFileModes ) -import qualified System.Posix.Files.ByteString as PF -import qualified "unix" System.Posix.IO.ByteString +import qualified System.Posix.Files.PosixString as PF +import qualified System.Posix.IO.PosixString as SPI import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB import System.Posix.FD ( openFd ) -import qualified System.Posix.RawFilePath.Directory.Traversals +import qualified System.Posix.PosixFilePath.Directory.Traversals as SPDT import qualified System.Posix.Foreign as SPDF -import qualified System.Posix.Process.ByteString +import qualified System.Posix.Process.PosixString as SPP import System.Posix.Types ( FileMode , ProcessID - , EpochTime ) import System.Posix.Time +import AFP.AbstractFilePath.Posix +import AFP.OsString.Internal.Types +import System.Directory.Types - ------------- - --[ Types ]-- - ------------- - - -data FileType = Directory - | RegularFile - | SymbolicLink - | BlockDevice - | CharacterDevice - | NamedPipe - | Socket - deriving (Eq, Show) - - - --- |The error mode for recursive operations. --- --- On `FailEarly` the whole operation fails immediately if any of the --- recursive sub-operations fail, which is sort of the default --- for IO operations. --- --- On `CollectFailures` skips errors in the recursion and keeps on recursing. --- However all errors are collected in the `RecursiveFailure` error type, --- which is raised finally if there was any error. Also note that --- `RecursiveFailure` does not give any guarantees on the ordering --- of the collected exceptions. -data RecursiveErrorMode = FailEarly - | CollectFailures - - --- |The mode for copy and file moves. --- Overwrite mode is usually not very well defined, but is a convenience --- shortcut. -data CopyMode = Strict -- ^ fail if any target exists - | Overwrite -- ^ overwrite targets - - - -------------------- --[ File Copying ]-- @@ -309,8 +276,8 @@ data CopyMode = Strict -- ^ fail if any target exists -- Throws in `Strict` CopyMode only: -- -- - `AlreadyExists` if destination already exists -copyDirRecursive :: RawFilePath -- ^ source dir - -> RawFilePath -- ^ destination (parent dirs +copyDirRecursive :: PosixFilePath -- ^ source dir + -> PosixFilePath -- ^ destination (parent dirs -- are not automatically created) -> CopyMode -> RecursiveErrorMode @@ -326,17 +293,17 @@ copyDirRecursive fromp destdirp cm rm = do (throwIO . RecursiveFailure $ collectedExceptions) where #if MIN_VERSION_base(4,9,0) - basename :: Fail.MonadFail m => RawFilePath -> m RawFilePath + basename :: Fail.MonadFail m => PosixFilePath -> m PosixFilePath #else - basename :: Fail.Monad m => RawFilePath -> m RawFilePath + basename :: Fail.Monad m => PosixFilePath -> m PosixFilePath #endif basename x = let b = takeBaseName x - in if BS.null b then Fail.fail ("No base name" :: String) else pure b + in if b == mempty then Fail.fail ("No base name" :: String) else pure b go :: IORef [(RecursiveFailureHint, IOException)] - -> RawFilePath - -> RawFilePath + -> PosixFilePath + -> PosixFilePath -> IO () go ce from destdir = do @@ -344,12 +311,12 @@ copyDirRecursive fromp destdirp cm rm = do -- on failure -- get the contents of the source dir - contents <- handleIOE (ReadContentsFailed from destdir) ce [] $ do + contents <- handleIOE (ReadContentsFailed (OsString from) (OsString destdir)) ce [] $ do contents <- getDirsFiles from -- create the destination dir and -- only return contents if we succeed - handleIOE (CreateDirFailed from destdir) ce [] $ do + handleIOE (CreateDirFailed (OsString from) (OsString destdir)) ce [] $ do fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus from case cm of Strict -> createDirectory destdir fmode' @@ -369,11 +336,11 @@ copyDirRecursive fromp destdirp cm rm = do newdest <- (destdir ) <$> basename f case ftype of SymbolicLink -> - handleIOE (RecreateSymlinkFailed f newdest) ce () + handleIOE (RecreateSymlinkFailed (OsString f) (OsString newdest)) ce () $ recreateSymlink f newdest cm Directory -> go ce f newdest RegularFile -> - handleIOE (CopyFileFailed f newdest) ce () $ copyFile f newdest cm + handleIOE (CopyFileFailed (OsString f) (OsString newdest)) ce () $ copyFile f newdest cm _ -> return () -- helper to handle errors for both RecursiveErrorModes and return a @@ -417,8 +384,8 @@ copyDirRecursive fromp destdirp cm rm = do -- Notes: -- -- - calls `symlink` -recreateSymlink :: RawFilePath -- ^ the old symlink file - -> RawFilePath -- ^ destination file +recreateSymlink :: PosixFilePath -- ^ the old symlink file + -> PosixFilePath -- ^ destination file -> CopyMode -> IO () recreateSymlink symsource newsym cm = do @@ -471,8 +438,8 @@ recreateSymlink symsource newsym cm = do -- Throws in `Strict` mode only: -- -- - `AlreadyExists` if destination already exists -copyFile :: RawFilePath -- ^ source file - -> RawFilePath -- ^ destination file +copyFile :: PosixFilePath -- ^ source file + -> PosixFilePath -- ^ destination file -> CopyMode -> IO () copyFile from to cm = do @@ -485,7 +452,7 @@ copyFile from to cm = do ) (\(_, handle) -> SIO.hClose handle) $ \(fromFd, fH) -> do - sourceFileMode <- System.Posix.Files.ByteString.fileMode + sourceFileMode <- System.Posix.Files.PosixString.fileMode <$> getFdStatus fromFd let dflags = [ SPDF.oNofollow @@ -524,8 +491,8 @@ copyFile from to cm = do -- -- * examines filetypes explicitly -- * calls `copyDirRecursive` for directories -easyCopy :: RawFilePath - -> RawFilePath +easyCopy :: PosixFilePath + -> PosixFilePath -> CopyMode -> RecursiveErrorMode -> IO () @@ -556,7 +523,7 @@ easyCopy from to cm rm = do -- - `PermissionDenied` if the directory cannot be read -- -- Notes: calls `unlink` -deleteFile :: RawFilePath -> IO () +deleteFile :: PosixFilePath -> IO () deleteFile = removeLink @@ -571,7 +538,7 @@ deleteFile = removeLink -- - `PermissionDenied` if we can't open or write to parent directory -- -- Notes: calls `rmdir` -deleteDir :: RawFilePath -> IO () +deleteDir :: PosixFilePath -> IO () deleteDir = removeDirectory @@ -594,7 +561,7 @@ deleteDir = removeDirectory -- - `InappropriateType` for wrong file type (regular file) -- - `NoSuchThing` if directory does not exist -- - `PermissionDenied` if we can't open or write to parent directory -deleteDirRecursive :: RawFilePath -> IO () +deleteDirRecursive :: PosixFilePath -> IO () deleteDirRecursive p = catchErrno [eNOTEMPTY, eEXIST] (deleteDir p) $ do files <- getDirsFiles p for_ files $ \file -> do @@ -616,7 +583,7 @@ deleteDirRecursive p = catchErrno [eNOTEMPTY, eEXIST] (deleteDir p) $ do -- -- * examines filetypes explicitly -- * calls `deleteDirRecursive` for directories -easyDelete :: RawFilePath -> IO () +easyDelete :: PosixFilePath -> IO () easyDelete p = do ftype <- getFileType p case ftype of @@ -635,16 +602,18 @@ easyDelete p = do -- |Opens a file appropriately by invoking xdg-open. The file type -- is not checked. This forks a process. -openFile :: RawFilePath -> IO ProcessID -openFile fp = SPP.forkProcess - $ SPP.executeFile (UTF8.fromString "xdg-open") True [fp] Nothing +openFile :: PosixFilePath -> IO ProcessID +openFile fp = + SPP.forkProcess + $ SPP.executeFile [pstr|xdg-open|] True [fp] Nothing -- |Executes a program with the given arguments. This forks a process. -executeFile :: RawFilePath -- ^ program - -> [ByteString] -- ^ arguments +executeFile :: PosixFilePath -- ^ program + -> [PosixString] -- ^ arguments -> IO ProcessID -executeFile fp args = SPP.forkProcess $ SPP.executeFile fp True args Nothing +executeFile fp args = + SPP.forkProcess $ SPP.executeFile fp True args Nothing @@ -663,7 +632,7 @@ executeFile fp args = SPP.forkProcess $ SPP.executeFile fp True args Nothing -- - `AlreadyExists` if destination already exists -- - `NoSuchThing` if any of the parent components of the path -- do not exist -createRegularFile :: FileMode -> RawFilePath -> IO () +createRegularFile :: FileMode -> PosixFilePath -> IO () createRegularFile fm destBS = bracket (SPI.openFd destBS SPI.WriteOnly @@ -682,7 +651,7 @@ createRegularFile fm destBS = bracket -- - `AlreadyExists` if destination already exists -- - `NoSuchThing` if any of the parent components of the path -- do not exist -createDir :: FileMode -> RawFilePath -> IO () +createDir :: FileMode -> PosixFilePath -> IO () createDir fm destBS = createDirectory destBS fm -- |Create an empty directory at the given directory with the given filename. @@ -692,7 +661,7 @@ createDir fm destBS = createDirectory destBS fm -- - `PermissionDenied` if output directory cannot be written to -- - `NoSuchThing` if any of the parent components of the path -- do not exist -createDirIfMissing :: FileMode -> RawFilePath -> IO () +createDirIfMissing :: FileMode -> PosixFilePath -> IO () createDirIfMissing fm destBS = hideError AlreadyExists $ createDirectory destBS fm @@ -715,10 +684,10 @@ createDirIfMissing fm destBS = -- exist and cannot be written to -- - `AlreadyExists` if destination already exists and -- is *not* a directory -createDirRecursive :: FileMode -> RawFilePath -> IO () +createDirRecursive :: FileMode -> PosixFilePath -> IO () createDirRecursive fm p = go p where - go :: RawFilePath -> IO () + go :: PosixFilePath -> IO () go dest = do catchIOError (createDirectory dest fm) $ \e -> do errno <- getErrno @@ -743,8 +712,8 @@ createDirRecursive fm p = go p -- do not exist -- -- Note: calls `symlink` -createSymlink :: RawFilePath -- ^ destination file - -> RawFilePath -- ^ path the symlink points to +createSymlink :: PosixFilePath -- ^ destination file + -> PosixFilePath -- ^ path the symlink points to -> IO () createSymlink destBS sympoint = createSymbolicLink sympoint destBS @@ -776,7 +745,7 @@ createSymlink destBS sympoint = createSymbolicLink sympoint destBS -- (`HPathIOException`) -- -- Note: calls `rename` (but does not allow to rename over existing files) -renameFile :: RawFilePath -> RawFilePath -> IO () +renameFile :: PosixFilePath -> PosixFilePath -> IO () renameFile fromf tof = do throwSameFile fromf tof throwFileDoesExist tof @@ -815,8 +784,8 @@ renameFile fromf tof = do -- Notes: -- -- - calls `rename` (but does not allow to rename over existing files) -moveFile :: RawFilePath -- ^ file to move - -> RawFilePath -- ^ destination +moveFile :: PosixFilePath -- ^ file to move + -> PosixFilePath -- ^ destination -> CopyMode -> IO () moveFile from to cm = do @@ -863,7 +832,7 @@ moveFile from to cm = do -- - `PermissionDenied` if we cannot read the file or the directory -- containting it -- - `NoSuchThing` if the file does not exist -readFile :: RawFilePath -> IO L.ByteString +readFile :: PosixFilePath -> IO L.ByteString readFile path = do stream <- readFileStream path SL.fromChunksIO stream @@ -879,7 +848,7 @@ readFile path = do -- - `PermissionDenied` if we cannot read the file or the directory -- containting it -- - `NoSuchThing` if the file does not exist -readFileStrict :: RawFilePath -> IO BS.ByteString +readFileStrict :: PosixFilePath -> IO BS.ByteString readFileStrict path = do stream <- readFileStream path fromArray <$> AS.toArray stream @@ -894,7 +863,7 @@ readFileStrict path = do -- - `PermissionDenied` if we cannot read the file or the directory -- containting it -- - `NoSuchThing` if the file does not exist -readFileStream :: RawFilePath -> IO (SerialT IO (Array Word8)) +readFileStream :: PosixFilePath -> IO (SerialT IO (Array Word8)) readFileStream fp = do fd <- openFd fp SPI.ReadOnly [] Nothing handle <- SPI.fdToHandle fd @@ -918,7 +887,7 @@ readFileStream fp = do -- - `PermissionDenied` if we cannot read the file or the directory -- containting it -- - `NoSuchThing` if the file does not exist -writeFile :: RawFilePath +writeFile :: PosixFilePath -> Maybe FileMode -- ^ if Nothing, file must exist -> ByteString -> IO () @@ -938,7 +907,7 @@ writeFile fp fmode bs = -- - `NoSuchThing` if the file does not exist -- -- Note: uses streamly under the hood -writeFileL :: RawFilePath +writeFileL :: PosixFilePath -> Maybe FileMode -- ^ if Nothing, file must exist -> L.ByteString -> IO () @@ -959,7 +928,7 @@ writeFileL fp fmode lbs = do -- - `PermissionDenied` if we cannot read the file or the directory -- containting it -- - `NoSuchThing` if the file does not exist -appendFile :: RawFilePath -> ByteString -> IO () +appendFile :: PosixFilePath -> ByteString -> IO () appendFile fp bs = bracket (openFd fp SPI.WriteOnly [SPDF.oAppend] Nothing) (SPI.closeFd) $ \fd -> void $ SPB.fdWrite fd bs @@ -975,7 +944,7 @@ appendFile fp bs = -- |Default permissions for a new file. newFilePerms :: FileMode newFilePerms = - ownerWriteMode + ownerWriteMode `unionFileModes` ownerReadMode `unionFileModes` groupWriteMode `unionFileModes` groupReadMode @@ -986,7 +955,7 @@ newFilePerms = -- |Default permissions for a new directory. newDirPerms :: FileMode newDirPerms = - ownerModes + ownerModes `unionFileModes` groupExecuteMode `unionFileModes` groupReadMode `unionFileModes` otherExecuteMode @@ -1004,7 +973,7 @@ newDirPerms = -- Does not follow symlinks. -- -- Only eNOENT is catched (and returns False). -doesExist :: RawFilePath -> IO Bool +doesExist :: PosixFilePath -> IO Bool doesExist bs = catchErrno [eNOENT] @@ -1019,7 +988,7 @@ doesExist bs = -- Does not follow symlinks. -- -- Only eNOENT is catched (and returns False). -doesFileExist :: RawFilePath -> IO Bool +doesFileExist :: PosixFilePath -> IO Bool doesFileExist bs = catchErrno [eNOENT] @@ -1034,7 +1003,7 @@ doesFileExist bs = -- Does not follow symlinks. -- -- Only eNOENT is catched (and returns False). -doesDirectoryExist :: RawFilePath -> IO Bool +doesDirectoryExist :: PosixFilePath -> IO Bool doesDirectoryExist bs = catchErrno [eNOENT] @@ -1052,7 +1021,7 @@ doesDirectoryExist bs = -- Throws: -- -- - `NoSuchThing` if the file does not exist -isReadable :: RawFilePath -> IO Bool +isReadable :: PosixFilePath -> IO Bool isReadable bs = fileAccess bs True False False -- |Checks whether a file or folder is writable. @@ -1062,7 +1031,7 @@ isReadable bs = fileAccess bs True False False -- Throws: -- -- - `NoSuchThing` if the file does not exist -isWritable :: RawFilePath -> IO Bool +isWritable :: PosixFilePath -> IO Bool isWritable bs = fileAccess bs False True False @@ -1073,14 +1042,14 @@ isWritable bs = fileAccess bs False True False -- Throws: -- -- - `NoSuchThing` if the file does not exist -isExecutable :: RawFilePath -> IO Bool +isExecutable :: PosixFilePath -> IO Bool isExecutable bs = fileAccess bs False False True -- |Checks whether the directory at the given path exists and can be -- opened. This invokes `openDirStream` which follows symlinks. -canOpenDirectory :: RawFilePath -> IO Bool +canOpenDirectory :: PosixFilePath -> IO Bool canOpenDirectory bs = handleIOError (\_ -> return False) $ do bracket (openDirStream bs) closeDirStream (\_ -> return ()) return True @@ -1093,18 +1062,18 @@ canOpenDirectory bs = handleIOError (\_ -> return False) $ do ------------------ -getModificationTime :: RawFilePath -> IO UTCTime +getModificationTime :: PosixFilePath -> IO UTCTime getModificationTime bs = do fs <- PF.getFileStatus bs pure $ posixSecondsToUTCTime $ PF.modificationTimeHiRes fs -setModificationTime :: RawFilePath -> EpochTime -> IO () +setModificationTime :: PosixFilePath -> UTCTime -> IO () setModificationTime bs t = do -- TODO: setFileTimes doesn't allow to pass NULL to utime ctime <- epochTime - PF.setFileTimes bs ctime t + PF.setFileTimes bs ctime (fromInteger . floor . utcTimeToPOSIXSeconds $ t) -setModificationTimeHiRes :: RawFilePath -> POSIXTime -> IO () +setModificationTimeHiRes :: PosixFilePath -> POSIXTime -> IO () setModificationTimeHiRes bs t = do -- TODO: setFileTimesHiRes doesn't allow to pass NULL to utimes ctime <- getPOSIXTime @@ -1129,8 +1098,8 @@ setModificationTimeHiRes bs t = do -- - `InappropriateType` if file type is wrong (symlink to file) -- - `InappropriateType` if file type is wrong (symlink to dir) -- - `PermissionDenied` if directory cannot be opened -getDirsFiles :: RawFilePath -- ^ dir to read - -> IO [RawFilePath] +getDirsFiles :: PosixFilePath -- ^ dir to read + -> IO [PosixFilePath] getDirsFiles p = do contents <- getDirsFiles' p pure $ fmap (p ) contents @@ -1138,21 +1107,31 @@ getDirsFiles p = do -- | Like 'getDirsFiles', but returns the filename only, instead -- of prepending the base path. -getDirsFiles' :: RawFilePath -- ^ dir to read - -> IO [RawFilePath] +getDirsFiles' :: PosixFilePath -- ^ dir to read + -> IO [PosixFilePath] getDirsFiles' fp = getDirsFilesStream fp >>= S.toList -- | Like 'getDirsFiles'', except returning a Stream. getDirsFilesStream :: (MonadCatch m, MonadAsync m, MonadMask m) - => RawFilePath - -> IO (SerialT m RawFilePath) + => PosixFilePath + -> IO (SerialT m PosixFilePath) getDirsFilesStream fp = do fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing ds <- SPDT.fdOpendir fd `onException` SPI.closeFd fd pure $ fmap snd $ SD.dirContentsStream ds + ----------- + --[ CWD ]-- + ----------- + +getCurrentDirectory :: IO PosixFilePath +getCurrentDirectory = getWorkingDirectory + +setCurrentDirectory :: PosixFilePath -> IO () +setCurrentDirectory = changeWorkingDirectory + --------------------------- @@ -1167,7 +1146,7 @@ getDirsFilesStream fp = do -- -- - `NoSuchThing` if the file does not exist -- - `PermissionDenied` if any part of the path is not accessible -getFileType :: RawFilePath -> IO FileType +getFileType :: PosixFilePath -> IO FileType getFileType fp = do fs <- PF.getSymbolicLinkStatus fp decide fs @@ -1195,7 +1174,7 @@ getFileType fp = do -- -- - `NoSuchThing` if the file at the given path does not exist -- - `NoSuchThing` if the symlink is broken -canonicalizePath :: RawFilePath -> IO RawFilePath +canonicalizePath :: PosixFilePath -> IO PosixFilePath canonicalizePath = SPDT.realpath @@ -1204,7 +1183,7 @@ canonicalizePath = SPDT.realpath -- -- - if the path is already an absolute one, just return it -- - if it's a relative path, prepend the current directory to it -toAbs :: RawFilePath -> IO RawFilePath +toAbs :: PosixFilePath -> IO PosixFilePath toAbs bs = do case isAbsolute bs of True -> return bs diff --git a/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs-boot b/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs-boot new file mode 100644 index 0000000..90bf5ec --- /dev/null +++ b/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs-boot @@ -0,0 +1,15 @@ +module System.Posix.PosixFilePath.Directory where + +import AFP.AbstractFilePath.Posix (PosixFilePath) + +canonicalizePath :: PosixFilePath -> IO PosixFilePath + +toAbs :: PosixFilePath -> IO PosixFilePath + +doesFileExist :: PosixFilePath -> IO Bool + +doesDirectoryExist :: PosixFilePath -> IO Bool + +isWritable :: PosixFilePath -> IO Bool + +canOpenDirectory :: PosixFilePath -> IO Bool diff --git a/hpath-directory/src/System/Posix/RawFilePath/Directory/Errors.hs b/hpath-directory/src/System/Posix/PosixFilePath/Directory/Errors.hs similarity index 77% rename from hpath-directory/src/System/Posix/RawFilePath/Directory/Errors.hs rename to hpath-directory/src/System/Posix/PosixFilePath/Directory/Errors.hs index 20d0862..bb09478 100644 --- a/hpath-directory/src/System/Posix/RawFilePath/Directory/Errors.hs +++ b/hpath-directory/src/System/Posix/PosixFilePath/Directory/Errors.hs @@ -1,5 +1,5 @@ -- | --- Module : System.Posix.RawFilePath.Directory.Errors +-- Module : System.Posix.PosixFilePath.Directory.Errors -- Copyright : © 2016 Julian Ospald -- License : BSD3 -- @@ -12,7 +12,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables #-} -module System.Posix.RawFilePath.Directory.Errors +module System.Posix.PosixFilePath.Directory.Errors ( -- * Types HPathIOException(..) @@ -59,19 +59,6 @@ import Control.Monad.IfElse ( whenM ) -import Data.ByteString - ( - ByteString - ) -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 - ( - toString - ) -import Data.Typeable - ( - Typeable - ) import Foreign.C.Error ( getErrno @@ -81,14 +68,12 @@ import GHC.IO.Exception ( IOErrorType ) -import {-# SOURCE #-} System.Posix.RawFilePath.Directory +import {-# SOURCE #-} System.Posix.PosixFilePath.Directory ( canonicalizePath , toAbs , doesFileExist , doesDirectoryExist - , isWritable - , canOpenDirectory ) import System.IO.Error ( @@ -96,38 +81,18 @@ import System.IO.Error , ioeGetErrorType , mkIOError ) -import System.Posix.FilePath -import qualified System.Posix.Directory.ByteString as PFD -import System.Posix.Files.ByteString +import System.Posix.Files.PosixString ( - fileAccess - , getFileStatus + getFileStatus ) -import qualified System.Posix.Files.ByteString as PF - +import qualified System.Posix.Files.PosixString as PF +import AFP.AbstractFilePath.Posix +import System.Directory.Types +import AFP.OsString.Internal.Types --- |Additional generic IO exceptions that the posix functions --- do not provide. -data HPathIOException = SameFile ByteString ByteString - | DestinationInSource ByteString ByteString - | RecursiveFailure [(RecursiveFailureHint, IOException)] - deriving (Eq, Show, Typeable) --- |A type for giving failure hints on recursive failure, which allows --- to programmatically make choices without examining --- the weakly typed I/O error attributes (like `ioeGetFileName`). --- --- The first argument to the data constructor is always the --- source and the second the destination. -data RecursiveFailureHint = ReadContentsFailed ByteString ByteString - | CreateDirFailed ByteString ByteString - | CopyFileFailed ByteString ByteString - | RecreateSymlinkFailed ByteString ByteString - deriving (Eq, Show) - -instance Exception HPathIOException toConstr :: HPathIOException -> String @@ -170,41 +135,43 @@ isRecreateSymlinkFailed _ = False -- |Throws `AlreadyExists` `IOError` if file exists. -throwFileDoesExist :: RawFilePath -> IO () -throwFileDoesExist bs = +throwFileDoesExist :: PosixFilePath -> IO () +throwFileDoesExist bs = do + locstr <- fromPlatformStringIO bs whenM (doesFileExist bs) (ioError . mkIOError alreadyExistsErrorType "File already exists" Nothing - $ (Just (toString $ bs)) + $ (Just locstr) ) -- |Throws `AlreadyExists` `IOError` if directory exists. -throwDirDoesExist :: RawFilePath -> IO () -throwDirDoesExist bs = +throwDirDoesExist :: PosixFilePath -> IO () +throwDirDoesExist bs = do + locstr <- fromPlatformStringIO bs whenM (doesDirectoryExist bs) (ioError . mkIOError alreadyExistsErrorType "Directory already exists" Nothing - $ (Just (toString $ bs)) + $ (Just locstr) ) -- |Uses `isSameFile` and throws `SameFile` if it returns True. -throwSameFile :: RawFilePath - -> RawFilePath +throwSameFile :: PosixFilePath + -> PosixFilePath -> IO () throwSameFile bs1 bs2 = whenM (sameFile bs1 bs2) - (throwIO $ SameFile bs1 bs2) + (throwIO $ SameFile (OsString bs1) (OsString bs2)) -- |Check if the files are the same by examining device and file id. -- This follows symbolic links. -sameFile :: RawFilePath -> RawFilePath -> IO Bool +sameFile :: PosixFilePath -> PosixFilePath -> IO Bool sameFile fp1 fp2 = handleIOError (\_ -> return False) $ do fs1 <- getFileStatus fp1 @@ -221,8 +188,8 @@ sameFile fp1 fp2 = -- within the source directory by comparing the device+file ID of the -- source directory with all device+file IDs of the parent directories -- of the destination. -throwDestinationInSource :: RawFilePath -- ^ source dir - -> RawFilePath -- ^ full destination, @dirname dest@ +throwDestinationInSource :: PosixFilePath -- ^ source dir + -> PosixFilePath -- ^ full destination, @dirname dest@ -- must exist -> IO () throwDestinationInSource sbs dbs = do @@ -235,10 +202,10 @@ throwDestinationInSource sbs dbs = do sid <- fmap (\x -> (PF.deviceID x, PF.fileID x)) $ PF.getFileStatus sbs when (elem sid dids) - (throwIO $ DestinationInSource dbs sbs) + (throwIO $ DestinationInSource (OsString dbs) (OsString sbs)) where basename x = let b = takeBaseName x - in if BS.null b then Nothing else Just b + in if b == mempty then Nothing else Just b diff --git a/hpath-directory/src/System/Posix/RawFilePath/Directory.hs-boot b/hpath-directory/src/System/Posix/RawFilePath/Directory.hs-boot deleted file mode 100644 index e3ac884..0000000 --- a/hpath-directory/src/System/Posix/RawFilePath/Directory.hs-boot +++ /dev/null @@ -1,15 +0,0 @@ -module System.Posix.RawFilePath.Directory where - -import System.Posix.ByteString.FilePath (RawFilePath) - -canonicalizePath :: RawFilePath -> IO RawFilePath - -toAbs :: RawFilePath -> IO RawFilePath - -doesFileExist :: RawFilePath -> IO Bool - -doesDirectoryExist :: RawFilePath -> IO Bool - -isWritable :: RawFilePath -> IO Bool - -canOpenDirectory :: RawFilePath -> IO Bool diff --git a/hpath-directory/test/Main.hs b/hpath-directory/test/Main.hs index 7a71eac..6cd2282 100644 --- a/hpath-directory/test/Main.hs +++ b/hpath-directory/test/Main.hs @@ -1,16 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} -import qualified Data.ByteString as BS import Data.IORef import Test.Hspec import Test.Hspec.Runner import Test.Hspec.Formatters import qualified Spec import Utils -import System.Posix.Temp.ByteString (mkdtemp) -import System.Posix.Env.ByteString (getEnvDefault) -import System.Posix.FilePath (()) -import "hpath-directory" System.Posix.RawFilePath.Directory +import System.Posix.Temp.PosixString (mkdtemp) +import System.Posix.Env.PosixString (getEnvDefault) +import "hpath-directory" System.Posix.PosixFilePath.Directory +import AFP.AbstractFilePath.Posix -- TODO: chardev, blockdev, namedpipe, socket @@ -20,7 +19,7 @@ main :: IO () main = do tmpdir <- getEnvDefault "TMPDIR" "/tmp" >>= canonicalizePath tmpBase <- mkdtemp (tmpdir "hpath-directory") - writeIORef baseTmpDir (Just (tmpBase `BS.append` "/")) + writeIORef baseTmpDir (Just (tmpBase <> "/")) putStrLn $ ("Temporary test directory at: " ++ show tmpBase) hspecWith defaultConfig { configFormatter = Just progress } diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/AppendFileSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/AppendFileSpec.hs similarity index 95% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/AppendFileSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/AppendFileSpec.hs index 0715e87..eda5502 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/AppendFileSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/AppendFileSpec.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.AppendFileSpec where +module System.Posix.PosixFilePath.Directory.AppendFileSpec where import Test.Hspec @@ -51,7 +51,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.appendFile" $ do + describe "System.Posix.PosixFilePath.Directory.appendFile" $ do -- successes -- it "appendFile file with content, everything clear" $ do diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/CanonicalizePathSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/CanonicalizePathSpec.hs similarity index 91% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/CanonicalizePathSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/CanonicalizePathSpec.hs index ae4cd93..19982f0 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/CanonicalizePathSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/CanonicalizePathSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.CanonicalizePathSpec where +module System.Posix.PosixFilePath.Directory.CanonicalizePathSpec where import Test.Hspec @@ -41,7 +41,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.canonicalizePath" $ do + describe "System.Posix.PosixFilePath.Directory.canonicalizePath" $ do -- successes -- it "canonicalizePath, all fine" $ do diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveCollectFailuresSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyDirRecursiveCollectFailuresSpec.hs similarity index 93% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveCollectFailuresSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyDirRecursiveCollectFailuresSpec.hs index 6086dd2..689872e 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveCollectFailuresSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyDirRecursiveCollectFailuresSpec.hs @@ -1,13 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.CopyDirRecursiveCollectFailuresSpec where +module System.Posix.PosixFilePath.Directory.CopyDirRecursiveCollectFailuresSpec where import Test.Hspec import Data.List (sort) -import "hpath-directory" System.Posix.RawFilePath.Directory -import System.Posix.RawFilePath.Directory.Errors +import "hpath-directory" System.Posix.PosixFilePath.Directory +import System.Posix.PosixFilePath.Directory.Errors import System.IO.Error ( ioeGetErrorType @@ -19,8 +19,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) +import AFP.AbstractFilePath.Posix @@ -116,18 +115,19 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.copyDirRecursive" $ do + describe "System.Posix.PosixFilePath.Directory.copyDirRecursive" $ do -- successes -- it "copyDirRecursive (Strict, CollectFailures), all fine and compare" $ do tmpDir' <- getRawTmpDir + tmpDirS <- fromPlatformStringIO tmpDir' copyDirRecursive' "inputDir" "outputDir" Strict CollectFailures (system $ "diff -r " - ++ toString tmpDir' ++ "inputDir" ++ " " - ++ toString tmpDir' ++ "outputDir" + ++ tmpDirS ++ "inputDir" ++ " " + ++ tmpDirS ++ "outputDir" ++ " >/dev/null") `shouldReturn` ExitSuccess removeDirIfExists "outputDir" @@ -166,7 +166,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ normalDirPerms "outputDir1/foo2/foo4/inputFile4" c <- allDirectoryContents' "outputDir1" tmpDir' <- getRawTmpDir - let shouldC = (fmap (\x -> tmpDir' `BS.append` x) + let shouldC = (fmap (\x -> tmpDir' x) ["outputDir1" ,"outputDir1/foo2" ,"outputDir1/foo2/inputFile1" diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveOverwriteSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyDirRecursiveOverwriteSpec.hs similarity index 88% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveOverwriteSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyDirRecursiveOverwriteSpec.hs index 9a66a60..87d0c38 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveOverwriteSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyDirRecursiveOverwriteSpec.hs @@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.CopyDirRecursiveOverwriteSpec where +module System.Posix.PosixFilePath.Directory.CopyDirRecursiveOverwriteSpec where import Test.Hspec -import "hpath-directory" System.Posix.RawFilePath.Directory -import System.Posix.RawFilePath.Directory.Errors +import "hpath-directory" System.Posix.PosixFilePath.Directory +import System.Posix.PosixFilePath.Directory.Errors import System.IO.Error ( ioeGetErrorType @@ -18,7 +18,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import Data.ByteString.UTF8 (toString) +import AFP.AbstractFilePath.Posix @@ -88,7 +88,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.copyDirRecursive" $ do + describe "System.Posix.PosixFilePath.Directory.copyDirRecursive" $ do -- successes -- it "copyDirRecursive (Overwrite, FailEarly), all fine" $ do @@ -100,22 +100,24 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "copyDirRecursive (Overwrite, FailEarly), all fine and compare" $ do tmpDir' <- getRawTmpDir + tmpDirS <- fromPlatformStringIO tmpDir' copyDirRecursive' "inputDir" "outputDir" Overwrite FailEarly (system $ "diff -r " - ++ toString tmpDir' ++ "inputDir" ++ " " - ++ toString tmpDir' ++ "outputDir" + ++ tmpDirS ++ "inputDir" ++ " " + ++ tmpDirS ++ "outputDir" ++ " >/dev/null") `shouldReturn` ExitSuccess removeDirIfExists "outputDir" it "copyDirRecursive (Overwrite, FailEarly), destination dir already exists" $ do tmpDir' <- getRawTmpDir + tmpDirS <- fromPlatformStringIO tmpDir' (system $ "diff -r " - ++ toString tmpDir' ++ "inputDir" ++ " " - ++ toString tmpDir' ++ "alreadyExistsD" + ++ tmpDirS ++ "inputDir" ++ " " + ++ tmpDirS ++ "alreadyExistsD" ++ " >/dev/null") `shouldReturn` (ExitFailure 1) copyDirRecursive' "inputDir" @@ -123,8 +125,8 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ Overwrite FailEarly (system $ "diff -r " - ++ toString tmpDir' ++ "inputDir" ++ " " - ++ toString tmpDir' ++ "alreadyExistsD" + ++ tmpDirS ++ "inputDir" ++ " " + ++ tmpDirS ++ "alreadyExistsD" ++ " >/dev/null") `shouldReturn` ExitSuccess removeDirIfExists "outputDir" diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyDirRecursiveSpec.hs similarity index 92% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyDirRecursiveSpec.hs index 6ab6526..fa9e2e0 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyDirRecursiveSpec.hs @@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.CopyDirRecursiveSpec where +module System.Posix.PosixFilePath.Directory.CopyDirRecursiveSpec where import Test.Hspec -import "hpath-directory" System.Posix.RawFilePath.Directory -import System.Posix.RawFilePath.Directory.Errors +import "hpath-directory" System.Posix.PosixFilePath.Directory +import System.Posix.PosixFilePath.Directory.Errors import System.IO.Error ( ioeGetErrorType @@ -18,7 +18,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import Data.ByteString.UTF8 (toString) +import AFP.AbstractFilePath.Posix @@ -73,7 +73,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.copyDirRecursive" $ do + describe "System.Posix.PosixFilePath.Directory.copyDirRecursive" $ do -- successes -- it "copyDirRecursive (Strict, FailEarly), all fine" $ do @@ -85,13 +85,14 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "copyDirRecursive (Strict, FailEarly), all fine and compare" $ do tmpDir' <- getRawTmpDir + tmpDirS <- fromPlatformStringIO tmpDir' copyDirRecursive' "inputDir" "outputDir" Strict FailEarly (system $ "diff -r " - ++ toString tmpDir' ++ "inputDir" ++ " " - ++ toString tmpDir' ++ "outputDir" + ++ tmpDirS ++ "inputDir" ++ " " + ++ tmpDirS ++ "outputDir" ++ " >/dev/null") `shouldReturn` ExitSuccess removeDirIfExists "outputDir" diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/CopyFileOverwriteSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyFileOverwriteSpec.hs similarity index 86% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/CopyFileOverwriteSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyFileOverwriteSpec.hs index c19759b..7393692 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/CopyFileOverwriteSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyFileOverwriteSpec.hs @@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.CopyFileOverwriteSpec where +module System.Posix.PosixFilePath.Directory.CopyFileOverwriteSpec where import Test.Hspec -import "hpath-directory" System.Posix.RawFilePath.Directory -import System.Posix.RawFilePath.Directory.Errors +import "hpath-directory" System.Posix.PosixFilePath.Directory +import System.Posix.PosixFilePath.Directory.Errors import System.IO.Error ( ioeGetErrorType @@ -17,7 +17,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import Data.ByteString.UTF8 (toString) +import AFP.AbstractFilePath.Posix @@ -59,7 +59,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.copyFile" $ do + describe "System.Posix.PosixFilePath.Directory.copyFile" $ do -- successes -- it "copyFile (Overwrite), everything clear" $ do @@ -70,10 +70,11 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "copyFile (Overwrite), output file already exists, all clear" $ do tmpDir' <- getRawTmpDir + tmpDirS <- fromPlatformStringIO tmpDir' copyFile' "alreadyExists" "alreadyExists.bak" Strict copyFile' "inputFile" "alreadyExists" Overwrite - (system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " " - ++ toString tmpDir' ++ "alreadyExists") + (system $ "cmp -s " ++ tmpDirS ++ "inputFile" ++ " " + ++ tmpDirS ++ "alreadyExists") `shouldReturn` ExitSuccess removeFileIfExists "alreadyExists" copyFile' "alreadyExists.bak" "alreadyExists" Strict @@ -81,11 +82,12 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "copyFile (Overwrite), and compare" $ do tmpDir' <- getRawTmpDir + tmpDirS <- fromPlatformStringIO tmpDir' copyFile' "inputFile" "outputFile" Overwrite - (system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " " - ++ toString tmpDir' ++ "outputFile") + (system $ "cmp -s " ++ tmpDirS ++ "inputFile" ++ " " + ++ tmpDirS ++ "outputFile") `shouldReturn` ExitSuccess removeFileIfExists "outputFile" diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/CopyFileSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyFileSpec.hs similarity index 89% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/CopyFileSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyFileSpec.hs index abcbf7f..b0148f0 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/CopyFileSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyFileSpec.hs @@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.CopyFileSpec where +module System.Posix.PosixFilePath.Directory.CopyFileSpec where import Test.Hspec -import "hpath-directory" System.Posix.RawFilePath.Directory -import System.Posix.RawFilePath.Directory.Errors +import "hpath-directory" System.Posix.PosixFilePath.Directory +import System.Posix.PosixFilePath.Directory.Errors import System.IO.Error ( ioeGetErrorType @@ -18,7 +18,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import Data.ByteString.UTF8 (toString) +import AFP.AbstractFilePath.Posix @@ -58,7 +58,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.copyFile" $ do + describe "System.Posix.PosixFilePath.Directory.copyFile" $ do -- successes -- it "copyFile (Strict), everything clear" $ do @@ -69,11 +69,12 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "copyFile (Strict), and compare" $ do tmpDir' <- getRawTmpDir + tmpDirS <- fromPlatformStringIO tmpDir' copyFile' "inputFile" "outputFile" Strict - (system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " " - ++ toString tmpDir' ++ "outputFile") + (system $ "cmp -s " ++ tmpDirS ++ "inputFile" ++ " " + ++ tmpDirS ++ "outputFile") `shouldReturn` ExitSuccess removeFileIfExists "outputFile" diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirIfMissingSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateDirIfMissingSpec.hs similarity index 91% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirIfMissingSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateDirIfMissingSpec.hs index 2d80f98..b942e76 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirIfMissingSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateDirIfMissingSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.CreateDirIfMissingSpec where +module System.Posix.PosixFilePath.Directory.CreateDirIfMissingSpec where import Test.Hspec @@ -42,7 +42,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.CreateDirIfMissing" $ do + describe "System.Posix.PosixFilePath.Directory.CreateDirIfMissing" $ do -- successes -- it "createDirIfMissing, all fine" $ do diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirRecursiveSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateDirRecursiveSpec.hs similarity index 93% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirRecursiveSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateDirRecursiveSpec.hs index 60d6aa9..083d0f9 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirRecursiveSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateDirRecursiveSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.CreateDirRecursiveSpec where +module System.Posix.PosixFilePath.Directory.CreateDirRecursiveSpec where import Test.Hspec @@ -42,7 +42,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.createDirRecursive" $ do + describe "System.Posix.PosixFilePath.Directory.createDirRecursive" $ do -- successes -- it "createDirRecursive, all fine" $ do diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateDirSpec.hs similarity index 92% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateDirSpec.hs index a3fb873..00874a4 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateDirSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.CreateDirSpec where +module System.Posix.PosixFilePath.Directory.CreateDirSpec where import Test.Hspec @@ -42,7 +42,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.createDir" $ do + describe "System.Posix.PosixFilePath.Directory.createDir" $ do -- successes -- it "createDir, all fine" $ do diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/CreateRegularFileSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateRegularFileSpec.hs similarity index 91% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/CreateRegularFileSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateRegularFileSpec.hs index 71af5c3..00ef6e5 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/CreateRegularFileSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateRegularFileSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.CreateRegularFileSpec where +module System.Posix.PosixFilePath.Directory.CreateRegularFileSpec where import Test.Hspec @@ -40,7 +40,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.createRegularFile" $ do + describe "System.Posix.PosixFilePath.Directory.createRegularFile" $ do -- successes -- it "createRegularFile, all fine" $ do diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/CreateSymlinkSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateSymlinkSpec.hs similarity index 92% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/CreateSymlinkSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateSymlinkSpec.hs index 3554829..61f2516 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/CreateSymlinkSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateSymlinkSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.CreateSymlinkSpec where +module System.Posix.PosixFilePath.Directory.CreateSymlinkSpec where import Test.Hspec @@ -41,7 +41,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.createSymlink" $ do + describe "System.Posix.PosixFilePath.Directory.createSymlink" $ do -- successes -- it "createSymlink, all fine" $ do diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteDirRecursiveSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/DeleteDirRecursiveSpec.hs similarity index 95% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteDirRecursiveSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/DeleteDirRecursiveSpec.hs index 0759518..e685fd9 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteDirRecursiveSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/DeleteDirRecursiveSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.DeleteDirRecursiveSpec where +module System.Posix.PosixFilePath.Directory.DeleteDirRecursiveSpec where import Test.Hspec @@ -52,7 +52,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.deleteDirRecursive" $ do + describe "System.Posix.PosixFilePath.Directory.deleteDirRecursive" $ do -- successes -- it "deleteDirRecursive, empty directory, all fine" $ do diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteDirSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/DeleteDirSpec.hs similarity index 95% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteDirSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/DeleteDirSpec.hs index 245b874..40bfd01 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteDirSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/DeleteDirSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.DeleteDirSpec where +module System.Posix.PosixFilePath.Directory.DeleteDirSpec where import Test.Hspec @@ -53,7 +53,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.deleteDir" $ do + describe "System.Posix.PosixFilePath.Directory.deleteDir" $ do -- successes -- it "deleteDir, empty directory, all fine" $ do diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteFileSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/DeleteFileSpec.hs similarity index 90% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteFileSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/DeleteFileSpec.hs index 0a15e71..9a7271a 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteFileSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/DeleteFileSpec.hs @@ -1,10 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.DeleteFileSpec where +module System.Posix.PosixFilePath.Directory.DeleteFileSpec where import Test.Hspec -import "hpath-directory" System.Posix.RawFilePath.Directory +import "hpath-directory" System.Posix.PosixFilePath.Directory import System.IO.Error ( ioeGetErrorType @@ -47,7 +47,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.deleteFile" $ do + describe "System.Posix.PosixFilePath.Directory.deleteFile" $ do -- successes -- it "deleteFile, regular file, all fine" $ do diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/GetDirsFilesSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/GetDirsFilesSpec.hs similarity index 89% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/GetDirsFilesSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/GetDirsFilesSpec.hs index 200b739..0219561 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/GetDirsFilesSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/GetDirsFilesSpec.hs @@ -1,14 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.GetDirsFilesSpec where +module System.Posix.PosixFilePath.Directory.GetDirsFilesSpec where import Data.List ( sort ) -import "hpath-directory" System.Posix.RawFilePath.Directory hiding (getDirsFiles') -import System.Posix.FilePath +import "hpath-directory" System.Posix.PosixFilePath.Directory hiding (getDirsFiles') import Test.Hspec import System.IO.Error ( @@ -19,6 +18,7 @@ import GHC.IO.Exception IOErrorType(..) ) import Utils +import AFP.AbstractFilePath.Posix upTmpDir :: IO () @@ -54,7 +54,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.getDirsFiles" $ do + describe "System.Posix.PosixFilePath.Directory.getDirsFiles" $ do -- successes -- it "getDirsFiles, all fine" $ diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/GetFileTypeSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/GetFileTypeSpec.hs similarity index 90% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/GetFileTypeSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/GetFileTypeSpec.hs index fb242cc..5d32b47 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/GetFileTypeSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/GetFileTypeSpec.hs @@ -1,9 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.GetFileTypeSpec where +module System.Posix.PosixFilePath.Directory.GetFileTypeSpec where -import "hpath-directory" System.Posix.RawFilePath.Directory +import "hpath-directory" System.Posix.PosixFilePath.Directory import Test.Hspec import System.IO.Error ( @@ -48,7 +48,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.getFileType" $ do + describe "System.Posix.PosixFilePath.Directory.getFileType" $ do -- successes -- it "getFileType, regular file" $ diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/MoveFileOverwriteSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/MoveFileOverwriteSpec.hs similarity index 92% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/MoveFileOverwriteSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/MoveFileOverwriteSpec.hs index ad0f4ba..f6b5ee4 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/MoveFileOverwriteSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/MoveFileOverwriteSpec.hs @@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.MoveFileOverwriteSpec where +module System.Posix.PosixFilePath.Directory.MoveFileOverwriteSpec where import Test.Hspec -import "hpath-directory" System.Posix.RawFilePath.Directory -import System.Posix.RawFilePath.Directory.Errors +import "hpath-directory" System.Posix.PosixFilePath.Directory +import System.Posix.PosixFilePath.Directory.Errors import System.IO.Error ( ioeGetErrorType @@ -52,7 +52,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.moveFile" $ do + describe "System.Posix.PosixFilePath.Directory.moveFile" $ do -- successes -- it "moveFile (Overwrite), all fine" $ diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/MoveFileSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/MoveFileSpec.hs similarity index 92% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/MoveFileSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/MoveFileSpec.hs index 66e239c..63abf48 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/MoveFileSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/MoveFileSpec.hs @@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.MoveFileSpec where +module System.Posix.PosixFilePath.Directory.MoveFileSpec where import Test.Hspec -import "hpath-directory" System.Posix.RawFilePath.Directory -import System.Posix.RawFilePath.Directory.Errors +import "hpath-directory" System.Posix.PosixFilePath.Directory +import System.Posix.PosixFilePath.Directory.Errors import System.IO.Error ( ioeGetErrorType @@ -54,7 +54,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.moveFile" $ do + describe "System.Posix.PosixFilePath.Directory.moveFile" $ do -- successes -- it "moveFile (Strict), all fine" $ diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/ReadFileSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/ReadFileSpec.hs similarity index 96% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/ReadFileSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/ReadFileSpec.hs index c6ce6e9..e2dde0c 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/ReadFileSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/ReadFileSpec.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.ReadFileSpec where +module System.Posix.PosixFilePath.Directory.ReadFileSpec where import Test.Hspec @@ -51,7 +51,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.readFile" $ do + describe "System.Posix.PosixFilePath.Directory.readFile" $ do -- successes -- it "readFile file with content, everything clear" $ do diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/RecreateSymlinkOverwriteSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/RecreateSymlinkOverwriteSpec.hs similarity index 93% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/RecreateSymlinkOverwriteSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/RecreateSymlinkOverwriteSpec.hs index 85d289c..dc30d67 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/RecreateSymlinkOverwriteSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/RecreateSymlinkOverwriteSpec.hs @@ -1,14 +1,14 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.RecreateSymlinkOverwriteSpec where +module System.Posix.PosixFilePath.Directory.RecreateSymlinkOverwriteSpec where -- TODO: exception if destination exists but is not a file + `OverWrite` CopyMode import Test.Hspec -import "hpath-directory" System.Posix.RawFilePath.Directory -import System.Posix.RawFilePath.Directory.Errors +import "hpath-directory" System.Posix.PosixFilePath.Directory +import System.Posix.PosixFilePath.Directory.Errors import System.IO.Error ( ioeGetErrorType @@ -59,7 +59,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.recreateSymlink" $ do + describe "System.Posix.PosixFilePath.Directory.recreateSymlink" $ do -- successes -- it "recreateSymLink (Overwrite), all fine" $ do diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/RecreateSymlinkSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/RecreateSymlinkSpec.hs similarity index 92% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/RecreateSymlinkSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/RecreateSymlinkSpec.hs index d51badf..8c1c11d 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/RecreateSymlinkSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/RecreateSymlinkSpec.hs @@ -1,13 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.RecreateSymlinkSpec where +module System.Posix.PosixFilePath.Directory.RecreateSymlinkSpec where import Test.Hspec -import "hpath-directory" System.Posix.RawFilePath.Directory -import System.Posix.RawFilePath.Directory.Errors +import "hpath-directory" System.Posix.PosixFilePath.Directory +import System.Posix.PosixFilePath.Directory.Errors import System.IO.Error ( ioeGetErrorType @@ -55,7 +55,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.recreateSymlink" $ do + describe "System.Posix.PosixFilePath.Directory.recreateSymlink" $ do -- successes -- it "recreateSymLink (Strict), all fine" $ do diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/RenameFileSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/RenameFileSpec.hs similarity index 93% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/RenameFileSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/RenameFileSpec.hs index e9af40b..aca9991 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/RenameFileSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/RenameFileSpec.hs @@ -1,10 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.RenameFileSpec where +module System.Posix.PosixFilePath.Directory.RenameFileSpec where import Test.Hspec -import System.Posix.RawFilePath.Directory.Errors +import System.Posix.PosixFilePath.Directory.Errors import System.IO.Error ( ioeGetErrorType @@ -52,7 +52,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.renameFile" $ do + describe "System.Posix.PosixFilePath.Directory.renameFile" $ do -- successes -- it "renameFile, all fine" $ diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/ToAbsSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/ToAbsSpec.hs similarity index 65% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/ToAbsSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/ToAbsSpec.hs index 22d54f5..4ce10df 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/ToAbsSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/ToAbsSpec.hs @@ -1,16 +1,16 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.ToAbsSpec where +module System.Posix.PosixFilePath.Directory.ToAbsSpec where import Test.Hspec -import "hpath-directory" System.Posix.RawFilePath.Directory +import "hpath-directory" System.Posix.PosixFilePath.Directory spec :: Spec -spec = describe "System.Posix.RawFilePath.Directory.toAbs" $ do +spec = describe "System.Posix.PosixFilePath.Directory.toAbs" $ do -- successes -- it "toAbs returns absolute paths unchanged" $ do diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/WriteFileLSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/WriteFileLSpec.hs similarity index 95% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/WriteFileLSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/WriteFileLSpec.hs index 897f9e1..8dab1f2 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/WriteFileLSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/WriteFileLSpec.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.WriteFileLSpec where +module System.Posix.PosixFilePath.Directory.WriteFileLSpec where import Test.Hspec @@ -51,7 +51,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.WriteFileL" $ do + describe "System.Posix.PosixFilePath.Directory.WriteFileL" $ do -- successes -- it "WriteFileL file with content, everything clear" $ do diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/WriteFileSpec.hs b/hpath-directory/test/System/Posix/PosixFilePath/Directory/WriteFileSpec.hs similarity index 95% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/WriteFileSpec.hs rename to hpath-directory/test/System/Posix/PosixFilePath/Directory/WriteFileSpec.hs index cc8687e..744ddaf 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/WriteFileSpec.hs +++ b/hpath-directory/test/System/Posix/PosixFilePath/Directory/WriteFileSpec.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.WriteFileSpec where +module System.Posix.PosixFilePath.Directory.WriteFileSpec where import Test.Hspec @@ -51,7 +51,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.writeFile" $ do + describe "System.Posix.PosixFilePath.Directory.writeFile" $ do -- successes -- it "writeFile file with content, everything clear" $ do diff --git a/hpath-directory/test/Utils.hs b/hpath-directory/test/Utils.hs index 88275b0..9d63f2c 100644 --- a/hpath-directory/test/Utils.hs +++ b/hpath-directory/test/Utils.hs @@ -17,7 +17,6 @@ import Control.Monad.IfElse ( whenM ) -import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import Data.IORef ( @@ -26,7 +25,7 @@ import Data.IORef , writeIORef , IORef ) -import "hpath-directory" System.Posix.RawFilePath.Directory +import "hpath-directory" System.Posix.PosixFilePath.Directory import Prelude hiding (appendFile, readFile, writeFile) import Data.Maybe ( @@ -36,13 +35,12 @@ import System.IO.Unsafe ( unsafePerformIO ) -import qualified System.Posix.RawFilePath.Directory.Traversals as DT +import qualified System.Posix.PosixFilePath.Directory.Traversals as DT import Data.ByteString ( ByteString ) -import System.Posix.FilePath -import System.Posix.Files.ByteString +import System.Posix.Files.PosixString ( groupExecuteMode , groupReadMode @@ -54,13 +52,15 @@ import System.Posix.Files.ByteString , setFileMode , unionFileModes ) +import AFP.AbstractFilePath.Posix +import qualified AFP.AbstractFilePath.Posix as AFP -baseTmpDir :: IORef (Maybe ByteString) +baseTmpDir :: IORef (Maybe PosixFilePath) {-# NOINLINE baseTmpDir #-} baseTmpDir = unsafePerformIO (newIORef Nothing) -tmpDir :: IORef (Maybe ByteString) +tmpDir :: IORef (Maybe PosixFilePath) {-# NOINLINE tmpDir #-} tmpDir = unsafePerformIO (newIORef Nothing) @@ -71,11 +71,11 @@ tmpDir = unsafePerformIO (newIORef Nothing) ----------------- -setTmpDir :: ByteString -> IO () +setTmpDir :: PosixFilePath -> IO () {-# NOINLINE setTmpDir #-} setTmpDir bs = do tmp <- fromJust <$> readIORef baseTmpDir - writeIORef tmpDir (Just (tmp `BS.append` bs)) + writeIORef tmpDir (Just (tmp AFP. bs)) createTmpDir :: IO () @@ -101,29 +101,29 @@ deleteBaseTmpDir = do void $ deleteDir tmp -withRawTmpDir :: (ByteString -> IO a) -> IO a +withRawTmpDir :: (PosixFilePath -> IO a) -> IO a {-# NOINLINE withRawTmpDir #-} withRawTmpDir f = do tmp <- fromJust <$> readIORef tmpDir f tmp -getRawTmpDir :: IO ByteString +getRawTmpDir :: IO PosixFilePath {-# NOINLINE getRawTmpDir #-} -getRawTmpDir = withRawTmpDir (return . flip BS.append "/") +getRawTmpDir = withRawTmpDir (return . packPlatformString . (++ [fromChar '/']) . unpackPlatformString) -withTmpDir :: ByteString -> (ByteString -> IO a) -> IO a +withTmpDir :: PosixFilePath -> (PosixFilePath -> IO a) -> IO a {-# NOINLINE withTmpDir #-} withTmpDir ip f = do tmp <- fromJust <$> readIORef tmpDir - let p = tmp ip + let p = tmp AFP. ip f p -withTmpDir' :: ByteString - -> ByteString - -> (ByteString -> ByteString -> IO a) +withTmpDir' :: PosixFilePath + -> PosixFilePath + -> (PosixFilePath -> PosixFilePath -> IO a) -> IO a {-# NOINLINE withTmpDir' #-} withTmpDir' ip1 ip2 f = do @@ -133,55 +133,55 @@ withTmpDir' ip1 ip2 f = do f p1 p2 -removeFileIfExists :: ByteString -> IO () +removeFileIfExists :: PosixFilePath -> IO () {-# NOINLINE removeFileIfExists #-} removeFileIfExists bs = withTmpDir bs $ \p -> whenM (doesFileExist p) (deleteFile p) -removeDirIfExists :: ByteString -> IO () +removeDirIfExists :: PosixFilePath -> IO () {-# NOINLINE removeDirIfExists #-} removeDirIfExists bs = withTmpDir bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p) -copyFile' :: ByteString -> ByteString -> CopyMode -> IO () +copyFile' :: PosixFilePath -> PosixFilePath -> CopyMode -> IO () {-# NOINLINE copyFile' #-} copyFile' inputFileP outputFileP cm = withTmpDir' inputFileP outputFileP (\p1 p2 -> copyFile p1 p2 cm) -copyDirRecursive' :: ByteString -> ByteString +copyDirRecursive' :: PosixFilePath -> PosixFilePath -> CopyMode -> RecursiveErrorMode -> IO () {-# NOINLINE copyDirRecursive' #-} copyDirRecursive' inputDirP outputDirP cm rm = withTmpDir' inputDirP outputDirP (\p1 p2 -> copyDirRecursive p1 p2 cm rm) -createDir' :: ByteString -> IO () +createDir' :: PosixFilePath -> IO () {-# NOINLINE createDir' #-} createDir' dest = withTmpDir dest (createDir newDirPerms) -createDirIfMissing' :: ByteString -> IO () +createDirIfMissing' :: PosixFilePath -> IO () {-# NOINLINE createDirIfMissing' #-} createDirIfMissing' dest = withTmpDir dest (createDirIfMissing newDirPerms) -createDirRecursive' :: ByteString -> IO () +createDirRecursive' :: PosixFilePath -> IO () {-# NOINLINE createDirRecursive' #-} createDirRecursive' dest = withTmpDir dest (createDirRecursive newDirPerms) -createRegularFile' :: ByteString -> IO () +createRegularFile' :: PosixFilePath -> IO () {-# NOINLINE createRegularFile' #-} createRegularFile' dest = withTmpDir dest (createRegularFile newFilePerms) -createSymlink' :: ByteString -> ByteString -> IO () +createSymlink' :: PosixFilePath -> PosixFilePath -> IO () {-# NOINLINE createSymlink' #-} createSymlink' dest sympoint = withTmpDir dest (\x -> createSymlink x sympoint) -renameFile' :: ByteString -> ByteString -> IO () +renameFile' :: PosixFilePath -> PosixFilePath -> IO () {-# NOINLINE renameFile' #-} renameFile' inputFileP outputFileP = withTmpDir' inputFileP outputFileP $ \i o -> do @@ -189,7 +189,7 @@ renameFile' inputFileP outputFileP = renameFile o i -moveFile' :: ByteString -> ByteString -> CopyMode -> IO () +moveFile' :: PosixFilePath -> PosixFilePath -> CopyMode -> IO () {-# NOINLINE moveFile' #-} moveFile' inputFileP outputFileP cm = withTmpDir' inputFileP outputFileP $ \i o -> do @@ -197,13 +197,13 @@ moveFile' inputFileP outputFileP cm = moveFile o i Strict -recreateSymlink' :: ByteString -> ByteString -> CopyMode -> IO () +recreateSymlink' :: PosixFilePath -> PosixFilePath -> CopyMode -> IO () {-# NOINLINE recreateSymlink' #-} recreateSymlink' inputFileP outputFileP cm = withTmpDir' inputFileP outputFileP (\p1 p2 -> recreateSymlink p1 p2 cm) -noWritableDirPerms :: ByteString -> IO () +noWritableDirPerms :: PosixFilePath -> IO () {-# NOINLINE noWritableDirPerms #-} noWritableDirPerms path = withTmpDir path $ \p -> setFileMode p perms @@ -216,81 +216,81 @@ noWritableDirPerms path = withTmpDir path $ \p -> `unionFileModes` otherExecuteMode -noPerms :: ByteString -> IO () +noPerms :: PosixFilePath -> IO () {-# NOINLINE noPerms #-} noPerms path = withTmpDir path $ \p -> setFileMode p nullFileMode -normalDirPerms :: ByteString -> IO () +normalDirPerms :: PosixFilePath -> IO () {-# NOINLINE normalDirPerms #-} normalDirPerms path = withTmpDir path $ \p -> setFileMode p newDirPerms -normalFilePerms :: ByteString -> IO () +normalFilePerms :: PosixFilePath -> IO () {-# NOINLINE normalFilePerms #-} normalFilePerms path = withTmpDir path $ \p -> setFileMode p newFilePerms -getFileType' :: ByteString -> IO FileType +getFileType' :: PosixFilePath -> IO FileType {-# NOINLINE getFileType' #-} getFileType' path = withTmpDir path getFileType -getDirsFiles' :: ByteString -> IO [ByteString] +getDirsFiles' :: PosixFilePath -> IO [PosixFilePath] {-# NOINLINE getDirsFiles' #-} getDirsFiles' path = withTmpDir path getDirsFiles -deleteFile' :: ByteString -> IO () +deleteFile' :: PosixFilePath -> IO () {-# NOINLINE deleteFile' #-} deleteFile' p = withTmpDir p deleteFile -deleteDir' :: ByteString -> IO () +deleteDir' :: PosixFilePath -> IO () {-# NOINLINE deleteDir' #-} deleteDir' p = withTmpDir p deleteDir -deleteDirRecursive' :: ByteString -> IO () +deleteDirRecursive' :: PosixFilePath -> IO () {-# NOINLINE deleteDirRecursive' #-} deleteDirRecursive' p = withTmpDir p deleteDirRecursive -canonicalizePath' :: ByteString -> IO ByteString +canonicalizePath' :: PosixFilePath -> IO PosixFilePath {-# NOINLINE canonicalizePath' #-} canonicalizePath' p = withTmpDir p canonicalizePath -writeFile' :: ByteString -> ByteString -> IO () +writeFile' :: PosixFilePath -> ByteString -> IO () {-# NOINLINE writeFile' #-} writeFile' ip bs = withTmpDir ip $ \p -> writeFile p Nothing bs -writeFileL' :: ByteString -> BSL.ByteString -> IO () +writeFileL' :: PosixFilePath -> BSL.ByteString -> IO () {-# NOINLINE writeFileL' #-} writeFileL' ip bs = withTmpDir ip $ \p -> writeFileL p Nothing bs -appendFile' :: ByteString -> ByteString -> IO () +appendFile' :: PosixFilePath -> ByteString -> IO () {-# NOINLINE appendFile' #-} appendFile' ip bs = withTmpDir ip $ \p -> appendFile p bs -allDirectoryContents' :: ByteString -> IO [ByteString] +allDirectoryContents' :: PosixFilePath -> IO [PosixFilePath] {-# NOINLINE allDirectoryContents' #-} allDirectoryContents' ip = withTmpDir ip $ \p -> DT.allDirectoryContents' p -readFile' :: ByteString -> IO ByteString +readFile' :: PosixFilePath -> IO ByteString {-# NOINLINE readFile' #-} readFile' p = withTmpDir p readFileStrict -readFileL :: ByteString -> IO BSL.ByteString +readFileL :: PosixFilePath -> IO BSL.ByteString {-# NOINLINE readFileL #-} readFileL p = withTmpDir p readFile From 2550f250ccd514d1962379909007695a90ec2acd Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Fri, 29 Oct 2021 23:12:52 +0200 Subject: [PATCH 06/17] Expose HPath.Internal --- hpath/hpath.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hpath/hpath.cabal b/hpath/hpath.cabal index 7adc370..7ac6a9a 100644 --- a/hpath/hpath.cabal +++ b/hpath/hpath.cabal @@ -30,7 +30,7 @@ library else ghc-options: -Wall exposed-modules: HPath - other-modules: HPath.Internal + HPath.Internal build-depends: abstract-filepath , base >= 4.8 && <5 , bytestring >= 0.10.0.0 From 504a9048c1b3b6382fa26142b282c4f66c49ea67 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Fri, 29 Oct 2021 23:13:02 +0200 Subject: [PATCH 07/17] Migrate hpath-io --- hpath-io/hpath-io.cabal | 7 +- hpath-io/src/HPath/IO.hs | 351 +++++++++++++++------------------------ 2 files changed, 139 insertions(+), 219 deletions(-) diff --git a/hpath-io/hpath-io.cabal b/hpath-io/hpath-io.cabal index 49849ad..b2c1477 100644 --- a/hpath-io/hpath-io.cabal +++ b/hpath-io/hpath-io.cabal @@ -26,11 +26,12 @@ library buildable: False exposed-modules: HPath.IO build-depends: base >= 4.8 && <5 + , abstract-filepath-types , bytestring >= 0.10.0.0 , exceptions - , hpath >= 0.12 && < 0.13 - , hpath-directory >= 0.14.2 && < 0.15 - , hpath-posix >= 0.13.3 && < 0.14 + , hpath >= 0.13 && < 0.14 + , hpath-directory >= 0.15.2 && < 0.16 + , hpath-posix >= 0.14.3 && < 0.15 , safe-exceptions >= 0.1 , streamly >= 0.7 , time >= 1.8 diff --git a/hpath-io/src/HPath/IO.hs b/hpath-io/src/HPath/IO.hs index 3e53867..447e609 100644 --- a/hpath-io/src/HPath/IO.hs +++ b/hpath-io/src/HPath/IO.hs @@ -33,9 +33,8 @@ module HPath.IO ( -- * Types - FileType(..) - , RecursiveErrorMode(..) - , CopyMode(..) + module System.Directory.Types + , Permissions -- * File copying , copyDirRecursive , recreateSymlink @@ -46,9 +45,6 @@ module HPath.IO , deleteDir , deleteDirRecursive , easyDelete - -- * File opening - , openFile - , executeFile -- * File creation , createRegularFile , createDir @@ -66,9 +62,6 @@ module HPath.IO , writeFile , writeFileL , appendFile - -- * File permissions - , RD.newFilePerms - , RD.newDirPerms -- * File checks , doesExist , doesFileExist @@ -87,124 +80,98 @@ module HPath.IO , getDirsFilesStream -- * Filetype operations , getFileType + -- * Permissions + , getPermissions + , setPermissions + , emptyPermissions + , setOwnerReadable + , setOwnerWritable + , setOwnerExecutable + , setOwnerSearchable + , newFilePerms + , newDirPerms -- * Others , canonicalizePath , toAbs - , withRawFilePath - , withHandle - , module System.Posix.RawFilePath.Directory.Errors ) where - -import Control.Exception.Safe ( MonadMask - , MonadCatch - , bracketOnError - , finally - ) -import Control.Monad.Catch ( MonadThrow(..) ) - -import Data.ByteString ( ByteString ) -import qualified Data.ByteString as BS -import Data.Traversable ( for ) -import qualified Data.ByteString.Lazy as L -import Data.Time.Clock -import Data.Time.Clock.POSIX ( POSIXTime ) -import Data.Word ( Word8 ) import HPath +import HPath.Internal import Prelude hiding ( appendFile , readFile , writeFile ) -import Streamly -import Streamly.Memory.Array -import qualified System.IO as SIO -import System.Posix.Directory.ByteString - ( getWorkingDirectory ) -import qualified "unix" System.Posix.IO.ByteString - as SPI -import System.Posix.FD ( openFd ) -import System.Posix.RawFilePath.Directory.Errors -import System.Posix.Types ( FileMode - , ProcessID - , EpochTime - ) -import qualified System.Posix.RawFilePath.Directory - as RD -import System.Posix.RawFilePath.Directory - ( FileType - , RecursiveErrorMode - , CopyMode - ) - +import AFP.AbstractFilePath.Types +import AFP.OsString.Internal.Types +import Control.Exception.Safe ( MonadCatch, MonadMask) +import Control.Monad.Catch +import Data.Bits +import Data.Time.Clock +import Data.Time.Clock.POSIX +import Data.Traversable +import Data.Word ( Word8 ) +import Streamly.Data.Array.Foreign +import Streamly.Prelude ( SerialT, MonadAsync ) +import System.Directory.Types +import System.Directory.AFP ( + Permissions + , emptyPermissions + , setOwnerReadable + , setOwnerWritable + , setOwnerExecutable + , setOwnerSearchable + , newFilePerms + , newDirPerms + ) +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString as BS +import qualified System.Directory.AFP as Dir + ------------------------ + --[ File Permissions ]-- + ------------------------ - -------------------- - --[ File Copying ]-- - -------------------- - - --- |Copies the contents of a directory recursively to the given destination, while preserving permissions. --- Does not follow symbolic links. This behaves more or less like --- the following, without descending into the destination if it --- already exists: --- --- @ --- cp -a \/source\/dir \/destination\/somedir --- @ --- --- For directory contents, this will ignore any file type that is not --- `RegularFile`, `SymbolicLink` or `Directory`. --- --- For `Overwrite` copy mode this does not prune destination directory --- contents, so the destination might contain more files than the source after --- the operation has completed. Permissions of existing directories are --- fixed. --- --- Safety/reliability concerns: +-- | Get the permissions of a file or directory. -- --- * not atomic --- * examines filetypes explicitly --- * an explicit check `throwDestinationInSource` is carried out for the --- top directory for basic sanity, because otherwise we might end up --- with an infinite copy loop... however, this operation is not --- carried out recursively (because it's slow) +-- On Windows, the 'writable' permission corresponds to the "read-only" +-- attribute. The 'executable' permission is set if the file extension is of +-- an executable file type. The 'readable' permission is always set. -- --- Throws: +-- On POSIX systems, this returns the result of @access@. -- --- - `NoSuchThing` if source directory does not exist --- - `PermissionDenied` if source directory can't be opened --- - `SameFile` if source and destination are the same file --- (`HPathIOException`) --- - `DestinationInSource` if destination is contained in source --- (`HPathIOException`) +-- The operation may fail with: -- --- Throws in `FailEarly` RecursiveErrorMode only: +-- * 'isPermissionError' if the user is not permitted to access the +-- permissions, or -- --- - `PermissionDenied` if output directory is not writable --- - `InvalidArgument` if source directory is wrong type (symlink) --- - `InappropriateType` if source directory is wrong type (regular file) --- --- Throws in `CollectFailures` RecursiveErrorMode only: --- --- - `RecursiveFailure` if any of the recursive operations that are not --- part of the top-directory sanity-checks fail (`HPathIOException`) --- --- Throws in `Strict` CopyMode only: --- --- - `AlreadyExists` if destination already exists -copyDirRecursive :: Path b1 -- ^ source dir - -> Path b2 -- ^ destination (parent dirs - -- are not automatically created) +-- * 'isDoesNotExistError' if the file or directory does not exist. +getPermissions :: Path b -> IO Permissions +getPermissions (MkPath b) = Dir.getPermissions b + + +setPermissions :: Path b -> Permissions -> IO () +setPermissions (MkPath b) perms = Dir.setPermissions b perms + + + + -------------------- + --[ File Copying ]-- + -------------------- + + +copyDirRecursive :: Path b1 -- ^ source dir + -> Path b2 -- ^ destination (parent dirs + -- are not automatically created) -> CopyMode -> RecursiveErrorMode -> IO () -copyDirRecursive (Path fromp) (Path destdirp) cm rm = - RD.copyDirRecursive fromp destdirp cm rm +copyDirRecursive (MkPath fromp) (MkPath destdirp) cm rm = + Dir.copyDirRecursive fromp destdirp cm rm -- |Recreate a symlink. @@ -235,12 +202,12 @@ copyDirRecursive (Path fromp) (Path destdirp) cm rm = -- Notes: -- -- - calls `symlink` -recreateSymlink :: Path b1 -- ^ the old symlink file - -> Path b2 -- ^ destination file +recreateSymlink :: Path b1 -- ^ the old symlink file + -> Path b2 -- ^ destination file -> CopyMode -> IO () -recreateSymlink (Path symsourceBS) (Path newsymBS) cm = - RD.recreateSymlink symsourceBS newsymBS cm +recreateSymlink (MkPath symsource) (MkPath newsym) cm = + Dir.recreateSymlink symsource newsym cm -- |Copies the given regular file to the given destination. @@ -277,11 +244,13 @@ recreateSymlink (Path symsourceBS) (Path newsymBS) cm = -- Throws in `Strict` mode only: -- -- - `AlreadyExists` if destination already exists -copyFile :: Path b1 -- ^ source file - -> Path b2 -- ^ destination file +copyFile :: Path b1 -- ^ source file + -> Path b2 -- ^ destination file -> CopyMode -> IO () -copyFile (Path from) (Path to) cm = RD.copyFile from to cm +copyFile (MkPath from) (MkPath to) cm = + Dir.copyFile from to cm + -- |Copies a regular file, directory or symbolic link. In case of a -- symbolic link it is just recreated, even if it points to a directory. @@ -291,9 +260,13 @@ copyFile (Path from) (Path to) cm = RD.copyFile from to cm -- -- * examines filetypes explicitly -- * calls `copyDirRecursive` for directories -easyCopy :: Path b1 -> Path b2 -> CopyMode -> RecursiveErrorMode -> IO () -easyCopy (Path from) (Path to) cm rm = RD.easyCopy from to cm rm - +easyCopy :: Path b1 + -> Path b2 + -> CopyMode + -> RecursiveErrorMode + -> IO () +easyCopy (MkPath from) (MkPath to) cm rm = + Dir.easyCopy from to cm rm @@ -315,7 +288,8 @@ easyCopy (Path from) (Path to) cm rm = RD.easyCopy from to cm rm -- -- Notes: calls `unlink` deleteFile :: Path b -> IO () -deleteFile (Path p) = RD.deleteFile p +deleteFile (MkPath fp) = + Dir.deleteFile fp -- |Deletes the given directory, which must be empty, never symlinks. @@ -330,7 +304,7 @@ deleteFile (Path p) = RD.deleteFile p -- -- Notes: calls `rmdir` deleteDir :: Path b -> IO () -deleteDir (Path p) = RD.deleteDir p +deleteDir (MkPath fp) = Dir.deleteDir fp -- |Deletes the given directory recursively. Does not follow symbolic @@ -353,8 +327,7 @@ deleteDir (Path p) = RD.deleteDir p -- - `NoSuchThing` if directory does not exist -- - `PermissionDenied` if we can't open or write to parent directory deleteDirRecursive :: Path b -> IO () -deleteDirRecursive (Path p) = RD.deleteDirRecursive p - +deleteDirRecursive (MkPath p) = Dir.deleteDirRecursive p -- |Deletes a file, directory or symlink. @@ -367,27 +340,7 @@ deleteDirRecursive (Path p) = RD.deleteDirRecursive p -- * examines filetypes explicitly -- * calls `deleteDirRecursive` for directories easyDelete :: Path b -> IO () -easyDelete (Path p) = RD.easyDelete p - - - - - -------------------- - --[ File Opening ]-- - -------------------- - - --- |Opens a file appropriately by invoking xdg-open. The file type --- is not checked. This forks a process. -openFile :: Path b -> IO ProcessID -openFile (Path fp) = RD.openFile fp - - --- |Executes a program with the given arguments. This forks a process. -executeFile :: Path b -- ^ program - -> [ByteString] -- ^ arguments - -> IO ProcessID -executeFile (Path fp) args = RD.executeFile fp args +easyDelete (MkPath p) = Dir.easyDelete p @@ -406,8 +359,8 @@ executeFile (Path fp) args = RD.executeFile fp args -- - `AlreadyExists` if destination already exists -- - `NoSuchThing` if any of the parent components of the path -- do not exist -createRegularFile :: FileMode -> Path b -> IO () -createRegularFile fm (Path destBS) = RD.createRegularFile fm destBS +createRegularFile :: Path b -> IO () +createRegularFile (MkPath destBS) = Dir.createRegularFile destBS -- |Create an empty directory at the given directory with the given filename. @@ -418,8 +371,8 @@ createRegularFile fm (Path destBS) = RD.createRegularFile fm destBS -- - `AlreadyExists` if destination already exists -- - `NoSuchThing` if any of the parent components of the path -- do not exist -createDir :: FileMode -> Path b -> IO () -createDir fm (Path destBS) = RD.createDir fm destBS +createDir :: Path b -> IO () +createDir (MkPath destBS) = Dir.createDir destBS -- |Create an empty directory at the given directory with the given filename. -- @@ -428,8 +381,8 @@ createDir fm (Path destBS) = RD.createDir fm destBS -- - `PermissionDenied` if output directory cannot be written to -- - `NoSuchThing` if any of the parent components of the path -- do not exist -createDirIfMissing :: FileMode -> Path b -> IO () -createDirIfMissing fm (Path destBS) = RD.createDirIfMissing fm destBS +createDirIfMissing :: Path b -> IO () +createDirIfMissing (MkPath destBS) = Dir.createDirIfMissing destBS -- |Create an empty directory at the given directory with the given filename. @@ -450,9 +403,8 @@ createDirIfMissing fm (Path destBS) = RD.createDirIfMissing fm destBS -- exist and cannot be written to -- - `AlreadyExists` if destination already exists and -- is *not* a directory -createDirRecursive :: FileMode -> Path b -> IO () -createDirRecursive fm (Path p) = RD.createDirRecursive fm p - +createDirRecursive :: Path b -> IO () +createDirRecursive (MkPath p) = Dir.createDirRecursive p -- |Create a symlink. @@ -465,10 +417,10 @@ createDirRecursive fm (Path p) = RD.createDirRecursive fm p -- do not exist -- -- Note: calls `symlink` -createSymlink :: Path b -- ^ destination file - -> ByteString -- ^ path the symlink points to +createSymlink :: Path b1 -- ^ destination file + -> Path b2 -- ^ path the symlink points to -> IO () -createSymlink (Path destBS) sympoint = RD.createSymlink destBS sympoint +createSymlink (MkPath destBS) (MkPath sympoint) = Dir.createSymlink destBS sympoint @@ -499,8 +451,7 @@ createSymlink (Path destBS) sympoint = RD.createSymlink destBS sympoint -- -- Note: calls `rename` (but does not allow to rename over existing files) renameFile :: Path b1 -> Path b2 -> IO () -renameFile (Path from) (Path to) = RD.renameFile from to - +renameFile (MkPath fromf) (MkPath tof) = Dir.renameFile fromf tof -- |Move a file. This also works across devices by copy-delete fallback. @@ -538,7 +489,7 @@ moveFile :: Path b1 -- ^ file to move -> Path b2 -- ^ destination -> CopyMode -> IO () -moveFile (Path from) (Path to) cm = RD.moveFile from to cm +moveFile (MkPath from) (MkPath to) cm = Dir.moveFile from to cm @@ -560,7 +511,7 @@ moveFile (Path from) (Path to) cm = RD.moveFile from to cm -- containting it -- - `NoSuchThing` if the file does not exist readFile :: Path b -> IO L.ByteString -readFile (Path path) = RD.readFile path +readFile (MkPath path) = Dir.readFile path -- |Read the given file strictly into memory. @@ -574,10 +525,10 @@ readFile (Path path) = RD.readFile path -- containting it -- - `NoSuchThing` if the file does not exist readFileStrict :: Path b -> IO BS.ByteString -readFileStrict (Path path) = RD.readFileStrict path +readFileStrict (MkPath path) = Dir.readFileStrict path --- | Open the given file as a filestream. Once the filestream is +-- | Open the given file as a filestream. Once the filestream -- exits, the filehandle is cleaned up. -- -- Throws: @@ -587,7 +538,7 @@ readFileStrict (Path path) = RD.readFileStrict path -- containting it -- - `NoSuchThing` if the file does not exist readFileStream :: Path b -> IO (SerialT IO (Array Word8)) -readFileStream (Path fp) = RD.readFileStream fp +readFileStream (MkPath fp) = Dir.readFileStream fp @@ -607,10 +558,10 @@ readFileStream (Path fp) = RD.readFileStream fp -- containting it -- - `NoSuchThing` if the file does not exist writeFile :: Path b - -> Maybe FileMode -- ^ if Nothing, file must exist - -> ByteString + -> Bool -- ^ True if file must exist + -> BS.ByteString -> IO () -writeFile (Path fp) fmode bs = RD.writeFile fp fmode bs +writeFile (MkPath fp) nocreat bs = Dir.writeFile fp nocreat bs -- |Write a given lazy ByteString to a file, truncating the file beforehand. @@ -625,10 +576,10 @@ writeFile (Path fp) fmode bs = RD.writeFile fp fmode bs -- -- Note: uses streamly under the hood writeFileL :: Path b - -> Maybe FileMode -- ^ if Nothing, file must exist + -> Bool -- ^ True if file must exist -> L.ByteString -> IO () -writeFileL (Path fp) fmode lbs = RD.writeFileL fp fmode lbs +writeFileL (MkPath fp) nocreat lbs = Dir.writeFileL fp nocreat lbs -- |Append a given ByteString to a file. @@ -640,10 +591,8 @@ writeFileL (Path fp) fmode lbs = RD.writeFileL fp fmode lbs -- - `PermissionDenied` if we cannot read the file or the directory -- containting it -- - `NoSuchThing` if the file does not exist -appendFile :: Path b -> ByteString -> IO () -appendFile (Path fp) bs = RD.appendFile fp bs - - +appendFile :: Path b -> BS.ByteString -> IO () +appendFile (MkPath fp) bs = Dir.appendFile fp bs @@ -657,7 +606,7 @@ appendFile (Path fp) bs = RD.appendFile fp bs -- -- Only eNOENT is catched (and returns False). doesExist :: Path b -> IO Bool -doesExist (Path bs) = RD.doesExist bs +doesExist (MkPath bs) = Dir.doesExist bs -- |Checks if the given file exists and is not a directory. @@ -665,7 +614,7 @@ doesExist (Path bs) = RD.doesExist bs -- -- Only eNOENT is catched (and returns False). doesFileExist :: Path b -> IO Bool -doesFileExist (Path bs) = RD.doesFileExist bs +doesFileExist (MkPath bs) = Dir.doesFileExist bs -- |Checks if the given file exists and is a directory. @@ -673,7 +622,7 @@ doesFileExist (Path bs) = RD.doesFileExist bs -- -- Only eNOENT is catched (and returns False). doesDirectoryExist :: Path b -> IO Bool -doesDirectoryExist (Path bs) = RD.doesDirectoryExist bs +doesDirectoryExist (MkPath bs) = Dir.doesDirectoryExist bs -- |Checks whether a file or folder is readable. @@ -684,7 +633,7 @@ doesDirectoryExist (Path bs) = RD.doesDirectoryExist bs -- -- - `NoSuchThing` if the file does not exist isReadable :: Path b -> IO Bool -isReadable (Path bs) = RD.isReadable bs +isReadable (MkPath bs) = Dir.isReadable bs -- |Checks whether a file or folder is writable. -- @@ -694,7 +643,7 @@ isReadable (Path bs) = RD.isReadable bs -- -- - `NoSuchThing` if the file does not exist isWritable :: Path b -> IO Bool -isWritable (Path bs) = RD.isWritable bs +isWritable (MkPath bs) = Dir.isWritable bs -- |Checks whether a file or folder is executable. @@ -705,14 +654,14 @@ isWritable (Path bs) = RD.isWritable bs -- -- - `NoSuchThing` if the file does not exist isExecutable :: Path b -> IO Bool -isExecutable (Path bs) = RD.isExecutable bs +isExecutable (MkPath bs) = Dir.isExecutable bs -- |Checks whether the directory at the given path exists and can be -- opened. This invokes `openDirStream` which follows symlinks. canOpenDirectory :: Path b -> IO Bool -canOpenDirectory (Path bs) = RD.canOpenDirectory bs +canOpenDirectory (MkPath bs) = Dir.canOpenDirectory bs @@ -723,13 +672,13 @@ canOpenDirectory (Path bs) = RD.canOpenDirectory bs getModificationTime :: Path b -> IO UTCTime -getModificationTime (Path bs) = RD.getModificationTime bs +getModificationTime (MkPath bs) = Dir.getModificationTime bs -setModificationTime :: Path b -> EpochTime -> IO () -setModificationTime (Path bs) t = RD.setModificationTime bs t +setModificationTime :: Path b -> UTCTime -> IO () +setModificationTime (MkPath bs) t = Dir.setModificationTime bs t setModificationTimeHiRes :: Path b -> POSIXTime -> IO () -setModificationTimeHiRes (Path bs) t = RD.setModificationTimeHiRes bs t +setModificationTimeHiRes (MkPath bs) t = Dir.setModificationTimeHiRes bs t @@ -750,20 +699,17 @@ setModificationTimeHiRes (Path bs) t = RD.setModificationTimeHiRes bs t -- - `InappropriateType` if file type is wrong (symlink to file) -- - `InappropriateType` if file type is wrong (symlink to dir) -- - `PermissionDenied` if directory cannot be opened --- - `PathParseException` if a filename could not be parsed (should never happen) getDirsFiles :: Path b -- ^ dir to read -> IO [Path b] -getDirsFiles p = do - contents <- getDirsFiles' p - pure $ fmap (p ) contents +getDirsFiles (MkPath p) = fmap MkPath <$> Dir.getDirsFiles p -- | Like 'getDirsFiles', but returns the filename only, instead -- of prepending the base path. getDirsFiles' :: Path b -- ^ dir to read -> IO [Path Rel] -getDirsFiles' (Path fp) = do - rawContents <- RD.getDirsFiles' fp +getDirsFiles' (MkPath fp) = do + rawContents <- Dir.getDirsFiles' fp for rawContents $ \r -> parseRel r @@ -771,8 +717,8 @@ getDirsFiles' (Path fp) = do getDirsFilesStream :: (MonadCatch m, MonadAsync m, MonadMask m) => Path b -> IO (SerialT m (Path Rel)) -getDirsFilesStream (Path fp) = do - s <- RD.getDirsFilesStream fp +getDirsFilesStream (MkPath fp) = do + s <- Dir.getDirsFilesStream fp pure (s >>= parseRel) @@ -791,7 +737,7 @@ getDirsFilesStream (Path fp) = do -- - `NoSuchThing` if the file does not exist -- - `PermissionDenied` if any part of the path is not accessible getFileType :: Path b -> IO FileType -getFileType (Path fp) = RD.getFileType fp +getFileType (MkPath fp) = Dir.getFileType fp @@ -807,10 +753,9 @@ getFileType (Path fp) = RD.getFileType fp -- -- - `NoSuchThing` if the file at the given path does not exist -- - `NoSuchThing` if the symlink is broken --- - `PathParseException` if realpath does not return an absolute path canonicalizePath :: Path b -> IO (Path Abs) -canonicalizePath (Path l) = do - nl <- RD.canonicalizePath l +canonicalizePath (MkPath l) = do + nl <- Dir.canonicalizePath l parseAbs nl @@ -820,14 +765,7 @@ canonicalizePath (Path l) = do -- - if the path is already an absolute one, just return it -- - if it's a relative path, prepend the current directory to it toAbs :: Path b -> IO (Path Abs) -toAbs (Path bs) = do - let mabs = parseAbs bs :: Maybe (Path Abs) - case mabs of - Just a -> return a - Nothing -> do - cwd <- getWorkingDirectory >>= parseAbs - r <- parseRel bs -- we know it must be relative now - return $ cwd r +toAbs (MkPath bs) = MkPath <$> Dir.toAbs bs -- | Helper function to use the Path library without @@ -839,29 +777,10 @@ toAbs (Path bs) = do -- - `PathParseException` if the bytestring could neither be parsed as -- relative or absolute Path withRawFilePath :: MonadThrow m - => ByteString + => AbstractFilePath -> (Either (Path Abs) (Path Rel) -> m b) -> m b withRawFilePath bs action = do path <- parseAny bs action path - --- | Convenience function to open the path as a handle. --- --- If the file does not exist, it will be created with 'newFilePerms'. --- --- Throws: --- --- - `PathParseException` if the bytestring could neither be parsed as --- relative or absolute Path -withHandle :: ByteString - -> SPI.OpenMode - -> ((SIO.Handle, Either (Path Abs) (Path Rel)) -> IO a) - -> IO a -withHandle bs mode action = do - path <- parseAny bs - handle <- - bracketOnError (openFd bs mode [] (Just RD.newFilePerms)) (SPI.closeFd) - $ SPI.fdToHandle - finally (action (handle, path)) (SIO.hClose handle) From 493cb09cf54b1f9ece773fffbaebd0e16e274cac Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Sat, 30 Oct 2021 23:47:13 +0200 Subject: [PATCH 08/17] Tests should run for AbstractFilePath --- hpath-directory/hpath-directory.cabal | 52 +++--- hpath-directory/src/System/Directory/Types.hs | 32 ++++ .../Posix/PosixFilePath/Directory/Errors.hs | 29 ---- hpath-directory/test/Main.hs | 16 +- .../AFP}/AppendFileSpec.hs | 2 +- .../AFP}/CanonicalizePathSpec.hs | 2 +- .../CopyDirRecursiveCollectFailuresSpec.hs | 26 ++- .../AFP}/CopyDirRecursiveOverwriteSpec.hs | 20 ++- .../AFP}/CopyDirRecursiveSpec.hs | 22 ++- .../AFP}/CopyFileOverwriteSpec.hs | 17 +- .../AFP}/CopyFileSpec.hs | 15 +- .../AFP}/CreateDirIfMissingSpec.hs | 2 +- .../AFP}/CreateDirRecursiveSpec.hs | 2 +- .../AFP}/CreateDirSpec.hs | 2 +- .../AFP}/CreateRegularFileSpec.hs | 2 +- .../AFP}/CreateSymlinkSpec.hs | 2 +- .../AFP}/DeleteDirRecursiveSpec.hs | 14 +- .../AFP}/DeleteDirSpec.hs | 14 +- .../AFP}/DeleteFileSpec.hs | 14 +- .../AFP}/GetDirsFilesSpec.hs | 6 +- .../AFP}/GetFileTypeSpec.hs | 4 +- .../AFP}/MoveFileOverwriteSpec.hs | 10 +- .../AFP}/MoveFileSpec.hs | 11 +- .../AFP}/ReadFileSpec.hs | 2 +- .../AFP}/RecreateSymlinkOverwriteSpec.hs | 10 +- .../AFP}/RecreateSymlinkSpec.hs | 10 +- .../AFP}/RenameFileSpec.hs | 8 +- .../Directory => Directory/AFP}/ToAbsSpec.hs | 4 +- .../AFP}/WriteFileLSpec.hs | 2 +- .../AFP}/WriteFileSpec.hs | 2 +- hpath-directory/test/Utils.hs | 162 ++++++++++-------- 31 files changed, 279 insertions(+), 237 deletions(-) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/AppendFileSpec.hs (97%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/CanonicalizePathSpec.hs (95%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/CopyDirRecursiveCollectFailuresSpec.hs (92%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/CopyDirRecursiveOverwriteSpec.hs (92%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/CopyDirRecursiveSpec.hs (92%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/CopyFileOverwriteSpec.hs (91%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/CopyFileSpec.hs (92%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/CreateDirIfMissingSpec.hs (95%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/CreateDirRecursiveSpec.hs (96%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/CreateDirSpec.hs (96%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/CreateRegularFileSpec.hs (95%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/CreateSymlinkSpec.hs (96%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/DeleteDirRecursiveSpec.hs (88%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/DeleteDirSpec.hs (87%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/DeleteFileSpec.hs (81%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/GetDirsFilesSpec.hs (92%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/GetFileTypeSpec.hs (93%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/MoveFileOverwriteSpec.hs (92%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/MoveFileSpec.hs (93%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/ReadFileSpec.hs (98%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/RecreateSymlinkOverwriteSpec.hs (94%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/RecreateSymlinkSpec.hs (93%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/RenameFileSpec.hs (94%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/ToAbsSpec.hs (77%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/WriteFileLSpec.hs (97%) rename hpath-directory/test/System/{Posix/PosixFilePath/Directory => Directory/AFP}/WriteFileSpec.hs (97%) diff --git a/hpath-directory/hpath-directory.cabal b/hpath-directory/hpath-directory.cabal index 66f20a0..0a7911b 100644 --- a/hpath-directory/hpath-directory.cabal +++ b/hpath-directory/hpath-directory.cabal @@ -70,32 +70,32 @@ test-suite spec Hs-Source-Dirs: test Main-Is: Main.hs other-modules: - System.Posix.PosixFilePath.Directory.AppendFileSpec - System.Posix.PosixFilePath.Directory.CanonicalizePathSpec - System.Posix.PosixFilePath.Directory.CopyDirRecursiveCollectFailuresSpec - System.Posix.PosixFilePath.Directory.CopyDirRecursiveOverwriteSpec - System.Posix.PosixFilePath.Directory.CopyDirRecursiveSpec - System.Posix.PosixFilePath.Directory.CopyFileOverwriteSpec - System.Posix.PosixFilePath.Directory.CopyFileSpec - System.Posix.PosixFilePath.Directory.CreateDirIfMissingSpec - System.Posix.PosixFilePath.Directory.CreateDirRecursiveSpec - System.Posix.PosixFilePath.Directory.CreateDirSpec - System.Posix.PosixFilePath.Directory.CreateRegularFileSpec - System.Posix.PosixFilePath.Directory.CreateSymlinkSpec - System.Posix.PosixFilePath.Directory.DeleteDirRecursiveSpec - System.Posix.PosixFilePath.Directory.DeleteDirSpec - System.Posix.PosixFilePath.Directory.DeleteFileSpec - System.Posix.PosixFilePath.Directory.GetDirsFilesSpec - System.Posix.PosixFilePath.Directory.GetFileTypeSpec - System.Posix.PosixFilePath.Directory.MoveFileOverwriteSpec - System.Posix.PosixFilePath.Directory.MoveFileSpec - System.Posix.PosixFilePath.Directory.ReadFileSpec - System.Posix.PosixFilePath.Directory.RecreateSymlinkOverwriteSpec - System.Posix.PosixFilePath.Directory.RecreateSymlinkSpec - System.Posix.PosixFilePath.Directory.RenameFileSpec - System.Posix.PosixFilePath.Directory.ToAbsSpec - System.Posix.PosixFilePath.Directory.WriteFileLSpec - System.Posix.PosixFilePath.Directory.WriteFileSpec + System.Directory.AFP.AppendFileSpec + System.Directory.AFP.CanonicalizePathSpec + System.Directory.AFP.CopyDirRecursiveCollectFailuresSpec + System.Directory.AFP.CopyDirRecursiveOverwriteSpec + System.Directory.AFP.CopyDirRecursiveSpec + System.Directory.AFP.CopyFileOverwriteSpec + System.Directory.AFP.CopyFileSpec + System.Directory.AFP.CreateDirIfMissingSpec + System.Directory.AFP.CreateDirRecursiveSpec + System.Directory.AFP.CreateDirSpec + System.Directory.AFP.CreateRegularFileSpec + System.Directory.AFP.CreateSymlinkSpec + System.Directory.AFP.DeleteDirRecursiveSpec + System.Directory.AFP.DeleteDirSpec + System.Directory.AFP.DeleteFileSpec + System.Directory.AFP.GetDirsFilesSpec + System.Directory.AFP.GetFileTypeSpec + System.Directory.AFP.MoveFileOverwriteSpec + System.Directory.AFP.MoveFileSpec + System.Directory.AFP.ReadFileSpec + System.Directory.AFP.RecreateSymlinkOverwriteSpec + System.Directory.AFP.RecreateSymlinkSpec + System.Directory.AFP.RenameFileSpec + System.Directory.AFP.ToAbsSpec + System.Directory.AFP.WriteFileLSpec + System.Directory.AFP.WriteFileSpec Spec Utils GHC-Options: -Wall diff --git a/hpath-directory/src/System/Directory/Types.hs b/hpath-directory/src/System/Directory/Types.hs index 9f6da23..5050fb1 100644 --- a/hpath-directory/src/System/Directory/Types.hs +++ b/hpath-directory/src/System/Directory/Types.hs @@ -7,6 +7,38 @@ import AFP.AbstractFilePath.Types +toConstr :: HPathIOException -> String +toConstr SameFile {} = "SameFile" +toConstr DestinationInSource {} = "DestinationInSource" +toConstr RecursiveFailure {} = "RecursiveFailure" + + + + + + ----------------------------- + --[ Exception identifiers ]-- + ----------------------------- + + +isSameFile, isDestinationInSource, isRecursiveFailure :: HPathIOException -> Bool +isSameFile ex = toConstr (ex :: HPathIOException) == toConstr (SameFile mempty mempty) +isDestinationInSource ex = toConstr (ex :: HPathIOException) == (toConstr $ DestinationInSource mempty mempty) +isRecursiveFailure ex = toConstr (ex :: HPathIOException) == (toConstr $ RecursiveFailure mempty) + + +isReadContentsFailed, isCreateDirFailed, isCopyFileFailed, isRecreateSymlinkFailed ::RecursiveFailureHint -> Bool +isReadContentsFailed ReadContentsFailed{} = True +isReadContentsFailed _ = False +isCreateDirFailed CreateDirFailed{} = True +isCreateDirFailed _ = False +isCopyFileFailed CopyFileFailed{} = True +isCopyFileFailed _ = False +isRecreateSymlinkFailed RecreateSymlinkFailed{} = True +isRecreateSymlinkFailed _ = False + + + ------------- --[ Types ]-- diff --git a/hpath-directory/src/System/Posix/PosixFilePath/Directory/Errors.hs b/hpath-directory/src/System/Posix/PosixFilePath/Directory/Errors.hs index bb09478..9a7e6d9 100644 --- a/hpath-directory/src/System/Posix/PosixFilePath/Directory/Errors.hs +++ b/hpath-directory/src/System/Posix/PosixFilePath/Directory/Errors.hs @@ -95,35 +95,6 @@ import AFP.OsString.Internal.Types -toConstr :: HPathIOException -> String -toConstr SameFile {} = "SameFile" -toConstr DestinationInSource {} = "DestinationInSource" -toConstr RecursiveFailure {} = "RecursiveFailure" - - - - - - ----------------------------- - --[ Exception identifiers ]-- - ----------------------------- - - -isSameFile, isDestinationInSource, isRecursiveFailure :: HPathIOException -> Bool -isSameFile ex = toConstr (ex :: HPathIOException) == toConstr (SameFile mempty mempty) -isDestinationInSource ex = toConstr (ex :: HPathIOException) == (toConstr $ DestinationInSource mempty mempty) -isRecursiveFailure ex = toConstr (ex :: HPathIOException) == (toConstr $ RecursiveFailure mempty) - - -isReadContentsFailed, isCreateDirFailed, isCopyFileFailed, isRecreateSymlinkFailed ::RecursiveFailureHint -> Bool -isReadContentsFailed ReadContentsFailed{} = True -isReadContentsFailed _ = False -isCreateDirFailed CreateDirFailed{} = True -isCreateDirFailed _ = False -isCopyFileFailed CopyFileFailed{} = True -isCopyFileFailed _ = False -isRecreateSymlinkFailed RecreateSymlinkFailed{} = True -isRecreateSymlinkFailed _ = False diff --git a/hpath-directory/test/Main.hs b/hpath-directory/test/Main.hs index 6cd2282..99dc771 100644 --- a/hpath-directory/test/Main.hs +++ b/hpath-directory/test/Main.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} import Data.IORef import Test.Hspec @@ -6,10 +7,14 @@ import Test.Hspec.Runner import Test.Hspec.Formatters import qualified Spec import Utils +#ifdef WINDOWS +#else import System.Posix.Temp.PosixString (mkdtemp) import System.Posix.Env.PosixString (getEnvDefault) -import "hpath-directory" System.Posix.PosixFilePath.Directory -import AFP.AbstractFilePath.Posix +#endif +import "hpath-directory" System.Directory.AFP +import AFP.AbstractFilePath +import AFP.OsString.Internal.Types -- TODO: chardev, blockdev, namedpipe, socket @@ -17,8 +22,11 @@ import AFP.AbstractFilePath.Posix main :: IO () main = do - tmpdir <- getEnvDefault "TMPDIR" "/tmp" >>= canonicalizePath - tmpBase <- mkdtemp (tmpdir "hpath-directory") +#ifdef WINDOWS +#else + (OsString tmpdir) <- fmap ( "hpath-directory") (getEnvDefault "TMPDIR" "/tmp" >>= canonicalizePath . OsString) + tmpBase <- OsString <$> mkdtemp tmpdir +#endif writeIORef baseTmpDir (Just (tmpBase <> "/")) putStrLn $ ("Temporary test directory at: " ++ show tmpBase) hspecWith diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/AppendFileSpec.hs b/hpath-directory/test/System/Directory/AFP/AppendFileSpec.hs similarity index 97% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/AppendFileSpec.hs rename to hpath-directory/test/System/Directory/AFP/AppendFileSpec.hs index eda5502..b3dfa03 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/AppendFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/AppendFileSpec.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.AppendFileSpec where +module System.Directory.AFP.AppendFileSpec where import Test.Hspec diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/CanonicalizePathSpec.hs b/hpath-directory/test/System/Directory/AFP/CanonicalizePathSpec.hs similarity index 95% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/CanonicalizePathSpec.hs rename to hpath-directory/test/System/Directory/AFP/CanonicalizePathSpec.hs index 19982f0..68f4b14 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/CanonicalizePathSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CanonicalizePathSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.CanonicalizePathSpec where +module System.Directory.AFP.CanonicalizePathSpec where import Test.Hspec diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyDirRecursiveCollectFailuresSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveCollectFailuresSpec.hs similarity index 92% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyDirRecursiveCollectFailuresSpec.hs rename to hpath-directory/test/System/Directory/AFP/CopyDirRecursiveCollectFailuresSpec.hs index 689872e..2dcd773 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyDirRecursiveCollectFailuresSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveCollectFailuresSpec.hs @@ -1,13 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.CopyDirRecursiveCollectFailuresSpec where +module System.Directory.AFP.CopyDirRecursiveCollectFailuresSpec where import Test.Hspec import Data.List (sort) -import "hpath-directory" System.Posix.PosixFilePath.Directory -import System.Posix.PosixFilePath.Directory.Errors +import "hpath-directory" System.Directory.AFP +import System.Directory.Types import System.IO.Error ( ioeGetErrorType @@ -19,7 +19,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import AFP.AbstractFilePath.Posix +import AFP.AbstractFilePath @@ -120,7 +120,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ -- successes -- it "copyDirRecursive (Strict, CollectFailures), all fine and compare" $ do tmpDir' <- getRawTmpDir - tmpDirS <- fromPlatformStringIO tmpDir' + tmpDirS <- fromAbstractFilePathIO tmpDir' copyDirRecursive' "inputDir" "outputDir" Strict @@ -195,7 +195,9 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ Strict CollectFailures `shouldThrow` - isRecursiveFailure + (\e -> case e of + RecursiveFailure{} -> True + _ -> False) it "copyDirRecursive (Strict, CollectFailures), destination dir already exists" $ copyDirRecursive' "inputDir" @@ -211,7 +213,9 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ Strict CollectFailures `shouldThrow` - isRecursiveFailure + (\e -> case e of + RecursiveFailure{} -> True + _ -> False) it "copyDirRecursive (Strict, CollectFailures), wrong input (regular file)" $ copyDirRecursive' "wrongInput" @@ -235,7 +239,9 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ Strict CollectFailures `shouldThrow` - isDestinationInSource + (\e -> case e of + DestinationInSource{} -> True + _ -> False) it "copyDirRecursive (Strict, CollectFailures), destination and source same directory" $ copyDirRecursive' "inputDir" @@ -243,6 +249,8 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ Strict CollectFailures `shouldThrow` - isSameFile + (\e -> case e of + SameFile{} -> True + _ -> False) diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyDirRecursiveOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveOverwriteSpec.hs similarity index 92% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyDirRecursiveOverwriteSpec.hs rename to hpath-directory/test/System/Directory/AFP/CopyDirRecursiveOverwriteSpec.hs index 87d0c38..2a89903 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyDirRecursiveOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveOverwriteSpec.hs @@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.CopyDirRecursiveOverwriteSpec where +module System.Directory.AFP.CopyDirRecursiveOverwriteSpec where import Test.Hspec -import "hpath-directory" System.Posix.PosixFilePath.Directory -import System.Posix.PosixFilePath.Directory.Errors +import "hpath-directory" System.Directory.AFP +import System.Directory.Types import System.IO.Error ( ioeGetErrorType @@ -18,7 +18,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import AFP.AbstractFilePath.Posix +import AFP.AbstractFilePath @@ -100,7 +100,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "copyDirRecursive (Overwrite, FailEarly), all fine and compare" $ do tmpDir' <- getRawTmpDir - tmpDirS <- fromPlatformStringIO tmpDir' + tmpDirS <- fromAbstractFilePathIO tmpDir' copyDirRecursive' "inputDir" "outputDir" Overwrite @@ -114,7 +114,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "copyDirRecursive (Overwrite, FailEarly), destination dir already exists" $ do tmpDir' <- getRawTmpDir - tmpDirS <- fromPlatformStringIO tmpDir' + tmpDirS <- fromAbstractFilePathIO tmpDir' (system $ "diff -r " ++ tmpDirS ++ "inputDir" ++ " " ++ tmpDirS ++ "alreadyExistsD" @@ -196,7 +196,9 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ Overwrite FailEarly `shouldThrow` - isDestinationInSource + (\e -> case e of + DestinationInSource{} -> True + _ -> False) it "copyDirRecursive (Overwrite, FailEarly), destination and source same directory" $ copyDirRecursive' "inputDir" @@ -204,4 +206,6 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ Overwrite FailEarly `shouldThrow` - isSameFile + (\e -> case e of + SameFile{} -> True + _ -> False) diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyDirRecursiveSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveSpec.hs similarity index 92% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyDirRecursiveSpec.hs rename to hpath-directory/test/System/Directory/AFP/CopyDirRecursiveSpec.hs index fa9e2e0..899bb1a 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyDirRecursiveSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveSpec.hs @@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.CopyDirRecursiveSpec where +module System.Directory.AFP.CopyDirRecursiveSpec where import Test.Hspec -import "hpath-directory" System.Posix.PosixFilePath.Directory -import System.Posix.PosixFilePath.Directory.Errors +import "hpath-directory" System.Directory.AFP +import System.Directory.Types import System.IO.Error ( ioeGetErrorType @@ -18,7 +18,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import AFP.AbstractFilePath.Posix +import AFP.AbstractFilePath @@ -85,7 +85,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "copyDirRecursive (Strict, FailEarly), all fine and compare" $ do tmpDir' <- getRawTmpDir - tmpDirS <- fromPlatformStringIO tmpDir' + tmpDirS <- fromAbstractFilePathIO tmpDir' copyDirRecursive' "inputDir" "outputDir" Strict @@ -169,7 +169,12 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ Strict FailEarly `shouldThrow` - isDestinationInSource + (\e -> case e of + DestinationInSource{} -> True + _ -> False) + + + it "copyDirRecursive (Strict, FailEarly), destination and source same directory" $ copyDirRecursive' "inputDir" @@ -177,6 +182,9 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ Strict FailEarly `shouldThrow` - isSameFile + (\e -> case e of + SameFile{} -> True + _ -> False) + diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyFileOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyFileOverwriteSpec.hs similarity index 91% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyFileOverwriteSpec.hs rename to hpath-directory/test/System/Directory/AFP/CopyFileOverwriteSpec.hs index 7393692..05a87a3 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyFileOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyFileOverwriteSpec.hs @@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.CopyFileOverwriteSpec where +module System.Directory.AFP.CopyFileOverwriteSpec where import Test.Hspec -import "hpath-directory" System.Posix.PosixFilePath.Directory -import System.Posix.PosixFilePath.Directory.Errors +import "hpath-directory" System.Directory.AFP +import System.Directory.Types import System.IO.Error ( ioeGetErrorType @@ -17,7 +17,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import AFP.AbstractFilePath.Posix +import AFP.AbstractFilePath @@ -70,7 +70,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "copyFile (Overwrite), output file already exists, all clear" $ do tmpDir' <- getRawTmpDir - tmpDirS <- fromPlatformStringIO tmpDir' + tmpDirS <- fromAbstractFilePathIO tmpDir' copyFile' "alreadyExists" "alreadyExists.bak" Strict copyFile' "inputFile" "alreadyExists" Overwrite (system $ "cmp -s " ++ tmpDirS ++ "inputFile" ++ " " @@ -82,7 +82,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "copyFile (Overwrite), and compare" $ do tmpDir' <- getRawTmpDir - tmpDirS <- fromPlatformStringIO tmpDir' + tmpDirS <- fromAbstractFilePathIO tmpDir' copyFile' "inputFile" "outputFile" Overwrite @@ -147,4 +147,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ copyFile' "inputFile" "inputFile" Overwrite - `shouldThrow` isSameFile + `shouldThrow` + (\e -> case e of + SameFile{} -> True + _ -> False) diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyFileSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyFileSpec.hs similarity index 92% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyFileSpec.hs rename to hpath-directory/test/System/Directory/AFP/CopyFileSpec.hs index b0148f0..5134f91 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/CopyFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyFileSpec.hs @@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.CopyFileSpec where +module System.Directory.AFP.CopyFileSpec where import Test.Hspec -import "hpath-directory" System.Posix.PosixFilePath.Directory -import System.Posix.PosixFilePath.Directory.Errors +import "hpath-directory" System.Directory.AFP +import System.Directory.Types import System.IO.Error ( ioeGetErrorType @@ -18,7 +18,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import AFP.AbstractFilePath.Posix +import AFP.AbstractFilePath @@ -69,7 +69,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "copyFile (Strict), and compare" $ do tmpDir' <- getRawTmpDir - tmpDirS <- fromPlatformStringIO tmpDir' + tmpDirS <- fromAbstractFilePathIO tmpDir' copyFile' "inputFile" "outputFile" Strict @@ -141,4 +141,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ "inputFile" Strict `shouldThrow` - isSameFile + (\e -> case e of + SameFile{} -> True + _ -> False) + diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateDirIfMissingSpec.hs b/hpath-directory/test/System/Directory/AFP/CreateDirIfMissingSpec.hs similarity index 95% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateDirIfMissingSpec.hs rename to hpath-directory/test/System/Directory/AFP/CreateDirIfMissingSpec.hs index b942e76..7da2fba 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateDirIfMissingSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CreateDirIfMissingSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.CreateDirIfMissingSpec where +module System.Directory.AFP.CreateDirIfMissingSpec where import Test.Hspec diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateDirRecursiveSpec.hs b/hpath-directory/test/System/Directory/AFP/CreateDirRecursiveSpec.hs similarity index 96% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateDirRecursiveSpec.hs rename to hpath-directory/test/System/Directory/AFP/CreateDirRecursiveSpec.hs index 083d0f9..3dd7b12 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateDirRecursiveSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CreateDirRecursiveSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.CreateDirRecursiveSpec where +module System.Directory.AFP.CreateDirRecursiveSpec where import Test.Hspec diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateDirSpec.hs b/hpath-directory/test/System/Directory/AFP/CreateDirSpec.hs similarity index 96% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateDirSpec.hs rename to hpath-directory/test/System/Directory/AFP/CreateDirSpec.hs index 00874a4..041eda9 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateDirSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CreateDirSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.CreateDirSpec where +module System.Directory.AFP.CreateDirSpec where import Test.Hspec diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateRegularFileSpec.hs b/hpath-directory/test/System/Directory/AFP/CreateRegularFileSpec.hs similarity index 95% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateRegularFileSpec.hs rename to hpath-directory/test/System/Directory/AFP/CreateRegularFileSpec.hs index 00ef6e5..a390c78 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateRegularFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CreateRegularFileSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.CreateRegularFileSpec where +module System.Directory.AFP.CreateRegularFileSpec where import Test.Hspec diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateSymlinkSpec.hs b/hpath-directory/test/System/Directory/AFP/CreateSymlinkSpec.hs similarity index 96% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateSymlinkSpec.hs rename to hpath-directory/test/System/Directory/AFP/CreateSymlinkSpec.hs index 61f2516..72110b1 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/CreateSymlinkSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CreateSymlinkSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.CreateSymlinkSpec where +module System.Directory.AFP.CreateSymlinkSpec where import Test.Hspec diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/DeleteDirRecursiveSpec.hs b/hpath-directory/test/System/Directory/AFP/DeleteDirRecursiveSpec.hs similarity index 88% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/DeleteDirRecursiveSpec.hs rename to hpath-directory/test/System/Directory/AFP/DeleteDirRecursiveSpec.hs index e685fd9..5415310 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/DeleteDirRecursiveSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/DeleteDirRecursiveSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.DeleteDirRecursiveSpec where +module System.Directory.AFP.DeleteDirRecursiveSpec where import Test.Hspec @@ -8,10 +8,6 @@ import System.IO.Error ( ioeGetErrorType ) -import System.Posix.Files.ByteString - ( - getSymbolicLinkStatus - ) import GHC.IO.Exception ( IOErrorType(..) @@ -58,9 +54,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "deleteDirRecursive, empty directory, all fine" $ do createDir' "testDir" deleteDirRecursive' "testDir" - getSymbolicLinkStatus "testDir" - `shouldThrow` - (\e -> ioeGetErrorType e == NoSuchThing) + dirExists "testDir" >>= (`shouldBe` False) it "deleteDirRecursive, empty directory with null permissions, all fine" $ do createDir' "noPerms/testDir" @@ -75,9 +69,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ createRegularFile' "nonEmpty/file1" createRegularFile' "nonEmpty/dir1/file2" deleteDirRecursive' "nonEmpty" - getSymbolicLinkStatus "nonEmpty" - `shouldThrow` - (\e -> ioeGetErrorType e == NoSuchThing) + dirExists "nonEmpty" >>= (`shouldBe` False) -- posix failures -- it "deleteDirRecursive, can't open parent directory" $ do diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/DeleteDirSpec.hs b/hpath-directory/test/System/Directory/AFP/DeleteDirSpec.hs similarity index 87% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/DeleteDirSpec.hs rename to hpath-directory/test/System/Directory/AFP/DeleteDirSpec.hs index 40bfd01..1a1f5b7 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/DeleteDirSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/DeleteDirSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.DeleteDirSpec where +module System.Directory.AFP.DeleteDirSpec where import Test.Hspec @@ -8,10 +8,6 @@ import System.IO.Error ( ioeGetErrorType ) -import System.Posix.Files.ByteString - ( - getSymbolicLinkStatus - ) import GHC.IO.Exception ( IOErrorType(..) @@ -59,17 +55,13 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "deleteDir, empty directory, all fine" $ do createDir' "testDir" deleteDir' "testDir" - getSymbolicLinkStatus "testDir" - `shouldThrow` - (\e -> ioeGetErrorType e == NoSuchThing) + dirExists "testDir" >>= (`shouldBe` False) it "deleteDir, directory with null permissions, all fine" $ do createDir' "noPerms/testDir" noPerms "noPerms/testDir" deleteDir' "noPerms/testDir" - getSymbolicLinkStatus "testDir" - `shouldThrow` - (\e -> ioeGetErrorType e == NoSuchThing) + dirExists "testDir" >>= (`shouldBe` False) -- posix failures -- it "deleteDir, wrong file type (symlink to directory)" $ diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/DeleteFileSpec.hs b/hpath-directory/test/System/Directory/AFP/DeleteFileSpec.hs similarity index 81% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/DeleteFileSpec.hs rename to hpath-directory/test/System/Directory/AFP/DeleteFileSpec.hs index 9a7271a..b444407 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/DeleteFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/DeleteFileSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.DeleteFileSpec where +module System.Directory.AFP.DeleteFileSpec where import Test.Hspec @@ -9,10 +9,6 @@ import System.IO.Error ( ioeGetErrorType ) -import System.Posix.Files.ByteString - ( - getSymbolicLinkStatus - ) import GHC.IO.Exception ( IOErrorType(..) @@ -53,18 +49,14 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "deleteFile, regular file, all fine" $ do createRegularFile' "testFile" deleteFile' "testFile" - getSymbolicLinkStatus "testFile" - `shouldThrow` - (\e -> ioeGetErrorType e == NoSuchThing) + dirExists "testFile" >>= (`shouldBe` False) it "deleteFile, symlink, all fine" $ do recreateSymlink' "syml" "testFile" Strict deleteFile' "testFile" - getSymbolicLinkStatus "testFile" - `shouldThrow` - (\e -> ioeGetErrorType e == NoSuchThing) + dirExists "testFile" >>= (`shouldBe` False) -- posix failures -- it "deleteFile, wrong file type (directory)" $ diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/GetDirsFilesSpec.hs b/hpath-directory/test/System/Directory/AFP/GetDirsFilesSpec.hs similarity index 92% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/GetDirsFilesSpec.hs rename to hpath-directory/test/System/Directory/AFP/GetDirsFilesSpec.hs index 0219561..76db97a 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/GetDirsFilesSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/GetDirsFilesSpec.hs @@ -1,13 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.GetDirsFilesSpec where +module System.Directory.AFP.GetDirsFilesSpec where import Data.List ( sort ) -import "hpath-directory" System.Posix.PosixFilePath.Directory hiding (getDirsFiles') +import "hpath-directory" System.Directory.AFP hiding (getDirsFiles') import Test.Hspec import System.IO.Error ( @@ -18,7 +18,7 @@ import GHC.IO.Exception IOErrorType(..) ) import Utils -import AFP.AbstractFilePath.Posix +import AFP.AbstractFilePath upTmpDir :: IO () diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/GetFileTypeSpec.hs b/hpath-directory/test/System/Directory/AFP/GetFileTypeSpec.hs similarity index 93% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/GetFileTypeSpec.hs rename to hpath-directory/test/System/Directory/AFP/GetFileTypeSpec.hs index 5d32b47..2ba781c 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/GetFileTypeSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/GetFileTypeSpec.hs @@ -1,9 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.GetFileTypeSpec where +module System.Directory.AFP.GetFileTypeSpec where -import "hpath-directory" System.Posix.PosixFilePath.Directory +import "hpath-directory" System.Directory.AFP import Test.Hspec import System.IO.Error ( diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/MoveFileOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/MoveFileOverwriteSpec.hs similarity index 92% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/MoveFileOverwriteSpec.hs rename to hpath-directory/test/System/Directory/AFP/MoveFileOverwriteSpec.hs index f6b5ee4..0ecc41a 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/MoveFileOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/MoveFileOverwriteSpec.hs @@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.MoveFileOverwriteSpec where +module System.Directory.AFP.MoveFileOverwriteSpec where import Test.Hspec -import "hpath-directory" System.Posix.PosixFilePath.Directory -import System.Posix.PosixFilePath.Directory.Errors +import "hpath-directory" System.Directory.AFP +import System.Directory.Types import System.IO.Error ( ioeGetErrorType @@ -123,4 +123,6 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ "myFile" Overwrite `shouldThrow` - isSameFile + (\e -> case e of + SameFile{} -> True + _ -> False) diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/MoveFileSpec.hs b/hpath-directory/test/System/Directory/AFP/MoveFileSpec.hs similarity index 93% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/MoveFileSpec.hs rename to hpath-directory/test/System/Directory/AFP/MoveFileSpec.hs index 63abf48..56d5247 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/MoveFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/MoveFileSpec.hs @@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.MoveFileSpec where +module System.Directory.AFP.MoveFileSpec where import Test.Hspec -import "hpath-directory" System.Posix.PosixFilePath.Directory -import System.Posix.PosixFilePath.Directory.Errors +import "hpath-directory" System.Directory.AFP +import System.Directory.Types import System.IO.Error ( ioeGetErrorType @@ -126,4 +126,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ "myFile" Strict `shouldThrow` - isSameFile + (\e -> case e of + SameFile{} -> True + _ -> False) + diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/ReadFileSpec.hs b/hpath-directory/test/System/Directory/AFP/ReadFileSpec.hs similarity index 98% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/ReadFileSpec.hs rename to hpath-directory/test/System/Directory/AFP/ReadFileSpec.hs index e2dde0c..f2e3ddf 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/ReadFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/ReadFileSpec.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.ReadFileSpec where +module System.Directory.AFP.ReadFileSpec where import Test.Hspec diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/RecreateSymlinkOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkOverwriteSpec.hs similarity index 94% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/RecreateSymlinkOverwriteSpec.hs rename to hpath-directory/test/System/Directory/AFP/RecreateSymlinkOverwriteSpec.hs index dc30d67..1a9af34 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/RecreateSymlinkOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkOverwriteSpec.hs @@ -1,14 +1,14 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.RecreateSymlinkOverwriteSpec where +module System.Directory.AFP.RecreateSymlinkOverwriteSpec where -- TODO: exception if destination exists but is not a file + `OverWrite` CopyMode import Test.Hspec -import "hpath-directory" System.Posix.PosixFilePath.Directory -import System.Posix.PosixFilePath.Directory.Errors +import "hpath-directory" System.Directory.AFP +import System.Directory.Types import System.IO.Error ( ioeGetErrorType @@ -135,5 +135,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ "myFileL" Overwrite `shouldThrow` - isSameFile + (\e -> case e of + SameFile{} -> True + _ -> False) diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/RecreateSymlinkSpec.hs b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkSpec.hs similarity index 93% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/RecreateSymlinkSpec.hs rename to hpath-directory/test/System/Directory/AFP/RecreateSymlinkSpec.hs index 8c1c11d..27c495b 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/RecreateSymlinkSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkSpec.hs @@ -1,13 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.RecreateSymlinkSpec where +module System.Directory.AFP.RecreateSymlinkSpec where import Test.Hspec -import "hpath-directory" System.Posix.PosixFilePath.Directory -import System.Posix.PosixFilePath.Directory.Errors +import "hpath-directory" System.Directory.AFP +import System.Directory.Types import System.IO.Error ( ioeGetErrorType @@ -126,5 +126,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ "myFileL" Strict `shouldThrow` - isSameFile + (\e -> case e of + SameFile{} -> True + _ -> False) diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/RenameFileSpec.hs b/hpath-directory/test/System/Directory/AFP/RenameFileSpec.hs similarity index 94% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/RenameFileSpec.hs rename to hpath-directory/test/System/Directory/AFP/RenameFileSpec.hs index aca9991..a8438f7 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/RenameFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/RenameFileSpec.hs @@ -1,10 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.RenameFileSpec where +module System.Directory.AFP.RenameFileSpec where import Test.Hspec -import System.Posix.PosixFilePath.Directory.Errors +import System.Directory.Types import System.IO.Error ( ioeGetErrorType @@ -113,5 +113,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ renameFile' "myFile" "myFile" `shouldThrow` - isSameFile + (\e -> case e of + SameFile{} -> True + _ -> False) diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/ToAbsSpec.hs b/hpath-directory/test/System/Directory/AFP/ToAbsSpec.hs similarity index 77% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/ToAbsSpec.hs rename to hpath-directory/test/System/Directory/AFP/ToAbsSpec.hs index 4ce10df..37c0f7c 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/ToAbsSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/ToAbsSpec.hs @@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.ToAbsSpec where +module System.Directory.AFP.ToAbsSpec where import Test.Hspec -import "hpath-directory" System.Posix.PosixFilePath.Directory +import "hpath-directory" System.Directory.AFP diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/WriteFileLSpec.hs b/hpath-directory/test/System/Directory/AFP/WriteFileLSpec.hs similarity index 97% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/WriteFileLSpec.hs rename to hpath-directory/test/System/Directory/AFP/WriteFileLSpec.hs index 8dab1f2..e869148 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/WriteFileLSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/WriteFileLSpec.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.WriteFileLSpec where +module System.Directory.AFP.WriteFileLSpec where import Test.Hspec diff --git a/hpath-directory/test/System/Posix/PosixFilePath/Directory/WriteFileSpec.hs b/hpath-directory/test/System/Directory/AFP/WriteFileSpec.hs similarity index 97% rename from hpath-directory/test/System/Posix/PosixFilePath/Directory/WriteFileSpec.hs rename to hpath-directory/test/System/Directory/AFP/WriteFileSpec.hs index 744ddaf..396745a 100644 --- a/hpath-directory/test/System/Posix/PosixFilePath/Directory/WriteFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/WriteFileSpec.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.PosixFilePath.Directory.WriteFileSpec where +module System.Directory.AFP.WriteFileSpec where import Test.Hspec diff --git a/hpath-directory/test/Utils.hs b/hpath-directory/test/Utils.hs index 9d63f2c..fcadb89 100644 --- a/hpath-directory/test/Utils.hs +++ b/hpath-directory/test/Utils.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} module Utils where @@ -8,6 +10,8 @@ import Control.Applicative ( (<$>) ) +import Control.Exception +import Data.Either import Control.Monad ( forM_ @@ -25,7 +29,6 @@ import Data.IORef , writeIORef , IORef ) -import "hpath-directory" System.Posix.PosixFilePath.Directory import Prelude hiding (appendFile, readFile, writeFile) import Data.Maybe ( @@ -35,32 +38,34 @@ import System.IO.Unsafe ( unsafePerformIO ) +#ifdef WINDOWS +#else import qualified System.Posix.PosixFilePath.Directory.Traversals as DT -import Data.ByteString +import System.Posix.Files.ByteString ( - ByteString + getSymbolicLinkStatus ) -import System.Posix.Files.PosixString +#endif +import Data.ByteString ( - groupExecuteMode - , groupReadMode - , nullFileMode - , otherExecuteMode - , otherReadMode - , ownerExecuteMode - , ownerReadMode - , setFileMode - , unionFileModes + ByteString ) -import AFP.AbstractFilePath.Posix -import qualified AFP.AbstractFilePath.Posix as AFP +import AFP.AbstractFilePath +import AFP.OsString.Internal.Types +import qualified AFP.AbstractFilePath as AFP +import qualified Data.ByteString.Short as SBS + +import System.Directory.AFP -baseTmpDir :: IORef (Maybe PosixFilePath) + + + +baseTmpDir :: IORef (Maybe AbstractFilePath) {-# NOINLINE baseTmpDir #-} baseTmpDir = unsafePerformIO (newIORef Nothing) -tmpDir :: IORef (Maybe PosixFilePath) +tmpDir :: IORef (Maybe AbstractFilePath) {-# NOINLINE tmpDir #-} tmpDir = unsafePerformIO (newIORef Nothing) @@ -71,7 +76,7 @@ tmpDir = unsafePerformIO (newIORef Nothing) ----------------- -setTmpDir :: PosixFilePath -> IO () +setTmpDir :: AbstractFilePath -> IO () {-# NOINLINE setTmpDir #-} setTmpDir bs = do tmp <- fromJust <$> readIORef baseTmpDir @@ -82,7 +87,7 @@ createTmpDir :: IO () {-# NOINLINE createTmpDir #-} createTmpDir = do tmp <- fromJust <$> readIORef tmpDir - void $ createDir newDirPerms tmp + void $ createDir tmp deleteTmpDir :: IO () @@ -101,19 +106,19 @@ deleteBaseTmpDir = do void $ deleteDir tmp -withRawTmpDir :: (PosixFilePath -> IO a) -> IO a +withRawTmpDir :: (AbstractFilePath -> IO a) -> IO a {-# NOINLINE withRawTmpDir #-} withRawTmpDir f = do tmp <- fromJust <$> readIORef tmpDir f tmp -getRawTmpDir :: IO PosixFilePath +getRawTmpDir :: IO AbstractFilePath {-# NOINLINE getRawTmpDir #-} -getRawTmpDir = withRawTmpDir (return . packPlatformString . (++ [fromChar '/']) . unpackPlatformString) +getRawTmpDir = withRawTmpDir (return . packAFP . (++ [fromChar '/']) . unpackAFP) -withTmpDir :: PosixFilePath -> (PosixFilePath -> IO a) -> IO a +withTmpDir :: AbstractFilePath -> (AbstractFilePath -> IO a) -> IO a {-# NOINLINE withTmpDir #-} withTmpDir ip f = do tmp <- fromJust <$> readIORef tmpDir @@ -121,9 +126,9 @@ withTmpDir ip f = do f p -withTmpDir' :: PosixFilePath - -> PosixFilePath - -> (PosixFilePath -> PosixFilePath -> IO a) +withTmpDir' :: AbstractFilePath + -> AbstractFilePath + -> (AbstractFilePath -> AbstractFilePath -> IO a) -> IO a {-# NOINLINE withTmpDir' #-} withTmpDir' ip1 ip2 f = do @@ -133,55 +138,55 @@ withTmpDir' ip1 ip2 f = do f p1 p2 -removeFileIfExists :: PosixFilePath -> IO () +removeFileIfExists :: AbstractFilePath -> IO () {-# NOINLINE removeFileIfExists #-} removeFileIfExists bs = withTmpDir bs $ \p -> whenM (doesFileExist p) (deleteFile p) -removeDirIfExists :: PosixFilePath -> IO () +removeDirIfExists :: AbstractFilePath -> IO () {-# NOINLINE removeDirIfExists #-} removeDirIfExists bs = withTmpDir bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p) -copyFile' :: PosixFilePath -> PosixFilePath -> CopyMode -> IO () +copyFile' :: AbstractFilePath -> AbstractFilePath -> CopyMode -> IO () {-# NOINLINE copyFile' #-} copyFile' inputFileP outputFileP cm = withTmpDir' inputFileP outputFileP (\p1 p2 -> copyFile p1 p2 cm) -copyDirRecursive' :: PosixFilePath -> PosixFilePath +copyDirRecursive' :: AbstractFilePath -> AbstractFilePath -> CopyMode -> RecursiveErrorMode -> IO () {-# NOINLINE copyDirRecursive' #-} copyDirRecursive' inputDirP outputDirP cm rm = withTmpDir' inputDirP outputDirP (\p1 p2 -> copyDirRecursive p1 p2 cm rm) -createDir' :: PosixFilePath -> IO () +createDir' :: AbstractFilePath -> IO () {-# NOINLINE createDir' #-} -createDir' dest = withTmpDir dest (createDir newDirPerms) +createDir' dest = withTmpDir dest createDir -createDirIfMissing' :: PosixFilePath -> IO () +createDirIfMissing' :: AbstractFilePath -> IO () {-# NOINLINE createDirIfMissing' #-} -createDirIfMissing' dest = withTmpDir dest (createDirIfMissing newDirPerms) +createDirIfMissing' dest = withTmpDir dest createDirIfMissing -createDirRecursive' :: PosixFilePath -> IO () +createDirRecursive' :: AbstractFilePath -> IO () {-# NOINLINE createDirRecursive' #-} -createDirRecursive' dest = withTmpDir dest (createDirRecursive newDirPerms) +createDirRecursive' dest = withTmpDir dest createDirRecursive -createRegularFile' :: PosixFilePath -> IO () +createRegularFile' :: AbstractFilePath -> IO () {-# NOINLINE createRegularFile' #-} -createRegularFile' dest = withTmpDir dest (createRegularFile newFilePerms) +createRegularFile' dest = withTmpDir dest createRegularFile -createSymlink' :: PosixFilePath -> PosixFilePath -> IO () +createSymlink' :: AbstractFilePath -> AbstractFilePath -> IO () {-# NOINLINE createSymlink' #-} createSymlink' dest sympoint = withTmpDir dest (\x -> createSymlink x sympoint) -renameFile' :: PosixFilePath -> PosixFilePath -> IO () +renameFile' :: AbstractFilePath -> AbstractFilePath -> IO () {-# NOINLINE renameFile' #-} renameFile' inputFileP outputFileP = withTmpDir' inputFileP outputFileP $ \i o -> do @@ -189,7 +194,7 @@ renameFile' inputFileP outputFileP = renameFile o i -moveFile' :: PosixFilePath -> PosixFilePath -> CopyMode -> IO () +moveFile' :: AbstractFilePath -> AbstractFilePath -> CopyMode -> IO () {-# NOINLINE moveFile' #-} moveFile' inputFileP outputFileP cm = withTmpDir' inputFileP outputFileP $ \i o -> do @@ -197,100 +202,113 @@ moveFile' inputFileP outputFileP cm = moveFile o i Strict -recreateSymlink' :: PosixFilePath -> PosixFilePath -> CopyMode -> IO () +recreateSymlink' :: AbstractFilePath -> AbstractFilePath -> CopyMode -> IO () {-# NOINLINE recreateSymlink' #-} recreateSymlink' inputFileP outputFileP cm = withTmpDir' inputFileP outputFileP (\p1 p2 -> recreateSymlink p1 p2 cm) -noWritableDirPerms :: PosixFilePath -> IO () +noWritableDirPerms :: AbstractFilePath -> IO () {-# NOINLINE noWritableDirPerms #-} noWritableDirPerms path = withTmpDir path $ \p -> - setFileMode p perms - where - perms = ownerReadMode - `unionFileModes` ownerExecuteMode - `unionFileModes` groupReadMode - `unionFileModes` groupExecuteMode - `unionFileModes` otherReadMode - `unionFileModes` otherExecuteMode + setPermissions p (setOwnerWritable False newDirPerms) -noPerms :: PosixFilePath -> IO () +noPerms :: AbstractFilePath -> IO () {-# NOINLINE noPerms #-} -noPerms path = withTmpDir path $ \p -> setFileMode p nullFileMode +noPerms path = withTmpDir path $ \p -> + setPermissions p emptyPermissions -normalDirPerms :: PosixFilePath -> IO () +normalDirPerms :: AbstractFilePath -> IO () {-# NOINLINE normalDirPerms #-} normalDirPerms path = - withTmpDir path $ \p -> setFileMode p newDirPerms + withTmpDir path $ \p -> + setPermissions p newDirPerms -normalFilePerms :: PosixFilePath -> IO () +normalFilePerms :: AbstractFilePath -> IO () {-# NOINLINE normalFilePerms #-} normalFilePerms path = - withTmpDir path $ \p -> setFileMode p newFilePerms + withTmpDir path $ \p -> + setPermissions p newFilePerms -getFileType' :: PosixFilePath -> IO FileType +getFileType' :: AbstractFilePath -> IO FileType {-# NOINLINE getFileType' #-} getFileType' path = withTmpDir path getFileType -getDirsFiles' :: PosixFilePath -> IO [PosixFilePath] +getDirsFiles' :: AbstractFilePath -> IO [AbstractFilePath] {-# NOINLINE getDirsFiles' #-} getDirsFiles' path = withTmpDir path getDirsFiles -deleteFile' :: PosixFilePath -> IO () +deleteFile' :: AbstractFilePath -> IO () {-# NOINLINE deleteFile' #-} deleteFile' p = withTmpDir p deleteFile -deleteDir' :: PosixFilePath -> IO () +deleteDir' :: AbstractFilePath -> IO () {-# NOINLINE deleteDir' #-} deleteDir' p = withTmpDir p deleteDir -deleteDirRecursive' :: PosixFilePath -> IO () +deleteDirRecursive' :: AbstractFilePath -> IO () {-# NOINLINE deleteDirRecursive' #-} deleteDirRecursive' p = withTmpDir p deleteDirRecursive -canonicalizePath' :: PosixFilePath -> IO PosixFilePath +canonicalizePath' :: AbstractFilePath -> IO AbstractFilePath {-# NOINLINE canonicalizePath' #-} canonicalizePath' p = withTmpDir p canonicalizePath -writeFile' :: PosixFilePath -> ByteString -> IO () +writeFile' :: AbstractFilePath -> ByteString -> IO () {-# NOINLINE writeFile' #-} writeFile' ip bs = - withTmpDir ip $ \p -> writeFile p Nothing bs + withTmpDir ip $ \p -> writeFile p True bs -writeFileL' :: PosixFilePath -> BSL.ByteString -> IO () +writeFileL' :: AbstractFilePath -> BSL.ByteString -> IO () {-# NOINLINE writeFileL' #-} writeFileL' ip bs = - withTmpDir ip $ \p -> writeFileL p Nothing bs + withTmpDir ip $ \p -> writeFileL p True bs -appendFile' :: PosixFilePath -> ByteString -> IO () +appendFile' :: AbstractFilePath -> ByteString -> IO () {-# NOINLINE appendFile' #-} appendFile' ip bs = withTmpDir ip $ \p -> appendFile p bs -allDirectoryContents' :: PosixFilePath -> IO [PosixFilePath] +allDirectoryContents' :: AbstractFilePath -> IO [AbstractFilePath] {-# NOINLINE allDirectoryContents' #-} allDirectoryContents' ip = - withTmpDir ip $ \p -> DT.allDirectoryContents' p +#ifdef WINDOWS + -- TODO + undefined +#else + withTmpDir ip $ \(OsString p) -> fmap OsString <$> DT.allDirectoryContents' p +#endif -readFile' :: PosixFilePath -> IO ByteString +readFile' :: AbstractFilePath -> IO ByteString {-# NOINLINE readFile' #-} readFile' p = withTmpDir p readFileStrict -readFileL :: PosixFilePath -> IO BSL.ByteString +readFileL :: AbstractFilePath -> IO BSL.ByteString {-# NOINLINE readFileL #-} readFileL p = withTmpDir p readFile + +dirExists :: AbstractFilePath -> IO Bool +{-# NOINLINE dirExists #-} +#ifdef WINDOWS +dirExists fp = + -- TODO + undefined +#else +dirExists (OsString (PS fp)) = + fmap isRight $ try @SomeException $ getSymbolicLinkStatus (SBS.fromShort fp) +#endif + From 37a6ce532280457ec006480b59d1f9d726551bf2 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Sat, 30 Oct 2021 23:48:05 +0200 Subject: [PATCH 09/17] Update abstract-filepath hash --- cabal.project | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal.project b/cabal.project index 3a23a16..0509bf8 100644 --- a/cabal.project +++ b/cabal.project @@ -11,7 +11,7 @@ source-repository-package source-repository-package type: git location: https://github.com/hasufell/abstract-filepath.git - tag: 78ddb6aa24a785d14807ceaa78652f3b41dddd39 + tag: 535133eb0eda91c55e96832bcede4b65f74e3fb9 subdir: abstract-filepath abstract-filepath-types abstract-filepath-unix From bd4ee44b82c7f5356135a998bf55cf15ecf72c3a Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Sat, 30 Oct 2021 23:48:17 +0200 Subject: [PATCH 10/17] Add stack.yaml --- stack.yaml | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) create mode 100644 stack.yaml diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..7f9d28e --- /dev/null +++ b/stack.yaml @@ -0,0 +1,27 @@ +resolver: lts-18.14 + +packages: + - ./hpath + - ./hpath-directory + - ./hpath-io + - ./hpath-posix + +extra-deps: + - IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445 + - hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269 + - streamly-bytestring-0.1.3@sha256:a13ddf464ead0f4d66a8ca7f8cd60e3a8198067a2e7ff98d662023bc220ebdd2,2477 + - streamly-0.8.0@sha256:9784c80ee1ada51477520cabc4e92a0c76a6bb265f968a188f2fce818e7398e0,19654 + - shortbytestring-0.1.0.0@sha256:b65a534f03eee496efaccc8ef5ba00e966589662c2ce6a0ba38e2112f025a09c,2403 + - word16-0.1.0.0@sha256:b15315a8572aafa05cdccecbe17b22cd89d33d7bbd7a86ac2003ae58686d99af,1549 + + - git: https://github.com/hasufell/abstract-filepath.git + commit: 535133eb0eda91c55e96832bcede4b65f74e3fb9 + subdirs: + - abstract-filepath + - abstract-filepath-types + - abstract-filepath-unix + - abstract-filepath-Win32 + + - git: https://github.com/hasufell/streamly-posix.git + commit: e14e5e877c584f7d7bf2fb10cb80bc331126fd5d + From 9ef9d2329cd487552c11562329396d6f9a954f45 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Sun, 31 Oct 2021 20:57:17 +0100 Subject: [PATCH 11/17] Add windows support to hpath-directory --- cabal.project | 2 +- hpath-directory/Setup.hs | 6 +- hpath-directory/configure.ac | 42 + hpath-directory/hpath-directory.cabal | 252 ++-- hpath-directory/src/HsDirectoryConfig.h.in | 70 + hpath-directory/src/System/Directory/AFP.hs | 122 +- .../src/System/Directory/Errors.hs | 163 ++ hpath-directory/src/System/Directory/Types.hs | 43 +- .../System/Posix/PosixFilePath/Directory.hs | 73 +- .../Posix/PosixFilePath/Directory/Errors.hs | 67 +- .../Win32/WindowsFilePath/Directory.hsc | 1324 +++++++++++++++++ .../System/Win32/WindowsFilePath/utility.h | 6 + .../Win32/WindowsFilePath/windows_ext.h | 33 + hpath-directory/test/Main.hs | 3 + .../System/Directory/AFP/AppendFileSpec.hs | 2 +- .../Directory/AFP/CanonicalizePathSpec.hs | 6 +- .../CopyDirRecursiveCollectFailuresSpec.hs | 6 +- .../AFP/CopyDirRecursiveOverwriteSpec.hs | 2 +- .../Directory/AFP/CopyDirRecursiveSpec.hs | 2 +- .../Directory/AFP/CopyFileOverwriteSpec.hs | 2 +- .../test/System/Directory/AFP/CopyFileSpec.hs | 2 +- .../System/Directory/AFP/CreateSymlinkSpec.hs | 10 +- .../Directory/AFP/DeleteDirRecursiveSpec.hs | 2 +- .../System/Directory/AFP/DeleteDirSpec.hs | 2 +- .../System/Directory/AFP/DeleteFileSpec.hs | 4 +- .../System/Directory/AFP/GetDirsFilesSpec.hs | 4 +- .../Directory/AFP/MoveFileOverwriteSpec.hs | 2 +- .../test/System/Directory/AFP/MoveFileSpec.hs | 2 +- .../test/System/Directory/AFP/ReadFileSpec.hs | 2 +- .../AFP/RecreateSymlinkOverwriteSpec.hs | 2 +- .../Directory/AFP/RecreateSymlinkSpec.hs | 2 +- .../System/Directory/AFP/RenameFileSpec.hs | 2 +- .../System/Directory/AFP/WriteFileLSpec.hs | 2 +- .../System/Directory/AFP/WriteFileSpec.hs | 2 +- .../Directory}/GetFileTypeSpec.hs | 19 +- hpath-directory/test/Utils.hs | 37 +- 36 files changed, 2012 insertions(+), 310 deletions(-) create mode 100644 hpath-directory/configure.ac create mode 100644 hpath-directory/src/HsDirectoryConfig.h.in create mode 100644 hpath-directory/src/System/Directory/Errors.hs create mode 100644 hpath-directory/src/System/Win32/WindowsFilePath/Directory.hsc create mode 100644 hpath-directory/src/System/Win32/WindowsFilePath/utility.h create mode 100644 hpath-directory/src/System/Win32/WindowsFilePath/windows_ext.h rename hpath-directory/test/System/Directory/{AFP => Posix/PosixFilePath/Directory}/GetFileTypeSpec.hs (83%) diff --git a/cabal.project b/cabal.project index 0509bf8..9193904 100644 --- a/cabal.project +++ b/cabal.project @@ -11,7 +11,7 @@ source-repository-package source-repository-package type: git location: https://github.com/hasufell/abstract-filepath.git - tag: 535133eb0eda91c55e96832bcede4b65f74e3fb9 + tag: 595973d0e2027315f5c7ac865e70b43fbb2356e4 subdir: abstract-filepath abstract-filepath-types abstract-filepath-unix diff --git a/hpath-directory/Setup.hs b/hpath-directory/Setup.hs index 9a994af..54f57d6 100644 --- a/hpath-directory/Setup.hs +++ b/hpath-directory/Setup.hs @@ -1,2 +1,6 @@ +module Main (main) where + import Distribution.Simple -main = defaultMain + +main :: IO () +main = defaultMainWithHooks autoconfUserHooks diff --git a/hpath-directory/configure.ac b/hpath-directory/configure.ac new file mode 100644 index 0000000..ef04f6e --- /dev/null +++ b/hpath-directory/configure.ac @@ -0,0 +1,42 @@ +AC_INIT([Haskell directory package], [1.0], [libraries@haskell.org], [directory]) + +# Safety check: Ensure that we are in the correct source directory. +AC_CONFIG_SRCDIR([src/System/Directory/AFP.hs]) + +AC_CONFIG_HEADERS([src/HsDirectoryConfig.h]) + +# Autoconf chokes on spaces, but we may receive a path from Cabal containing +# spaces. In that case, we just ignore Cabal's suggestion. +set_with_gcc() { + case $withval in + *" "*) + AC_MSG_WARN([--with-gcc ignored due to presence of spaces]);; + *) + CC=$withval + esac +} + +# Legacy support for setting the C compiler with Cabal<1.24 +# Newer versions use Autoconf's native `CC=...` facility +AC_ARG_WITH([gcc], + [C compiler], + [set_with_gcc]) +# avoid warnings when run via Cabal +AC_ARG_WITH([compiler], + [GHC compiler], + []) +AC_PROG_CC() + +# check for specific header (.h) files that we are interested in +AC_CHECK_HEADERS([fcntl.h limits.h sys/types.h sys/stat.h time.h]) + +AC_CHECK_FUNCS([utimensat]) +AC_CHECK_FUNCS([CreateSymbolicLinkW]) +AC_CHECK_FUNCS([GetFinalPathNameByHandleW]) + +# EXTEXT is defined automatically by AC_PROG_CC; +# we just need to capture it in the header file +AC_DEFINE_UNQUOTED([EXE_EXTENSION], ["$EXEEXT"], + [Filename extension of executable files]) + +AC_OUTPUT diff --git a/hpath-directory/hpath-directory.cabal b/hpath-directory/hpath-directory.cabal index 0a7911b..a192cd5 100644 --- a/hpath-directory/hpath-directory.cabal +++ b/hpath-directory/hpath-directory.cabal @@ -1,120 +1,160 @@ -cabal-version: >=1.10 - -name: hpath-directory -version: 0.15.2.2 -synopsis: Alternative to 'directory' package with AbstractFilePath based filepaths -description: This provides a safer alternative to the 'directory' - package. - - For a more high-level version of this with - proper Path type, use 'hpath-io', which makes - use of this package. -homepage: https://github.com/hasufell/hpath -bug-reports: https://github.com/hasufell/hpath/issues -license: BSD3 -license-file: LICENSE -author: Julian Ospald -maintainer: Julian Ospald -copyright: Julian Ospald 2020 -category: Filesystem -build-type: Simple -extra-source-files: CHANGELOG.md - ./src/System/Directory/AFP.hs -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 +cabal-version: >=1.10 +name: hpath-directory +version: 0.15.2.2 +synopsis: + Alternative to 'directory' package with AbstractFilePath based filepaths + +description: + This provides a safer alternative to the 'directory' + package. + For a more high-level version of this with + proper Path type, use 'hpath-io', which makes + use of this package. + +homepage: https://github.com/hasufell/hpath +bug-reports: https://github.com/hasufell/hpath/issues +license: BSD3 +license-file: LICENSE +author: Julian Ospald +maintainer: Julian Ospald +copyright: Julian Ospald 2020 +category: Filesystem +build-type: Configure +extra-tmp-files: + autom4te.cache + config.log + config.status + src/HsDirectoryConfig.h + +extra-source-files: + ./src/HsDirectoryConfig.h.in + ./src/System/Directory/AFP.hs + ./src/System/Win32/WindowsFilePath/*.h + CHANGELOG.md + +tested-with: + GHC ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1 library if os(windows) - cpp-options: -DWINDOWS - exposed-modules: System.Directory.AFP - System.Directory.Types - System.Posix.PosixFilePath.Directory - System.Posix.PosixFilePath.Directory.Errors + cpp-options: -DWINDOWS + exposed-modules: System.Win32.WindowsFilePath.Directory + build-depends: + abstract-filepath-Win32 + , shortbytestring + , Win32 + + include-dirs: src + + else + exposed-modules: + System.Posix.PosixFilePath.Directory + System.Posix.PosixFilePath.Directory.Errors + + build-depends: + abstract-filepath-unix + , hpath-posix >=0.14.0 + , streamly-posix >=0.1.0.2 + , unix >=2.5 + , unix-bytestring >=0.3 + + exposed-modules: + System.Directory.AFP + System.Directory.Errors + System.Directory.Types + -- other-modules: -- other-extensions: - build-depends: base >= 4.8 && <5 - , IfElse - , abstract-filepath - , abstract-filepath-types - , abstract-filepath-unix - , bytestring >= 0.10 - , exceptions >= 0.10 - , hpath-posix >= 0.14.0 - , safe-exceptions >= 0.1 - , streamly >= 0.7 - , streamly-bytestring >= 0.1.2 - , streamly-posix >= 0.1.0.2 - , time >= 1.8 - , transformers - , unix >= 2.5 - , unix-bytestring >= 0.3 - , utf8-string - if impl(ghc < 8.0) - build-depends: - fail >= 4.9 + build-depends: + abstract-filepath + , abstract-filepath-types + , base >=4.8 && <5 + , bytestring >=0.10 + , exceptions >=0.10 + , IfElse + , safe-exceptions >=0.1 + , split + , streamly >=0.7 + , streamly-bytestring >=0.1.2 + , time >=1.8 + , transformers + , utf8-string + + if impl(ghc <8.0) + build-depends: fail >=4.9 - hs-source-dirs: src - default-language: Haskell2010 + hs-source-dirs: src + default-language: Haskell2010 default-extensions: PackageImports - GHC-Options: -Wall + ghc-options: -Wall test-suite spec if os(windows) - cpp-options: -DWINDOWS - Type: exitcode-stdio-1.0 - Default-Language: Haskell2010 - Hs-Source-Dirs: test - Main-Is: Main.hs + cpp-options: -DWINDOWS + + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + main-is: Main.hs other-modules: - System.Directory.AFP.AppendFileSpec - System.Directory.AFP.CanonicalizePathSpec - System.Directory.AFP.CopyDirRecursiveCollectFailuresSpec - System.Directory.AFP.CopyDirRecursiveOverwriteSpec - System.Directory.AFP.CopyDirRecursiveSpec - System.Directory.AFP.CopyFileOverwriteSpec - System.Directory.AFP.CopyFileSpec - System.Directory.AFP.CreateDirIfMissingSpec - System.Directory.AFP.CreateDirRecursiveSpec - System.Directory.AFP.CreateDirSpec - System.Directory.AFP.CreateRegularFileSpec - System.Directory.AFP.CreateSymlinkSpec - System.Directory.AFP.DeleteDirRecursiveSpec - System.Directory.AFP.DeleteDirSpec - System.Directory.AFP.DeleteFileSpec - System.Directory.AFP.GetDirsFilesSpec - System.Directory.AFP.GetFileTypeSpec - System.Directory.AFP.MoveFileOverwriteSpec - System.Directory.AFP.MoveFileSpec - System.Directory.AFP.ReadFileSpec - System.Directory.AFP.RecreateSymlinkOverwriteSpec - System.Directory.AFP.RecreateSymlinkSpec - System.Directory.AFP.RenameFileSpec - System.Directory.AFP.ToAbsSpec - System.Directory.AFP.WriteFileLSpec - System.Directory.AFP.WriteFileSpec - Spec - Utils - GHC-Options: -Wall - Build-Depends: abstract-filepath - , abstract-filepath-unix - , base - , HUnit - , IfElse - , bytestring >= 0.10.0.0 - , hpath-directory - , hpath-filepath >= 0.10 - , hpath-posix >= 0.13 - , hspec >= 1.3 - , process - , time >= 1.8 - , unix - , unix-bytestring - , utf8-string - build-tool-depends: hspec-discover:hspec-discover + Spec + System.Directory.AFP.AppendFileSpec + System.Directory.AFP.CanonicalizePathSpec + System.Directory.AFP.CopyDirRecursiveCollectFailuresSpec + System.Directory.AFP.CopyDirRecursiveOverwriteSpec + System.Directory.AFP.CopyDirRecursiveSpec + System.Directory.AFP.CopyFileOverwriteSpec + System.Directory.AFP.CopyFileSpec + System.Directory.AFP.CreateDirIfMissingSpec + System.Directory.AFP.CreateDirRecursiveSpec + System.Directory.AFP.CreateDirSpec + System.Directory.AFP.CreateRegularFileSpec + System.Directory.AFP.CreateSymlinkSpec + System.Directory.AFP.DeleteDirRecursiveSpec + System.Directory.AFP.DeleteDirSpec + System.Directory.AFP.DeleteFileSpec + System.Directory.AFP.GetDirsFilesSpec + System.Directory.AFP.MoveFileOverwriteSpec + System.Directory.AFP.MoveFileSpec + System.Directory.AFP.ReadFileSpec + System.Directory.AFP.RecreateSymlinkOverwriteSpec + System.Directory.AFP.RecreateSymlinkSpec + System.Directory.AFP.RenameFileSpec + System.Directory.AFP.ToAbsSpec + System.Directory.AFP.WriteFileLSpec + System.Directory.AFP.WriteFileSpec + System.Directory.Posix.PosixFilePath.Directory.GetFileTypeSpec + Utils + + ghc-options: -Wall + + if os(windows) + cpp-options: -DWINDOWS + build-depends: + abstract-filepath-Win32 + , Win32 + + else + build-depends: + abstract-filepath-unix + , hpath-posix >=0.13 + , unix + , unix-bytestring + + build-depends: + abstract-filepath + , abstract-filepath-types + , base + , bytestring >=0.10.0.0 + , hpath-directory + , hspec >=1.3 + , HUnit + , IfElse + , process + , time >=1.8 + , utf8-string + + build-tool-depends: hspec-discover:hspec-discover -any default-extensions: PackageImports source-repository head diff --git a/hpath-directory/src/HsDirectoryConfig.h.in b/hpath-directory/src/HsDirectoryConfig.h.in new file mode 100644 index 0000000..81a8549 --- /dev/null +++ b/hpath-directory/src/HsDirectoryConfig.h.in @@ -0,0 +1,70 @@ +/* src/HsDirectoryConfig.h.in. Generated from configure.ac by autoheader. */ + +/* Filename extension of executable files */ +#undef EXE_EXTENSION + +/* Define to 1 if you have the `CreateSymbolicLinkW' function. */ +#undef HAVE_CREATESYMBOLICLINKW + +/* Define to 1 if you have the header file. */ +#undef HAVE_FCNTL_H + +/* Define to 1 if you have the `GetFinalPathNameByHandleW' function. */ +#undef HAVE_GETFINALPATHNAMEBYHANDLEW + +/* Define to 1 if you have the header file. */ +#undef HAVE_INTTYPES_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_LIMITS_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_MEMORY_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_STDINT_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_STDLIB_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_STRINGS_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_STRING_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_STAT_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_TYPES_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_TIME_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_UNISTD_H + +/* Define to 1 if you have the `utimensat' function. */ +#undef HAVE_UTIMENSAT + +/* Define to the address where bug reports for this package should be sent. */ +#undef PACKAGE_BUGREPORT + +/* Define to the full name of this package. */ +#undef PACKAGE_NAME + +/* Define to the full name and version of this package. */ +#undef PACKAGE_STRING + +/* Define to the one symbol short name of this package. */ +#undef PACKAGE_TARNAME + +/* Define to the home page for this package. */ +#undef PACKAGE_URL + +/* Define to the version of this package. */ +#undef PACKAGE_VERSION + +/* Define to 1 if you have the ANSI C header files. */ +#undef STDC_HEADERS diff --git a/hpath-directory/src/System/Directory/AFP.hs b/hpath-directory/src/System/Directory/AFP.hs index 1bafb6e..81f7508 100644 --- a/hpath-directory/src/System/Directory/AFP.hs +++ b/hpath-directory/src/System/Directory/AFP.hs @@ -29,6 +29,7 @@ module System.Directory.AFP , readFile , readFileStrict , readFileStream + , readSymbolicLink -- * File writing , writeFile , writeFileL @@ -47,13 +48,14 @@ module System.Directory.AFP , setModificationTimeHiRes -- * Directory reading , getDirsFiles + , getDirsFilesRec , getDirsFiles' + , getDirsFilesRec' , getDirsFilesStream + , getDirsFilesStreamRec -- * CWD , getCurrentDirectory , setCurrentDirectory - -- * Filetype operations - , getFileType -- * Permissions , getPermissions , setPermissions @@ -98,10 +100,10 @@ import Control.Exception.Safe ( MonadCatch , MonadMask ) + ---------------------- + --[ Abstract types ]-- + ---------------------- - ------------------------ - --[ File Permissions ]-- - ------------------------ @@ -114,6 +116,13 @@ data Permissions } deriving (Eq, Ord, Read, Show) + + + ------------------------ + --[ File Permissions ]-- + ------------------------ + + emptyPermissions :: Permissions emptyPermissions = Permissions { readable = False, @@ -171,8 +180,17 @@ newDirPerms = Permissions { -- * 'isDoesNotExistError' if the file or directory does not exist. getPermissions :: AbstractFilePath -> IO Permissions #ifdef WINDOWS -getPermissions _ = - undefined +getPermissions (OsString path) = do + t <- Dir.getFileType path + let isDir = t == Dir.Directory || t == Dir.DirectoryLink + w <- Dir.isWritable path + x <- Dir.isExecutable path + pure Permissions + { readable = True + , writable = w + , executable = x && not isDir + , searchable = isDir + } #else getPermissions (OsString (PS path')) = do let path = SBS.fromShort path' @@ -191,7 +209,8 @@ getPermissions (OsString (PS path')) = do setPermissions :: AbstractFilePath -> Permissions -> IO () #ifdef WINDOWS -setPermissions = undefined +setPermissions (OsString path) Permissions{writable = w} = do + Dir.setFilePermissions path (Dir.setWriteMode w 0) #else setPermissions (OsString (PS path')) (Permissions r w e s) = do let path = SBS.fromShort path' @@ -393,7 +412,6 @@ easyDelete (OsString p) = Dir.easyDelete p - --------------------- --[ File Creation ]-- --------------------- @@ -421,7 +439,12 @@ createRegularFile (OsString destBS) = Dir.createRegularFile Dir.newFilePerms des -- - `NoSuchThing` if any of the parent components of the path -- do not exist createDir :: AbstractFilePath -> IO () -createDir (OsString destBS) = Dir.createDir Dir.newDirPerms destBS +createDir (OsString destBS) = +#if WINDOWS + Dir.createDir destBS +#else + Dir.createDir Dir.newDirPerms destBS +#endif -- |Create an empty directory at the given directory with the given filename. -- @@ -431,7 +454,12 @@ createDir (OsString destBS) = Dir.createDir Dir.newDirPerms destBS -- - `NoSuchThing` if any of the parent components of the path -- do not exist createDirIfMissing :: AbstractFilePath -> IO () -createDirIfMissing (OsString destBS) = Dir.createDirIfMissing Dir.newDirPerms destBS +createDirIfMissing (OsString destBS) = +#if WINDOWS + Dir.createDirIfMissing destBS +#else + Dir.createDirIfMissing Dir.newDirPerms destBS +#endif -- |Create an empty directory at the given directory with the given filename. @@ -453,7 +481,12 @@ createDirIfMissing (OsString destBS) = Dir.createDirIfMissing Dir.newDirPerms de -- - `AlreadyExists` if destination already exists and -- is *not* a directory createDirRecursive :: AbstractFilePath -> IO () -createDirRecursive (OsString p) = Dir.createDirRecursive Dir.newDirPerms p +createDirRecursive (OsString p) = +#if WINDOWS + Dir.createDirRecursive p +#else + Dir.createDirRecursive Dir.newDirPerms p +#endif -- |Create a symlink. @@ -468,8 +501,15 @@ createDirRecursive (OsString p) = Dir.createDirRecursive Dir.newDirPerms p -- Note: calls `symlink` createSymlink :: AbstractFilePath -- ^ destination file -> AbstractFilePath -- ^ path the symlink points to + -> Bool -- ^ whether this is a dir (irrelevant on posix) -> IO () -createSymlink (OsString destBS) (OsString sympoint) = Dir.createSymlink destBS sympoint +#if WINDOWS +createSymlink (OsString destBS) (OsString sympoint) dir = + Dir.createSymlink destBS sympoint dir +#else +createSymlink (OsString destBS) (OsString sympoint) _ = + Dir.createSymlink destBS sympoint +#endif @@ -590,6 +630,9 @@ readFileStream :: AbstractFilePath -> IO (SerialT IO (Array Word8)) readFileStream (OsString fp) = Dir.readFileStream fp +-- | Read the target of a symbolic link. +readSymbolicLink :: AbstractFilePath -> IO AbstractFilePath +readSymbolicLink (OsString fp) = OsString <$> Dir.readSymbolicLink fp -------------------- @@ -610,7 +653,12 @@ writeFile :: AbstractFilePath -> Bool -- ^ True if file must exist -> BS.ByteString -> IO () -writeFile (OsString fp) nocreat bs = Dir.writeFile fp (if nocreat then Nothing else Just Dir.newFilePerms) bs +writeFile (OsString fp) nocreat bs = +#if WINDOWS + Dir.writeFile fp nocreat bs +#else + Dir.writeFile fp (if nocreat then Nothing else Just Dir.newFilePerms) bs +#endif -- |Write a given lazy ByteString to a file, truncating the file beforehand. @@ -628,7 +676,12 @@ writeFileL :: AbstractFilePath -> Bool -- ^ True if file must exist -> L.ByteString -> IO () -writeFileL (OsString fp) nocreat lbs = Dir.writeFileL fp (if nocreat then Nothing else Just Dir.newFilePerms) lbs +writeFileL (OsString fp) nocreat lbs = +#if WINDOWS + Dir.writeFileL fp nocreat lbs +#else + Dir.writeFileL fp (if nocreat then Nothing else Just Dir.newFilePerms) lbs +#endif -- |Append a given ByteString to a file. @@ -727,7 +780,12 @@ setModificationTime :: AbstractFilePath -> UTCTime -> IO () setModificationTime (OsString bs) t = Dir.setModificationTime bs t setModificationTimeHiRes :: AbstractFilePath -> POSIXTime -> IO () -setModificationTimeHiRes (OsString bs) t = Dir.setModificationTimeHiRes bs t +setModificationTimeHiRes (OsString bs) t = +#ifdef WINDOWS + Dir.setModificationTimeHiRes bs (Dir.posixToWindowsTime t) +#else + Dir.setModificationTimeHiRes bs t +#endif @@ -753,6 +811,11 @@ getDirsFiles :: AbstractFilePath -- ^ dir to read getDirsFiles (OsString p) = fmap OsString <$> Dir.getDirsFiles p +getDirsFilesRec :: AbstractFilePath -- ^ dir to read + -> IO [AbstractFilePath] +getDirsFilesRec (OsString p) = fmap OsString <$> Dir.getDirsFilesRec p + + -- | Like 'getDirsFiles', but returns the filename only, instead -- of prepending the base path. getDirsFiles' :: AbstractFilePath -- ^ dir to read @@ -760,6 +823,17 @@ getDirsFiles' :: AbstractFilePath -- ^ dir to read getDirsFiles' (OsString fp) = fmap OsString <$> Dir.getDirsFiles' fp +getDirsFilesRec' :: AbstractFilePath -- ^ dir to read + -> IO [AbstractFilePath] +getDirsFilesRec' (OsString p) = fmap OsString <$> Dir.getDirsFilesRec' p + + +getDirsFilesStreamRec :: (MonadCatch m, MonadAsync m, MonadMask m) + => AbstractFilePath + -> IO (SerialT m AbstractFilePath) +getDirsFilesStreamRec (OsString fp) = fmap OsString <$> Dir.getDirsFilesStreamRec fp + + -- | Like 'getDirsFiles'', except returning a Stream. getDirsFilesStream :: (MonadCatch m, MonadAsync m, MonadMask m) => AbstractFilePath @@ -779,22 +853,6 @@ setCurrentDirectory (OsString fp) = Dir.setCurrentDirectory fp - --------------------------- - --[ FileType operations ]-- - --------------------------- - - --- |Get the file type of the file located at the given path. Does --- not follow symbolic links. --- --- Throws: --- --- - `NoSuchThing` if the file does not exist --- - `PermissionDenied` if any part of the path is not accessible -getFileType :: AbstractFilePath -> IO FileType -getFileType (OsString fp) = Dir.getFileType fp - - -------------- --[ Others ]-- diff --git a/hpath-directory/src/System/Directory/Errors.hs b/hpath-directory/src/System/Directory/Errors.hs new file mode 100644 index 0000000..94e3668 --- /dev/null +++ b/hpath-directory/src/System/Directory/Errors.hs @@ -0,0 +1,163 @@ +-- | +-- Module : System.Directory.Errors +-- Copyright : © 2016 Julian Ospald +-- License : BSD3 +-- +-- Maintainer : Julian Ospald +-- Stability : experimental +-- Portability : portable +-- +-- Provides error handling. + +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module System.Directory.Errors + ( + -- * Types + HPathIOException(..) + , RecursiveFailureHint(..) + + -- * Exception identifiers + , isSameFile + , isDestinationInSource + , isRecursiveFailure + , isReadContentsFailed + , isCreateDirFailed + , isCopyFileFailed + , isRecreateSymlinkFailed + + -- * Error handling functions + , handleIOError + , hideError + , bracketeer + , reactOnError + ) + where + + +import Control.Applicative + ( + (<$>) + ) +import Control.Exception.Safe hiding (handleIOError) +import Control.Monad + ( + forM + , when + ) +import Control.Monad.IfElse + ( + whenM + ) +import Foreign.C.Error + ( + getErrno + , Errno + ) +import GHC.IO.Exception + ( + IOErrorType + ) +import System.IO.Error + ( + alreadyExistsErrorType + , ioeGetErrorType + , mkIOError + ) +import System.Directory.Types + + + + +toConstr :: HPathIOException -> String +toConstr SameFile {} = "SameFile" +toConstr DestinationInSource {} = "DestinationInSource" +toConstr RecursiveFailure {} = "RecursiveFailure" + + + + + + ----------------------------- + --[ Exception identifiers ]-- + ----------------------------- + + +isSameFile, isDestinationInSource, isRecursiveFailure :: HPathIOException -> Bool +isSameFile ex = toConstr (ex :: HPathIOException) == toConstr (SameFile mempty mempty) +isDestinationInSource ex = toConstr (ex :: HPathIOException) == (toConstr $ DestinationInSource mempty mempty) +isRecursiveFailure ex = toConstr (ex :: HPathIOException) == (toConstr $ RecursiveFailure mempty) + + +isReadContentsFailed, isCreateDirFailed, isCopyFileFailed, isRecreateSymlinkFailed ::RecursiveFailureHint -> Bool +isReadContentsFailed ReadContentsFailed{} = True +isReadContentsFailed _ = False +isCreateDirFailed CreateDirFailed{} = True +isCreateDirFailed _ = False +isCopyFileFailed CopyFileFailed{} = True +isCopyFileFailed _ = False +isRecreateSymlinkFailed RecreateSymlinkFailed{} = True +isRecreateSymlinkFailed _ = False + + + + + + -------------------------------- + --[ Error handling functions ]-- + -------------------------------- + + + + +-- |Like `catchIOError`, with arguments swapped. +handleIOError :: (IOError -> IO a) -> IO a -> IO a +handleIOError = flip catchIOError + + +hideError :: IOErrorType -> IO () -> IO () +hideError err = handleIO (\e -> if err == ioeGetErrorType e then pure () else ioError e) + + +-- |Like `bracket`, but allows to have different clean-up +-- actions depending on whether the in-between computation +-- has raised an exception or not. +bracketeer :: IO a -- ^ computation to run first + -> (a -> IO b) -- ^ computation to run last, when + -- no exception was raised + -> (a -> IO b) -- ^ computation to run last, + -- when an exception was raised + -> (a -> IO c) -- ^ computation to run in-between + -> IO c +bracketeer before after afterEx thing = + mask $ \restore -> do + a <- before + r <- restore (thing a) `onException` afterEx a + _ <- after a + return r + + +reactOnError :: IO a + -> [(IOErrorType, IO a)] -- ^ reaction on IO errors + -> [(HPathIOException, IO a)] -- ^ reaction on HPathIOException + -> IO a +reactOnError a ios fmios = + a `catches` [iohandler, fmiohandler] + where + iohandler = Handler $ + \(ex :: IOException) -> + foldr (\(t, a') y -> if ioeGetErrorType ex == t + then a' + else y) + (throwIO ex) + ios + fmiohandler = Handler $ + \(ex :: HPathIOException) -> + foldr (\(t, a') y -> if toConstr ex == toConstr t + then a' + else y) + (throwIO ex) + fmios + + diff --git a/hpath-directory/src/System/Directory/Types.hs b/hpath-directory/src/System/Directory/Types.hs index 5050fb1..6c7dc69 100644 --- a/hpath-directory/src/System/Directory/Types.hs +++ b/hpath-directory/src/System/Directory/Types.hs @@ -7,38 +7,6 @@ import AFP.AbstractFilePath.Types -toConstr :: HPathIOException -> String -toConstr SameFile {} = "SameFile" -toConstr DestinationInSource {} = "DestinationInSource" -toConstr RecursiveFailure {} = "RecursiveFailure" - - - - - - ----------------------------- - --[ Exception identifiers ]-- - ----------------------------- - - -isSameFile, isDestinationInSource, isRecursiveFailure :: HPathIOException -> Bool -isSameFile ex = toConstr (ex :: HPathIOException) == toConstr (SameFile mempty mempty) -isDestinationInSource ex = toConstr (ex :: HPathIOException) == (toConstr $ DestinationInSource mempty mempty) -isRecursiveFailure ex = toConstr (ex :: HPathIOException) == (toConstr $ RecursiveFailure mempty) - - -isReadContentsFailed, isCreateDirFailed, isCopyFileFailed, isRecreateSymlinkFailed ::RecursiveFailureHint -> Bool -isReadContentsFailed ReadContentsFailed{} = True -isReadContentsFailed _ = False -isCreateDirFailed CreateDirFailed{} = True -isCreateDirFailed _ = False -isCopyFileFailed CopyFileFailed{} = True -isCopyFileFailed _ = False -isRecreateSymlinkFailed RecreateSymlinkFailed{} = True -isRecreateSymlinkFailed _ = False - - - ------------- --[ Types ]-- @@ -68,15 +36,6 @@ data RecursiveFailureHint = ReadContentsFailed AbstractFilePath AbstractFileP instance Exception HPathIOException -data FileType = Directory - | RegularFile - | SymbolicLink - | BlockDevice - | CharacterDevice - | NamedPipe - | Socket - deriving (Eq, Show) - -- |The error mode for recursive operations. @@ -92,6 +51,7 @@ data FileType = Directory -- of the collected exceptions. data RecursiveErrorMode = FailEarly | CollectFailures + deriving (Eq, Show) -- |The mode for copy and file moves. @@ -99,4 +59,5 @@ data RecursiveErrorMode = FailEarly -- shortcut. data CopyMode = Strict -- ^ fail if any target exists | Overwrite -- ^ overwrite targets + deriving (Eq, Show) diff --git a/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs b/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs index b3c0917..05a6c9a 100644 --- a/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs +++ b/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs @@ -47,7 +47,7 @@ module System.Posix.PosixFilePath.Directory , deleteDir , deleteDirRecursive , easyDelete - -- * File opening + -- * File opening (posix specific) , openFile , executeFile -- * File creation @@ -63,6 +63,7 @@ module System.Posix.PosixFilePath.Directory , readFile , readFileStrict , readFileStream + , readSymbolicLink -- * File writing , writeFile , writeFileL @@ -84,8 +85,11 @@ module System.Posix.PosixFilePath.Directory , setModificationTimeHiRes -- * Directory reading , getDirsFiles + , getDirsFilesRec , getDirsFiles' + , getDirsFilesRec' , getDirsFilesStream + , getDirsFilesStreamRec -- * CWD , getCurrentDirectory , setCurrentDirectory @@ -163,7 +167,11 @@ import qualified Streamly.Internal.Data.Array.Stream.Foreign import qualified Streamly.Internal.Memory.ArrayStream as AS #endif +import qualified Streamly.Internal.Data.Stream.IsStream.Expand as SE +import Streamly.Internal.Data.Fold.Type (Fold) import qualified Streamly.Prelude as S +import Control.Monad.IO.Class ( liftIO + ) import qualified System.IO as SIO import System.IO.Error ( catchIOError , ioeGetErrorType @@ -191,7 +199,6 @@ import System.Posix.Files.PosixString ( createSymbolicLink , ownerModes , ownerReadMode , ownerWriteMode - , readSymbolicLink , removeLink , rename , setFileMode @@ -216,7 +223,24 @@ import System.Posix.Time import AFP.AbstractFilePath.Posix import AFP.OsString.Internal.Types import System.Directory.Types +import System.Directory.Errors + + + + + ---------------------------- + --[ Posix specific types ]-- + ---------------------------- + +data FileType = Directory + | RegularFile + | SymbolicLink + | BlockDevice + | CharacterDevice + | NamedPipe + | Socket + deriving (Eq, Show) @@ -871,6 +895,10 @@ readFileStream fp = do pure stream +-- | Read the target of a symbolic link. +readSymbolicLink :: PosixFilePath -> IO PosixString +readSymbolicLink = PF.readSymbolicLink + -------------------- @@ -911,12 +939,20 @@ writeFileL :: PosixFilePath -> Maybe FileMode -- ^ if Nothing, file must exist -> L.ByteString -> IO () -writeFileL fp fmode lbs = do +writeFileL fp fmode lbs = writeFileStream fp fmode FH.writeChunks (SL.toChunks lbs) + + +writeFileStream :: PosixFilePath + -> Maybe FileMode -- ^ if Nothing, file must exist + -> (SIO.Handle -> Fold IO a ()) -- ^ writer + -> SerialT IO a -- ^ stream + -> IO () +writeFileStream fp fmode writer stream = do handle <- bracketOnError (openFd fp SPI.WriteOnly [SPDF.oTrunc] fmode) (SPI.closeFd) $ SPI.fdToHandle finally (streamlyCopy handle) (SIO.hClose handle) - where streamlyCopy tH = S.fold (FH.writeChunks tH) $ SL.toChunks lbs + where streamlyCopy tH = S.fold (writer tH) stream -- |Append a given ByteString to a file. @@ -1105,6 +1141,13 @@ getDirsFiles p = do pure $ fmap (p ) contents +getDirsFilesRec :: PosixFilePath -- ^ dir to read + -> IO [PosixFilePath] +getDirsFilesRec p = do + contents <- getDirsFilesRec' p + pure $ fmap (p ) contents + + -- | Like 'getDirsFiles', but returns the filename only, instead -- of prepending the base path. getDirsFiles' :: PosixFilePath -- ^ dir to read @@ -1112,6 +1155,28 @@ getDirsFiles' :: PosixFilePath -- ^ dir to read getDirsFiles' fp = getDirsFilesStream fp >>= S.toList +getDirsFilesRec' :: PosixFilePath -- ^ dir to read + -> IO [PosixFilePath] +getDirsFilesRec' fp = getDirsFilesStreamRec fp >>= S.toList + + +getDirsFilesStreamRec :: (MonadCatch m, MonadAsync m, MonadMask m) + => PosixFilePath + -> IO (SerialT m PosixFilePath) +getDirsFilesStreamRec fp = do + stream <- getDirsFilesStream fp + pure $ S.concatMapM inner stream + where + inner f = do + let nextFile = fp f + isdir <- liftIO $ doesDirectoryExist nextFile + if isdir + then do + stream <- liftIO (getDirsFilesStreamRec nextFile) + pure $ SE.append (pure f) (fmap (f ) stream) + else pure (pure f) + + -- | Like 'getDirsFiles'', except returning a Stream. getDirsFilesStream :: (MonadCatch m, MonadAsync m, MonadMask m) => PosixFilePath diff --git a/hpath-directory/src/System/Posix/PosixFilePath/Directory/Errors.hs b/hpath-directory/src/System/Posix/PosixFilePath/Directory/Errors.hs index 9a7e6d9..6862841 100644 --- a/hpath-directory/src/System/Posix/PosixFilePath/Directory/Errors.hs +++ b/hpath-directory/src/System/Posix/PosixFilePath/Directory/Errors.hs @@ -18,15 +18,6 @@ module System.Posix.PosixFilePath.Directory.Errors HPathIOException(..) , RecursiveFailureHint(..) - -- * Exception identifiers - , isSameFile - , isDestinationInSource - , isRecursiveFailure - , isReadContentsFailed - , isCreateDirFailed - , isCopyFileFailed - , isRecreateSymlinkFailed - -- * Path based functions , throwFileDoesExist , throwDirDoesExist @@ -37,10 +28,6 @@ module System.Posix.PosixFilePath.Directory.Errors -- * Error handling functions , catchErrno , rethrowErrnoAs - , handleIOError - , hideError - , bracketeer - , reactOnError ) where @@ -49,7 +36,7 @@ import Control.Applicative ( (<$>) ) -import Control.Exception.Safe hiding (handleIOError) +import Control.Exception.Safe import Control.Monad ( forM @@ -211,55 +198,3 @@ rethrowErrnoAs :: Exception e -> IO a rethrowErrnoAs en fmex action = catchErrno en action (throwIO fmex) - - --- |Like `catchIOError`, with arguments swapped. -handleIOError :: (IOError -> IO a) -> IO a -> IO a -handleIOError = flip catchIOError - - -hideError :: IOErrorType -> IO () -> IO () -hideError err = handleIO (\e -> if err == ioeGetErrorType e then pure () else ioError e) - - --- |Like `bracket`, but allows to have different clean-up --- actions depending on whether the in-between computation --- has raised an exception or not. -bracketeer :: IO a -- ^ computation to run first - -> (a -> IO b) -- ^ computation to run last, when - -- no exception was raised - -> (a -> IO b) -- ^ computation to run last, - -- when an exception was raised - -> (a -> IO c) -- ^ computation to run in-between - -> IO c -bracketeer before after afterEx thing = - mask $ \restore -> do - a <- before - r <- restore (thing a) `onException` afterEx a - _ <- after a - return r - - -reactOnError :: IO a - -> [(IOErrorType, IO a)] -- ^ reaction on IO errors - -> [(HPathIOException, IO a)] -- ^ reaction on HPathIOException - -> IO a -reactOnError a ios fmios = - a `catches` [iohandler, fmiohandler] - where - iohandler = Handler $ - \(ex :: IOException) -> - foldr (\(t, a') y -> if ioeGetErrorType ex == t - then a' - else y) - (throwIO ex) - ios - fmiohandler = Handler $ - \(ex :: HPathIOException) -> - foldr (\(t, a') y -> if toConstr ex == toConstr t - then a' - else y) - (throwIO ex) - fmios - - diff --git a/hpath-directory/src/System/Win32/WindowsFilePath/Directory.hsc b/hpath-directory/src/System/Win32/WindowsFilePath/Directory.hsc new file mode 100644 index 0000000..8a75694 --- /dev/null +++ b/hpath-directory/src/System/Win32/WindowsFilePath/Directory.hsc @@ -0,0 +1,1324 @@ +-- | +-- Module : System.Win32.WindowsFilePath.Directory +-- Copyright : © 2020 Julian Ospald +-- License : BSD3 +-- +-- Maintainer : Julian Ospald +-- Stability : experimental +-- Portability : portable +-- +-- This module provides IO related file operations like +-- copy, delete, move and so on, similar to the 'directory' package. +-- +-- Some of these operations are due to their nature __not atomic__, which +-- means they may do multiple syscalls which form one context. Some +-- of them also have to examine the filetypes explicitly before the +-- syscalls, so a reasonable decision can be made. That means +-- the result is undefined if another process changes that context +-- while the non-atomic operation is still happening. However, where +-- possible, as few syscalls as possible are used and the underlying +-- exception handling is kept. +-- +-- Note: `BlockDevice`, `CharacterDevice`, `NamedPipe` and `Socket` +-- are ignored by some of the more high-level functions (like `easyCopy`). +-- For other functions (like `copyFile`), the behavior on these file types is +-- unreliable/unsafe. Check the documentation of those functions for details. +-- +-- Import as: +-- > import System.Win32.WindowsFilePath.Directory + +{-# LANGUAGE CPP #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE FlexibleContexts #-} -- streamly + +module System.Win32.WindowsFilePath.Directory + ( + -- * Types + FileType(..) + , RecursiveErrorMode(..) + , CopyMode(..) + -- * File copying + , copyDirRecursive + , recreateSymlink + , copyFile + , easyCopy + -- * File deletion + , deleteFile + , deleteDir + , deleteDirRecursive + , easyDelete + -- * File creation + , createRegularFile + , createDir + , createDirIfMissing + , createDirRecursive + , createSymlink + -- * File renaming/moving + , renameFile + , moveFile + -- * File reading + , readFile + , readFileStrict + , readFileStream + , readSymbolicLink + -- * File writing + , writeFile + , writeFileL + , appendFile + -- * File permissions + , setWriteMode + , setFilePermissions + , newFilePerms + -- * File checks + , doesExist + , doesFileExist + , doesDirectoryExist + , isReadable + , isWritable + , isExecutable + , canOpenDirectory + -- * File times + , getModificationTime + , setModificationTime + , setModificationTimeHiRes + , windowsToPosixTime + , posixToWindowsTime + -- * Directory reading + , getDirsFiles + , getDirsFilesRec + , getDirsFiles' + , getDirsFilesRec' + , getDirsFilesStream + , getDirsFilesStreamRec + -- * CWD + , getCurrentDirectory + , setCurrentDirectory + -- * Filetype operations + , getFileType + -- * Others + , canonicalizePath + , toAbs + ) +where + +#include +#if defined(mingw32_HOST_OS) +##if defined(i386_HOST_ARCH) +## define WINAPI stdcall +##elif defined(x86_64_HOST_ARCH) +## define WINAPI ccall +##else +## error unknown architecture +##endif +#include +#include +#include +#include + +import Control.Exception.Safe ( IOException + , MonadCatch + , MonadMask + , bracket + , bracketOnError + , throwIO + , finally + , handleIO + ) +#if MIN_VERSION_base(4,9,0) +import qualified Control.Monad.Fail as Fail +#else +import qualified Control.Monad as Fail +#endif +import Control.Monad ( when + ) +import Control.Monad.IO.Class ( liftIO + , MonadIO + ) +import Control.Monad.IfElse ( unlessM ) +import qualified Data.ByteString as BS +import Data.ByteString ( ByteString ) +import qualified Data.ByteString.Lazy as L +import Data.Foldable ( for_ ) +import Data.String +import Data.List.Split +import Data.IORef ( IORef + , modifyIORef + , newIORef + ) +import Data.Time.Clock +import Data.Time.Clock.POSIX ( posixSecondsToUTCTime + , utcTimeToPOSIXSeconds + , POSIXTime + ) +import Data.Word ( Word8 ) +import GHC.IO.Exception ( IOErrorType(..) ) +import Prelude hiding ( appendFile + , readFile + , writeFile + ) +import Streamly.Prelude ( SerialT, MonadAsync ) +import Streamly.Data.Array.Foreign +import qualified Streamly.External.ByteString as SB +import qualified Streamly.External.ByteString.Lazy + as SL +import qualified Streamly.FileSystem.Handle as FH +import qualified Streamly.Internal.Data.Unfold as SU +import qualified Streamly.Internal.Data.Array.Stream.Foreign + as AS +import qualified Streamly.Internal.Data.Stream.StreamD.Type + as D +import Streamly.Internal.Data.Unfold.Type +import qualified Streamly.Internal.Data.Stream.IsStream.Expand as SE +import Streamly.Internal.Data.Fold.Type (Fold) +import Streamly.Internal.Data.Array.Stream.Foreign (arraysOf) +import Streamly.Internal.Data.Array.Foreign.Mut.Type (defaultChunkSize) +import qualified Streamly.Prelude as S +import qualified System.IO as SIO + +import AFP.AbstractFilePath.Windows +import AFP.OsString.Internal.Types +import System.Directory.Types +import System.Directory.Errors +import Data.Bits +import qualified System.Win32 as Win32 +import qualified System.Win32.WindowsString.File as WS +import qualified System.Win32.WindowsString.Info as WS +import qualified System.Win32.WindowsString.SymbolicLink as WS +import Data.Maybe +import System.Environment +import Data.Char +import Foreign.Ptr +import Foreign.Marshal.Alloc +import Foreign.Marshal.Utils +import Foreign.Storable +import Foreign.C.Types +import Data.ByteString.Short.Word16 (packCWStringLen, ShortByteString) +import qualified Data.ByteString.Short.Word16 as W16 +import System.IO.Error +import Data.Void + + + + + ------------------------------ + --[ Windows specific types ]-- + ------------------------------ + + +data FileType = Directory + | DirectoryLink + | SymbolicLink + | File + deriving (Eq, Show) + + + +maxShareMode :: Win32.ShareMode +maxShareMode = + Win32.fILE_SHARE_DELETE .|. + Win32.fILE_SHARE_READ .|. + Win32.fILE_SHARE_WRITE + +writeShareMode :: Win32.ShareMode +writeShareMode = + Win32.fILE_SHARE_DELETE .|. + Win32.fILE_SHARE_READ + + +data Win32_REPARSE_DATA_BUFFER + = Win32_MOUNT_POINT_REPARSE_DATA_BUFFER ShortByteString ShortByteString + -- ^ substituteName printName + | Win32_SYMLINK_REPARSE_DATA_BUFFER ShortByteString ShortByteString Bool + -- ^ substituteName printName isRelative + | Win32_GENERIC_REPARSE_DATA_BUFFER + + + -------------------- + --[ File Copying ]-- + -------------------- + + + +-- |Copies the contents of a directory recursively to the given destination, while preserving permissions. +-- Does not follow symbolic links. This behaves more or less like +-- the following, without descending into the destination if it +-- already exists: +-- +-- @ +-- cp -a \/source\/dir \/destination\/somedir +-- @ +-- +-- For directory contents, this will ignore any file type that is not +-- `RegularFile`, `SymbolicLink` or `Directory`. +-- +-- For `Overwrite` copy mode this does not prune destination directory +-- contents, so the destination might contain more files than the source after +-- the operation has completed. Permissions of existing directories are +-- fixed. +-- +-- Safety/reliability concerns: +-- +-- * not atomic +-- * examines filetypes explicitly +-- * an explicit check `throwDestinationInSource` is carried out for the +-- top directory for basic sanity, because otherwise we might end up +-- with an infinite copy loop... however, this operation is not +-- carried out recursively (because it's slow) +-- +-- Throws: +-- +-- - `NoSuchThing` if source directory does not exist +-- - `PermissionDenied` if source directory can't be opened +-- - `SameFile` if source and destination are the same file +-- (`HPathIOException`) +-- - `DestinationInSource` if destination is contained in source +-- (`HPathIOException`) +-- +-- Throws in `FailEarly` RecursiveErrorMode only: +-- +-- - `PermissionDenied` if output directory is not writable +-- - `InvalidArgument` if source directory is wrong type (symlink) +-- - `InappropriateType` if source directory is wrong type (regular file) +-- +-- Throws in `CollectFailures` RecursiveErrorMode only: +-- +-- - `RecursiveFailure` if any of the recursive operations that are not +-- part of the top-directory sanity-checks fail (`HPathIOException`) +-- +-- Throws in `Strict` CopyMode only: +-- +-- - `AlreadyExists` if destination already exists +copyDirRecursive :: WindowsFilePath -- ^ source dir + -> WindowsFilePath -- ^ destination (parent dirs + -- are not automatically created) + -> CopyMode + -> RecursiveErrorMode + -> IO () +copyDirRecursive fromp destdirp cm rm = do + ce <- newIORef [] + -- for performance, sanity checks are only done for the top dir + -- TODO + -- throwSameFile fromp destdirp + -- throwDestinationInSource fromp destdirp + go ce fromp destdirp + -- collectedExceptions <- readIORef ce + -- unless (null collectedExceptions) + -- (throwIO . RecursiveFailure $ collectedExceptions) + where +#if MIN_VERSION_base(4,9,0) + basename :: Fail.MonadFail m => WindowsFilePath -> m WindowsFilePath +#else + basename :: Fail.Monad m => WindowsFilePath -> m WindowsFilePath +#endif + basename x = + let b = takeFileName x + in if b == mempty then Fail.fail ("No base name" :: String) else pure b + + go :: IORef [(RecursiveFailureHint, IOException)] + -> WindowsFilePath + -> WindowsFilePath + -> IO () + go ce from destdir = do + + -- NOTE: order is important here, so we don't get empty directories + -- on failure + + -- get the contents of the source dir + contents <- handleIOE (ReadContentsFailed (OsString from) (OsString destdir)) ce [] $ do + contents <- getDirsFiles from + + -- create the destination dir and + -- only return contents if we succeed + handleIOE (CreateDirFailed (OsString from) (OsString destdir)) ce [] $ do + fmode' <- WS.getFileAttributes from + case cm of + Strict -> createDir destdir + Overwrite -> catchIOError (createDir destdir) $ \e -> + case ioeGetErrorType e of + AlreadyExists -> pure () + _ -> ioError e + WS.setFileAttributes destdir fmode' + return contents + + -- NOTE: we can't use `easyCopy` here, because we want to call `go` + -- recursively to skip the top-level sanity checks + + -- if reading the contents and creating the destination dir worked, + -- then copy the contents to the destination too + for_ contents $ \f -> do + ftype <- getFileType f + newdest <- (destdir ) <$> basename f + case ftype of + SymbolicLink -> + handleIOE (RecreateSymlinkFailed (OsString f) (OsString newdest)) ce () + $ recreateSymlink f newdest cm + DirectoryLink -> + handleIOE (RecreateSymlinkFailed (OsString f) (OsString newdest)) ce () + $ recreateSymlink f newdest cm + Directory -> go ce f newdest + File -> + handleIOE (CopyFileFailed (OsString f) (OsString newdest)) ce () $ copyFile f newdest cm + + -- helper to handle errors for both RecursiveErrorModes and return a + -- default value + handleIOE :: RecursiveFailureHint + -> IORef [(RecursiveFailureHint, IOException)] + -> a + -> IO a + -> IO a + handleIOE hint ce def = case rm of + FailEarly -> handleIOError throwIO + CollectFailures -> + handleIOError (\e -> modifyIORef ce ((hint, e) :) >> return def) + + +-- |Recreate a symlink. +-- +-- In `Overwrite` copy mode only files and empty directories are deleted. +-- +-- Safety/reliability concerns: +-- +-- * `Overwrite` mode is inherently non-atomic +-- +-- Throws: +-- +-- - `InvalidArgument` if source file is wrong type (not a symlink) +-- - `PermissionDenied` if output directory cannot be written to +-- - `PermissionDenied` if source directory cannot be opened +-- - `SameFile` if source and destination are the same file +-- (`HPathIOException`) +-- +-- +-- Throws in `Strict` mode only: +-- +-- - `AlreadyExists` if destination already exists +-- +-- Throws in `Overwrite` mode only: +-- +-- - `UnsatisfiedConstraints` if destination file is non-empty directory +recreateSymlink :: WindowsFilePath -- ^ the old symlink file + -> WindowsFilePath -- ^ destination file + -> CopyMode + -> IO () +recreateSymlink symsource newsym cm = do + isdirSource <- doesDirectoryExist symsource + sympoint <- readSymbolicLink symsource + case cm of + Strict -> return () + Overwrite -> do + writable <- do + e <- doesExist newsym + if e then isWritable newsym else pure False + isfile <- doesFileExist newsym + isdir <- doesDirectoryExist newsym + when (writable && isfile) (deleteFile newsym) + when (writable && isdir) (deleteDir newsym) + createSymlink newsym sympoint isdirSource + + +-- |Copies the given regular file to the given destination. +-- Neither follows symbolic links, nor accepts them. +-- For "copying" symbolic links, use `recreateSymlink` instead. +-- +-- Note that this is still sort of a low-level function and doesn't +-- examine file types. For a more high-level version, use `easyCopy` +-- instead. +-- +-- In `Overwrite` copy mode only overwrites actual files, not directories. +-- In `Strict` mode the destination file must not exist. +-- +-- Safety/reliability concerns: +-- +-- * `Overwrite` mode is not atomic +-- * when used on `CharacterDevice`, reads the "contents" and copies +-- them to a regular file, which might take indefinitely +-- * when used on `BlockDevice`, may either read the "contents" +-- and copy them to a regular file (potentially hanging indefinitely) +-- or may create a regular empty destination file +-- * when used on `NamedPipe`, will hang indefinitely +-- +-- Throws: +-- +-- - `NoSuchThing` if source file does not exist +-- - `NoSuchThing` if source file is a a `Socket` +-- - `PermissionDenied` if output directory is not writable +-- - `PermissionDenied` if source directory can't be opened +-- - `InvalidArgument` if source file is wrong type (symlink or directory) +-- - `SameFile` if source and destination are the same file +-- (`HPathIOException`) +-- +-- Throws in `Strict` mode only: +-- +-- - `AlreadyExists` if destination already exists +copyFile :: WindowsFilePath -- ^ source file + -> WindowsFilePath -- ^ destination file + -> CopyMode + -> IO () +copyFile from to cm = WS.copyFile from to (cm == Strict) + + +-- |Copies a regular file, directory or symbolic link. In case of a +-- symbolic link it is just recreated, even if it points to a directory. +-- Any other file type is ignored. +-- +-- Safety/reliability concerns: +-- +-- * examines filetypes explicitly +-- * calls `copyDirRecursive` for directories +easyCopy :: WindowsFilePath + -> WindowsFilePath + -> CopyMode + -> RecursiveErrorMode + -> IO () +easyCopy from to cm rm = do + ftype <- getFileType from + case ftype of + SymbolicLink -> recreateSymlink from to cm + Directory -> copyDirRecursive from to cm rm + DirectoryLink -> recreateSymlink from to cm + File -> copyFile from to cm + + + + + + --------------------- + --[ File Deletion ]-- + --------------------- + + +-- |Deletes the given file. Raises `eISDIR` +-- if run on a directory. Does not follow symbolic links. +-- +-- Throws: +-- +-- - `InappropriateType` for wrong file type (directory) +-- - `NoSuchThing` if the file does not exist +-- - `PermissionDenied` if the directory cannot be read +-- +-- Notes: calls `unlink` +deleteFile :: WindowsFilePath -> IO () +deleteFile = WS.deleteFile + + +-- |Deletes the given directory, which must be empty, never symlinks. +-- +-- Throws: +-- +-- - `InappropriateType` for wrong file type (symlink to directory) +-- - `InappropriateType` for wrong file type (regular file) +-- - `NoSuchThing` if directory does not exist +-- - `UnsatisfiedConstraints` if directory is not empty +-- - `PermissionDenied` if we can't open or write to parent directory +deleteDir :: WindowsFilePath -> IO () +deleteDir = WS.removeDirectory + + +-- |Deletes the given directory recursively. Does not follow symbolic +-- links. Tries `deleteDir` first before attemtping a recursive +-- deletion. +-- +-- Safety/reliability concerns: +-- +-- * not atomic +-- * examines filetypes explicitly +-- +-- Throws: +-- +-- - `InappropriateType` for wrong file type (symlink to directory) +-- - `InappropriateType` for wrong file type (regular file) +-- - `NoSuchThing` if directory does not exist +-- - `PermissionDenied` if we can't open or write to parent directory +deleteDirRecursive :: WindowsFilePath -> IO () +deleteDirRecursive p = catchIOError (deleteDir p) $ \e -> + case ioeGetErrorType e of + NoSuchThing -> rmRecursive p + UnsatisfiedConstraints -> rmRecursive p + _ -> throwIO e + where + rmRecursive fp = do + files <- getDirsFiles fp + for_ files $ \file -> do + ftype <- getFileType file + case ftype of + SymbolicLink -> deleteFile file + Directory -> deleteDirRecursive file + DirectoryLink -> deleteDirRecursive file + File -> deleteFile file + deleteDir fp + + +-- |Deletes a file, directory or symlink. +-- In case of directory, performs recursive deletion. In case of +-- a symlink, the symlink file is deleted. +-- +-- Safety/reliability concerns: +-- +-- * examines filetypes explicitly +-- * calls `deleteDirRecursive` for directories +easyDelete :: WindowsFilePath -> IO () +easyDelete p = do + ftype <- getFileType p + case ftype of + SymbolicLink -> deleteFile p + Directory -> deleteDirRecursive p + DirectoryLink -> deleteDirRecursive p + File -> deleteFile p + + + + + + + + + --------------------- + --[ File Creation ]-- + --------------------- + + +-- |Create an empty regular file at the given directory with the given +-- filename. +-- +-- Throws: +-- +-- - `PermissionDenied` if output directory cannot be written to +-- - `AlreadyExists` if destination already exists +-- - `NoSuchThing` if any of the parent components of the path +-- do not exist +createRegularFile :: Win32.AccessMode -> WindowsFilePath -> IO () +createRegularFile mode fp = bracket open close (\_ -> return ()) + where + open = WS.createFile + fp + mode + maxShareMode + Nothing + Win32.cREATE_NEW + Win32.fILE_ATTRIBUTE_NORMAL + Nothing + close = Win32.closeHandle + + +-- |Create an empty directory at the given directory with the given filename. +-- +-- Throws: +-- +-- - `PermissionDenied` if output directory cannot be written to +-- - `AlreadyExists` if destination already exists +-- - `NoSuchThing` if any of the parent components of the path +-- do not exist +createDir :: WindowsFilePath -> IO () +createDir = flip WS.createDirectory Nothing + + +-- |Create an empty directory at the given directory with the given filename. +-- +-- Throws: +-- +-- - `PermissionDenied` if output directory cannot be written to +-- - `NoSuchThing` if any of the parent components of the path +-- do not exist +createDirIfMissing :: WindowsFilePath -> IO () +createDirIfMissing = hideError AlreadyExists . createDir + + + +-- |Create an empty directory at the given directory with the given filename. +-- All parent directories are created with the same filemode. This +-- basically behaves like: +-- +-- @ +-- mkdir -p \/some\/dir +-- @ +-- +-- Safety/reliability concerns: +-- +-- * not atomic +-- +-- Throws: +-- +-- - `PermissionDenied` if any part of the path components do not +-- exist and cannot be written to +-- - `AlreadyExists` if destination already exists and +-- is *not* a directory +createDirRecursive :: WindowsFilePath -> IO () +createDirRecursive p = go p + where + go :: WindowsFilePath -> IO () + go dest = do + catchIOError (createDir dest) $ \e -> do + case ioeGetErrorType e of + en + | en == alreadyExistsErrorType + -> unlessM (doesDirectoryExist dest) (ioError e) + | en == doesNotExistErrorType + -> go (takeDirectory $ dropTrailingPathSeparator dest) + >> createDir dest + | otherwise + -> ioError e + + +-- |Create a symlink. And tries to do so in unprivileged mode (needs developer mode activated). +-- +-- Throws: +-- +-- - `PermissionDenied` if output directory cannot be written to +-- - `AlreadyExists` if destination file already exists +-- - `NoSuchThing` if any of the parent components of the path +-- do not exist +createSymlink :: WindowsFilePath -- ^ destination file + -> WindowsFilePath -- ^ path the symlink points to + -> Bool -- ^ whether this is a directory + -> IO () +createSymlink destBS sympoint dir = + WS.createSymbolicLink' destBS sympoint ((if dir then Win32.sYMBOLIC_LINK_FLAG_DIRECTORY else Win32.sYMBOLIC_LINK_FLAG_FILE) .|. Win32.sYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE) + + + + ---------------------------- + --[ File Renaming/Moving ]-- + ---------------------------- + + +-- |Rename a given file with the provided filename. Destination and source +-- must be on the same device. +-- +-- Throws: +-- +-- - `NoSuchThing` if source file does not exist +-- - `PermissionDenied` if output directory cannot be written to +-- - `PermissionDenied` if source directory cannot be opened +-- - `UnsupportedOperation` if source and destination are on different +-- devices +-- - `AlreadyExists` if destination already exists +renameFile :: WindowsFilePath -> WindowsFilePath -> IO () +renameFile from to = + WS.moveFileEx from (Just to) 0 + + +-- |Move a file. This also works across devices by copy-delete fallback. +-- And also works on directories. +-- +-- Safety/reliability concerns: +-- +-- * `Overwrite` mode is not atomic +-- * copy-delete fallback is inherently non-atomic +-- +-- Throws: +-- +-- - `NoSuchThing` if source file does not exist +-- - `PermissionDenied` if output directory cannot be written to +-- - `PermissionDenied` if source directory cannot be opened +-- - `PermissionDenied` when moving one directory over another (even in Overwrite mode) +-- +-- Throws in `Strict` mode only: +-- +-- - `AlreadyExists` if destination already exists +moveFile :: WindowsFilePath -- ^ file to move + -> WindowsFilePath -- ^ destination + -> CopyMode + -> IO () +moveFile from to cm = do + let flag = case cm of + Strict -> Win32.mOVEFILE_COPY_ALLOWED + Overwrite -> Win32.mOVEFILE_COPY_ALLOWED .|. Win32.mOVEFILE_REPLACE_EXISTING + WS.moveFileEx from (Just to) flag + + + + + -------------------- + --[ File Reading ]-- + -------------------- + + +-- |Read the given file lazily. +-- +-- Symbolic links are followed. File must exist. +-- +-- Throws: +-- +-- - `InappropriateType` if file is not a regular file or a symlink +-- - `PermissionDenied` if we cannot read the file or the directory +-- containting it +-- - `NoSuchThing` if the file does not exist +readFile :: WindowsFilePath -> IO L.ByteString +readFile path = do + stream <- readFileStream path + SL.fromChunksIO stream + + +-- |Read the given file strictly into memory. +-- +-- Symbolic links are followed. File must exist. +-- +-- Throws: +-- +-- - `InappropriateType` if file is not a regular file or a symlink +-- - `PermissionDenied` if we cannot read the file or the directory +-- containting it +-- - `NoSuchThing` if the file does not exist +readFileStrict :: WindowsFilePath -> IO BS.ByteString +readFileStrict path = do + stream <- readFileStream path + SB.fromArray <$> AS.toArray stream + + +-- | Open the given file as a filestream. Once the filestream +-- exits, the filehandle is cleaned up. +-- +-- Throws: +-- +-- - `InappropriateType` if file is not a regular file or a symlink +-- - `PermissionDenied` if we cannot read the file or the directory +-- containting it +-- - `NoSuchThing` if the file does not exist +readFileStream :: WindowsFilePath -> IO (SerialT IO (Array Word8)) +readFileStream fp = do + handle <- bracketOnError + (WS.createFile + fp + Win32.gENERIC_READ + maxShareMode + Nothing + Win32.oPEN_EXISTING + Win32.fILE_ATTRIBUTE_NORMAL + Nothing) + Win32.closeHandle + Win32.hANDLEToHandle + let stream = S.unfold (SU.finally SIO.hClose FH.readChunks) handle + pure stream + + +foreign import WINAPI unsafe "windows.h DeviceIoControl" + c_DeviceIoControl + :: Win32.HANDLE + -> Win32.DWORD + -> Ptr a + -> Win32.DWORD + -> Ptr b + -> Win32.DWORD + -> Ptr Win32.DWORD + -> Ptr Void + -> IO Win32.BOOL + + +-- | Read the target of a symbolic link. +-- +-- This is mostly stolen from 'directory' package. +readSymbolicLink :: WindowsFilePath -> IO WindowsFilePath +readSymbolicLink path = WS <$> do + let open = WS.createFile path 0 maxShareMode Nothing Win32.oPEN_EXISTING + (Win32.fILE_FLAG_BACKUP_SEMANTICS .|. + win32_fILE_FLAG_OPEN_REPARSE_POINT) Nothing + bracket open Win32.closeHandle $ \ h -> do + win32_alloca_REPARSE_DATA_BUFFER $ \ ptrAndSize@(ptr, _) -> do + result <- deviceIoControl h win32_fSCTL_GET_REPARSE_POINT + (nullPtr, 0) ptrAndSize Nothing + case result of + Left e | e == (#const ERROR_INVALID_FUNCTION) -> do + let msg = "Incorrect function. The file system " <> + "might not support symbolic links." + throwIO (mkIOError illegalOperationErrorType + "DeviceIoControl" Nothing Nothing + `ioeSetErrorString` msg) + | otherwise -> Win32.failWith "DeviceIoControl" e + Right _ -> pure () + rData <- win32_peek_REPARSE_DATA_BUFFER ptr + strip <$> case rData of + Win32_MOUNT_POINT_REPARSE_DATA_BUFFER sn _ -> pure sn + Win32_SYMLINK_REPARSE_DATA_BUFFER sn _ _ -> pure sn + _ -> throwIO (mkIOError InappropriateType + "readSymbolicLink" Nothing Nothing) + where + strip sn = fromMaybe sn (W16.stripPrefix (unWFP $ fromString "\\??\\") sn) + + win32_iO_REPARSE_TAG_MOUNT_POINT, win32_iO_REPARSE_TAG_SYMLINK :: CULong + win32_iO_REPARSE_TAG_MOUNT_POINT = (#const IO_REPARSE_TAG_MOUNT_POINT) + win32_iO_REPARSE_TAG_SYMLINK = (#const IO_REPARSE_TAG_SYMLINK) + + win32_mAXIMUM_REPARSE_DATA_BUFFER_SIZE :: Win32.DWORD + win32_mAXIMUM_REPARSE_DATA_BUFFER_SIZE = + (#const MAXIMUM_REPARSE_DATA_BUFFER_SIZE) + + win32_sYMLINK_FLAG_RELATIVE :: CULong + win32_sYMLINK_FLAG_RELATIVE = 0x00000001 + + + win32_fILE_FLAG_OPEN_REPARSE_POINT :: Win32.FileAttributeOrFlag + win32_fILE_FLAG_OPEN_REPARSE_POINT = 0x00200000 + + win32_fSCTL_GET_REPARSE_POINT :: Win32.DWORD + win32_fSCTL_GET_REPARSE_POINT = 0x900a8 + + deviceIoControl + :: Win32.HANDLE + -> Win32.DWORD + -> (Ptr a, Int) + -> (Ptr b, Int) + -> Maybe Void + -> IO (Either Win32.ErrCode Int) + deviceIoControl h code (inPtr, inSize) (outPtr, outSize) _ = do + with 0 $ \ lenPtr -> do + ok <- c_DeviceIoControl h code inPtr (fromIntegral inSize) outPtr + (fromIntegral outSize) lenPtr nullPtr + if ok + then Right . fromIntegral <$> peek lenPtr + else Left <$> Win32.getLastError + + win32_alloca_REPARSE_DATA_BUFFER + :: ((Ptr Win32_REPARSE_DATA_BUFFER, Int) -> IO a) -> IO a + win32_alloca_REPARSE_DATA_BUFFER action = + allocaBytesAligned size align $ \ ptr -> + action (ptr, size) + where size = fromIntegral win32_mAXIMUM_REPARSE_DATA_BUFFER_SIZE + -- workaround (hsc2hs for GHC < 8.0 don't support #{alignment ...}) + align = #{size char[alignof(HsDirectory_REPARSE_DATA_BUFFER)]} + + win32_peek_REPARSE_DATA_BUFFER + :: Ptr Win32_REPARSE_DATA_BUFFER -> IO Win32_REPARSE_DATA_BUFFER + win32_peek_REPARSE_DATA_BUFFER p = do + tag <- #{peek HsDirectory_REPARSE_DATA_BUFFER, ReparseTag} p + case () of + _ | tag == win32_iO_REPARSE_TAG_MOUNT_POINT -> do + let buf = #{ptr HsDirectory_REPARSE_DATA_BUFFER, + MountPointReparseBuffer.PathBuffer} p + sni <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + MountPointReparseBuffer.SubstituteNameOffset} p + sns <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + MountPointReparseBuffer.SubstituteNameLength} p + sn <- peekName buf sni sns + pni <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + MountPointReparseBuffer.PrintNameOffset} p + pns <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + MountPointReparseBuffer.PrintNameLength} p + pn <- peekName buf pni pns + pure (Win32_MOUNT_POINT_REPARSE_DATA_BUFFER sn pn) + | tag == win32_iO_REPARSE_TAG_SYMLINK -> do + let buf = #{ptr HsDirectory_REPARSE_DATA_BUFFER, + SymbolicLinkReparseBuffer.PathBuffer} p + sni <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + SymbolicLinkReparseBuffer.SubstituteNameOffset} p + sns <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + SymbolicLinkReparseBuffer.SubstituteNameLength} p + sn <- peekName buf sni sns + pni <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + SymbolicLinkReparseBuffer.PrintNameOffset} p + pns <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + SymbolicLinkReparseBuffer.PrintNameLength} p + pn <- peekName buf pni pns + flags <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + SymbolicLinkReparseBuffer.Flags} p + pure (Win32_SYMLINK_REPARSE_DATA_BUFFER sn pn + (flags .&. win32_sYMLINK_FLAG_RELATIVE /= 0)) + | otherwise -> pure Win32_GENERIC_REPARSE_DATA_BUFFER + where + peekName :: Ptr CWchar -> CUShort -> CUShort -> IO ShortByteString + peekName buf offset size = + packCWStringLen ( buf `plusPtr` fromIntegral offset + , fromIntegral size `div` sizeOf (0 :: CWchar) ) + + + + + -------------------- + --[ File Writing ]-- + -------------------- + + +-- |Write a given ByteString to a file, truncating the file beforehand. +-- Follows symlinks. +-- +-- Throws: +-- +-- - `InappropriateType` if file is not a regular file or a symlink +-- - `PermissionDenied` if we cannot read the file or the directory +-- containting it +-- - `NoSuchThing` if the file does not exist +writeFile :: WindowsFilePath + -> Bool -- ^ True if file must exist + -> ByteString + -> IO () +writeFile fp fmode bs = + writeFileStream + fp + Win32.gENERIC_WRITE + (if fmode then Win32.tRUNCATE_EXISTING else Win32.cREATE_ALWAYS) + FH.writeChunks + (arraysOf defaultChunkSize $ S.unfold SB.read bs) + + +-- |Write a given lazy ByteString to a file, truncating the file beforehand. +-- Follows symlinks. +-- +-- Throws: +-- +-- - `InappropriateType` if file is not a regular file or a symlink +-- - `PermissionDenied` if we cannot read the file or the directory +-- containting it +-- - `NoSuchThing` if the file does not exist +-- +-- Note: uses streamly under the hood +writeFileL :: WindowsFilePath + -> Bool -- ^ True if file must exist + -> L.ByteString + -> IO () +writeFileL fp fmode lbs = + writeFileStream + fp + Win32.gENERIC_WRITE + (if fmode then Win32.tRUNCATE_EXISTING else Win32.cREATE_ALWAYS) + FH.writeChunks + (SL.toChunks lbs) + + +writeFileStream :: WindowsFilePath + -> Win32.AccessMode + -> Win32.CreateMode + -> (SIO.Handle -> Fold IO a ()) -- ^ writer + -> SerialT IO a -- ^ stream + -> IO () +writeFileStream fp am cm writer stream = do + handle <- bracketOnError + (WS.createFile + fp + am + writeShareMode + Nothing + cm + Win32.fILE_ATTRIBUTE_NORMAL + Nothing) + Win32.closeHandle + Win32.hANDLEToHandle + finally (streamlyCopy handle) (SIO.hClose handle) + where streamlyCopy tH = S.fold (writer tH) stream + + +-- |Append a given ByteString to a file. +-- The file must exist. Follows symlinks. +-- +-- Throws: +-- +-- - `InappropriateType` if file is not a regular file or a symlink +-- - `PermissionDenied` if we cannot read the file or the directory +-- containting it +-- - `NoSuchThing` if the file does not exist +appendFile :: WindowsFilePath -> ByteString -> IO () +appendFile fp bs = writeFileStream fp Win32.fILE_APPEND_DATA Win32.oPEN_ALWAYS FH.writeChunks + (arraysOf defaultChunkSize $ S.unfold SB.read bs) + + + + ----------------------- + --[ File Permissions]-- + ----------------------- + + +setWriteMode :: Bool -> Win32.FileAttributeOrFlag -> Win32.FileAttributeOrFlag +setWriteMode False m = m .|. Win32.fILE_ATTRIBUTE_READONLY +setWriteMode True m = m .&. complement Win32.fILE_ATTRIBUTE_READONLY + + +-- | A restricted form of 'setFileMode' that only sets the permission bits. +-- For Windows, this means only the "read-only" attribute is affected. +setFilePermissions :: WindowsFilePath -> Win32.FileAttributeOrFlag -> IO () +setFilePermissions path m = do + m' <- Win32.bhfiFileAttributes <$> getFileMetadata path + WS.setFileAttributes path ((m' .&. complement Win32.fILE_ATTRIBUTE_READONLY) .|. + (m .&. Win32.fILE_ATTRIBUTE_READONLY)) + + +-- |Default permissions for a new file. +newFilePerms :: Win32.AccessMode +newFilePerms = Win32.gENERIC_READ .|. Win32.gENERIC_WRITE + + + + + ------------------- + --[ File checks ]-- + ------------------- + + +-- |Checks if the given file exists. +-- +-- Only NoSuchThing is catched (and returns False). +doesExist :: WindowsFilePath -> IO Bool +doesExist bs = + handleIO (\e -> if NoSuchThing == ioeGetErrorType e then pure False else ioError e) $ + (const True) <$> getFileType bs + + +-- |Checks if the given file exists and is not a directory. +-- Does follow symlinks. +-- +-- Only NoSuchThing is catched (and returns False). +doesFileExist :: WindowsFilePath -> IO Bool +doesFileExist bs = + handleIO (\e -> if NoSuchThing == ioeGetErrorType e then pure False else ioError e) $ + (\ft -> ft == File || ft == SymbolicLink) <$> getFileType bs + + + +-- |Checks if the given file exists and is a directory. +-- Does follow reparse points. +-- +-- Only NoSuchThing is catched (and returns False). +doesDirectoryExist :: WindowsFilePath -> IO Bool +doesDirectoryExist bs = + handleIO (\e -> if NoSuchThing == ioeGetErrorType e then pure False else ioError e) $ + (\ft -> ft == Directory || ft == DirectoryLink) <$> getFileType bs + + + +-- |Checks whether a file or folder is readable. +-- +-- Throws: +-- +-- - `NoSuchThing` if the file or folder does not exist +isReadable :: WindowsFilePath -> IO Bool +isReadable bs = (const True) <$> getFileType bs + +-- |Checks whether a file or folder is writable. +-- +-- Throws: +-- +-- - `NoSuchThing` if the file or folder does not exist +isWritable :: WindowsFilePath -> IO Bool +isWritable bs = do + fi <- getFileMetadata bs + pure (hasWriteMode (Win32.bhfiFileAttributes fi)) + where + hasWriteMode m = m .&. Win32.fILE_ATTRIBUTE_READONLY == 0 + + +-- |Checks whether a file is executable. Returns 'False' on directories. +-- +-- This looks up PATHEXT and compares the files extension with the list. +-- +-- Throws: +-- +-- - `NoSuchThing` if the file does not exist +isExecutable :: WindowsFilePath -> IO Bool +isExecutable bs = do + getFileType bs >>= \case + Directory -> pure False + DirectoryLink -> pure False + _ -> do + let ext = takeExtension bs + exeExts <- fmap toPlatformString + . (fmap . fmap) toLower + . (wordsBy (==';')) + . fromMaybe "" + <$> lookupEnv "PATHEXT" + pure $ ext `elem` exeExts + + +-- |Checks whether the directory at the given path exists and can be +-- opened. Returns 'False' on non-directories. +canOpenDirectory :: WindowsFilePath -> IO Bool +canOpenDirectory bs = handleIOError (\_ -> return False) $ do + let query = bs fromString "*" + bracket + (WS.findFirstFile query) + (\(h, _) -> Win32.findClose h) + (\_ -> return True) + + + + + ------------------ + --[ File times ]-- + ------------------ + + +getModificationTime :: WindowsFilePath -> IO UTCTime +getModificationTime bs = do + m <- getFileMetadata bs + pure $ posixSecondsToUTCTime $ windowsToPosixTime $ Win32.bhfiLastWriteTime m + +setModificationTime :: WindowsFilePath -> UTCTime -> IO () +setModificationTime fp t = + bracket (WS.createFile fp Win32.fILE_WRITE_ATTRIBUTES maxShareMode Nothing Win32.oPEN_EXISTING Win32.fILE_FLAG_BACKUP_SEMANTICS Nothing) Win32.closeHandle $ \h -> do + Win32.setFileTime h Nothing Nothing (Just . posixToWindowsTime . utcTimeToPOSIXSeconds $ t) + + +setModificationTimeHiRes :: WindowsFilePath -> Win32.FILETIME -> IO () +setModificationTimeHiRes fp t = + bracket (WS.createFile fp Win32.fILE_WRITE_ATTRIBUTES maxShareMode Nothing Win32.oPEN_EXISTING Win32.fILE_FLAG_BACKUP_SEMANTICS Nothing) Win32.closeHandle $ \h -> do + Win32.setFileTime h Nothing Nothing (Just t) + +-- https://docs.microsoft.com/en-us/windows/win32/api/minwinbase/ns-minwinbase-filetime +windowsToPosixTime :: Win32.FILETIME -> POSIXTime +windowsToPosixTime (Win32.FILETIME t) = + (fromIntegral t - 116444736000000000) / 10000000 + +posixToWindowsTime :: POSIXTime -> Win32.FILETIME +posixToWindowsTime t = Win32.FILETIME $ + truncate (t * 10000000 + 116444736000000000) + + + + ------------------------- + --[ Directory reading ]-- + ------------------------- + + +-- |Gets all filenames of the given directory. +-- +-- The contents are not sorted and there is no guarantee on the ordering. +-- +-- Throws: +-- +-- - `NoSuchThing` if directory does not exist +-- - `InappropriateType` if file type is wrong (file) +-- - `InappropriateType` if file type is wrong (symlink to file) +-- - `InappropriateType` if file type is wrong (symlink to dir) +-- - `PermissionDenied` if directory cannot be opened +getDirsFiles :: WindowsFilePath -- ^ dir to read + -> IO [WindowsFilePath] +getDirsFiles p = do + contents <- getDirsFiles' p + pure $ fmap (p ) contents + + +getDirsFilesRec :: WindowsFilePath -- ^ dir to read + -> IO [WindowsFilePath] +getDirsFilesRec p = do + contents <- getDirsFilesRec' p + pure $ fmap (p ) contents + + +-- | Like 'getDirsFiles', but returns the filename only, instead +-- of prepending the base path. +getDirsFiles' :: WindowsFilePath -- ^ dir to read + -> IO [WindowsFilePath] +getDirsFiles' fp = getDirsFilesStream fp >>= S.toList + + +getDirsFilesRec' :: WindowsFilePath -- ^ dir to read + -> IO [WindowsFilePath] +getDirsFilesRec' fp = getDirsFilesStreamRec fp >>= S.toList + + +getDirsFilesStreamRec :: (MonadCatch m, MonadAsync m, MonadMask m) + => WindowsFilePath + -> IO (SerialT m WindowsFilePath) +getDirsFilesStreamRec fp = do + stream <- getDirsFilesStream fp + pure $ S.concatMapM inner stream + where + inner f = do + let nextFile = fp f + isdir <- liftIO $ doesDirectoryExist nextFile + if isdir + then do + stream <- liftIO (getDirsFilesStreamRec nextFile) + pure $ SE.append (pure f) (fmap (f ) stream) + else pure (pure f) + + +-- | Like 'getDirsFiles'', except returning a Stream. +getDirsFilesStream :: (MonadCatch m, MonadAsync m, MonadMask m) + => WindowsFilePath + -> IO (SerialT m WindowsFilePath) +getDirsFilesStream fp = do + let query = fp fromString "*" + t <- WS.findFirstFile query + let stream = S.unfold (SU.finally (liftIO . Win32.findClose . fst) unfoldDirContents) $ (fmap Just t) + pure stream + where + unfoldDirContents :: MonadIO m => Unfold m (Win32.HANDLE, Maybe Win32.FindData) WindowsFilePath + unfoldDirContents = Unfold step return + where + {-# INLINE [0] step #-} + step (_, Nothing) = pure D.Stop + step (handle, Just fd) = do + filename <- liftIO $ WS.getFindDataFileName fd + more <- liftIO $ Win32.findNextFile handle fd + pure $ case () of + _ + | [fromChar '.'] == unpackPlatformString filename -> D.Skip (handle, if more then Just fd else Nothing) + | [fromChar '.', fromChar '.'] == unpackPlatformString filename -> D.Skip (handle, if more then Just fd else Nothing) + | otherwise -> D.Yield filename (handle, if more then Just fd else Nothing) + + + + ----------- + --[ CWD ]-- + ----------- + +getCurrentDirectory :: IO WindowsFilePath +getCurrentDirectory = WS.getCurrentDirectory + +setCurrentDirectory :: WindowsFilePath -> IO () +setCurrentDirectory = WS.setCurrentDirectory + + + + --------------------------- + --[ FileType operations ]-- + --------------------------- + +-- |Get the file type of the file located at the given path. Does +-- not follow symbolic links. +-- +-- Throws: +-- +-- - `NoSuchThing` if the file does not exist +-- - `PermissionDenied` if any part of the path is not accessible +getFileType :: WindowsFilePath -> IO FileType +getFileType fp = do + fi <- getFileMetadata fp + pure $ decide fi + where + attrs fi = Win32.bhfiFileAttributes fi + isLink fi = attrs fi .&. Win32.fILE_ATTRIBUTE_REPARSE_POINT /= 0 + isDir fi = attrs fi .&. Win32.fILE_ATTRIBUTE_DIRECTORY /= 0 + decide fi | isLink fi && isDir fi = DirectoryLink + | isLink fi = SymbolicLink + | isDir fi = Directory + | otherwise = File + + +getFileMetadata :: WindowsFilePath -> IO Win32.BY_HANDLE_FILE_INFORMATION +getFileMetadata fp = do + bracket (WS.createFile fp 0 maxShareMode Nothing Win32.oPEN_EXISTING Win32.fILE_FLAG_BACKUP_SEMANTICS Nothing) + Win32.closeHandle $ \h -> Win32.getFileInformationByHandle h + + + + -------------- + --[ Others ]-- + -------------- + + + +-- |Applies `GetFullPathName` on the given path. +-- +-- Throws: +-- +-- - `NoSuchThing` if the file at the given path does not exist +-- - `NoSuchThing` if the symlink is broken +canonicalizePath :: WindowsFilePath -> IO WindowsFilePath +canonicalizePath = WS.getFullPathName + + +-- |Converts any path to an absolute path. +-- This is done in the following way: +-- +-- - if the path is already an absolute one, just return it +-- - if it's a relative path, prepend the current directory to it +toAbs :: WindowsFilePath -> IO WindowsFilePath +toAbs bs = do + case isAbsolute bs of + True -> return bs + False -> do + cwd <- getCurrentDirectory + return $ cwd bs + + + +#endif diff --git a/hpath-directory/src/System/Win32/WindowsFilePath/utility.h b/hpath-directory/src/System/Win32/WindowsFilePath/utility.h new file mode 100644 index 0000000..2f37ef3 --- /dev/null +++ b/hpath-directory/src/System/Win32/WindowsFilePath/utility.h @@ -0,0 +1,6 @@ +#if !defined(alignof) && __cplusplus < 201103L +# ifdef STDC_HEADERS +# include +# endif +# define alignof(x) offsetof(struct { char c; x m; }, m) +#endif diff --git a/hpath-directory/src/System/Win32/WindowsFilePath/windows_ext.h b/hpath-directory/src/System/Win32/WindowsFilePath/windows_ext.h new file mode 100644 index 0000000..9c5de01 --- /dev/null +++ b/hpath-directory/src/System/Win32/WindowsFilePath/windows_ext.h @@ -0,0 +1,33 @@ +#ifndef HS_DIRECTORY_WINDOWS_EXT_H +#define HS_DIRECTORY_WINDOWS_EXT_H +#include + +// define prototype to get size, offsets, and alignments +// (can't include because that only exists in WDK) +typedef struct { + ULONG ReparseTag; + USHORT ReparseDataLength; + USHORT Reserved; + union { + struct { + USHORT SubstituteNameOffset; + USHORT SubstituteNameLength; + USHORT PrintNameOffset; + USHORT PrintNameLength; + ULONG Flags; + WCHAR PathBuffer[1]; + } SymbolicLinkReparseBuffer; + struct { + USHORT SubstituteNameOffset; + USHORT SubstituteNameLength; + USHORT PrintNameOffset; + USHORT PrintNameLength; + WCHAR PathBuffer[1]; + } MountPointReparseBuffer; + struct { + UCHAR DataBuffer[1]; + } GenericReparseBuffer; + }; +} HsDirectory_REPARSE_DATA_BUFFER; + +#endif diff --git a/hpath-directory/test/Main.hs b/hpath-directory/test/Main.hs index 99dc771..6e42169 100644 --- a/hpath-directory/test/Main.hs +++ b/hpath-directory/test/Main.hs @@ -8,6 +8,7 @@ import Test.Hspec.Formatters import qualified Spec import Utils #ifdef WINDOWS +import System.Win32.WindowsString.Info #else import System.Posix.Temp.PosixString (mkdtemp) import System.Posix.Env.PosixString (getEnvDefault) @@ -23,6 +24,8 @@ import AFP.OsString.Internal.Types main :: IO () main = do #ifdef WINDOWS + tmpBase <- fmap (( "hpath-directory") . OsString) getTemporaryDirectory + createDirRecursive tmpBase #else (OsString tmpdir) <- fmap ( "hpath-directory") (getEnvDefault "TMPDIR" "/tmp" >>= canonicalizePath . OsString) tmpBase <- OsString <$> mkdtemp tmpdir diff --git a/hpath-directory/test/System/Directory/AFP/AppendFileSpec.hs b/hpath-directory/test/System/Directory/AFP/AppendFileSpec.hs index b3dfa03..9d87dce 100644 --- a/hpath-directory/test/System/Directory/AFP/AppendFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/AppendFileSpec.hs @@ -26,7 +26,7 @@ setupFiles :: IO () setupFiles = do createRegularFile' "fileWithContent" createRegularFile' "fileWithoutContent" - createSymlink' "inputFileSymL" "fileWithContent" + createSymlink' "inputFileSymL" "fileWithContent" False createDir' "alreadyExistsD" createRegularFile' "noPerms" noPerms "noPerms" diff --git a/hpath-directory/test/System/Directory/AFP/CanonicalizePathSpec.hs b/hpath-directory/test/System/Directory/AFP/CanonicalizePathSpec.hs index 68f4b14..94aa6a4 100644 --- a/hpath-directory/test/System/Directory/AFP/CanonicalizePathSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CanonicalizePathSpec.hs @@ -26,9 +26,9 @@ setupFiles :: IO () setupFiles = do createRegularFile' "file" createDir' "dir" - createSymlink' "dirSym" "dir/" - createSymlink' "brokenSym" "nothing" - createSymlink' "fileSym" "file" + createSymlink' "dirSym" "dir/" True + createSymlink' "brokenSym" "nothing" False + createSymlink' "fileSym" "file" False cleanupFiles :: IO () cleanupFiles = do diff --git a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveCollectFailuresSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveCollectFailuresSpec.hs index 2dcd773..24a2dfc 100644 --- a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveCollectFailuresSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveCollectFailuresSpec.hs @@ -7,6 +7,7 @@ module System.Directory.AFP.CopyDirRecursiveCollectFailuresSpec where import Test.Hspec import Data.List (sort) import "hpath-directory" System.Directory.AFP +import System.Directory.Errors import System.Directory.Types import System.IO.Error ( @@ -32,7 +33,7 @@ setupFiles :: IO () setupFiles = do createRegularFile' "alreadyExists" createRegularFile' "wrongInput" - createSymlink' "wrongInputSymL" "inputDir/" + createSymlink' "wrongInputSymL" "inputDir/" True createDir' "alreadyExistsD" createDir' "noPerms" createDir' "noWritePerm" @@ -167,8 +168,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ c <- allDirectoryContents' "outputDir1" tmpDir' <- getRawTmpDir let shouldC = (fmap (\x -> tmpDir' x) - ["outputDir1" - ,"outputDir1/foo2" + ["outputDir1/foo2" ,"outputDir1/foo2/inputFile1" ,"outputDir1/foo2/inputFile2" ,"outputDir1/foo2/inputFile3" diff --git a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveOverwriteSpec.hs index 2a89903..c068bd8 100644 --- a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveOverwriteSpec.hs @@ -32,7 +32,7 @@ setupFiles :: IO () setupFiles = do createRegularFile' "alreadyExists" createRegularFile' "wrongInput" - createSymlink' "wrongInputSymL" "inputDir/" + createSymlink' "wrongInputSymL" "inputDir/" True createDir' "noPerms" createDir' "noWritePerm" diff --git a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveSpec.hs index 899bb1a..af011f8 100644 --- a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveSpec.hs @@ -31,7 +31,7 @@ setupFiles :: IO () setupFiles = do createRegularFile' "alreadyExists" createRegularFile' "wrongInput" - createSymlink' "wrongInputSymL" "inputDir/" + createSymlink' "wrongInputSymL" "inputDir/" True createDir' "alreadyExistsD" createDir' "noPerms" createDir' "noWritePerm" diff --git a/hpath-directory/test/System/Directory/AFP/CopyFileOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyFileOverwriteSpec.hs index 05a87a3..b72880e 100644 --- a/hpath-directory/test/System/Directory/AFP/CopyFileOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyFileOverwriteSpec.hs @@ -31,7 +31,7 @@ setupFiles :: IO () setupFiles = do createRegularFile' "inputFile" createRegularFile' "alreadyExists" - createSymlink' "inputFileSymL" "inputFile" + createSymlink' "inputFileSymL" "inputFile" False createDir' "alreadyExistsD" createDir' "noPerms" createRegularFile' "noPerms/inputFile" diff --git a/hpath-directory/test/System/Directory/AFP/CopyFileSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyFileSpec.hs index 5134f91..f4df7d6 100644 --- a/hpath-directory/test/System/Directory/AFP/CopyFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyFileSpec.hs @@ -31,7 +31,7 @@ setupFiles :: IO () setupFiles = do createRegularFile' "inputFile" createRegularFile' "alreadyExists" - createSymlink' "inputFileSymL" "inputFile" + createSymlink' "inputFileSymL" "inputFile" False createDir' "alreadyExistsD" createDir' "noPerms" createRegularFile' "noPerms/inputFile" diff --git a/hpath-directory/test/System/Directory/AFP/CreateSymlinkSpec.hs b/hpath-directory/test/System/Directory/AFP/CreateSymlinkSpec.hs index 72110b1..001b4a5 100644 --- a/hpath-directory/test/System/Directory/AFP/CreateSymlinkSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CreateSymlinkSpec.hs @@ -45,27 +45,27 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ -- successes -- it "createSymlink, all fine" $ do - createSymlink' "newSymL" "alreadyExists/" + createSymlink' "newSymL" "alreadyExists/" False removeFileIfExists "newSymL" -- posix failures -- it "createSymlink, parent directories do not exist" $ - createSymlink' "some/thing/dada" "lala" + createSymlink' "some/thing/dada" "lala" False `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) it "createSymlink, can't write to destination directory" $ - createSymlink' "noWritePerms/newDir" "lala" + createSymlink' "noWritePerms/newDir" "lala" True `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "createSymlink, can't write to destination directory" $ - createSymlink' "noPerms/newDir" "lala" + createSymlink' "noPerms/newDir" "lala" True `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "createSymlink, destination file already exists" $ - createSymlink' "alreadyExists" "lala" + createSymlink' "alreadyExists" "lala" False `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) diff --git a/hpath-directory/test/System/Directory/AFP/DeleteDirRecursiveSpec.hs b/hpath-directory/test/System/Directory/AFP/DeleteDirRecursiveSpec.hs index 5415310..e65aaa5 100644 --- a/hpath-directory/test/System/Directory/AFP/DeleteDirRecursiveSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/DeleteDirRecursiveSpec.hs @@ -27,7 +27,7 @@ setupFiles = do createRegularFile' "file" createDir' "dir" createRegularFile' "dir/.keep" - createSymlink' "dirSym" "dir/" + createSymlink' "dirSym" "dir/" True createDir' "noPerms" createRegularFile' "noPerms/.keep" createDir' "noWritable" diff --git a/hpath-directory/test/System/Directory/AFP/DeleteDirSpec.hs b/hpath-directory/test/System/Directory/AFP/DeleteDirSpec.hs index 1a1f5b7..3b48a33 100644 --- a/hpath-directory/test/System/Directory/AFP/DeleteDirSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/DeleteDirSpec.hs @@ -28,7 +28,7 @@ setupFiles = do createRegularFile' "file" createDir' "dir" createRegularFile' "dir/.keep" - createSymlink' "dirSym" "dir/" + createSymlink' "dirSym" "dir/" True createDir' "noPerms" createRegularFile' "noPerms/.keep" createDir' "noWritable" diff --git a/hpath-directory/test/System/Directory/AFP/DeleteFileSpec.hs b/hpath-directory/test/System/Directory/AFP/DeleteFileSpec.hs index b444407..44dfbad 100644 --- a/hpath-directory/test/System/Directory/AFP/DeleteFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/DeleteFileSpec.hs @@ -3,8 +3,8 @@ module System.Directory.AFP.DeleteFileSpec where +import System.Directory.AFP import Test.Hspec -import "hpath-directory" System.Posix.PosixFilePath.Directory import System.IO.Error ( ioeGetErrorType @@ -25,7 +25,7 @@ upTmpDir = do setupFiles :: IO () setupFiles = do createRegularFile' "foo" - createSymlink' "syml" "foo" + createSymlink' "syml" "foo" False createDir' "dir" createDir' "noPerms" noPerms "noPerms" diff --git a/hpath-directory/test/System/Directory/AFP/GetDirsFilesSpec.hs b/hpath-directory/test/System/Directory/AFP/GetDirsFilesSpec.hs index 76db97a..4c06c9f 100644 --- a/hpath-directory/test/System/Directory/AFP/GetDirsFilesSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/GetDirsFilesSpec.hs @@ -32,9 +32,9 @@ setupFiles = do createRegularFile' "file" createRegularFile' "Lala" createRegularFile' ".hidden" - createSymlink' "syml" "Lala" + createSymlink' "syml" "Lala" False createDir' "dir" - createSymlink' "dirsym" "dir" + createSymlink' "dirsym" "dir" True createDir' "noPerms" noPerms "noPerms" diff --git a/hpath-directory/test/System/Directory/AFP/MoveFileOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/MoveFileOverwriteSpec.hs index 0ecc41a..50eebfa 100644 --- a/hpath-directory/test/System/Directory/AFP/MoveFileOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/MoveFileOverwriteSpec.hs @@ -27,7 +27,7 @@ upTmpDir = do setupFiles :: IO () setupFiles = do createRegularFile' "myFile" - createSymlink' "myFileL" "myFile" + createSymlink' "myFileL" "myFile" False createDir' "alreadyExistsD" createDir' "dir" createDir' "noPerms" diff --git a/hpath-directory/test/System/Directory/AFP/MoveFileSpec.hs b/hpath-directory/test/System/Directory/AFP/MoveFileSpec.hs index 56d5247..e983801 100644 --- a/hpath-directory/test/System/Directory/AFP/MoveFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/MoveFileSpec.hs @@ -27,7 +27,7 @@ upTmpDir = do setupFiles :: IO () setupFiles = do createRegularFile' "myFile" - createSymlink' "myFileL" "myFile" + createSymlink' "myFileL" "myFile" False createRegularFile' "alreadyExists" createDir' "alreadyExistsD" createDir' "dir" diff --git a/hpath-directory/test/System/Directory/AFP/ReadFileSpec.hs b/hpath-directory/test/System/Directory/AFP/ReadFileSpec.hs index f2e3ddf..2cfc22e 100644 --- a/hpath-directory/test/System/Directory/AFP/ReadFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/ReadFileSpec.hs @@ -26,7 +26,7 @@ setupFiles :: IO () setupFiles = do createRegularFile' "fileWithContent" createRegularFile' "fileWithoutContent" - createSymlink' "inputFileSymL" "fileWithContent" + createSymlink' "inputFileSymL" "fileWithContent" False createDir' "alreadyExistsD" createRegularFile' "noPerms" noPerms "noPerms" diff --git a/hpath-directory/test/System/Directory/AFP/RecreateSymlinkOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkOverwriteSpec.hs index 1a9af34..2932655 100644 --- a/hpath-directory/test/System/Directory/AFP/RecreateSymlinkOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkOverwriteSpec.hs @@ -29,7 +29,7 @@ upTmpDir = do setupFiles :: IO () setupFiles = do createRegularFile' "myFile" - createSymlink' "myFileL" "myFile" + createSymlink' "myFileL" "myFile" False createRegularFile' "alreadyExists" createDir' "alreadyExistsD" createDir' "dir" diff --git a/hpath-directory/test/System/Directory/AFP/RecreateSymlinkSpec.hs b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkSpec.hs index 27c495b..c2b0aff 100644 --- a/hpath-directory/test/System/Directory/AFP/RecreateSymlinkSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkSpec.hs @@ -29,7 +29,7 @@ upTmpDir = do setupFiles :: IO () setupFiles = do createRegularFile' "myFile" - createSymlink' "myFileL" "myFile" + createSymlink' "myFileL" "myFile" False createRegularFile' "alreadyExists" createDir' "alreadyExistsD" createDir' "dir" diff --git a/hpath-directory/test/System/Directory/AFP/RenameFileSpec.hs b/hpath-directory/test/System/Directory/AFP/RenameFileSpec.hs index a8438f7..62021e5 100644 --- a/hpath-directory/test/System/Directory/AFP/RenameFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/RenameFileSpec.hs @@ -26,7 +26,7 @@ upTmpDir = do setupFiles :: IO () setupFiles = do createRegularFile' "myFile" - createSymlink' "myFileL" "myFile" + createSymlink' "myFileL" "myFile" False createRegularFile' "alreadyExists" createDir' "alreadyExistsD" createDir' "dir" diff --git a/hpath-directory/test/System/Directory/AFP/WriteFileLSpec.hs b/hpath-directory/test/System/Directory/AFP/WriteFileLSpec.hs index e869148..60a0588 100644 --- a/hpath-directory/test/System/Directory/AFP/WriteFileLSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/WriteFileLSpec.hs @@ -26,7 +26,7 @@ setupFiles :: IO () setupFiles = do createRegularFile' "fileWithContent" createRegularFile' "fileWithoutContent" - createSymlink' "inputFileSymL" "fileWithContent" + createSymlink' "inputFileSymL" "fileWithContent" False createDir' "alreadyExistsD" createRegularFile' "noPerms" noPerms "noPerms" diff --git a/hpath-directory/test/System/Directory/AFP/WriteFileSpec.hs b/hpath-directory/test/System/Directory/AFP/WriteFileSpec.hs index 396745a..2689aed 100644 --- a/hpath-directory/test/System/Directory/AFP/WriteFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/WriteFileSpec.hs @@ -26,7 +26,7 @@ setupFiles :: IO () setupFiles = do createRegularFile' "fileWithContent" createRegularFile' "fileWithoutContent" - createSymlink' "inputFileSymL" "fileWithContent" + createSymlink' "inputFileSymL" "fileWithContent" False createDir' "alreadyExistsD" createRegularFile' "noPerms" noPerms "noPerms" diff --git a/hpath-directory/test/System/Directory/AFP/GetFileTypeSpec.hs b/hpath-directory/test/System/Directory/Posix/PosixFilePath/Directory/GetFileTypeSpec.hs similarity index 83% rename from hpath-directory/test/System/Directory/AFP/GetFileTypeSpec.hs rename to hpath-directory/test/System/Directory/Posix/PosixFilePath/Directory/GetFileTypeSpec.hs index 2ba781c..d29de89 100644 --- a/hpath-directory/test/System/Directory/AFP/GetFileTypeSpec.hs +++ b/hpath-directory/test/System/Directory/Posix/PosixFilePath/Directory/GetFileTypeSpec.hs @@ -1,10 +1,13 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -module System.Directory.AFP.GetFileTypeSpec where +module System.Directory.Posix.PosixFilePath.Directory.GetFileTypeSpec where - -import "hpath-directory" System.Directory.AFP import Test.Hspec + +#ifndef WINDOWS + +import "hpath-directory" System.Posix.PosixFilePath.Directory import System.IO.Error ( ioeGetErrorType @@ -26,10 +29,10 @@ upTmpDir = do setupFiles :: IO () setupFiles = do createRegularFile' "regularfile" - createSymlink' "symlink" "regularfile" - createSymlink' "brokenSymlink" "broken" + createSymlink' "symlink" "regularfile" False + createSymlink' "brokenSymlink" "broken" False createDir' "directory" - createSymlink' "symlinkD" "directory" + createSymlink' "symlinkD" "directory" True createDir' "noPerms" noPerms "noPerms" @@ -86,3 +89,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) +#else +spec :: Spec +spec = pure () +#endif diff --git a/hpath-directory/test/Utils.hs b/hpath-directory/test/Utils.hs index fcadb89..b1b4381 100644 --- a/hpath-directory/test/Utils.hs +++ b/hpath-directory/test/Utils.hs @@ -41,10 +41,12 @@ import System.IO.Unsafe #ifdef WINDOWS #else import qualified System.Posix.PosixFilePath.Directory.Traversals as DT -import System.Posix.Files.ByteString +import System.Posix.PosixFilePath.Directory ( - getSymbolicLinkStatus + getFileType + , FileType ) +import AFP.AbstractFilePath.Posix (PosixFilePath) #endif import Data.ByteString ( @@ -180,10 +182,10 @@ createRegularFile' :: AbstractFilePath -> IO () createRegularFile' dest = withTmpDir dest createRegularFile -createSymlink' :: AbstractFilePath -> AbstractFilePath -> IO () +createSymlink' :: AbstractFilePath -> AbstractFilePath -> Bool -> IO () {-# NOINLINE createSymlink' #-} -createSymlink' dest sympoint = withTmpDir dest - (\x -> createSymlink x sympoint) +createSymlink' dest sympoint b = withTmpDir dest + (\x -> createSymlink x sympoint b) renameFile' :: AbstractFilePath -> AbstractFilePath -> IO () @@ -233,10 +235,11 @@ normalFilePerms path = withTmpDir path $ \p -> setPermissions p newFilePerms - -getFileType' :: AbstractFilePath -> IO FileType +#ifndef WINDOWS +getFileType' :: PosixFilePath -> IO FileType {-# NOINLINE getFileType' #-} -getFileType' path = withTmpDir path getFileType +getFileType' path = withTmpDir (OsString path) $ \(OsString p) -> getFileType p +#endif getDirsFiles' :: AbstractFilePath -> IO [AbstractFilePath] @@ -281,15 +284,10 @@ appendFile' ip bs = withTmpDir ip $ \p -> appendFile p bs -allDirectoryContents' :: AbstractFilePath -> IO [AbstractFilePath] {-# NOINLINE allDirectoryContents' #-} +allDirectoryContents' :: AbstractFilePath -> IO [AbstractFilePath] allDirectoryContents' ip = -#ifdef WINDOWS - -- TODO - undefined -#else - withTmpDir ip $ \(OsString p) -> fmap OsString <$> DT.allDirectoryContents' p -#endif + withTmpDir ip $ \p -> getDirsFilesRec p readFile' :: AbstractFilePath -> IO ByteString @@ -303,12 +301,5 @@ readFileL p = withTmpDir p readFile dirExists :: AbstractFilePath -> IO Bool {-# NOINLINE dirExists #-} -#ifdef WINDOWS -dirExists fp = - -- TODO - undefined -#else -dirExists (OsString (PS fp)) = - fmap isRight $ try @SomeException $ getSymbolicLinkStatus (SBS.fromShort fp) -#endif +dirExists fp = doesDirectoryExist fp From ffd57b668724fc91cf7f36bd495106ba93559c4a Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Sun, 1 May 2022 18:31:38 +0200 Subject: [PATCH 12/17] Add streamly-posix --- streamly-posix/.gitignore | 4 + streamly-posix/CHANGELOG.md | 14 +++ streamly-posix/LICENSE | 30 ++++++ streamly-posix/README.md | 14 +++ streamly-posix/Setup.hs | 2 + streamly-posix/cabal.project | 14 +++ .../src/Streamly/External/Posix/DirStream.hs | 98 +++++++++++++++++++ streamly-posix/streamly-posix.cabal | 59 +++++++++++ streamly-posix/test/Main.hs | 41 ++++++++ 9 files changed, 276 insertions(+) create mode 100644 streamly-posix/.gitignore create mode 100644 streamly-posix/CHANGELOG.md create mode 100644 streamly-posix/LICENSE create mode 100644 streamly-posix/README.md create mode 100644 streamly-posix/Setup.hs create mode 100644 streamly-posix/cabal.project create mode 100644 streamly-posix/src/Streamly/External/Posix/DirStream.hs create mode 100644 streamly-posix/streamly-posix.cabal create mode 100644 streamly-posix/test/Main.hs diff --git a/streamly-posix/.gitignore b/streamly-posix/.gitignore new file mode 100644 index 0000000..a1f77f5 --- /dev/null +++ b/streamly-posix/.gitignore @@ -0,0 +1,4 @@ +dist/ +dist-newstyle/ +.ghci +cabal.project.local diff --git a/streamly-posix/CHANGELOG.md b/streamly-posix/CHANGELOG.md new file mode 100644 index 0000000..b9b7f43 --- /dev/null +++ b/streamly-posix/CHANGELOG.md @@ -0,0 +1,14 @@ +# Revision history for streamly-posix + +## 0.1.0.2 -- 2021-08-12 + +* Make compatible with streamly 0.8.0 +* Update bounds + +## 0.1.0.1 -- 2020-05-09 + +* fix build with older GHCs + +## 0.1.0.0 -- 2020-02-16 + +* First version. Released on an unsuspecting world. diff --git a/streamly-posix/LICENSE b/streamly-posix/LICENSE new file mode 100644 index 0000000..7ecfe24 --- /dev/null +++ b/streamly-posix/LICENSE @@ -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. diff --git a/streamly-posix/README.md b/streamly-posix/README.md new file mode 100644 index 0000000..ddff0de --- /dev/null +++ b/streamly-posix/README.md @@ -0,0 +1,14 @@ +# streamly-posix + +[![Build Status](https://api.travis-ci.org/hasufell/streamly-posix.png?branch=master)](http://travis-ci.org/hasufell/streamly-posix) + +POSIX related streaming APIs. + +## Motivation + +Since upstream wants to stay cross-platform, this library provides +strictly POSIX only API. + +## TODO + +* [ ] Fd based streaming (some is in internal modules of streamly) diff --git a/streamly-posix/Setup.hs b/streamly-posix/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/streamly-posix/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/streamly-posix/cabal.project b/streamly-posix/cabal.project new file mode 100644 index 0000000..aa3d7dd --- /dev/null +++ b/streamly-posix/cabal.project @@ -0,0 +1,14 @@ +packages: ./streamly-posix.cabal + https://hackage.haskell.org/package/filepath-2.0.0.0/candidate/filepath-2.0.0.0.tar.gz + +source-repository-package + type: git + location: https://github.com/hasufell/unix.git + tag: 4d7bce9d85f077908f699532673e12ae66b178b0 + +source-repository-package + type: git + location: https://github.com/hasufell/Win32.git + tag: a2ab9bc501614c48c62f9508488e87f0c2924b7b + +allow-newer: filepath diff --git a/streamly-posix/src/Streamly/External/Posix/DirStream.hs b/streamly-posix/src/Streamly/External/Posix/DirStream.hs new file mode 100644 index 0000000..0ea81fa --- /dev/null +++ b/streamly-posix/src/Streamly/External/Posix/DirStream.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiWayIf #-} + +-- | +-- Module : Streamly.External.Posix.DirStream +-- Copyright : © 2020 Julian Ospald +-- License : BSD3 +-- +-- Maintainer : Julian Ospald +-- Stability : experimental +-- Portability : portable +-- +-- This module provides high-level file streaming API, +-- working with directory streams (POSIX). +module Streamly.External.Posix.DirStream + ( + -- * Directory listing + unfoldDirContents + , dirContentsStream + , dirContents + ) +where + +import Control.Exception.Safe +import Control.Monad.IO.Class ( liftIO + , MonadIO + ) +import Prelude hiding ( readFile ) +import System.Posix.ByteString +import System.Posix.Directory.ByteString + as PosixBS +import System.Posix.Foreign ( DirType ) +import System.Posix.PosixFilePath.Directory.Traversals + hiding ( getDirectoryContents ) +import qualified Streamly.Internal.Data.Stream.StreamD.Type + as D +#if MIN_VERSION_streamly(0,7,1) +import qualified Streamly.Internal.Data.Unfold as SIU +#endif +#if MIN_VERSION_streamly(0,8,0) +import Streamly.Prelude +import Streamly.Internal.Data.Unfold.Type +#else +import Streamly +import Streamly.Internal.Data.Unfold.Types +import qualified Streamly.Internal.Prelude as S +#endif + +import System.AbstractFilePath.Posix + + +-- | Create an 'Unfold' of directory contents. +unfoldDirContents :: MonadIO m => Unfold m DirStream (DirType, PosixFilePath) +unfoldDirContents = Unfold step return + where + {-# INLINE [0] step #-} + step dirstream = do + (typ, e) <- liftIO $ readDirEnt dirstream + return $ if + | e == mempty -> D.Stop + | [unsafeFromChar '.'] == unpackPlatformString e -> D.Skip dirstream + | [unsafeFromChar '.', unsafeFromChar '.'] == unpackPlatformString e -> D.Skip dirstream + | otherwise -> D.Yield (typ, e) dirstream + + +-- | Read the directory contents as a stream. +-- +-- The DirStream is closed automatically, when the streamly stream exits +-- normally, aborts or gets garbage collected. +-- The stream must not be used after the dirstream is closed. +dirContentsStream :: (MonadCatch m, MonadAsync m, MonadMask m) + => DirStream + -> SerialT m (DirType, PosixFilePath) +dirContentsStream ds = +#if MIN_VERSION_streamly(0,8,0) + unfold (SIU.finally (liftIO . PosixBS.closeDirStream) unfoldDirContents) $ ds +#else +#if MIN_VERSION_streamly(0,7,1) + S.unfold (SIU.finallyIO (liftIO . PosixBS.closeDirStream) unfoldDirContents) $ ds +#else + S.finally (liftIO . PosixBS.closeDirStream $ ds) . S.unfold unfoldDirContents $ ds +#endif +#endif + + +-- | Read the directory contents strictly as a list. +-- +-- The DirStream is closed automatically. +dirContents :: (MonadCatch m, MonadAsync m, MonadMask m) + => DirStream + -> m [(DirType, PosixFilePath)] +#if MIN_VERSION_streamly(0,8,0) +dirContents = toList . dirContentsStream +#else +dirContents = S.toList . dirContentsStream +#endif + diff --git a/streamly-posix/streamly-posix.cabal b/streamly-posix/streamly-posix.cabal new file mode 100644 index 0000000..dd8a978 --- /dev/null +++ b/streamly-posix/streamly-posix.cabal @@ -0,0 +1,59 @@ +cabal-version: >=1.10 +name: streamly-posix +version: 0.2.0.0 +license: BSD3 +license-file: LICENSE +copyright: Julian Ospald 2020 +maintainer: Julian Ospald +author: Julian Ospald +bug-reports: https://github.com/hasufell/streamly-posix/issues +synopsis: Posix related streaming APIs +description: Posix related streaming APIs (such as file reading/writing) +category: Streaming +build-type: Simple +extra-source-files: CHANGELOG.md + +source-repository head + type: git + location: https://github.com/hasufell/streamly-posix + +library + exposed-modules: Streamly.External.Posix.DirStream + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: + -Wall -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 + + build-depends: + base >=4.8 && <5 + , hpath-posix >=0.14 && <0.15 + , filepath >=2.0.0.0 + , safe-exceptions >=0.1 && <0.2 + , streamly >=0.7 && <0.9 + , streamly-bytestring >=0.1.0.1 && <0.2 + , transformers >=0.5.6.2 && <0.6 + , unix >=2.8 + + if os(windows) + buildable: False + build-depends: unbuildable <0 + +test-suite sf-test + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: test + default-language: Haskell2010 + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.8 && <5 + , filepath >=1.4.2.1 && <1.5 + , hpath-posix >=0.14 && <0.15 + , hspec >=2.7.10 && <2.9 + , hspec-discover >=2.7.10 && <2.9 + , streamly-posix + , temporary >=1.3 && <1.4 + , unix >=2.8 + + if os(windows) + buildable: False + build-depends: unbuildable <0 diff --git a/streamly-posix/test/Main.hs b/streamly-posix/test/Main.hs new file mode 100644 index 0000000..f47f2cf --- /dev/null +++ b/streamly-posix/test/Main.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Data.Foldable +import Data.List ( sortBy ) +import Streamly.External.Posix.DirStream +import System.FilePath +import System.IO +import System.IO.Temp +import System.Posix.Directory as Posix +import System.Posix.Foreign +import Test.Hspec + + + +checkDirContents :: FilePath -> IO () +checkDirContents fp = do + let f1 = fp "f1" + let f2 = fp "f2" + let f3 = fp "f3" + let f4 = fp "f4" + for_ [f1, f2, f3, f4] $ \f -> openFile f ReadWriteMode + ds <- Posix.openDirStream fp + contents <- fmap (sortBy (\(_, y) (_, z) -> compare y z)) $ dirContents ds + contents + `shouldBe` [ (DirType 8, "f1") + , (DirType 8, "f2") + , (DirType 8, "f3") + , (DirType 8, "f4") + ] + + + + +main :: IO () +main = hspec $ do + describe "Streamly.External.FileSystem.DirStream.Posix" $ do + it "dirContents" $ withSystemTempDirectory "y" checkDirContents From faeeb223aff1a279e0d1a4ec556b40038177880d Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Sun, 1 May 2022 18:32:09 +0200 Subject: [PATCH 13/17] Use filepath AFPP --- cabal.project | 16 +++--- hpath-directory/hpath-directory.cabal | 25 ++++----- hpath-directory/src/System/Directory/AFP.hs | 9 +++- .../src/System/Directory/Errors.hs | 22 +------- hpath-directory/src/System/Directory/Types.hs | 2 +- .../System/Posix/PosixFilePath/Directory.hs | 7 ++- .../Posix/PosixFilePath/Directory.hs-boot | 2 +- .../Posix/PosixFilePath/Directory/Errors.hs | 51 ++++++++++++++----- hpath-directory/test/Main.hs | 4 +- .../CopyDirRecursiveCollectFailuresSpec.hs | 3 +- .../AFP/CopyDirRecursiveOverwriteSpec.hs | 3 +- .../Directory/AFP/CopyDirRecursiveSpec.hs | 3 +- .../Directory/AFP/CopyFileOverwriteSpec.hs | 3 +- .../test/System/Directory/AFP/CopyFileSpec.hs | 3 +- .../System/Directory/AFP/GetDirsFilesSpec.hs | 2 +- .../Directory/AFP/MoveFileOverwriteSpec.hs | 1 - .../test/System/Directory/AFP/MoveFileSpec.hs | 1 - .../AFP/RecreateSymlinkOverwriteSpec.hs | 1 - .../Directory/AFP/RecreateSymlinkSpec.hs | 1 - hpath-directory/test/Utils.hs | 21 +++----- hpath-io/hpath-io.cabal | 4 +- hpath-io/src/HPath/IO.hs | 7 +-- hpath-posix/hpath-posix.cabal | 4 +- hpath-posix/src/System/Posix/FD.hs | 2 +- .../PosixFilePath/Directory/Traversals.hs | 6 +-- hpath/hpath.cabal | 5 +- hpath/src/HPath.hs | 41 +++++++++++++-- hpath/src/HPath/Internal.hs | 2 +- 28 files changed, 134 insertions(+), 117 deletions(-) diff --git a/cabal.project b/cabal.project index 9193904..1b48121 100644 --- a/cabal.project +++ b/cabal.project @@ -2,20 +2,18 @@ packages: ./hpath ./hpath-directory ./hpath-io ./hpath-posix + ./streamly-posix + https://hackage.haskell.org/package/filepath-2.0.0.0/candidate/filepath-2.0.0.0.tar.gz source-repository-package type: git - location: https://github.com/hasufell/streamly-posix.git - tag: e14e5e877c584f7d7bf2fb10cb80bc331126fd5d + location: https://github.com/hasufell/unix.git + tag: 4d7bce9d85f077908f699532673e12ae66b178b0 source-repository-package type: git - location: https://github.com/hasufell/abstract-filepath.git - tag: 595973d0e2027315f5c7ac865e70b43fbb2356e4 - subdir: abstract-filepath - abstract-filepath-types - abstract-filepath-unix - abstract-filepath-Win32 + location: https://github.com/hasufell/Win32.git + tag: a2ab9bc501614c48c62f9508488e87f0c2924b7b package hpath-io ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 @@ -23,3 +21,5 @@ package hpath-io -- https://github.com/composewell/streamly/blob/master/docs/Build.md package streamly ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 + +allow-newer: filepath diff --git a/hpath-directory/hpath-directory.cabal b/hpath-directory/hpath-directory.cabal index a192cd5..f461064 100644 --- a/hpath-directory/hpath-directory.cabal +++ b/hpath-directory/hpath-directory.cabal @@ -40,9 +40,7 @@ library cpp-options: -DWINDOWS exposed-modules: System.Win32.WindowsFilePath.Directory build-depends: - abstract-filepath-Win32 - , shortbytestring - , Win32 + Win32 include-dirs: src @@ -52,10 +50,9 @@ library System.Posix.PosixFilePath.Directory.Errors build-depends: - abstract-filepath-unix - , hpath-posix >=0.14.0 + hpath-posix >=0.14.0 , streamly-posix >=0.1.0.2 - , unix >=2.5 + , unix >=2.8 , unix-bytestring >=0.3 exposed-modules: @@ -66,11 +63,10 @@ library -- other-modules: -- other-extensions: build-depends: - abstract-filepath - , abstract-filepath-types - , base >=4.8 && <5 + base >=4.8 && <5 , bytestring >=0.10 , exceptions >=0.10 + , filepath >=2.0.0.0 , IfElse , safe-exceptions >=0.1 , split @@ -131,19 +127,16 @@ test-suite spec if os(windows) cpp-options: -DWINDOWS build-depends: - abstract-filepath-Win32 - , Win32 + Win32 >=2.13.2.0 else build-depends: - abstract-filepath-unix - , hpath-posix >=0.13 - , unix + hpath-posix >=0.13 + , unix >=2.8 , unix-bytestring build-depends: - abstract-filepath - , abstract-filepath-types + filepath >=2.0.0.0 , base , bytestring >=0.10.0.0 , hpath-directory diff --git a/hpath-directory/src/System/Directory/AFP.hs b/hpath-directory/src/System/Directory/AFP.hs index 81f7508..47ea25a 100644 --- a/hpath-directory/src/System/Directory/AFP.hs +++ b/hpath-directory/src/System/Directory/AFP.hs @@ -69,6 +69,8 @@ module System.Directory.AFP -- * Others , canonicalizePath , toAbs + , getFileType + , Dir.FileType ) where @@ -86,8 +88,8 @@ import qualified System.Posix as Posix (FileMode) import qualified System.Posix.Files.ByteString as Posix import qualified Data.ByteString.Short as SBS #endif -import AFP.AbstractFilePath.Types -import AFP.OsString.Internal.Types +import System.AbstractFilePath.Types +import System.OsString.Internal.Types import Data.Time.Clock import Data.Time.Clock.POSIX import Streamly.Prelude ( SerialT, MonadAsync ) @@ -207,6 +209,9 @@ getPermissions (OsString (PS path')) = do } #endif +getFileType :: AbstractFilePath -> IO Dir.FileType +getFileType (OsString path) = Dir.getFileType path + setPermissions :: AbstractFilePath -> Permissions -> IO () #ifdef WINDOWS setPermissions (OsString path) Permissions{writable = w} = do diff --git a/hpath-directory/src/System/Directory/Errors.hs b/hpath-directory/src/System/Directory/Errors.hs index 94e3668..711b3c8 100644 --- a/hpath-directory/src/System/Directory/Errors.hs +++ b/hpath-directory/src/System/Directory/Errors.hs @@ -36,34 +36,14 @@ module System.Directory.Errors where -import Control.Applicative - ( - (<$>) - ) import Control.Exception.Safe hiding (handleIOError) -import Control.Monad - ( - forM - , when - ) -import Control.Monad.IfElse - ( - whenM - ) -import Foreign.C.Error - ( - getErrno - , Errno - ) import GHC.IO.Exception ( IOErrorType ) import System.IO.Error ( - alreadyExistsErrorType - , ioeGetErrorType - , mkIOError + ioeGetErrorType ) import System.Directory.Types diff --git a/hpath-directory/src/System/Directory/Types.hs b/hpath-directory/src/System/Directory/Types.hs index 6c7dc69..5063f78 100644 --- a/hpath-directory/src/System/Directory/Types.hs +++ b/hpath-directory/src/System/Directory/Types.hs @@ -2,7 +2,7 @@ module System.Directory.Types where import Control.Exception (Exception, IOException) import Data.Typeable (Typeable) -import AFP.AbstractFilePath.Types +import System.AbstractFilePath.Types diff --git a/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs b/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs index 05a6c9a..4e25697 100644 --- a/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs +++ b/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs @@ -220,8 +220,8 @@ import System.Posix.Types ( FileMode ) import System.Posix.Time -import AFP.AbstractFilePath.Posix -import AFP.OsString.Internal.Types +import System.AbstractFilePath.Posix +import System.OsString.Internal.Types import System.Directory.Types import System.Directory.Errors @@ -660,8 +660,7 @@ createRegularFile :: FileMode -> PosixFilePath -> IO () createRegularFile fm destBS = bracket (SPI.openFd destBS SPI.WriteOnly - (Just fm) - (SPI.defaultFileFlags { exclusive = True }) + (SPI.defaultFileFlags { exclusive = True, SPI.creat = Just fm }) ) SPI.closeFd (\_ -> return ()) diff --git a/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs-boot b/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs-boot index 90bf5ec..4732ac0 100644 --- a/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs-boot +++ b/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs-boot @@ -1,6 +1,6 @@ module System.Posix.PosixFilePath.Directory where -import AFP.AbstractFilePath.Posix (PosixFilePath) +import System.AbstractFilePath.Posix (PosixFilePath) canonicalizePath :: PosixFilePath -> IO PosixFilePath diff --git a/hpath-directory/src/System/Posix/PosixFilePath/Directory/Errors.hs b/hpath-directory/src/System/Posix/PosixFilePath/Directory/Errors.hs index 6862841..45a1984 100644 --- a/hpath-directory/src/System/Posix/PosixFilePath/Directory/Errors.hs +++ b/hpath-directory/src/System/Posix/PosixFilePath/Directory/Errors.hs @@ -9,8 +9,9 @@ -- -- Provides error handling. -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE MultiWayIf #-} module System.Posix.PosixFilePath.Directory.Errors ( @@ -32,10 +33,6 @@ module System.Posix.PosixFilePath.Directory.Errors where -import Control.Applicative - ( - (<$>) - ) import Control.Exception.Safe import Control.Monad ( @@ -46,15 +43,15 @@ import Control.Monad.IfElse ( whenM ) +import Data.List + ( + mapAccumL + ) import Foreign.C.Error ( getErrno , Errno ) -import GHC.IO.Exception - ( - IOErrorType - ) import {-# SOURCE #-} System.Posix.PosixFilePath.Directory ( canonicalizePath @@ -65,7 +62,6 @@ import {-# SOURCE #-} System.Posix.PosixFilePath.Directory import System.IO.Error ( alreadyExistsErrorType - , ioeGetErrorType , mkIOError ) import System.Posix.Files.PosixString @@ -73,9 +69,12 @@ import System.Posix.Files.PosixString getFileStatus ) import qualified System.Posix.Files.PosixString as PF -import AFP.AbstractFilePath.Posix +import System.AbstractFilePath.Posix +import qualified System.AbstractFilePath.Posix.Internal as Raw +import qualified System.OsString.Internal.Types as Raw +import qualified System.AbstractFilePath.Data.ByteString.Short as BS import System.Directory.Types -import AFP.OsString.Internal.Types +import System.OsString.Internal.Types @@ -165,6 +164,34 @@ throwDestinationInSource sbs dbs = do basename x = let b = takeBaseName x in if b == mempty then Nothing else Just b + takeAllParents :: PosixFilePath -> [PosixFilePath] + takeAllParents p = + let s = splitDirectories p + in fmap Raw.PS + . filterEmptyHead + . snd + . mapAccumL (\a b -> (if | BS.null a -> ( b + , a + ) + | BS.length a == 1 + , Raw.isPathSeparator (BS.head a) -> ( BS.singleton (Raw.unPW pathSeparator) <> b + , BS.singleton (Raw.unPW pathSeparator) + ) + | otherwise -> (a <> BS.singleton (Raw.unPW pathSeparator) <> b + , a + ) + ) + ) mempty + . fmap Raw.unPFP + $ s + where + filterEmptyHead :: [BS.ShortByteString] -> [BS.ShortByteString] + filterEmptyHead [] = [] + filterEmptyHead (a:as) + | BS.null a = as + | otherwise = (a:as) + + -------------------------------- diff --git a/hpath-directory/test/Main.hs b/hpath-directory/test/Main.hs index 6e42169..bdfed40 100644 --- a/hpath-directory/test/Main.hs +++ b/hpath-directory/test/Main.hs @@ -14,8 +14,8 @@ import System.Posix.Temp.PosixString (mkdtemp) import System.Posix.Env.PosixString (getEnvDefault) #endif import "hpath-directory" System.Directory.AFP -import AFP.AbstractFilePath -import AFP.OsString.Internal.Types +import System.AbstractFilePath +import System.OsString.Internal.Types -- TODO: chardev, blockdev, namedpipe, socket diff --git a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveCollectFailuresSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveCollectFailuresSpec.hs index 24a2dfc..10ee7b4 100644 --- a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveCollectFailuresSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveCollectFailuresSpec.hs @@ -8,7 +8,6 @@ import Test.Hspec import Data.List (sort) import "hpath-directory" System.Directory.AFP import System.Directory.Errors -import System.Directory.Types import System.IO.Error ( ioeGetErrorType @@ -20,7 +19,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import AFP.AbstractFilePath +import System.AbstractFilePath diff --git a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveOverwriteSpec.hs index c068bd8..5b3d56d 100644 --- a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveOverwriteSpec.hs @@ -6,7 +6,6 @@ module System.Directory.AFP.CopyDirRecursiveOverwriteSpec where import Test.Hspec import "hpath-directory" System.Directory.AFP -import System.Directory.Types import System.IO.Error ( ioeGetErrorType @@ -18,7 +17,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import AFP.AbstractFilePath +import System.AbstractFilePath diff --git a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveSpec.hs index af011f8..2d0cb64 100644 --- a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveSpec.hs @@ -6,7 +6,6 @@ module System.Directory.AFP.CopyDirRecursiveSpec where import Test.Hspec import "hpath-directory" System.Directory.AFP -import System.Directory.Types import System.IO.Error ( ioeGetErrorType @@ -18,7 +17,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import AFP.AbstractFilePath +import System.AbstractFilePath diff --git a/hpath-directory/test/System/Directory/AFP/CopyFileOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyFileOverwriteSpec.hs index b72880e..c79139c 100644 --- a/hpath-directory/test/System/Directory/AFP/CopyFileOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyFileOverwriteSpec.hs @@ -5,7 +5,6 @@ module System.Directory.AFP.CopyFileOverwriteSpec where import Test.Hspec import "hpath-directory" System.Directory.AFP -import System.Directory.Types import System.IO.Error ( ioeGetErrorType @@ -17,7 +16,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import AFP.AbstractFilePath +import System.AbstractFilePath diff --git a/hpath-directory/test/System/Directory/AFP/CopyFileSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyFileSpec.hs index f4df7d6..b24442e 100644 --- a/hpath-directory/test/System/Directory/AFP/CopyFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyFileSpec.hs @@ -6,7 +6,6 @@ module System.Directory.AFP.CopyFileSpec where import Test.Hspec import "hpath-directory" System.Directory.AFP -import System.Directory.Types import System.IO.Error ( ioeGetErrorType @@ -18,7 +17,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import AFP.AbstractFilePath +import System.AbstractFilePath diff --git a/hpath-directory/test/System/Directory/AFP/GetDirsFilesSpec.hs b/hpath-directory/test/System/Directory/AFP/GetDirsFilesSpec.hs index 4c06c9f..fbdaa92 100644 --- a/hpath-directory/test/System/Directory/AFP/GetDirsFilesSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/GetDirsFilesSpec.hs @@ -18,7 +18,7 @@ import GHC.IO.Exception IOErrorType(..) ) import Utils -import AFP.AbstractFilePath +import System.AbstractFilePath upTmpDir :: IO () diff --git a/hpath-directory/test/System/Directory/AFP/MoveFileOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/MoveFileOverwriteSpec.hs index 50eebfa..1e60f2f 100644 --- a/hpath-directory/test/System/Directory/AFP/MoveFileOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/MoveFileOverwriteSpec.hs @@ -5,7 +5,6 @@ module System.Directory.AFP.MoveFileOverwriteSpec where import Test.Hspec import "hpath-directory" System.Directory.AFP -import System.Directory.Types import System.IO.Error ( ioeGetErrorType diff --git a/hpath-directory/test/System/Directory/AFP/MoveFileSpec.hs b/hpath-directory/test/System/Directory/AFP/MoveFileSpec.hs index e983801..311f78d 100644 --- a/hpath-directory/test/System/Directory/AFP/MoveFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/MoveFileSpec.hs @@ -5,7 +5,6 @@ module System.Directory.AFP.MoveFileSpec where import Test.Hspec import "hpath-directory" System.Directory.AFP -import System.Directory.Types import System.IO.Error ( ioeGetErrorType diff --git a/hpath-directory/test/System/Directory/AFP/RecreateSymlinkOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkOverwriteSpec.hs index 2932655..345741f 100644 --- a/hpath-directory/test/System/Directory/AFP/RecreateSymlinkOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkOverwriteSpec.hs @@ -8,7 +8,6 @@ module System.Directory.AFP.RecreateSymlinkOverwriteSpec where import Test.Hspec import "hpath-directory" System.Directory.AFP -import System.Directory.Types import System.IO.Error ( ioeGetErrorType diff --git a/hpath-directory/test/System/Directory/AFP/RecreateSymlinkSpec.hs b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkSpec.hs index c2b0aff..4c9f66a 100644 --- a/hpath-directory/test/System/Directory/AFP/RecreateSymlinkSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkSpec.hs @@ -7,7 +7,6 @@ module System.Directory.AFP.RecreateSymlinkSpec where import Test.Hspec import "hpath-directory" System.Directory.AFP -import System.Directory.Types import System.IO.Error ( ioeGetErrorType diff --git a/hpath-directory/test/Utils.hs b/hpath-directory/test/Utils.hs index b1b4381..f20a99d 100644 --- a/hpath-directory/test/Utils.hs +++ b/hpath-directory/test/Utils.hs @@ -6,12 +6,6 @@ module Utils where -import Control.Applicative - ( - (<$>) - ) -import Control.Exception -import Data.Either import Control.Monad ( forM_ @@ -40,24 +34,21 @@ import System.IO.Unsafe ) #ifdef WINDOWS #else -import qualified System.Posix.PosixFilePath.Directory.Traversals as DT import System.Posix.PosixFilePath.Directory ( getFileType - , FileType ) -import AFP.AbstractFilePath.Posix (PosixFilePath) +import System.AbstractFilePath.Posix (PosixFilePath) #endif import Data.ByteString ( ByteString ) -import AFP.AbstractFilePath -import AFP.OsString.Internal.Types -import qualified AFP.AbstractFilePath as AFP -import qualified Data.ByteString.Short as SBS +import System.AbstractFilePath +import System.OsString.Internal.Types +import qualified System.AbstractFilePath as AFP -import System.Directory.AFP +import System.Directory.AFP hiding ( getFileType ) @@ -117,7 +108,7 @@ withRawTmpDir f = do getRawTmpDir :: IO AbstractFilePath {-# NOINLINE getRawTmpDir #-} -getRawTmpDir = withRawTmpDir (return . packAFP . (++ [fromChar '/']) . unpackAFP) +getRawTmpDir = withRawTmpDir (return . packAFP . (++ [unsafeFromChar '/']) . unpackAFP) withTmpDir :: AbstractFilePath -> (AbstractFilePath -> IO a) -> IO a diff --git a/hpath-io/hpath-io.cabal b/hpath-io/hpath-io.cabal index b2c1477..1cb6255 100644 --- a/hpath-io/hpath-io.cabal +++ b/hpath-io/hpath-io.cabal @@ -26,7 +26,7 @@ library buildable: False exposed-modules: HPath.IO build-depends: base >= 4.8 && <5 - , abstract-filepath-types + , filepath >= 2.0.0.0 , bytestring >= 0.10.0.0 , exceptions , hpath >= 0.13 && < 0.14 @@ -35,7 +35,7 @@ library , safe-exceptions >= 0.1 , streamly >= 0.7 , time >= 1.8 - , unix >= 2.5 + , unix >= 2.8 if !impl(ghc>=7.11) build-depends: transformers hs-source-dirs: src diff --git a/hpath-io/src/HPath/IO.hs b/hpath-io/src/HPath/IO.hs index 447e609..4708116 100644 --- a/hpath-io/src/HPath/IO.hs +++ b/hpath-io/src/HPath/IO.hs @@ -102,8 +102,8 @@ import Prelude hiding ( appendFile , readFile , writeFile ) -import AFP.AbstractFilePath.Types -import AFP.OsString.Internal.Types +import System.AbstractFilePath.Types +import System.OsString.Internal.Types import Control.Exception.Safe ( MonadCatch, MonadMask) import Control.Monad.Catch import Data.Bits @@ -419,6 +419,7 @@ createDirRecursive (MkPath p) = Dir.createDirRecursive p -- Note: calls `symlink` createSymlink :: Path b1 -- ^ destination file -> Path b2 -- ^ path the symlink points to + -> Bool -- ^ whether this is a dir (irrelevant on posix) -> IO () createSymlink (MkPath destBS) (MkPath sympoint) = Dir.createSymlink destBS sympoint @@ -736,7 +737,7 @@ getDirsFilesStream (MkPath fp) = do -- -- - `NoSuchThing` if the file does not exist -- - `PermissionDenied` if any part of the path is not accessible -getFileType :: Path b -> IO FileType +getFileType :: Path b -> IO Dir.FileType getFileType (MkPath fp) = Dir.getFileType fp diff --git a/hpath-posix/hpath-posix.cabal b/hpath-posix/hpath-posix.cabal index 3532ccc..b12c095 100644 --- a/hpath-posix/hpath-posix.cabal +++ b/hpath-posix/hpath-posix.cabal @@ -31,9 +31,7 @@ library -- other-modules: -- other-extensions: c-sources: cbits/dirutils.c - build-depends: abstract-filepath-unix >= 2.5 - , abstract-filepath - , abstract-filepath-types + build-depends: filepath >= 2.0.0.0 , base >= 4.8 && <5 , bytestring >= 0.10 , hpath-filepath >= 0.10.4 diff --git a/hpath-posix/src/System/Posix/FD.hs b/hpath-posix/src/System/Posix/FD.hs index bb5746c..d67b9c4 100644 --- a/hpath-posix/src/System/Posix/FD.hs +++ b/hpath-posix/src/System/Posix/FD.hs @@ -29,7 +29,7 @@ import Foreign.C.Types import System.Posix.Foreign import qualified System.Posix as Posix import System.Posix.PosixFilePath.FilePath -import AFP.AbstractFilePath.Types +import System.AbstractFilePath.Types foreign import ccall unsafe "open" diff --git a/hpath-posix/src/System/Posix/PosixFilePath/Directory/Traversals.hs b/hpath-posix/src/System/Posix/PosixFilePath/Directory/Traversals.hs index 10cca8c..3e0a97d 100644 --- a/hpath-posix/src/System/Posix/PosixFilePath/Directory/Traversals.hs +++ b/hpath-posix/src/System/Posix/PosixFilePath/Directory/Traversals.hs @@ -43,7 +43,7 @@ module System.Posix.PosixFilePath.Directory.Traversals ( import Control.Applicative ((<$>)) #endif import Control.Monad -import AFP.AbstractFilePath.Posix ((), fromPlatformString) +import System.AbstractFilePath.Posix ((), fromPlatformString) import System.Posix.Foreign import qualified System.Posix as Posix @@ -63,8 +63,8 @@ import Foreign.Marshal.Alloc (alloca,allocaBytes) import Foreign.Ptr import Foreign.Storable -import AFP.AbstractFilePath.Types -import qualified AFP.OsString.Internal.Types as T +import System.AbstractFilePath.Types +import qualified System.OsString.Internal.Types as T import qualified Data.ByteString.Short as SBS diff --git a/hpath/hpath.cabal b/hpath/hpath.cabal index 7ac6a9a..b6edbd1 100644 --- a/hpath/hpath.cabal +++ b/hpath/hpath.cabal @@ -31,12 +31,11 @@ library ghc-options: -Wall exposed-modules: HPath HPath.Internal - build-depends: abstract-filepath + build-depends: filepath >= 2.0.0.0 , base >= 4.8 && <5 - , bytestring >= 0.10.0.0 + , bytestring >= 0.10.0.0 , deepseq , exceptions - , hpath-filepath >= 0.10 && < 0.11 , template-haskell , utf8-string , word8 diff --git a/hpath/src/HPath.hs b/hpath/src/HPath.hs index b3b6201..a4cd49c 100644 --- a/hpath/src/HPath.hs +++ b/hpath/src/HPath.hs @@ -68,8 +68,8 @@ module HPath ) where -import AFP.AbstractFilePath hiding (()) -import qualified AFP.AbstractFilePath as AFP +import System.AbstractFilePath hiding (()) +import qualified System.AbstractFilePath as AFP import Control.Exception (Exception) import Control.Monad.Catch (MonadThrow(..)) import qualified Data.List as L @@ -80,6 +80,14 @@ import Language.Haskell.TH import Language.Haskell.TH.Syntax (Lift(..), lift) import Language.Haskell.TH.Quote (QuasiQuoter(..)) import Prelude hiding (abs, any) +import System.OsString.Internal.Types +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +import qualified System.AbstractFilePath.Windows.Internal as Raw +import qualified System.AbstractFilePath.Data.ByteString.Short.Word16 as BS +#else +import qualified System.AbstractFilePath.Posix.Internal as Raw +import qualified System.AbstractFilePath.Data.ByteString.Short as BS +#endif -- $setup -- >>> :set -XQuasiQuotes @@ -152,6 +160,7 @@ parseAbs filepath = do then pure . MkPath . dropTrailingPathSeparator . normalise $ filepath else throwM (InvalidAbs filepath) + parseAbs' :: MonadThrow m => String -> m (Path Abs) parseAbs' = parseAbs . toAbstractFilePath @@ -505,7 +514,7 @@ mkRel = either (error . show) lift . parseRel -- >>> [abs|/|] :: Path Abs -- "/" -- >>> [abs|/|] :: Path Abs --- "/\239\131\144" +-- "/" abs :: QuasiQuoter abs = qq mkAbs @@ -516,7 +525,31 @@ abs = qq mkAbs -- >>> [rel|bar/baz|] :: Path Rel -- "bar/baz" -- >>> [rel||] :: Path Rel --- "\239\131\144" +-- "" rel :: QuasiQuoter rel = qq mkRel + +hasParentDir :: AbstractFilePath -> Bool +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +hasParentDir (OsString (WS fp)) = +#else +hasParentDir (OsString (PS fp)) = +#endif + predicate (`BS.cons` pathDoubleDot) + BS.isSuffixOf + || + predicate (\sep -> BS.singleton sep + `BS.append` pathDoubleDot + `BS.append` BS.singleton sep) + BS.isInfixOf + || + predicate (BS.snoc pathDoubleDot) + BS.isPrefixOf + where + pathDoubleDot = BS.pack [0x2e, 0x2e] + predicate f p = + foldr (\a b -> f a + `p` fp || b) + False + Raw.pathSeparators diff --git a/hpath/src/HPath/Internal.hs b/hpath/src/HPath/Internal.hs index 789e6ea..7f09d68 100644 --- a/hpath/src/HPath/Internal.hs +++ b/hpath/src/HPath/Internal.hs @@ -10,7 +10,7 @@ module HPath.Internal (Path(..)) where -import AFP.AbstractFilePath +import System.AbstractFilePath import Control.DeepSeq (NFData (..)) import Data.Data import GHC.Generics (Generic) From 14b11ed7b8915a1008228d502e7c9828a18078a8 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Sun, 1 May 2022 18:35:51 +0200 Subject: [PATCH 14/17] Add configure script --- hpath-directory/configure | 4401 +++++++++++++++++++++++++++++++++++++ 1 file changed, 4401 insertions(+) create mode 100755 hpath-directory/configure diff --git a/hpath-directory/configure b/hpath-directory/configure new file mode 100755 index 0000000..c9114ae --- /dev/null +++ b/hpath-directory/configure @@ -0,0 +1,4401 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.69 for Haskell directory package 1.0. +# +# Report bugs to . +# +# +# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. +# +# +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + +# Use a proper internal environment variable to ensure we don't fall + # into an infinite loop, continuously re-executing ourselves. + if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then + _as_can_reexec=no; export _as_can_reexec; + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +as_fn_exit 255 + fi + # We don't want this to propagate to other subprocesses. + { _as_can_reexec=; unset _as_can_reexec;} +if test "x$CONFIG_SHELL" = x; then + as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which + # is contrary to our usage. Disable this feature. + alias -g '\${1+\"\$@\"}'='\"\$@\"' + setopt NO_GLOB_SUBST +else + case \`(set -o) 2>/dev/null\` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi +" + as_required="as_fn_return () { (exit \$1); } +as_fn_success () { as_fn_return 0; } +as_fn_failure () { as_fn_return 1; } +as_fn_ret_success () { return 0; } +as_fn_ret_failure () { return 1; } + +exitcode=0 +as_fn_success || { exitcode=1; echo as_fn_success failed.; } +as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } +as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } +as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } +if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : + +else + exitcode=1; echo positional parameters were not saved. +fi +test x\$exitcode = x0 || exit 1 +test -x / || exit 1" + as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO + as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO + eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && + test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 +test \$(( 1 + 1 )) = 2 || exit 1" + if (eval "$as_required") 2>/dev/null; then : + as_have_required=yes +else + as_have_required=no +fi + if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : + +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_found=false +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + as_found=: + case $as_dir in #( + /*) + for as_base in sh bash ksh sh5; do + # Try only shells that exist, to save several forks. + as_shell=$as_dir/$as_base + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : + CONFIG_SHELL=$as_shell as_have_required=yes + if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : + break 2 +fi +fi + done;; + esac + as_found=false +done +$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : + CONFIG_SHELL=$SHELL as_have_required=yes +fi; } +IFS=$as_save_IFS + + + if test "x$CONFIG_SHELL" != x; then : + export CONFIG_SHELL + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +exit 255 +fi + + if test x$as_have_required = xno; then : + $as_echo "$0: This script requires a shell more modern than all" + $as_echo "$0: the shells that I found on your system." + if test x${ZSH_VERSION+set} = xset ; then + $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" + $as_echo "$0: be upgraded to zsh 4.3.4 or later." + else + $as_echo "$0: Please tell bug-autoconf@gnu.org and +$0: libraries@haskell.org about your system, including any +$0: error possibly output before this message. Then install +$0: a modern shell, or manually run the script under such a +$0: shell if you do have one." + fi + exit 1 +fi +fi +fi +SHELL=${CONFIG_SHELL-/bin/sh} +export SHELL +# Unset more variables known to interfere with behavior of common tools. +CLICOLOR_FORCE= GREP_OPTIONS= +unset CLICOLOR_FORCE GREP_OPTIONS + +## --------------------- ## +## M4sh Shell Functions. ## +## --------------------- ## +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + + + as_lineno_1=$LINENO as_lineno_1a=$LINENO + as_lineno_2=$LINENO as_lineno_2a=$LINENO + eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && + test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { + # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | + sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno + N + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + t loop + s/-\n.*// + ' >$as_me.lineno && + chmod +x "$as_me.lineno" || + { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } + + # If we had to re-execute with $CONFIG_SHELL, we're ensured to have + # already done that, so ensure we don't try to do so again and fall + # in an infinite loop. This has already happened in practice. + _as_can_reexec=no; export _as_can_reexec + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensitive to this). + . "./$as_me.lineno" + # Exit status is that of the last command. + exit +} + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +test -n "$DJDIR" || exec 7<&0 &1 + +# Name of the host. +# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, +# so uname gets run too. +ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +# +# Initializations. +# +ac_default_prefix=/usr/local +ac_clean_files= +ac_config_libobj_dir=. +LIBOBJS= +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= + +# Identity of this package. +PACKAGE_NAME='Haskell directory package' +PACKAGE_TARNAME='directory' +PACKAGE_VERSION='1.0' +PACKAGE_STRING='Haskell directory package 1.0' +PACKAGE_BUGREPORT='libraries@haskell.org' +PACKAGE_URL='' + +ac_unique_file="src/System/Directory/AFP.hs" +# Factoring default headers for most tests. +ac_includes_default="\ +#include +#ifdef HAVE_SYS_TYPES_H +# include +#endif +#ifdef HAVE_SYS_STAT_H +# include +#endif +#ifdef STDC_HEADERS +# include +# include +#else +# ifdef HAVE_STDLIB_H +# include +# endif +#endif +#ifdef HAVE_STRING_H +# if !defined STDC_HEADERS && defined HAVE_MEMORY_H +# include +# endif +# include +#endif +#ifdef HAVE_STRINGS_H +# include +#endif +#ifdef HAVE_INTTYPES_H +# include +#endif +#ifdef HAVE_STDINT_H +# include +#endif +#ifdef HAVE_UNISTD_H +# include +#endif" + +ac_subst_vars='LTLIBOBJS +LIBOBJS +EGREP +GREP +CPP +OBJEXT +EXEEXT +ac_ct_CC +CPPFLAGS +LDFLAGS +CFLAGS +CC +target_alias +host_alias +build_alias +LIBS +ECHO_T +ECHO_N +ECHO_C +DEFS +mandir +localedir +libdir +psdir +pdfdir +dvidir +htmldir +infodir +docdir +oldincludedir +includedir +runstatedir +localstatedir +sharedstatedir +sysconfdir +datadir +datarootdir +libexecdir +sbindir +bindir +program_transform_name +prefix +exec_prefix +PACKAGE_URL +PACKAGE_BUGREPORT +PACKAGE_STRING +PACKAGE_VERSION +PACKAGE_TARNAME +PACKAGE_NAME +PATH_SEPARATOR +SHELL' +ac_subst_files='' +ac_user_opts=' +enable_option_checking +with_gcc +with_compiler +' + ac_precious_vars='build_alias +host_alias +target_alias +CC +CFLAGS +LDFLAGS +LIBS +CPPFLAGS +CPP' + + +# Initialize some variables set by options. +ac_init_help= +ac_init_version=false +ac_unrecognized_opts= +ac_unrecognized_sep= +# The variables have the same names as the options, with +# dashes changed to underlines. +cache_file=/dev/null +exec_prefix=NONE +no_create= +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +verbose= +x_includes=NONE +x_libraries=NONE + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. +# (The list follows the same order as the GNU Coding Standards.) +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datarootdir='${prefix}/share' +datadir='${datarootdir}' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +runstatedir='${localstatedir}/run' +includedir='${prefix}/include' +oldincludedir='/usr/include' +docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' +infodir='${datarootdir}/info' +htmldir='${docdir}' +dvidir='${docdir}' +pdfdir='${docdir}' +psdir='${docdir}' +libdir='${exec_prefix}/lib' +localedir='${datarootdir}/locale' +mandir='${datarootdir}/man' + +ac_prev= +ac_dashdash= +for ac_option +do + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval $ac_prev=\$ac_option + ac_prev= + continue + fi + + case $ac_option in + *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *=) ac_optarg= ;; + *) ac_optarg=yes ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case $ac_dashdash$ac_option in + --) + ac_dashdash=yes ;; + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir=$ac_optarg ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build_alias ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build_alias=$ac_optarg ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file=$ac_optarg ;; + + --config-cache | -C) + cache_file=config.cache ;; + + -datadir | --datadir | --datadi | --datad) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=*) + datadir=$ac_optarg ;; + + -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ + | --dataroo | --dataro | --datar) + ac_prev=datarootdir ;; + -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ + | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) + datarootdir=$ac_optarg ;; + + -disable-* | --disable-*) + ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=no ;; + + -docdir | --docdir | --docdi | --doc | --do) + ac_prev=docdir ;; + -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) + docdir=$ac_optarg ;; + + -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) + ac_prev=dvidir ;; + -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) + dvidir=$ac_optarg ;; + + -enable-* | --enable-*) + ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=\$ac_optarg ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix=$ac_optarg ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he | -h) + ac_init_help=long ;; + -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) + ac_init_help=recursive ;; + -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) + ac_init_help=short ;; + + -host | --host | --hos | --ho) + ac_prev=host_alias ;; + -host=* | --host=* | --hos=* | --ho=*) + host_alias=$ac_optarg ;; + + -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) + ac_prev=htmldir ;; + -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ + | --ht=*) + htmldir=$ac_optarg ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir=$ac_optarg ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir=$ac_optarg ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir=$ac_optarg ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir=$ac_optarg ;; + + -localedir | --localedir | --localedi | --localed | --locale) + ac_prev=localedir ;; + -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) + localedir=$ac_optarg ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst | --locals) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) + localstatedir=$ac_optarg ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir=$ac_optarg ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c | -n) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir=$ac_optarg ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix=$ac_optarg ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix=$ac_optarg ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix=$ac_optarg ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name=$ac_optarg ;; + + -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) + ac_prev=pdfdir ;; + -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) + pdfdir=$ac_optarg ;; + + -psdir | --psdir | --psdi | --psd | --ps) + ac_prev=psdir ;; + -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) + psdir=$ac_optarg ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -runstatedir | --runstatedir | --runstatedi | --runstated \ + | --runstate | --runstat | --runsta | --runst | --runs \ + | --run | --ru | --r) + ac_prev=runstatedir ;; + -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ + | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ + | --run=* | --ru=* | --r=*) + runstatedir=$ac_optarg ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir=$ac_optarg ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir=$ac_optarg ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site=$ac_optarg ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir=$ac_optarg ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir=$ac_optarg ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target_alias ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target_alias=$ac_optarg ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers | -V) + ac_init_version=: ;; + + -with-* | --with-*) + ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=\$ac_optarg ;; + + -without-* | --without-*) + ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=no ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes=$ac_optarg ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries=$ac_optarg ;; + + -*) as_fn_error $? "unrecognized option: \`$ac_option' +Try \`$0 --help' for more information" + ;; + + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + case $ac_envvar in #( + '' | [0-9]* | *[!_$as_cr_alnum]* ) + as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; + esac + eval $ac_envvar=\$ac_optarg + export $ac_envvar ;; + + *) + # FIXME: should be removed in autoconf 3.0. + $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" + ;; + + esac +done + +if test -n "$ac_prev"; then + ac_option=--`echo $ac_prev | sed 's/_/-/g'` + as_fn_error $? "missing argument to $ac_option" +fi + +if test -n "$ac_unrecognized_opts"; then + case $enable_option_checking in + no) ;; + fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; + *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; + esac +fi + +# Check all directory arguments for consistency. +for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ + datadir sysconfdir sharedstatedir localstatedir includedir \ + oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ + libdir localedir mandir runstatedir +do + eval ac_val=\$$ac_var + # Remove trailing slashes. + case $ac_val in + */ ) + ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` + eval $ac_var=\$ac_val;; + esac + # Be sure to have absolute directory names. + case $ac_val in + [\\/$]* | ?:[\\/]* ) continue;; + NONE | '' ) case $ac_var in *prefix ) continue;; esac;; + esac + as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" +done + +# There might be people who depend on the old broken behavior: `$host' +# used to hold the argument of --host etc. +# FIXME: To remove some day. +build=$build_alias +host=$host_alias +target=$target_alias + +# FIXME: To remove some day. +if test "x$host_alias" != x; then + if test "x$build_alias" = x; then + cross_compiling=maybe + elif test "x$build_alias" != "x$host_alias"; then + cross_compiling=yes + fi +fi + +ac_tool_prefix= +test -n "$host_alias" && ac_tool_prefix=$host_alias- + +test "$silent" = yes && exec 6>/dev/null + + +ac_pwd=`pwd` && test -n "$ac_pwd" && +ac_ls_di=`ls -di .` && +ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || + as_fn_error $? "working directory cannot be determined" +test "X$ac_ls_di" = "X$ac_pwd_ls_di" || + as_fn_error $? "pwd does not report name of working directory" + + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then the parent directory. + ac_confdir=`$as_dirname -- "$as_myself" || +$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_myself" : 'X\(//\)[^/]' \| \ + X"$as_myself" : 'X\(//\)$' \| \ + X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_myself" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + srcdir=$ac_confdir + if test ! -r "$srcdir/$ac_unique_file"; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r "$srcdir/$ac_unique_file"; then + test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." + as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" +fi +ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_abs_confdir=`( + cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" + pwd)` +# When building in place, set srcdir=. +if test "$ac_abs_confdir" = "$ac_pwd"; then + srcdir=. +fi +# Remove unnecessary trailing slashes from srcdir. +# Double slashes in file names in object file debugging info +# mess up M-x gdb in Emacs. +case $srcdir in +*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; +esac +for ac_var in $ac_precious_vars; do + eval ac_env_${ac_var}_set=\${${ac_var}+set} + eval ac_env_${ac_var}_value=\$${ac_var} + eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} + eval ac_cv_env_${ac_var}_value=\$${ac_var} +done + +# +# Report the --help message. +# +if test "$ac_init_help" = "long"; then + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat <<_ACEOF +\`configure' configures Haskell directory package 1.0 to adapt to many kinds of systems. + +Usage: $0 [OPTION]... [VAR=VALUE]... + +To assign environment variables (e.g., CC, CFLAGS...), specify them as +VAR=VALUE. See below for descriptions of some of the useful variables. + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + --help=short display options specific to this package + --help=recursive display the short help of all the included packages + -V, --version display version information and exit + -q, --quiet, --silent do not print \`checking ...' messages + --cache-file=FILE cache test results in FILE [disabled] + -C, --config-cache alias for \`--cache-file=config.cache' + -n, --no-create do not create output files + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] + --datadir=DIR read-only architecture-independent data [DATAROOTDIR] + --infodir=DIR info documentation [DATAROOTDIR/info] + --localedir=DIR locale-dependent data [DATAROOTDIR/locale] + --mandir=DIR man documentation [DATAROOTDIR/man] + --docdir=DIR documentation root [DATAROOTDIR/doc/directory] + --htmldir=DIR html documentation [DOCDIR] + --dvidir=DIR dvi documentation [DOCDIR] + --pdfdir=DIR pdf documentation [DOCDIR] + --psdir=DIR ps documentation [DOCDIR] +_ACEOF + + cat <<\_ACEOF +_ACEOF +fi + +if test -n "$ac_init_help"; then + case $ac_init_help in + short | recursive ) echo "Configuration of Haskell directory package 1.0:";; + esac + cat <<\_ACEOF + +Optional Packages: + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) +C compiler +GHC compiler + +Some influential environment variables: + CC C compiler command + CFLAGS C compiler flags + LDFLAGS linker flags, e.g. -L if you have libraries in a + nonstandard directory + LIBS libraries to pass to the linker, e.g. -l + CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if + you have headers in a nonstandard directory + CPP C preprocessor + +Use these variables to override the choices made by `configure' or to help +it to find libraries and programs with nonstandard names/locations. + +Report bugs to . +_ACEOF +ac_status=$? +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d "$ac_dir" || + { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || + continue + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + cd "$ac_dir" || { ac_status=$?; continue; } + # Check for guested configure. + if test -f "$ac_srcdir/configure.gnu"; then + echo && + $SHELL "$ac_srcdir/configure.gnu" --help=recursive + elif test -f "$ac_srcdir/configure"; then + echo && + $SHELL "$ac_srcdir/configure" --help=recursive + else + $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi || ac_status=$? + cd "$ac_pwd" || { ac_status=$?; break; } + done +fi + +test -n "$ac_init_help" && exit $ac_status +if $ac_init_version; then + cat <<\_ACEOF +Haskell directory package configure 1.0 +generated by GNU Autoconf 2.69 + +Copyright (C) 2012 Free Software Foundation, Inc. +This configure script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it. +_ACEOF + exit +fi + +## ------------------------ ## +## Autoconf initialization. ## +## ------------------------ ## + +# ac_fn_c_try_compile LINENO +# -------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_compile + +# ac_fn_c_try_cpp LINENO +# ---------------------- +# Try to preprocess conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_cpp () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } > conftest.i && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.err + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_cpp + +# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists, giving a warning if it cannot be compiled using +# the include files in INCLUDES and setting the cache variable VAR +# accordingly. +ac_fn_c_check_header_mongrel () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if eval \${$3+:} false; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +else + # Is the header compilable? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5 +$as_echo_n "checking $2 usability... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_header_compiler=yes +else + ac_header_compiler=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5 +$as_echo "$ac_header_compiler" >&6; } + +# Is the header present? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5 +$as_echo_n "checking $2 presence... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <$2> +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + ac_header_preproc=yes +else + ac_header_preproc=no +fi +rm -f conftest.err conftest.i conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5 +$as_echo "$ac_header_preproc" >&6; } + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #(( + yes:no: ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5 +$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} + ;; + no:yes:* ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5 +$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: check for missing prerequisite headers?" >&5 +$as_echo "$as_me: WARNING: $2: check for missing prerequisite headers?" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5 +$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&5 +$as_echo "$as_me: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} +( $as_echo "## ------------------------------------ ## +## Report this to libraries@haskell.org ## +## ------------------------------------ ##" + ) | sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + eval "$3=\$ac_header_compiler" +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_mongrel + +# ac_fn_c_try_run LINENO +# ---------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes +# that executables *can* be run. +ac_fn_c_try_run () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then : + ac_retval=0 +else + $as_echo "$as_me: program exited with status $ac_status" >&5 + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=$ac_status +fi + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_run + +# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists and can be compiled using the include files in +# INCLUDES, setting the cache variable VAR accordingly. +ac_fn_c_check_header_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_compile + +# ac_fn_c_try_link LINENO +# ----------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + test -x conftest$ac_exeext + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_link + +# ac_fn_c_check_func LINENO FUNC VAR +# ---------------------------------- +# Tests whether FUNC exists, setting the cache variable VAR accordingly +ac_fn_c_check_func () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +/* Define $2 to an innocuous variant, in case declares $2. + For example, HP-UX 11i declares gettimeofday. */ +#define $2 innocuous_$2 + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $2 (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef $2 + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $2 (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined __stub_$2 || defined __stub___$2 +choke me +#endif + +int +main () +{ +return $2 (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_func +cat >config.log <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by Haskell directory package $as_me 1.0, which was +generated by GNU Autoconf 2.69. Invocation command line was + + $ $0 $@ + +_ACEOF +exec 5>>config.log +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + $as_echo "PATH: $as_dir" + done +IFS=$as_save_IFS + +} >&5 + +cat >&5 <<_ACEOF + + +## ----------- ## +## Core tests. ## +## ----------- ## + +_ACEOF + + +# Keep a trace of the command line. +# Strip out --no-create and --no-recursion so they do not pile up. +# Strip out --silent because we don't want to record it for future runs. +# Also quote any args containing shell meta-characters. +# Make two passes to allow for proper duplicate-argument suppression. +ac_configure_args= +ac_configure_args0= +ac_configure_args1= +ac_must_keep_next=false +for ac_pass in 1 2 +do + for ac_arg + do + case $ac_arg in + -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + continue ;; + *\'*) + ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; + 2) + as_fn_append ac_configure_args1 " '$ac_arg'" + if test $ac_must_keep_next = true; then + ac_must_keep_next=false # Got value, back to normal. + else + case $ac_arg in + *=* | --config-cache | -C | -disable-* | --disable-* \ + | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ + | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ + | -with-* | --with-* | -without-* | --without-* | --x) + case "$ac_configure_args0 " in + "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; + esac + ;; + -* ) ac_must_keep_next=true ;; + esac + fi + as_fn_append ac_configure_args " '$ac_arg'" + ;; + esac + done +done +{ ac_configure_args0=; unset ac_configure_args0;} +{ ac_configure_args1=; unset ac_configure_args1;} + +# When interrupted or exit'd, cleanup temporary files, and complete +# config.log. We remove comments because anyway the quotes in there +# would cause problems or look ugly. +# WARNING: Use '\'' to represent an apostrophe within the trap. +# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. +trap 'exit_status=$? + # Save into config.log some information that might help in debugging. + { + echo + + $as_echo "## ---------------- ## +## Cache variables. ## +## ---------------- ##" + echo + # The following way of writing the cache mishandles newlines in values, +( + for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + (set) 2>&1 | + case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + sed -n \ + "s/'\''/'\''\\\\'\'''\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" + ;; #( + *) + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) + echo + + $as_echo "## ----------------- ## +## Output variables. ## +## ----------------- ##" + echo + for ac_var in $ac_subst_vars + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + + if test -n "$ac_subst_files"; then + $as_echo "## ------------------- ## +## File substitutions. ## +## ------------------- ##" + echo + for ac_var in $ac_subst_files + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + fi + + if test -s confdefs.h; then + $as_echo "## ----------- ## +## confdefs.h. ## +## ----------- ##" + echo + cat confdefs.h + echo + fi + test "$ac_signal" != 0 && + $as_echo "$as_me: caught signal $ac_signal" + $as_echo "$as_me: exit $exit_status" + } >&5 + rm -f core *.core core.conftest.* && + rm -f -r conftest* confdefs* conf$$* $ac_clean_files && + exit $exit_status +' 0 +for ac_signal in 1 2 13 15; do + trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal +done +ac_signal=0 + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -f -r conftest* confdefs.h + +$as_echo "/* confdefs.h */" > confdefs.h + +# Predefined preprocessor variables. + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_NAME "$PACKAGE_NAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_TARNAME "$PACKAGE_TARNAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_VERSION "$PACKAGE_VERSION" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_STRING "$PACKAGE_STRING" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_URL "$PACKAGE_URL" +_ACEOF + + +# Let the site file select an alternate cache file if it wants to. +# Prefer an explicitly selected file to automatically selected ones. +ac_site_file1=NONE +ac_site_file2=NONE +if test -n "$CONFIG_SITE"; then + # We do not want a PATH search for config.site. + case $CONFIG_SITE in #(( + -*) ac_site_file1=./$CONFIG_SITE;; + */*) ac_site_file1=$CONFIG_SITE;; + *) ac_site_file1=./$CONFIG_SITE;; + esac +elif test "x$prefix" != xNONE; then + ac_site_file1=$prefix/share/config.site + ac_site_file2=$prefix/etc/config.site +else + ac_site_file1=$ac_default_prefix/share/config.site + ac_site_file2=$ac_default_prefix/etc/config.site +fi +for ac_site_file in "$ac_site_file1" "$ac_site_file2" +do + test "x$ac_site_file" = xNONE && continue + if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 +$as_echo "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 + . "$ac_site_file" \ + || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "failed to load site script $ac_site_file +See \`config.log' for more details" "$LINENO" 5; } + fi +done + +if test -r "$cache_file"; then + # Some versions of bash will fail to source /dev/null (special files + # actually), so we avoid doing that. DJGPP emulates it as a regular file. + if test /dev/null != "$cache_file" && test -f "$cache_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 +$as_echo "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . "$cache_file";; + *) . "./$cache_file";; + esac + fi +else + { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 +$as_echo "$as_me: creating cache $cache_file" >&6;} + >$cache_file +fi + +# Check that the precious variables saved in the cache have kept the same +# value. +ac_cache_corrupted=false +for ac_var in $ac_precious_vars; do + eval ac_old_set=\$ac_cv_env_${ac_var}_set + eval ac_new_set=\$ac_env_${ac_var}_set + eval ac_old_val=\$ac_cv_env_${ac_var}_value + eval ac_new_val=\$ac_env_${ac_var}_value + case $ac_old_set,$ac_new_set in + set,) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,);; + *) + if test "x$ac_old_val" != "x$ac_new_val"; then + # differences in whitespace do not lead to failure. + ac_old_val_w=`echo x $ac_old_val` + ac_new_val_w=`echo x $ac_new_val` + if test "$ac_old_val_w" != "$ac_new_val_w"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 +$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + ac_cache_corrupted=: + else + { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 +$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + eval $ac_var=\$ac_old_val + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 +$as_echo "$as_me: former value: \`$ac_old_val'" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 +$as_echo "$as_me: current value: \`$ac_new_val'" >&2;} + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *) ac_arg=$ac_var=$ac_new_val ;; + esac + case " $ac_configure_args " in + *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. + *) as_fn_append ac_configure_args " '$ac_arg'" ;; + esac + fi +done +if $ac_cache_corrupted; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 +$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} + as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 +fi +## -------------------- ## +## Main body of script. ## +## -------------------- ## + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + +# Safety check: Ensure that we are in the correct source directory. + + +ac_config_headers="$ac_config_headers src/HsDirectoryConfig.h" + + +# Autoconf chokes on spaces, but we may receive a path from Cabal containing +# spaces. In that case, we just ignore Cabal's suggestion. +set_with_gcc() { + case $withval in + *" "*) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: --with-gcc ignored due to presence of spaces" >&5 +$as_echo "$as_me: WARNING: --with-gcc ignored due to presence of spaces" >&2;};; + *) + CC=$withval + esac +} + +# Legacy support for setting the C compiler with Cabal<1.24 +# Newer versions use Autoconf's native `CC=...` facility + +# Check whether --with-gcc was given. +if test "${with_gcc+set}" = set; then : + withval=$with_gcc; set_with_gcc +fi + +# avoid warnings when run via Cabal + +# Check whether --with-compiler was given. +if test "${with_compiler+set}" = set; then : + withval=$with_compiler; +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. +set dummy ${ac_tool_prefix}gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +else + CC="$ac_cv_prog_CC" +fi + +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. +set dummy ${ac_tool_prefix}cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + fi +fi +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + ac_prog_rejected=no +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# != 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" + fi +fi +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + for ac_prog in cl.exe + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$CC" && break + done +fi +if test -z "$CC"; then + ac_ct_CC=$CC + for ac_prog in cl.exe +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_CC" && break +done + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +fi + +fi + + +test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "no acceptable C compiler found in \$PATH +See \`config.log' for more details" "$LINENO" 5; } + +# Provide some information about the compiler. +$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done + +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" +# Try to create an executable without -o first, disregard a.out. +# It will help us diagnose broken compilers, and finding out an intuition +# of exeext. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 +$as_echo_n "checking whether the C compiler works... " >&6; } +ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` + +# The possible output files: +ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" + +ac_rmfiles= +for ac_file in $ac_files +do + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + * ) ac_rmfiles="$ac_rmfiles $ac_file";; + esac +done +rm -f $ac_rmfiles + +if { { ac_try="$ac_link_default" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link_default") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. +# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' +# in a Makefile. We should not override ac_cv_exeext if it was cached, +# so that the user can short-circuit this test for compilers unknown to +# Autoconf. +for ac_file in $ac_files '' +do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) + ;; + [ab].out ) + # We found the default executable, but exeext='' is most + # certainly right. + break;; + *.* ) + if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; + then :; else + ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + fi + # We set ac_cv_exeext here because the later test for it is not + # safe: cross compilers may not add the suffix if given an `-o' + # argument, so we may need to know it at that point already. + # Even if this section looks crufty: it has the advantage of + # actually working. + break;; + * ) + break;; + esac +done +test "$ac_cv_exeext" = no && ac_cv_exeext= + +else + ac_file='' +fi +if test -z "$ac_file"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +$as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "C compiler cannot create executables +See \`config.log' for more details" "$LINENO" 5; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 +$as_echo_n "checking for C compiler default output file name... " >&6; } +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 +$as_echo "$ac_file" >&6; } +ac_exeext=$ac_cv_exeext + +rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out +ac_clean_files=$ac_clean_files_save +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 +$as_echo_n "checking for suffix of executables... " >&6; } +if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # If both `conftest.exe' and `conftest' are `present' (well, observable) +# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will +# work properly (i.e., refer to `conftest.exe'), while it won't with +# `rm'. +for ac_file in conftest.exe conftest conftest.*; do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + break;; + * ) break;; + esac +done +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest conftest$ac_cv_exeext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 +$as_echo "$ac_cv_exeext" >&6; } + +rm -f conftest.$ac_ext +EXEEXT=$ac_cv_exeext +ac_exeext=$EXEEXT +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +FILE *f = fopen ("conftest.out", "w"); + return ferror (f) || fclose (f) != 0; + + ; + return 0; +} +_ACEOF +ac_clean_files="$ac_clean_files conftest.out" +# Check that the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 +$as_echo_n "checking whether we are cross compiling... " >&6; } +if test "$cross_compiling" != yes; then + { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + if { ac_try='./conftest$ac_cv_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then + cross_compiling=no + else + if test "$cross_compiling" = maybe; then + cross_compiling=yes + else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details" "$LINENO" 5; } + fi + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 +$as_echo "$cross_compiling" >&6; } + +rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out +ac_clean_files=$ac_clean_files_save +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 +$as_echo_n "checking for suffix of object files... " >&6; } +if ${ac_cv_objext+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.o conftest.obj +if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + for ac_file in conftest.o conftest.obj conftest.*; do + test -f "$ac_file" || continue; + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; + *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` + break;; + esac +done +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of object files: cannot compile +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest.$ac_cv_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 +$as_echo "$ac_cv_objext" >&6; } +OBJEXT=$ac_cv_objext +ac_objext=$OBJEXT +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 +$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } +if ${ac_cv_c_compiler_gnu+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_compiler_gnu=yes +else + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_c_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 +$as_echo "$ac_cv_c_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GCC=yes +else + GCC= +fi +ac_test_CFLAGS=${CFLAGS+set} +ac_save_CFLAGS=$CFLAGS +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 +$as_echo_n "checking whether $CC accepts -g... " >&6; } +if ${ac_cv_prog_cc_g+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +else + CFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 +$as_echo "$ac_cv_prog_cc_g" >&6; } +if test "$ac_test_CFLAGS" = set; then + CFLAGS=$ac_save_CFLAGS +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then + CFLAGS="-O2" + else + CFLAGS= + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 +$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } +if ${ac_cv_prog_cc_c89+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_prog_cc_c89=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +struct stat; +/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ +struct buf { int x; }; +FILE * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not '\xHH' hex character constants. + These don't provoke an error unfortunately, instead are silently treated + as 'x'. The following induces an error, until -std is added to get + proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an + array size at least. It's necessary to write '\x00'==0 to get something + that's true only with -std. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) 'x' +int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); +int argc; +char **argv; +int +main () +{ +return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; + ; + return 0; +} +_ACEOF +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ + -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_c89=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c89" in + x) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c89" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; +esac +if test "x$ac_cv_prog_cc_c89" != xno; then : + +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +# check for specific header (.h) files that we are interested in + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 +$as_echo_n "checking how to run the C preprocessor... " >&6; } +# On Suns, sometimes $CPP names a directory. +if test -n "$CPP" && test -d "$CPP"; then + CPP= +fi +if test -z "$CPP"; then + if ${ac_cv_prog_CPP+:} false; then : + $as_echo_n "(cached) " >&6 +else + # Double quotes because CPP needs to be expanded + for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" + do + ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer to if __STDC__ is defined, since + # exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include +#else +# include +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + break +fi + + done + ac_cv_prog_CPP=$CPP + +fi + CPP=$ac_cv_prog_CPP +else + ac_cv_prog_CPP=$CPP +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 +$as_echo "$CPP" >&6; } +ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer to if __STDC__ is defined, since + # exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include +#else +# include +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details" "$LINENO" 5; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 +$as_echo_n "checking for grep that handles long lines and -e... " >&6; } +if ${ac_cv_path_GREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$GREP"; then + ac_path_GREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in grep ggrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_GREP" || continue +# Check for GNU ac_path_GREP and select it if it is found. + # Check for GNU $ac_path_GREP +case `"$ac_path_GREP" --version 2>&1` in +*GNU*) + ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'GREP' >> "conftest.nl" + "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_GREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_GREP="$ac_path_GREP" + ac_path_GREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_GREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_GREP"; then + as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_GREP=$GREP +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 +$as_echo "$ac_cv_path_GREP" >&6; } + GREP="$ac_cv_path_GREP" + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 +$as_echo_n "checking for egrep... " >&6; } +if ${ac_cv_path_EGREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 + then ac_cv_path_EGREP="$GREP -E" + else + if test -z "$EGREP"; then + ac_path_EGREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in egrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_EGREP" || continue +# Check for GNU ac_path_EGREP and select it if it is found. + # Check for GNU $ac_path_EGREP +case `"$ac_path_EGREP" --version 2>&1` in +*GNU*) + ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'EGREP' >> "conftest.nl" + "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_EGREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_EGREP="$ac_path_EGREP" + ac_path_EGREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_EGREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_EGREP"; then + as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_EGREP=$EGREP +fi + + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 +$as_echo "$ac_cv_path_EGREP" >&6; } + EGREP="$ac_cv_path_EGREP" + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 +$as_echo_n "checking for ANSI C header files... " >&6; } +if ${ac_cv_header_stdc+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#include +#include + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_header_stdc=yes +else + ac_cv_header_stdc=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +if test $ac_cv_header_stdc = yes; then + # SunOS 4.x string.h does not declare mem*, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "memchr" >/dev/null 2>&1; then : + +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "free" >/dev/null 2>&1; then : + +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. + if test "$cross_compiling" = yes; then : + : +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#if ((' ' & 0x0FF) == 0x020) +# define ISLOWER(c) ('a' <= (c) && (c) <= 'z') +# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) +#else +# define ISLOWER(c) \ + (('a' <= (c) && (c) <= 'i') \ + || ('j' <= (c) && (c) <= 'r') \ + || ('s' <= (c) && (c) <= 'z')) +# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) +#endif + +#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) +int +main () +{ + int i; + for (i = 0; i < 256; i++) + if (XOR (islower (i), ISLOWER (i)) + || toupper (i) != TOUPPER (i)) + return 2; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + +else + ac_cv_header_stdc=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5 +$as_echo "$ac_cv_header_stdc" >&6; } +if test $ac_cv_header_stdc = yes; then + +$as_echo "#define STDC_HEADERS 1" >>confdefs.h + +fi + +# On IRIX 5.3, sys/types and inttypes.h are conflicting. +for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ + inttypes.h stdint.h unistd.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default +" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + +for ac_header in fcntl.h limits.h sys/types.h sys/stat.h time.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + +for ac_func in utimensat +do : + ac_fn_c_check_func "$LINENO" "utimensat" "ac_cv_func_utimensat" +if test "x$ac_cv_func_utimensat" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_UTIMENSAT 1 +_ACEOF + +fi +done + +for ac_func in CreateSymbolicLinkW +do : + ac_fn_c_check_func "$LINENO" "CreateSymbolicLinkW" "ac_cv_func_CreateSymbolicLinkW" +if test "x$ac_cv_func_CreateSymbolicLinkW" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_CREATESYMBOLICLINKW 1 +_ACEOF + +fi +done + +for ac_func in GetFinalPathNameByHandleW +do : + ac_fn_c_check_func "$LINENO" "GetFinalPathNameByHandleW" "ac_cv_func_GetFinalPathNameByHandleW" +if test "x$ac_cv_func_GetFinalPathNameByHandleW" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_GETFINALPATHNAMEBYHANDLEW 1 +_ACEOF + +fi +done + + +# EXTEXT is defined automatically by AC_PROG_CC; +# we just need to capture it in the header file + +cat >>confdefs.h <<_ACEOF +#define EXE_EXTENSION "$EXEEXT" +_ACEOF + + +cat >confcache <<\_ACEOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. +# +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. +# +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, we kill variables containing newlines. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +( + for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + + (set) 2>&1 | + case $as_nl`(ac_space=' '; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + # `set' does not quote correctly, so add quotes: double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \. + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; #( + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) | + sed ' + /^ac_cv_env_/b end + t clear + :clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ + t end + s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + :end' >>confcache +if diff "$cache_file" confcache >/dev/null 2>&1; then :; else + if test -w "$cache_file"; then + if test "x$cache_file" != "x/dev/null"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 +$as_echo "$as_me: updating cache $cache_file" >&6;} + if test ! -f "$cache_file" || test -h "$cache_file"; then + cat confcache >"$cache_file" + else + case $cache_file in #( + */* | ?:*) + mv -f confcache "$cache_file"$$ && + mv -f "$cache_file"$$ "$cache_file" ;; #( + *) + mv -f confcache "$cache_file" ;; + esac + fi + fi + else + { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 +$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} + fi +fi +rm -f confcache + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +DEFS=-DHAVE_CONFIG_H + +ac_libobjs= +ac_ltlibobjs= +U= +for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue + # 1. Remove the extension, and $U if already installed. + ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' + ac_i=`$as_echo "$ac_i" | sed "$ac_script"` + # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR + # will be set to the directory where LIBOBJS objects are built. + as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" + as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + + +: "${CONFIG_STATUS=./config.status}" +ac_write_fail=0 +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 +$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} +as_write_fail=0 +cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 +#! $SHELL +# Generated by $as_me. +# Run this file to recreate the current configuration. +# Compiler output produced by configure, useful for debugging +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false + +SHELL=\${CONFIG_SHELL-$SHELL} +export SHELL +_ASEOF +cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +exec 6>&1 +## ----------------------------------- ## +## Main body of $CONFIG_STATUS script. ## +## ----------------------------------- ## +_ASEOF +test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# Save the log message, to keep $0 and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. +ac_log=" +This file was extended by Haskell directory package $as_me 1.0, which was +generated by GNU Autoconf 2.69. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +on `(hostname || uname -n) 2>/dev/null | sed 1q` +" + +_ACEOF + + +case $ac_config_headers in *" +"*) set x $ac_config_headers; shift; ac_config_headers=$*;; +esac + + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# Files that config.status was made for. +config_headers="$ac_config_headers" + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +ac_cs_usage="\ +\`$as_me' instantiates files and other configuration actions +from templates according to the current configuration. Unless the files +and actions are specified as TAGs, all are instantiated by default. + +Usage: $0 [OPTION]... [TAG]... + + -h, --help print this help, then exit + -V, --version print version number and configuration settings, then exit + --config print configuration, then exit + -q, --quiet, --silent + do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --header=FILE[:TEMPLATE] + instantiate the configuration header FILE + +Configuration headers: +$config_headers + +Report bugs to ." + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" +ac_cs_version="\\ +Haskell directory package config.status 1.0 +configured by $0, generated by GNU Autoconf 2.69, + with options \\"\$ac_cs_config\\" + +Copyright (C) 2012 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." + +ac_pwd='$ac_pwd' +srcdir='$srcdir' +test -n "\$AWK" || AWK=awk +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=?*) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` + ac_shift=: + ;; + --*=) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= + ac_shift=: + ;; + *) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + esac + + case $ac_option in + # Handling of the options. + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) + $as_echo "$ac_cs_version"; exit ;; + --config | --confi | --conf | --con | --co | --c ) + $as_echo "$ac_cs_config"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) + debug=: ;; + --header | --heade | --head | --hea ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + as_fn_append CONFIG_HEADERS " '$ac_optarg'" + ac_need_defaults=false;; + --he | --h) + # Conflict between --help and --header + as_fn_error $? "ambiguous option: \`$1' +Try \`$0 --help' for more information.";; + --help | --hel | -h ) + $as_echo "$ac_cs_usage"; exit ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) as_fn_error $? "unrecognized option: \`$1' +Try \`$0 --help' for more information." ;; + + *) as_fn_append ac_config_targets " $1" + ac_need_defaults=false ;; + + esac + shift +done + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +if \$ac_cs_recheck; then + set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' + export CONFIG_SHELL + exec "\$@" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + $as_echo "$ac_log" +} >&5 + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "src/HsDirectoryConfig.h") CONFIG_HEADERS="$CONFIG_HEADERS src/HsDirectoryConfig.h" ;; + + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + esac +done + + +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason against having it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Hook for its removal unless debugging. +# Note that there is a small window in which the directory will not be cleaned: +# after its creation but before its name has been assigned to `$tmp'. +$debug || +{ + tmp= ac_tmp= + trap 'exit_status=$? + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status +' 0 + trap 'as_fn_exit 1' 1 2 13 15 +} +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 +ac_tmp=$tmp + +# Set up the scripts for CONFIG_HEADERS section. +# No need to generate them if there are no CONFIG_HEADERS. +# This happens for instance with `./config.status Makefile'. +if test -n "$CONFIG_HEADERS"; then +cat >"$ac_tmp/defines.awk" <<\_ACAWK || +BEGIN { +_ACEOF + +# Transform confdefs.h into an awk script `defines.awk', embedded as +# here-document in config.status, that substitutes the proper values into +# config.h.in to produce config.h. + +# Create a delimiter string that does not exist in confdefs.h, to ease +# handling of long lines. +ac_delim='%!_!# ' +for ac_last_try in false false :; do + ac_tt=`sed -n "/$ac_delim/p" confdefs.h` + if test -z "$ac_tt"; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done + +# For the awk script, D is an array of macro values keyed by name, +# likewise P contains macro parameters if any. Preserve backslash +# newline sequences. + +ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* +sed -n ' +s/.\{148\}/&'"$ac_delim"'/g +t rset +:rset +s/^[ ]*#[ ]*define[ ][ ]*/ / +t def +d +:def +s/\\$// +t bsnl +s/["\\]/\\&/g +s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ +D["\1"]=" \3"/p +s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2"/p +d +:bsnl +s/["\\]/\\&/g +s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ +D["\1"]=" \3\\\\\\n"\\/p +t cont +s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p +t cont +d +:cont +n +s/.\{148\}/&'"$ac_delim"'/g +t clear +:clear +s/\\$// +t bsnlc +s/["\\]/\\&/g; s/^/"/; s/$/"/p +d +:bsnlc +s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p +b cont +' >$CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + for (key in D) D_is_set[key] = 1 + FS = "" +} +/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ { + line = \$ 0 + split(line, arg, " ") + if (arg[1] == "#") { + defundef = arg[2] + mac1 = arg[3] + } else { + defundef = substr(arg[1], 2) + mac1 = arg[2] + } + split(mac1, mac2, "(") #) + macro = mac2[1] + prefix = substr(line, 1, index(line, defundef) - 1) + if (D_is_set[macro]) { + # Preserve the white space surrounding the "#". + print prefix "define", macro P[macro] D[macro] + next + } else { + # Replace #undef with comments. This is necessary, for example, + # in the case of _POSIX_SOURCE, which is predefined and required + # on some systems where configure will not decide to define it. + if (defundef == "undef") { + print "/*", prefix defundef, macro, "*/" + next + } + } +} +{ print } +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + as_fn_error $? "could not setup config headers machinery" "$LINENO" 5 +fi # test -n "$CONFIG_HEADERS" + + +eval set X " :H $CONFIG_HEADERS " +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :[FH]-) ac_tag=-:-;; + :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; + esac + ac_save_IFS=$IFS + IFS=: + set x $ac_tag + IFS=$ac_save_IFS + shift + ac_file=$1 + shift + + case $ac_mode in + :L) ac_source=$1;; + :[FH]) + ac_file_inputs= + for ac_f + do + case $ac_f in + -) ac_f="$ac_tmp/stdin";; + *) # Look for the file first in the build tree, then in the source tree + # (if the path is not absolute). The absolute path cannot be DOS-style, + # because $ac_f cannot contain `:'. + test -f "$ac_f" || + case $ac_f in + [\\/$]*) false;; + *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; + esac || + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + esac + case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + as_fn_append ac_file_inputs " '$ac_f'" + done + + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + configure_input='Generated from '` + $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 +$as_echo "$as_me: creating $ac_file" >&6;} + fi + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`$as_echo "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac + + case $ac_tag in + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + esac + ;; + esac + + ac_dir=`$as_dirname -- "$ac_file" || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + as_dir="$ac_dir"; as_fn_mkdir_p + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + + case $ac_mode in + + :H) + # + # CONFIG_HEADER + # + if test x"$ac_file" != x-; then + { + $as_echo "/* $configure_input */" \ + && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" + } >"$ac_tmp/config.h" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + if diff "$ac_file" "$ac_tmp/config.h" >/dev/null 2>&1; then + { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5 +$as_echo "$as_me: $ac_file is unchanged" >&6;} + else + rm -f "$ac_file" + mv "$ac_tmp/config.h" "$ac_file" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + fi + else + $as_echo "/* $configure_input */" \ + && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \ + || as_fn_error $? "could not create -" "$LINENO" 5 + fi + ;; + + + esac + +done # for ac_tag + + +as_fn_exit 0 +_ACEOF +ac_clean_files=$ac_clean_files_save + +test $ac_write_fail = 0 || + as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 + + +# configure is writing to config.log, and then calls config.status. +# config.status does its own redirection, appending to config.log. +# Unfortunately, on DOS this fails, as config.log is still kept open +# by configure, so config.status won't be able to write to it; its +# output is simply discarded. So we exec the FD to /dev/null, +# effectively closing config.log, so it can be properly (re)opened and +# appended to by config.status. When coming back to configure, we +# need to make the FD available again. +if test "$no_create" != yes; then + ac_cs_success=: + ac_config_status_args= + test "$silent" = yes && + ac_config_status_args="$ac_config_status_args --quiet" + exec 5>/dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || as_fn_exit 1 +fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} +fi + From b3a1b11098df7aec00275951895c5cbd7faa9297 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Sun, 1 May 2022 21:22:10 +0200 Subject: [PATCH 15/17] Include HPath --- cabal.project | 7 +- hpath-directory/configure | 2 +- hpath-directory/configure.ac | 2 +- hpath-directory/hpath-directory.cabal | 8 +- .../Directory/{AFP.hs => AbstractFilePath.hs} | 130 +------ .../src/System/Directory/HPath.hs | 355 ++++++------------ .../Win32/WindowsFilePath/Directory.hsc | 204 ++-------- hpath-io/CHANGELOG.md | 55 --- hpath-io/LICENSE | 30 -- hpath-io/README.md | 27 -- hpath-io/Setup.hs | 2 - hpath-io/TODO.md | 6 - hpath-io/hpath-io.cabal | 47 --- 13 files changed, 167 insertions(+), 708 deletions(-) rename hpath-directory/src/System/Directory/{AFP.hs => AbstractFilePath.hs} (86%) rename hpath-io/src/HPath/IO.hs => hpath-directory/src/System/Directory/HPath.hs (64%) delete mode 100644 hpath-io/CHANGELOG.md delete mode 100644 hpath-io/LICENSE delete mode 100644 hpath-io/README.md delete mode 100644 hpath-io/Setup.hs delete mode 100644 hpath-io/TODO.md delete mode 100644 hpath-io/hpath-io.cabal diff --git a/cabal.project b/cabal.project index 1b48121..f3f3afd 100644 --- a/cabal.project +++ b/cabal.project @@ -15,6 +15,11 @@ source-repository-package location: https://github.com/hasufell/Win32.git tag: a2ab9bc501614c48c62f9508488e87f0c2924b7b +source-repository-package + type: git + location: https://github.com/hasufell/file-io.git + tag: 1e01f6aaf1d725999cd20088db8bc8b6f642bd03 + package hpath-io ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 @@ -22,4 +27,4 @@ package hpath-io package streamly ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 -allow-newer: filepath +allow-newer: filepath, Win32 diff --git a/hpath-directory/configure b/hpath-directory/configure index c9114ae..730dc2d 100755 --- a/hpath-directory/configure +++ b/hpath-directory/configure @@ -585,7 +585,7 @@ PACKAGE_STRING='Haskell directory package 1.0' PACKAGE_BUGREPORT='libraries@haskell.org' PACKAGE_URL='' -ac_unique_file="src/System/Directory/AFP.hs" +ac_unique_file="src/System/Directory/AbstractFilePath.hs" # Factoring default headers for most tests. ac_includes_default="\ #include diff --git a/hpath-directory/configure.ac b/hpath-directory/configure.ac index ef04f6e..4e86dbc 100644 --- a/hpath-directory/configure.ac +++ b/hpath-directory/configure.ac @@ -1,7 +1,7 @@ AC_INIT([Haskell directory package], [1.0], [libraries@haskell.org], [directory]) # Safety check: Ensure that we are in the correct source directory. -AC_CONFIG_SRCDIR([src/System/Directory/AFP.hs]) +AC_CONFIG_SRCDIR([src/System/Directory/AbstractFilePath.hs]) AC_CONFIG_HEADERS([src/HsDirectoryConfig.h]) diff --git a/hpath-directory/hpath-directory.cabal b/hpath-directory/hpath-directory.cabal index f461064..a322726 100644 --- a/hpath-directory/hpath-directory.cabal +++ b/hpath-directory/hpath-directory.cabal @@ -28,7 +28,6 @@ extra-tmp-files: extra-source-files: ./src/HsDirectoryConfig.h.in - ./src/System/Directory/AFP.hs ./src/System/Win32/WindowsFilePath/*.h CHANGELOG.md @@ -56,7 +55,8 @@ library , unix-bytestring >=0.3 exposed-modules: - System.Directory.AFP + System.Directory.AbstractFilePath + System.Directory.HPath System.Directory.Errors System.Directory.Types @@ -67,10 +67,12 @@ library , bytestring >=0.10 , exceptions >=0.10 , filepath >=2.0.0.0 + , file-io , IfElse + , hpath , safe-exceptions >=0.1 , split - , streamly >=0.7 + , streamly >=0.8.2 , streamly-bytestring >=0.1.2 , time >=1.8 , transformers diff --git a/hpath-directory/src/System/Directory/AFP.hs b/hpath-directory/src/System/Directory/AbstractFilePath.hs similarity index 86% rename from hpath-directory/src/System/Directory/AFP.hs rename to hpath-directory/src/System/Directory/AbstractFilePath.hs index 47ea25a..13e5490 100644 --- a/hpath-directory/src/System/Directory/AFP.hs +++ b/hpath-directory/src/System/Directory/AbstractFilePath.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} -module System.Directory.AFP +module System.Directory.AbstractFilePath ( -- * Types module System.Directory.Types @@ -25,15 +25,22 @@ module System.Directory.AFP -- * File renaming/moving , renameFile , moveFile - -- * File reading - , readFile - , readFileStrict - , readFileStream - , readSymbolicLink + -- * File opening + , openFile + , openBinaryFile + , withFile + , withBinaryFile + , withFile' + , withBinaryFile' -- * File writing , writeFile - , writeFileL + , writeFile' , appendFile + , appendFile' + -- * File reading + , readFile + , readFile' + , readSymbolicLink -- * File checks , doesExist , doesFileExist @@ -74,15 +81,16 @@ module System.Directory.AFP ) where +import System.File.AbstractFilePath import Prelude hiding ( appendFile , readFile , writeFile ) -import Data.Bits import System.Directory.Types #ifdef WINDOWS import qualified System.Win32.WindowsFilePath.Directory as Dir #else +import Data.Bits import qualified System.Posix.PosixFilePath.Directory as Dir import qualified System.Posix as Posix (FileMode) import qualified System.Posix.Files.ByteString as Posix @@ -93,11 +101,7 @@ import System.OsString.Internal.Types import Data.Time.Clock import Data.Time.Clock.POSIX import Streamly.Prelude ( SerialT, MonadAsync ) -import Streamly.Data.Array.Foreign -import Data.Word ( Word8 ) -import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString as BS import Control.Exception.Safe ( MonadCatch , MonadMask ) @@ -594,114 +598,12 @@ moveFile (OsString from) (OsString to) cm = Dir.moveFile from to cm -------------------- --- |Read the given file lazily. --- --- Symbolic links are followed. File must exist. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -readFile :: AbstractFilePath -> IO L.ByteString -readFile (OsString path) = Dir.readFile path - - --- |Read the given file strictly into memory. --- --- Symbolic links are followed. File must exist. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -readFileStrict :: AbstractFilePath -> IO BS.ByteString -readFileStrict (OsString path) = Dir.readFileStrict path - - --- | Open the given file as a filestream. Once the filestream --- exits, the filehandle is cleaned up. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -readFileStream :: AbstractFilePath -> IO (SerialT IO (Array Word8)) -readFileStream (OsString fp) = Dir.readFileStream fp - -- | Read the target of a symbolic link. readSymbolicLink :: AbstractFilePath -> IO AbstractFilePath readSymbolicLink (OsString fp) = OsString <$> Dir.readSymbolicLink fp - -------------------- - --[ File Writing ]-- - -------------------- - - --- |Write a given ByteString to a file, truncating the file beforehand. --- Follows symlinks. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -writeFile :: AbstractFilePath - -> Bool -- ^ True if file must exist - -> BS.ByteString - -> IO () -writeFile (OsString fp) nocreat bs = -#if WINDOWS - Dir.writeFile fp nocreat bs -#else - Dir.writeFile fp (if nocreat then Nothing else Just Dir.newFilePerms) bs -#endif - - --- |Write a given lazy ByteString to a file, truncating the file beforehand. --- Follows symlinks. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist --- --- Note: uses streamly under the hood -writeFileL :: AbstractFilePath - -> Bool -- ^ True if file must exist - -> L.ByteString - -> IO () -writeFileL (OsString fp) nocreat lbs = -#if WINDOWS - Dir.writeFileL fp nocreat lbs -#else - Dir.writeFileL fp (if nocreat then Nothing else Just Dir.newFilePerms) lbs -#endif - - --- |Append a given ByteString to a file. --- The file must exist. Follows symlinks. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -appendFile :: AbstractFilePath -> BS.ByteString -> IO () -appendFile (OsString fp) bs = Dir.appendFile fp bs - - ------------------- --[ File checks ]-- diff --git a/hpath-io/src/HPath/IO.hs b/hpath-directory/src/System/Directory/HPath.hs similarity index 64% rename from hpath-io/src/HPath/IO.hs rename to hpath-directory/src/System/Directory/HPath.hs index 4708116..2955e6b 100644 --- a/hpath-io/src/HPath/IO.hs +++ b/hpath-directory/src/System/Directory/HPath.hs @@ -1,36 +1,7 @@ --- | --- Module : HPath.IO --- Copyright : © 2016 Julian Ospald --- License : BSD3 --- --- Maintainer : Julian Ospald --- Stability : experimental --- Portability : portable --- --- This module provides high-level IO related file operations like --- copy, delete, move and so on. It only operates on /Path x/ which --- guarantees us well-typed paths. This is a thin wrapper over --- System.Posix.RawFilePath.Directory in 'hpath-directory'. It's --- encouraged to use this module. --- --- Some of these operations are due to their nature __not atomic__, which --- means they may do multiple syscalls which form one context. Some --- of them also have to examine the filetypes explicitly before the --- syscalls, so a reasonable decision can be made. That means --- the result is undefined if another process changes that context --- while the non-atomic operation is still happening. However, where --- possible, as few syscalls as possible are used and the underlying --- exception handling is kept. --- --- Note: `BlockDevice`, `CharacterDevice`, `NamedPipe` and `Socket` --- are ignored by some of the more high-level functions (like `easyCopy`). --- For other functions (like `copyFile`), the behavior on these file types is --- unreliable/unsafe. Check the documentation of those functions for details. - -{-# LANGUAGE FlexibleContexts #-} -- streamly -{-# LANGUAGE PackageImports #-} - -module HPath.IO +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} + +module System.Directory.HPath ( -- * Types module System.Directory.Types @@ -54,14 +25,22 @@ module HPath.IO -- * File renaming/moving , renameFile , moveFile - -- * File reading - , readFile - , readFileStrict - , readFileStream + -- * File opening + , openFile + , openBinaryFile + , withFile + , withBinaryFile + , withFile' + , withBinaryFile' -- * File writing , writeFile - , writeFileL + , writeFile' , appendFile + , appendFile' + -- * File reading + , readFile + , readFile' + , readSymbolicLink -- * File checks , doesExist , doesFileExist @@ -76,64 +55,55 @@ module HPath.IO , setModificationTimeHiRes -- * Directory reading , getDirsFiles + , getDirsFilesRec , getDirsFiles' + , getDirsFilesRec' , getDirsFilesStream - -- * Filetype operations - , getFileType + , getDirsFilesStreamRec + -- * CWD + , getCurrentDirectory + , setCurrentDirectory -- * Permissions , getPermissions , setPermissions - , emptyPermissions - , setOwnerReadable - , setOwnerWritable - , setOwnerExecutable - , setOwnerSearchable - , newFilePerms - , newDirPerms + , AFP.emptyPermissions + , AFP.setOwnerReadable + , AFP.setOwnerWritable + , AFP.setOwnerExecutable + , AFP.setOwnerSearchable + , AFP.newFilePerms + , AFP.newDirPerms -- * Others , canonicalizePath , toAbs + , getFileType + , AFP.FileType ) -where + where -import HPath -import HPath.Internal +import System.Directory.AbstractFilePath (Permissions) +import qualified System.Directory.AbstractFilePath as AFP +import System.File.AbstractFilePath import Prelude hiding ( appendFile , readFile , writeFile ) -import System.AbstractFilePath.Types -import System.OsString.Internal.Types -import Control.Exception.Safe ( MonadCatch, MonadMask) -import Control.Monad.Catch -import Data.Bits -import Data.Time.Clock -import Data.Time.Clock.POSIX -import Data.Traversable -import Data.Word ( Word8 ) -import Streamly.Data.Array.Foreign -import Streamly.Prelude ( SerialT, MonadAsync ) + +import HPath +import HPath.Internal import System.Directory.Types -import System.Directory.AFP ( - Permissions - , emptyPermissions - , setOwnerReadable - , setOwnerWritable - , setOwnerExecutable - , setOwnerSearchable - , newFilePerms - , newDirPerms - ) +import Data.Time.Clock +import Data.Time.Clock.POSIX +import Streamly.Prelude ( SerialT, MonadAsync ) + +import Control.Exception.Safe ( MonadCatch + , MonadMask + ) + -import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString as BS -import qualified System.Directory.AFP as Dir - ------------------------ - --[ File Permissions ]-- - ------------------------ -- | Get the permissions of a file or directory. @@ -151,11 +121,13 @@ import qualified System.Directory.AFP as Dir -- -- * 'isDoesNotExistError' if the file or directory does not exist. getPermissions :: Path b -> IO Permissions -getPermissions (MkPath b) = Dir.getPermissions b +getPermissions (MkPath path) = AFP.getPermissions path +getFileType :: Path b -> IO AFP.FileType +getFileType (MkPath path) = AFP.getFileType path setPermissions :: Path b -> Permissions -> IO () -setPermissions (MkPath b) perms = Dir.setPermissions b perms +setPermissions (MkPath path) = AFP.setPermissions path @@ -164,14 +136,14 @@ setPermissions (MkPath b) perms = Dir.setPermissions b perms -------------------- -copyDirRecursive :: Path b1 -- ^ source dir - -> Path b2 -- ^ destination (parent dirs +copyDirRecursive :: Path b1 -- ^ source dir + -> Path b2 -- ^ destination (parent dirs -- are not automatically created) -> CopyMode -> RecursiveErrorMode -> IO () copyDirRecursive (MkPath fromp) (MkPath destdirp) cm rm = - Dir.copyDirRecursive fromp destdirp cm rm + AFP.copyDirRecursive fromp destdirp cm rm -- |Recreate a symlink. @@ -207,7 +179,7 @@ recreateSymlink :: Path b1 -- ^ the old symlink file -> CopyMode -> IO () recreateSymlink (MkPath symsource) (MkPath newsym) cm = - Dir.recreateSymlink symsource newsym cm + AFP.recreateSymlink symsource newsym cm -- |Copies the given regular file to the given destination. @@ -244,12 +216,12 @@ recreateSymlink (MkPath symsource) (MkPath newsym) cm = -- Throws in `Strict` mode only: -- -- - `AlreadyExists` if destination already exists -copyFile :: Path b1 -- ^ source file - -> Path b2 -- ^ destination file +copyFile :: Path b1 -- ^ source file + -> Path b2 -- ^ destination file -> CopyMode -> IO () copyFile (MkPath from) (MkPath to) cm = - Dir.copyFile from to cm + AFP.copyFile from to cm -- |Copies a regular file, directory or symbolic link. In case of a @@ -266,7 +238,7 @@ easyCopy :: Path b1 -> RecursiveErrorMode -> IO () easyCopy (MkPath from) (MkPath to) cm rm = - Dir.easyCopy from to cm rm + AFP.easyCopy from to cm rm @@ -289,7 +261,7 @@ easyCopy (MkPath from) (MkPath to) cm rm = -- Notes: calls `unlink` deleteFile :: Path b -> IO () deleteFile (MkPath fp) = - Dir.deleteFile fp + AFP.deleteFile fp -- |Deletes the given directory, which must be empty, never symlinks. @@ -304,7 +276,7 @@ deleteFile (MkPath fp) = -- -- Notes: calls `rmdir` deleteDir :: Path b -> IO () -deleteDir (MkPath fp) = Dir.deleteDir fp +deleteDir (MkPath fp) = AFP.deleteDir fp -- |Deletes the given directory recursively. Does not follow symbolic @@ -327,7 +299,7 @@ deleteDir (MkPath fp) = Dir.deleteDir fp -- - `NoSuchThing` if directory does not exist -- - `PermissionDenied` if we can't open or write to parent directory deleteDirRecursive :: Path b -> IO () -deleteDirRecursive (MkPath p) = Dir.deleteDirRecursive p +deleteDirRecursive (MkPath p) = AFP.deleteDirRecursive p -- |Deletes a file, directory or symlink. @@ -340,8 +312,7 @@ deleteDirRecursive (MkPath p) = Dir.deleteDirRecursive p -- * examines filetypes explicitly -- * calls `deleteDirRecursive` for directories easyDelete :: Path b -> IO () -easyDelete (MkPath p) = Dir.easyDelete p - +easyDelete (MkPath p) = AFP.easyDelete p @@ -360,7 +331,7 @@ easyDelete (MkPath p) = Dir.easyDelete p -- - `NoSuchThing` if any of the parent components of the path -- do not exist createRegularFile :: Path b -> IO () -createRegularFile (MkPath destBS) = Dir.createRegularFile destBS +createRegularFile (MkPath destBS) = AFP.createRegularFile destBS -- |Create an empty directory at the given directory with the given filename. @@ -372,7 +343,7 @@ createRegularFile (MkPath destBS) = Dir.createRegularFile destBS -- - `NoSuchThing` if any of the parent components of the path -- do not exist createDir :: Path b -> IO () -createDir (MkPath destBS) = Dir.createDir destBS +createDir (MkPath destBS) = AFP.createDir destBS -- |Create an empty directory at the given directory with the given filename. -- @@ -382,7 +353,8 @@ createDir (MkPath destBS) = Dir.createDir destBS -- - `NoSuchThing` if any of the parent components of the path -- do not exist createDirIfMissing :: Path b -> IO () -createDirIfMissing (MkPath destBS) = Dir.createDirIfMissing destBS +createDirIfMissing (MkPath destBS) = + AFP.createDirIfMissing destBS -- |Create an empty directory at the given directory with the given filename. @@ -404,7 +376,7 @@ createDirIfMissing (MkPath destBS) = Dir.createDirIfMissing destBS -- - `AlreadyExists` if destination already exists and -- is *not* a directory createDirRecursive :: Path b -> IO () -createDirRecursive (MkPath p) = Dir.createDirRecursive p +createDirRecursive (MkPath p) = AFP.createDirRecursive p -- |Create a symlink. @@ -421,7 +393,8 @@ createSymlink :: Path b1 -- ^ destination file -> Path b2 -- ^ path the symlink points to -> Bool -- ^ whether this is a dir (irrelevant on posix) -> IO () -createSymlink (MkPath destBS) (MkPath sympoint) = Dir.createSymlink destBS sympoint +createSymlink (MkPath destBS) (MkPath sympoint) dir = + AFP.createSymlink destBS sympoint dir @@ -452,7 +425,7 @@ createSymlink (MkPath destBS) (MkPath sympoint) = Dir.createSymlink destBS sympo -- -- Note: calls `rename` (but does not allow to rename over existing files) renameFile :: Path b1 -> Path b2 -> IO () -renameFile (MkPath fromf) (MkPath tof) = Dir.renameFile fromf tof +renameFile (MkPath fromf) (MkPath tof) = AFP.renameFile fromf tof -- |Move a file. This also works across devices by copy-delete fallback. @@ -490,7 +463,7 @@ moveFile :: Path b1 -- ^ file to move -> Path b2 -- ^ destination -> CopyMode -> IO () -moveFile (MkPath from) (MkPath to) cm = Dir.moveFile from to cm +moveFile (MkPath from) (MkPath to) cm = AFP.moveFile from to cm @@ -501,99 +474,10 @@ moveFile (MkPath from) (MkPath to) cm = Dir.moveFile from to cm -------------------- --- |Read the given file lazily. --- --- Symbolic links are followed. File must exist. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -readFile :: Path b -> IO L.ByteString -readFile (MkPath path) = Dir.readFile path - - --- |Read the given file strictly into memory. --- --- Symbolic links are followed. File must exist. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -readFileStrict :: Path b -> IO BS.ByteString -readFileStrict (MkPath path) = Dir.readFileStrict path - - --- | Open the given file as a filestream. Once the filestream --- exits, the filehandle is cleaned up. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -readFileStream :: Path b -> IO (SerialT IO (Array Word8)) -readFileStream (MkPath fp) = Dir.readFileStream fp - - - - -------------------- - --[ File Writing ]-- - -------------------- - - --- |Write a given ByteString to a file, truncating the file beforehand. --- Follows symlinks. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -writeFile :: Path b - -> Bool -- ^ True if file must exist - -> BS.ByteString - -> IO () -writeFile (MkPath fp) nocreat bs = Dir.writeFile fp nocreat bs - - --- |Write a given lazy ByteString to a file, truncating the file beforehand. --- Follows symlinks. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist --- --- Note: uses streamly under the hood -writeFileL :: Path b - -> Bool -- ^ True if file must exist - -> L.ByteString - -> IO () -writeFileL (MkPath fp) nocreat lbs = Dir.writeFileL fp nocreat lbs - - --- |Append a given ByteString to a file. --- The file must exist. Follows symlinks. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -appendFile :: Path b -> BS.ByteString -> IO () -appendFile (MkPath fp) bs = Dir.appendFile fp bs +-- | Read the target of a symbolic link. +readSymbolicLink :: Path b1 -> IO (Path b2) +readSymbolicLink (MkPath fp) = MkPath <$> AFP.readSymbolicLink fp @@ -607,7 +491,7 @@ appendFile (MkPath fp) bs = Dir.appendFile fp bs -- -- Only eNOENT is catched (and returns False). doesExist :: Path b -> IO Bool -doesExist (MkPath bs) = Dir.doesExist bs +doesExist (MkPath bs) = AFP.doesExist bs -- |Checks if the given file exists and is not a directory. @@ -615,7 +499,7 @@ doesExist (MkPath bs) = Dir.doesExist bs -- -- Only eNOENT is catched (and returns False). doesFileExist :: Path b -> IO Bool -doesFileExist (MkPath bs) = Dir.doesFileExist bs +doesFileExist (MkPath bs) = AFP.doesFileExist bs -- |Checks if the given file exists and is a directory. @@ -623,7 +507,7 @@ doesFileExist (MkPath bs) = Dir.doesFileExist bs -- -- Only eNOENT is catched (and returns False). doesDirectoryExist :: Path b -> IO Bool -doesDirectoryExist (MkPath bs) = Dir.doesDirectoryExist bs +doesDirectoryExist (MkPath bs) = AFP.doesDirectoryExist bs -- |Checks whether a file or folder is readable. @@ -634,7 +518,7 @@ doesDirectoryExist (MkPath bs) = Dir.doesDirectoryExist bs -- -- - `NoSuchThing` if the file does not exist isReadable :: Path b -> IO Bool -isReadable (MkPath bs) = Dir.isReadable bs +isReadable (MkPath bs) = AFP.isReadable bs -- |Checks whether a file or folder is writable. -- @@ -644,7 +528,7 @@ isReadable (MkPath bs) = Dir.isReadable bs -- -- - `NoSuchThing` if the file does not exist isWritable :: Path b -> IO Bool -isWritable (MkPath bs) = Dir.isWritable bs +isWritable (MkPath bs) = AFP.isWritable bs -- |Checks whether a file or folder is executable. @@ -655,14 +539,14 @@ isWritable (MkPath bs) = Dir.isWritable bs -- -- - `NoSuchThing` if the file does not exist isExecutable :: Path b -> IO Bool -isExecutable (MkPath bs) = Dir.isExecutable bs +isExecutable (MkPath bs) = AFP.isExecutable bs -- |Checks whether the directory at the given path exists and can be -- opened. This invokes `openDirStream` which follows symlinks. canOpenDirectory :: Path b -> IO Bool -canOpenDirectory (MkPath bs) = Dir.canOpenDirectory bs +canOpenDirectory (MkPath bs) = AFP.canOpenDirectory bs @@ -673,13 +557,13 @@ canOpenDirectory (MkPath bs) = Dir.canOpenDirectory bs getModificationTime :: Path b -> IO UTCTime -getModificationTime (MkPath bs) = Dir.getModificationTime bs +getModificationTime (MkPath bs) = AFP.getModificationTime bs setModificationTime :: Path b -> UTCTime -> IO () -setModificationTime (MkPath bs) t = Dir.setModificationTime bs t +setModificationTime (MkPath bs) t = AFP.setModificationTime bs t setModificationTimeHiRes :: Path b -> POSIXTime -> IO () -setModificationTimeHiRes (MkPath bs) t = Dir.setModificationTimeHiRes bs t +setModificationTimeHiRes (MkPath bs) t = AFP.setModificationTimeHiRes bs t @@ -702,44 +586,50 @@ setModificationTimeHiRes (MkPath bs) t = Dir.setModificationTimeHiRes bs t -- - `PermissionDenied` if directory cannot be opened getDirsFiles :: Path b -- ^ dir to read -> IO [Path b] -getDirsFiles (MkPath p) = fmap MkPath <$> Dir.getDirsFiles p +getDirsFiles (MkPath p) = fmap MkPath <$> AFP.getDirsFiles p + + +getDirsFilesRec :: Path b -- ^ dir to read + -> IO [Path b] +getDirsFilesRec (MkPath p) = fmap MkPath <$> AFP.getDirsFilesRec p -- | Like 'getDirsFiles', but returns the filename only, instead -- of prepending the base path. getDirsFiles' :: Path b -- ^ dir to read -> IO [Path Rel] -getDirsFiles' (MkPath fp) = do - rawContents <- Dir.getDirsFiles' fp - for rawContents $ \r -> parseRel r +getDirsFiles' (MkPath fp) = fmap MkPath <$> AFP.getDirsFiles' fp + + +getDirsFilesRec' :: Path b -- ^ dir to read + -> IO [Path Rel] +getDirsFilesRec' (MkPath p) = fmap MkPath <$> AFP.getDirsFilesRec' p + + +getDirsFilesStreamRec :: (MonadCatch m, MonadAsync m, MonadMask m) + => Path b + -> IO (SerialT m (Path Rel)) +getDirsFilesStreamRec (MkPath fp) = fmap MkPath <$> AFP.getDirsFilesStreamRec fp -- | Like 'getDirsFiles'', except returning a Stream. getDirsFilesStream :: (MonadCatch m, MonadAsync m, MonadMask m) => Path b -> IO (SerialT m (Path Rel)) -getDirsFilesStream (MkPath fp) = do - s <- Dir.getDirsFilesStream fp - pure (s >>= parseRel) +getDirsFilesStream (MkPath fp) = fmap MkPath <$> AFP.getDirsFilesStream fp + ----------- + --[ CWD ]-- + ----------- +getCurrentDirectory :: IO (Path b) +getCurrentDirectory = MkPath <$> AFP.getCurrentDirectory - --------------------------- - --[ FileType operations ]-- - --------------------------- +setCurrentDirectory :: Path b -> IO () +setCurrentDirectory (MkPath fp) = AFP.setCurrentDirectory fp --- |Get the file type of the file located at the given path. Does --- not follow symbolic links. --- --- Throws: --- --- - `NoSuchThing` if the file does not exist --- - `PermissionDenied` if any part of the path is not accessible -getFileType :: Path b -> IO Dir.FileType -getFileType (MkPath fp) = Dir.getFileType fp - -------------- @@ -755,9 +645,7 @@ getFileType (MkPath fp) = Dir.getFileType fp -- - `NoSuchThing` if the file at the given path does not exist -- - `NoSuchThing` if the symlink is broken canonicalizePath :: Path b -> IO (Path Abs) -canonicalizePath (MkPath l) = do - nl <- Dir.canonicalizePath l - parseAbs nl +canonicalizePath (MkPath fp) = MkPath <$> AFP.canonicalizePath fp -- |Converts any path to an absolute path. @@ -766,22 +654,5 @@ canonicalizePath (MkPath l) = do -- - if the path is already an absolute one, just return it -- - if it's a relative path, prepend the current directory to it toAbs :: Path b -> IO (Path Abs) -toAbs (MkPath bs) = MkPath <$> Dir.toAbs bs - - --- | Helper function to use the Path library without --- buying into the Path type too much. This uses 'parseAny' --- under the hood and may throw `PathParseException`. --- --- Throws: --- --- - `PathParseException` if the bytestring could neither be parsed as --- relative or absolute Path -withRawFilePath :: MonadThrow m - => AbstractFilePath - -> (Either (Path Abs) (Path Rel) -> m b) - -> m b -withRawFilePath bs action = do - path <- parseAny bs - action path +toAbs (MkPath bs) = MkPath <$> AFP.toAbs bs diff --git a/hpath-directory/src/System/Win32/WindowsFilePath/Directory.hsc b/hpath-directory/src/System/Win32/WindowsFilePath/Directory.hsc index 8a75694..c2dab43 100644 --- a/hpath-directory/src/System/Win32/WindowsFilePath/Directory.hsc +++ b/hpath-directory/src/System/Win32/WindowsFilePath/Directory.hsc @@ -57,15 +57,22 @@ module System.Win32.WindowsFilePath.Directory -- * File renaming/moving , renameFile , moveFile - -- * File reading - , readFile - , readFileStrict - , readFileStream - , readSymbolicLink + -- * File opening + , openFile + , openBinaryFile + , withFile + , withBinaryFile + , withFile' + , withBinaryFile' -- * File writing , writeFile - , writeFileL + , writeFile' , appendFile + , appendFile' + -- * File reading + , readFile + , readFile' + , readSymbolicLink -- * File permissions , setWriteMode , setFilePermissions @@ -116,13 +123,12 @@ where #include #include +import System.File.PlatformFilePath import Control.Exception.Safe ( IOException , MonadCatch , MonadMask , bracket - , bracketOnError , throwIO - , finally , handleIO ) #if MIN_VERSION_base(4,9,0) @@ -136,9 +142,6 @@ import Control.Monad.IO.Class ( liftIO , MonadIO ) import Control.Monad.IfElse ( unlessM ) -import qualified Data.ByteString as BS -import Data.ByteString ( ByteString ) -import qualified Data.ByteString.Lazy as L import Data.Foldable ( for_ ) import Data.String import Data.List.Split @@ -151,33 +154,24 @@ import Data.Time.Clock.POSIX ( posixSecondsToUTCTime , utcTimeToPOSIXSeconds , POSIXTime ) -import Data.Word ( Word8 ) import GHC.IO.Exception ( IOErrorType(..) ) import Prelude hiding ( appendFile , readFile , writeFile ) -import Streamly.Prelude ( SerialT, MonadAsync ) -import Streamly.Data.Array.Foreign -import qualified Streamly.External.ByteString as SB -import qualified Streamly.External.ByteString.Lazy - as SL -import qualified Streamly.FileSystem.Handle as FH + +import Streamly (MonadAsync, SerialT) + import qualified Streamly.Internal.Data.Unfold as SU -import qualified Streamly.Internal.Data.Array.Stream.Foreign - as AS + import qualified Streamly.Internal.Data.Stream.StreamD.Type as D import Streamly.Internal.Data.Unfold.Type import qualified Streamly.Internal.Data.Stream.IsStream.Expand as SE -import Streamly.Internal.Data.Fold.Type (Fold) -import Streamly.Internal.Data.Array.Stream.Foreign (arraysOf) -import Streamly.Internal.Data.Array.Foreign.Mut.Type (defaultChunkSize) import qualified Streamly.Prelude as S -import qualified System.IO as SIO -import AFP.AbstractFilePath.Windows -import AFP.OsString.Internal.Types +import System.AbstractFilePath.Windows +import System.OsString.Internal.Types import System.Directory.Types import System.Directory.Errors import Data.Bits @@ -193,14 +187,15 @@ import Foreign.Marshal.Alloc import Foreign.Marshal.Utils import Foreign.Storable import Foreign.C.Types -import Data.ByteString.Short.Word16 (packCWStringLen, ShortByteString) -import qualified Data.ByteString.Short.Word16 as W16 +import System.AbstractFilePath.Data.ByteString.Short.Word16 (packCWStringLen, ShortByteString) +import qualified System.AbstractFilePath.Data.ByteString.Short.Word16 as W16 import System.IO.Error import Data.Void + ------------------------------ --[ Windows specific types ]-- ------------------------------ @@ -220,10 +215,6 @@ maxShareMode = Win32.fILE_SHARE_READ .|. Win32.fILE_SHARE_WRITE -writeShareMode :: Win32.ShareMode -writeShareMode = - Win32.fILE_SHARE_DELETE .|. - Win32.fILE_SHARE_READ data Win32_REPARSE_DATA_BUFFER @@ -734,64 +725,6 @@ moveFile from to cm = do -------------------- --- |Read the given file lazily. --- --- Symbolic links are followed. File must exist. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -readFile :: WindowsFilePath -> IO L.ByteString -readFile path = do - stream <- readFileStream path - SL.fromChunksIO stream - - --- |Read the given file strictly into memory. --- --- Symbolic links are followed. File must exist. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -readFileStrict :: WindowsFilePath -> IO BS.ByteString -readFileStrict path = do - stream <- readFileStream path - SB.fromArray <$> AS.toArray stream - - --- | Open the given file as a filestream. Once the filestream --- exits, the filehandle is cleaned up. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -readFileStream :: WindowsFilePath -> IO (SerialT IO (Array Word8)) -readFileStream fp = do - handle <- bracketOnError - (WS.createFile - fp - Win32.gENERIC_READ - maxShareMode - Nothing - Win32.oPEN_EXISTING - Win32.fILE_ATTRIBUTE_NORMAL - Nothing) - Win32.closeHandle - Win32.hANDLEToHandle - let stream = S.unfold (SU.finally SIO.hClose FH.readChunks) handle - pure stream - - foreign import WINAPI unsafe "windows.h DeviceIoControl" c_DeviceIoControl :: Win32.HANDLE @@ -923,93 +856,6 @@ readSymbolicLink path = WS <$> do - -------------------- - --[ File Writing ]-- - -------------------- - - --- |Write a given ByteString to a file, truncating the file beforehand. --- Follows symlinks. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -writeFile :: WindowsFilePath - -> Bool -- ^ True if file must exist - -> ByteString - -> IO () -writeFile fp fmode bs = - writeFileStream - fp - Win32.gENERIC_WRITE - (if fmode then Win32.tRUNCATE_EXISTING else Win32.cREATE_ALWAYS) - FH.writeChunks - (arraysOf defaultChunkSize $ S.unfold SB.read bs) - - --- |Write a given lazy ByteString to a file, truncating the file beforehand. --- Follows symlinks. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist --- --- Note: uses streamly under the hood -writeFileL :: WindowsFilePath - -> Bool -- ^ True if file must exist - -> L.ByteString - -> IO () -writeFileL fp fmode lbs = - writeFileStream - fp - Win32.gENERIC_WRITE - (if fmode then Win32.tRUNCATE_EXISTING else Win32.cREATE_ALWAYS) - FH.writeChunks - (SL.toChunks lbs) - - -writeFileStream :: WindowsFilePath - -> Win32.AccessMode - -> Win32.CreateMode - -> (SIO.Handle -> Fold IO a ()) -- ^ writer - -> SerialT IO a -- ^ stream - -> IO () -writeFileStream fp am cm writer stream = do - handle <- bracketOnError - (WS.createFile - fp - am - writeShareMode - Nothing - cm - Win32.fILE_ATTRIBUTE_NORMAL - Nothing) - Win32.closeHandle - Win32.hANDLEToHandle - finally (streamlyCopy handle) (SIO.hClose handle) - where streamlyCopy tH = S.fold (writer tH) stream - - --- |Append a given ByteString to a file. --- The file must exist. Follows symlinks. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -appendFile :: WindowsFilePath -> ByteString -> IO () -appendFile fp bs = writeFileStream fp Win32.fILE_APPEND_DATA Win32.oPEN_ALWAYS FH.writeChunks - (arraysOf defaultChunkSize $ S.unfold SB.read bs) - - ----------------------- --[ File Permissions]-- @@ -1240,8 +1086,8 @@ getDirsFilesStream fp = do more <- liftIO $ Win32.findNextFile handle fd pure $ case () of _ - | [fromChar '.'] == unpackPlatformString filename -> D.Skip (handle, if more then Just fd else Nothing) - | [fromChar '.', fromChar '.'] == unpackPlatformString filename -> D.Skip (handle, if more then Just fd else Nothing) + | [unsafeFromChar '.'] == unpackPlatformString filename -> D.Skip (handle, if more then Just fd else Nothing) + | [unsafeFromChar '.', unsafeFromChar '.'] == unpackPlatformString filename -> D.Skip (handle, if more then Just fd else Nothing) | otherwise -> D.Yield filename (handle, if more then Just fd else Nothing) diff --git a/hpath-io/CHANGELOG.md b/hpath-io/CHANGELOG.md deleted file mode 100644 index c79200b..0000000 --- a/hpath-io/CHANGELOG.md +++ /dev/null @@ -1,55 +0,0 @@ -# Revision history for hpath-io - -## 0.14.1 -- ????-??-?? - -- add `readFileStrict` - -## 0.14.0 -- 2020-07-04 - -* Use hpath-directory-0.14.0 - -## 0.13.2 -- 2020-05-08 - -* Add getDirsFilesStream and use streamly-posix for dircontents (#34) - -## 0.13.0 -- 2020-01-26 - -* switch to using 'hpath-bytestring' for the implementation (this is now just a wrapper module, mostly) - -## 0.12.0 -- 2020-01-20 - -* breaking API changes - * RelC and Fn were removed from `hpath` - * further changes to `parseAny` - - -## 0.11.0 -- 2020-01-18 - -* `writeFile` not allows to set file mode and create file if it does not exist (this broke API) -* added various new functions: - * createDirIfMissing - * writeFileL (for lazy bytestring) - * isReadable - * isExecutable - * getModificationTime - * setModificationTime - * setModificationTimeHiRes - * getDirsFiles' (returns filenames instead of paths) - * withRawFilePath - * withHandle - -## 0.10.1 -- 2020-01-13 - -* Move file check functions to HPath.IO -* Add 'doesExist' -* Exception handling of `doesExist`, `doesFileExist`, `doesDirectoryExist` has changed: only eNOENT is catched -* Exception handling of `isWritable` has changed: just a wrapper around `access` now -* switch exception handling to `safe-exceptions` -* Redo file reading API (readFileEOF dropped and now using streamly under the hood, added `readFileStream`) - - -## 0.10.0 -- 2020-01-04 - -* First version. Split from 'hpath', contains only the IO parts. -* Now uses streamly for 'copyFile' -* Fixed tmpdir in hspec diff --git a/hpath-io/LICENSE b/hpath-io/LICENSE deleted file mode 100644 index 7ecfe24..0000000 --- a/hpath-io/LICENSE +++ /dev/null @@ -1,30 +0,0 @@ -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. diff --git a/hpath-io/README.md b/hpath-io/README.md deleted file mode 100644 index 90c7b6c..0000000 --- a/hpath-io/README.md +++ /dev/null @@ -1,27 +0,0 @@ -# HPath-IO - -[![Gitter chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/hasufell/hpath?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Hackage version](https://img.shields.io/hackage/v/hpath-io.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-io) [![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/hpath-io.svg)](http://packdeps.haskellers.com/feed?needle=hpath-io) - -High-level IO operations on files/directories, utilizing type-safe Paths. This uses [hpath-directory](https://hackage.haskell.org/package/hpath-directory) under the hood. - -This package is part of the HPath suite, also check out: - -* [hpath](https://hackage.haskell.org/package/hpath) -* [hpath-directory](https://hackage.haskell.org/package/hpath-directory) -* [hpath-filepath](https://hackage.haskell.org/package/hpath-filepath) - -## Motivation - -The motivation came during development of -[hsfm](https://github.com/hasufell/hsfm) -in order to have a proper high-level API of file related operations, -while utilizing type-safe Paths. - -## Goals - -* high-level API to file operations like recursive directory copy -* still allowing sufficient control to interact with the underlying low-level calls -* unit-testing exceptions (because yes, people may rely on them) - -Note: this library was written for __posix__ systems and it will probably not support other systems. - diff --git a/hpath-io/Setup.hs b/hpath-io/Setup.hs deleted file mode 100644 index 9a994af..0000000 --- a/hpath-io/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/hpath-io/TODO.md b/hpath-io/TODO.md deleted file mode 100644 index 1a0301e..0000000 --- a/hpath-io/TODO.md +++ /dev/null @@ -1,6 +0,0 @@ -# TODO - -## Tests - -* `doesExist` not tested -* `readFileStream` only implicitly tested by `readFile` diff --git a/hpath-io/hpath-io.cabal b/hpath-io/hpath-io.cabal deleted file mode 100644 index 1cb6255..0000000 --- a/hpath-io/hpath-io.cabal +++ /dev/null @@ -1,47 +0,0 @@ -name: hpath-io -version: 0.14.2 -synopsis: High-level IO operations on files/directories -description: High-level IO operations on files/directories, utilizing type-safe Paths --- bug-reports: -license: BSD3 -license-file: LICENSE -author: Julian Ospald -maintainer: Julian Ospald -copyright: Julian Ospald 2016 -category: Filesystem -build-type: Simple -cabal-version: 1.14 -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 -extra-source-files: README.md - CHANGELOG.md - -library - if os(windows) - build-depends: unbuildable<0 - buildable: False - exposed-modules: HPath.IO - build-depends: base >= 4.8 && <5 - , filepath >= 2.0.0.0 - , bytestring >= 0.10.0.0 - , exceptions - , hpath >= 0.13 && < 0.14 - , hpath-directory >= 0.15.2 && < 0.16 - , hpath-posix >= 0.14.3 && < 0.15 - , safe-exceptions >= 0.1 - , streamly >= 0.7 - , time >= 1.8 - , unix >= 2.8 - if !impl(ghc>=7.11) - build-depends: transformers - hs-source-dirs: src - default-language: Haskell2010 - - -source-repository head - type: git - location: https://github.com/hasufell/hpath From 7bcff5953165373e9786b817ee716bf1143f239e Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Mon, 2 May 2022 14:04:47 +0200 Subject: [PATCH 16/17] Update --- cabal.project | 10 +- hpath-directory/hpath-directory.cabal | 1 + .../src/System/Directory/AbstractFilePath.hs | 28 ++ .../System/Posix/PosixFilePath/Directory.hs | 231 ++++--------- .../Win32/WindowsFilePath/Directory.hsc | 306 ++++++++++-------- hpath-directory/test/Main.hs | 2 +- .../System/Directory/AFP/AppendFileSpec.hs | 2 +- .../CopyDirRecursiveCollectFailuresSpec.hs | 2 +- .../AFP/CopyDirRecursiveOverwriteSpec.hs | 2 +- .../Directory/AFP/CopyDirRecursiveSpec.hs | 2 +- .../Directory/AFP/CopyFileOverwriteSpec.hs | 2 +- .../test/System/Directory/AFP/CopyFileSpec.hs | 2 +- .../System/Directory/AFP/DeleteFileSpec.hs | 2 +- .../System/Directory/AFP/GetDirsFilesSpec.hs | 2 +- .../Directory/AFP/MoveFileOverwriteSpec.hs | 2 +- .../test/System/Directory/AFP/MoveFileSpec.hs | 2 +- .../test/System/Directory/AFP/ReadFileSpec.hs | 4 +- .../AFP/RecreateSymlinkOverwriteSpec.hs | 2 +- .../Directory/AFP/RecreateSymlinkSpec.hs | 2 +- .../test/System/Directory/AFP/ToAbsSpec.hs | 2 +- .../System/Directory/AFP/WriteFileLSpec.hs | 2 +- .../System/Directory/AFP/WriteFileSpec.hs | 2 +- hpath-directory/test/Utils.hs | 32 +- hpath/hpath.cabal | 3 - 24 files changed, 304 insertions(+), 343 deletions(-) diff --git a/cabal.project b/cabal.project index f3f3afd..1643361 100644 --- a/cabal.project +++ b/cabal.project @@ -1,8 +1,8 @@ packages: ./hpath ./hpath-directory - ./hpath-io ./hpath-posix ./streamly-posix + ../../tmp/file-io https://hackage.haskell.org/package/filepath-2.0.0.0/candidate/filepath-2.0.0.0.tar.gz source-repository-package @@ -15,10 +15,10 @@ source-repository-package location: https://github.com/hasufell/Win32.git tag: a2ab9bc501614c48c62f9508488e87f0c2924b7b -source-repository-package - type: git - location: https://github.com/hasufell/file-io.git - tag: 1e01f6aaf1d725999cd20088db8bc8b6f642bd03 +-- source-repository-package +-- type: git +-- location: https://github.com/hasufell/file-io.git +-- tag: 6bea7270a224c3357f0866b5e9e3aa91fa39e431 package hpath-io ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 diff --git a/hpath-directory/hpath-directory.cabal b/hpath-directory/hpath-directory.cabal index a322726..f1d3755 100644 --- a/hpath-directory/hpath-directory.cabal +++ b/hpath-directory/hpath-directory.cabal @@ -142,6 +142,7 @@ test-suite spec , base , bytestring >=0.10.0.0 , hpath-directory + , file-io , hspec >=1.3 , HUnit , IfElse diff --git a/hpath-directory/src/System/Directory/AbstractFilePath.hs b/hpath-directory/src/System/Directory/AbstractFilePath.hs index 13e5490..b96801a 100644 --- a/hpath-directory/src/System/Directory/AbstractFilePath.hs +++ b/hpath-directory/src/System/Directory/AbstractFilePath.hs @@ -27,6 +27,7 @@ module System.Directory.AbstractFilePath , moveFile -- * File opening , openFile + , openExistingFile , openBinaryFile , withFile , withBinaryFile @@ -35,11 +36,17 @@ module System.Directory.AbstractFilePath -- * File writing , writeFile , writeFile' + , writeExistingFile + , writeExistingFile' , appendFile , appendFile' + , appendExistingFile + , appendExistingFile' -- * File reading , readFile , readFile' + , readExistingFile + , readExistingFile' , readSymbolicLink -- * File checks , doesExist @@ -96,6 +103,8 @@ import qualified System.Posix as Posix (FileMode) import qualified System.Posix.Files.ByteString as Posix import qualified Data.ByteString.Short as SBS #endif +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as L import System.AbstractFilePath.Types import System.OsString.Internal.Types import Data.Time.Clock @@ -590,14 +599,32 @@ moveFile :: AbstractFilePath -- ^ file to move moveFile (OsString from) (OsString to) cm = Dir.moveFile from to cm + ------------------ + --[ File Write ]-- + ------------------ + +appendExistingFile :: AbstractFilePath -> L.ByteString -> IO () +appendExistingFile (OsString fp) = Dir.appendExistingFile fp +appendExistingFile' :: AbstractFilePath -> BS.ByteString -> IO () +appendExistingFile' (OsString fp) = Dir.appendExistingFile' fp +writeExistingFile :: AbstractFilePath -> L.ByteString -> IO () +writeExistingFile (OsString fp) = Dir.writeExistingFile fp + +writeExistingFile' :: AbstractFilePath -> BS.ByteString -> IO () +writeExistingFile' (OsString fp) = Dir.writeExistingFile' fp + -------------------- --[ File Reading ]-- -------------------- +readExistingFile :: AbstractFilePath -> IO L.ByteString +readExistingFile (OsString fp) = Dir.readExistingFile fp +readExistingFile' :: AbstractFilePath -> IO BS.ByteString +readExistingFile' (OsString fp) = Dir.readExistingFile' fp -- | Read the target of a symbolic link. readSymbolicLink :: AbstractFilePath -> IO AbstractFilePath @@ -605,6 +632,7 @@ readSymbolicLink (OsString fp) = OsString <$> Dir.readSymbolicLink fp + ------------------- --[ File checks ]-- ------------------- diff --git a/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs b/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs index 4e25697..3f19866 100644 --- a/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs +++ b/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs @@ -47,9 +47,6 @@ module System.Posix.PosixFilePath.Directory , deleteDir , deleteDirRecursive , easyDelete - -- * File opening (posix specific) - , openFile - , executeFile -- * File creation , createRegularFile , createDir @@ -59,15 +56,28 @@ module System.Posix.PosixFilePath.Directory -- * File renaming/moving , renameFile , moveFile - -- * File reading - , readFile - , readFileStrict - , readFileStream - , readSymbolicLink + -- * File opening + , openFile + , openBinaryFile + , withFile + , withBinaryFile + , withFile' + , withBinaryFile' -- * File writing , writeFile - , writeFileL + , writeFile' + , writeExistingFile + , writeExistingFile' , appendFile + , appendFile' + , appendExistingFile + , appendExistingFile' + -- * File reading + , readFile + , readFile' + , readExistingFile + , readExistingFile' + , readSymbolicLink -- * File permissions , newFilePerms , newDirPerms @@ -102,14 +112,13 @@ module System.Posix.PosixFilePath.Directory where +import System.File.PlatformFilePath import Control.Exception.Safe ( IOException , MonadCatch , MonadMask , bracket - , bracketOnError , onException , throwIO - , finally ) #if MIN_VERSION_base(4,9,0) import qualified Control.Monad.Fail as Fail @@ -117,12 +126,10 @@ import qualified Control.Monad.Fail as Fail import qualified Control.Monad as Fail #endif import Control.Monad ( unless - , void , when ) import Control.Monad.IfElse ( unlessM ) import qualified Data.ByteString as BS -import Data.ByteString ( ByteString ) import qualified Data.ByteString.Lazy as L import Data.Foldable ( for_ ) import Data.String @@ -137,7 +144,6 @@ import Data.Time.Clock.POSIX ( getPOSIXTime , utcTimeToPOSIXSeconds , POSIXTime ) -import Data.Word ( Word8 ) import Foreign.C.Error ( eEXIST , eNOENT , eNOTEMPTY @@ -150,25 +156,12 @@ import Prelude hiding ( appendFile , writeFile ) import Streamly.Prelude ( SerialT, MonadAsync ) -import Streamly.Data.Array.Foreign -import Streamly.External.ByteString -import qualified Streamly.External.ByteString.Lazy - as SL import qualified Streamly.External.Posix.DirStream as SD import qualified Streamly.FileSystem.Handle as FH -import qualified Streamly.Internal.Data.Unfold as SU import qualified Streamly.Internal.FileSystem.Handle as IFH -#if MIN_VERSION_streamly(0,8,0) -import qualified Streamly.Internal.Data.Array.Stream.Foreign - as AS -#else -import qualified Streamly.Internal.Memory.ArrayStream - as AS -#endif import qualified Streamly.Internal.Data.Stream.IsStream.Expand as SE -import Streamly.Internal.Data.Fold.Type (Fold) import qualified Streamly.Prelude as S import Control.Monad.IO.Class ( liftIO ) @@ -207,16 +200,11 @@ import System.Posix.Files.PosixString ( createSymbolicLink import qualified System.Posix.Files.PosixString as PF import qualified System.Posix.IO.PosixString as SPI -import qualified "unix-bytestring" System.Posix.IO.ByteString - as SPB import System.Posix.FD ( openFd ) import qualified System.Posix.PosixFilePath.Directory.Traversals as SPDT import qualified System.Posix.Foreign as SPDF -import qualified System.Posix.Process.PosixString - as SPP import System.Posix.Types ( FileMode - , ProcessID ) import System.Posix.Time @@ -617,28 +605,36 @@ easyDelete p = do _ -> return () + ------------------ + --[ File Write ]-- + ------------------ +appendExistingFile :: PosixFilePath -> L.ByteString -> IO () +appendExistingFile fp contents = withExistingFile fp SIO.AppendMode (`L.hPut` contents) - -------------------- - --[ File Opening ]-- - -------------------- +appendExistingFile' :: PosixFilePath -> BS.ByteString -> IO () +appendExistingFile' fp contents = withExistingFile fp SIO.AppendMode (`BS.hPut` contents) + + +writeExistingFile :: PosixFilePath -> L.ByteString -> IO () +writeExistingFile fp contents = withExistingFile fp SIO.WriteMode (`L.hPut` contents) +writeExistingFile' :: PosixFilePath -> BS.ByteString -> IO () +writeExistingFile' fp contents = withExistingFile fp SIO.WriteMode (`BS.hPut` contents) --- |Opens a file appropriately by invoking xdg-open. The file type --- is not checked. This forks a process. -openFile :: PosixFilePath -> IO ProcessID -openFile fp = - SPP.forkProcess - $ SPP.executeFile [pstr|xdg-open|] True [fp] Nothing + -------------------- + --[ File Reading ]-- + -------------------- +readExistingFile :: PosixFilePath -> IO L.ByteString +readExistingFile fp = withExistingFile' fp SIO.ReadMode L.hGetContents --- |Executes a program with the given arguments. This forks a process. -executeFile :: PosixFilePath -- ^ program - -> [PosixString] -- ^ arguments - -> IO ProcessID -executeFile fp args = - SPP.forkProcess $ SPP.executeFile fp True args Nothing +readExistingFile' :: PosixFilePath -> IO BS.ByteString +readExistingFile' fp = withExistingFile fp SIO.ReadMode BS.hGetContents +-- | Read the target of a symbolic link. +readSymbolicLink :: PosixFilePath -> IO PosixString +readSymbolicLink = PF.readSymbolicLink @@ -840,135 +836,6 @@ moveFile from to cm = do - -------------------- - --[ File Reading ]-- - -------------------- - - --- |Read the given file lazily. --- --- Symbolic links are followed. File must exist. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -readFile :: PosixFilePath -> IO L.ByteString -readFile path = do - stream <- readFileStream path - SL.fromChunksIO stream - - --- |Read the given file strictly into memory. --- --- Symbolic links are followed. File must exist. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -readFileStrict :: PosixFilePath -> IO BS.ByteString -readFileStrict path = do - stream <- readFileStream path - fromArray <$> AS.toArray stream - - --- | Open the given file as a filestream. Once the filestream --- exits, the filehandle is cleaned up. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -readFileStream :: PosixFilePath -> IO (SerialT IO (Array Word8)) -readFileStream fp = do - fd <- openFd fp SPI.ReadOnly [] Nothing - handle <- SPI.fdToHandle fd - let stream = S.unfold (SU.finally SIO.hClose FH.readChunks) handle - pure stream - - --- | Read the target of a symbolic link. -readSymbolicLink :: PosixFilePath -> IO PosixString -readSymbolicLink = PF.readSymbolicLink - - - - -------------------- - --[ File Writing ]-- - -------------------- - - --- |Write a given ByteString to a file, truncating the file beforehand. --- Follows symlinks. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -writeFile :: PosixFilePath - -> Maybe FileMode -- ^ if Nothing, file must exist - -> ByteString - -> IO () -writeFile fp fmode bs = - bracket (openFd fp SPI.WriteOnly [SPDF.oTrunc] fmode) (SPI.closeFd) - $ \fd -> void $ SPB.fdWrite fd bs - - --- |Write a given lazy ByteString to a file, truncating the file beforehand. --- Follows symlinks. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist --- --- Note: uses streamly under the hood -writeFileL :: PosixFilePath - -> Maybe FileMode -- ^ if Nothing, file must exist - -> L.ByteString - -> IO () -writeFileL fp fmode lbs = writeFileStream fp fmode FH.writeChunks (SL.toChunks lbs) - - -writeFileStream :: PosixFilePath - -> Maybe FileMode -- ^ if Nothing, file must exist - -> (SIO.Handle -> Fold IO a ()) -- ^ writer - -> SerialT IO a -- ^ stream - -> IO () -writeFileStream fp fmode writer stream = do - handle <- - bracketOnError (openFd fp SPI.WriteOnly [SPDF.oTrunc] fmode) (SPI.closeFd) - $ SPI.fdToHandle - finally (streamlyCopy handle) (SIO.hClose handle) - where streamlyCopy tH = S.fold (writer tH) stream - - --- |Append a given ByteString to a file. --- The file must exist. Follows symlinks. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -appendFile :: PosixFilePath -> ByteString -> IO () -appendFile fp bs = - bracket (openFd fp SPI.WriteOnly [SPDF.oAppend] Nothing) (SPI.closeFd) - $ \fd -> void $ SPB.fdWrite fd bs - - ----------------------- @@ -1254,3 +1121,15 @@ toAbs bs = do False -> do cwd <- getWorkingDirectory return $ cwd bs + + +withExistingFile :: PosixFilePath -> SIO.IOMode -> (SIO.Handle -> IO r) -> IO r +withExistingFile fp iomode = bracket + (openExistingFile fp iomode) + SIO.hClose + +withExistingFile' :: PosixFilePath -> SIO.IOMode -> (SIO.Handle -> IO r) -> IO r +withExistingFile' fp iomode action = do + h <- openExistingFile fp iomode + action h + diff --git a/hpath-directory/src/System/Win32/WindowsFilePath/Directory.hsc b/hpath-directory/src/System/Win32/WindowsFilePath/Directory.hsc index c2dab43..24f04a1 100644 --- a/hpath-directory/src/System/Win32/WindowsFilePath/Directory.hsc +++ b/hpath-directory/src/System/Win32/WindowsFilePath/Directory.hsc @@ -67,11 +67,17 @@ module System.Win32.WindowsFilePath.Directory -- * File writing , writeFile , writeFile' + , writeExistingFile + , writeExistingFile' , appendFile , appendFile' + , appendExistingFile + , appendExistingFile' -- * File reading , readFile , readFile' + , readExistingFile + , readExistingFile' , readSymbolicLink -- * File permissions , setWriteMode @@ -559,8 +565,161 @@ easyDelete p = do + ------------------ + --[ File Write ]-- + ------------------ + +appendExistingFile :: WindowsFilePath -> L.ByteString -> IO () +appendExistingFile fp contents = withExistingFile fp SIO.AppendMode (`L.hPut` contents) + +appendExistingFile' :: WindowsFilePath -> BS.ByteString -> IO () +appendExistingFile' fp contents = withExistingFile fp SIO.AppendMode (`BS.hPut` contents) + + +writeExistingFile :: WindowsFilePath -> L.ByteString -> IO () +writeExistingFile fp contents = withExistingFile fp SIO.WriteMode (`L.hPut` contents) + +writeExistingFile' :: WindowsFilePath -> BS.ByteString -> IO () +writeExistingFile' fp contents = withExistingFile fp SIO.WriteMode (`BS.hPut` contents) + + -------------------- + --[ File Reading ]-- + -------------------- + +readExistingFile :: WindowsFilePath -> IO L.ByteString +readExistingFile fp = withExistingFile' fp SIO.ReadMode L.hGetContents + +readExistingFile' :: WindowsFilePath -> IO BS.ByteString +readExistingFile' fp = withExistingFile fp SIO.ReadMode BS.hGetContents + + +foreign import WINAPI unsafe "windows.h DeviceIoControl" + c_DeviceIoControl + :: Win32.HANDLE + -> Win32.DWORD + -> Ptr a + -> Win32.DWORD + -> Ptr b + -> Win32.DWORD + -> Ptr Win32.DWORD + -> Ptr Void + -> IO Win32.BOOL + + +-- | Read the target of a symbolic link. +-- +-- This is mostly stolen from 'directory' package. +readSymbolicLink :: WindowsFilePath -> IO WindowsFilePath +readSymbolicLink path = WS <$> do + let open = WS.createFile path 0 maxShareMode Nothing Win32.oPEN_EXISTING + (Win32.fILE_FLAG_BACKUP_SEMANTICS .|. + win32_fILE_FLAG_OPEN_REPARSE_POINT) Nothing + bracket open Win32.closeHandle $ \ h -> do + win32_alloca_REPARSE_DATA_BUFFER $ \ ptrAndSize@(ptr, _) -> do + result <- deviceIoControl h win32_fSCTL_GET_REPARSE_POINT + (nullPtr, 0) ptrAndSize Nothing + case result of + Left e | e == (#const ERROR_INVALID_FUNCTION) -> do + let msg = "Incorrect function. The file system " <> + "might not support symbolic links." + throwIO (mkIOError illegalOperationErrorType + "DeviceIoControl" Nothing Nothing + `ioeSetErrorString` msg) + | otherwise -> Win32.failWith "DeviceIoControl" e + Right _ -> pure () + rData <- win32_peek_REPARSE_DATA_BUFFER ptr + strip <$> case rData of + Win32_MOUNT_POINT_REPARSE_DATA_BUFFER sn _ -> pure sn + Win32_SYMLINK_REPARSE_DATA_BUFFER sn _ _ -> pure sn + _ -> throwIO (mkIOError InappropriateType + "readSymbolicLink" Nothing Nothing) + where + strip sn = fromMaybe sn (W16.stripPrefix (unWFP $ fromString "\\??\\") sn) + + win32_iO_REPARSE_TAG_MOUNT_POINT, win32_iO_REPARSE_TAG_SYMLINK :: CULong + win32_iO_REPARSE_TAG_MOUNT_POINT = (#const IO_REPARSE_TAG_MOUNT_POINT) + win32_iO_REPARSE_TAG_SYMLINK = (#const IO_REPARSE_TAG_SYMLINK) + + win32_mAXIMUM_REPARSE_DATA_BUFFER_SIZE :: Win32.DWORD + win32_mAXIMUM_REPARSE_DATA_BUFFER_SIZE = + (#const MAXIMUM_REPARSE_DATA_BUFFER_SIZE) + + win32_sYMLINK_FLAG_RELATIVE :: CULong + win32_sYMLINK_FLAG_RELATIVE = 0x00000001 + + + win32_fILE_FLAG_OPEN_REPARSE_POINT :: Win32.FileAttributeOrFlag + win32_fILE_FLAG_OPEN_REPARSE_POINT = 0x00200000 + win32_fSCTL_GET_REPARSE_POINT :: Win32.DWORD + win32_fSCTL_GET_REPARSE_POINT = 0x900a8 + deviceIoControl + :: Win32.HANDLE + -> Win32.DWORD + -> (Ptr a, Int) + -> (Ptr b, Int) + -> Maybe Void + -> IO (Either Win32.ErrCode Int) + deviceIoControl h code (inPtr, inSize) (outPtr, outSize) _ = do + with 0 $ \ lenPtr -> do + ok <- c_DeviceIoControl h code inPtr (fromIntegral inSize) outPtr + (fromIntegral outSize) lenPtr nullPtr + if ok + then Right . fromIntegral <$> peek lenPtr + else Left <$> Win32.getLastError + + win32_alloca_REPARSE_DATA_BUFFER + :: ((Ptr Win32_REPARSE_DATA_BUFFER, Int) -> IO a) -> IO a + win32_alloca_REPARSE_DATA_BUFFER action = + allocaBytesAligned size align $ \ ptr -> + action (ptr, size) + where size = fromIntegral win32_mAXIMUM_REPARSE_DATA_BUFFER_SIZE + -- workaround (hsc2hs for GHC < 8.0 don't support #{alignment ...}) + align = #{size char[alignof(HsDirectory_REPARSE_DATA_BUFFER)]} + + win32_peek_REPARSE_DATA_BUFFER + :: Ptr Win32_REPARSE_DATA_BUFFER -> IO Win32_REPARSE_DATA_BUFFER + win32_peek_REPARSE_DATA_BUFFER p = do + tag <- #{peek HsDirectory_REPARSE_DATA_BUFFER, ReparseTag} p + case () of + _ | tag == win32_iO_REPARSE_TAG_MOUNT_POINT -> do + let buf = #{ptr HsDirectory_REPARSE_DATA_BUFFER, + MountPointReparseBuffer.PathBuffer} p + sni <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + MountPointReparseBuffer.SubstituteNameOffset} p + sns <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + MountPointReparseBuffer.SubstituteNameLength} p + sn <- peekName buf sni sns + pni <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + MountPointReparseBuffer.PrintNameOffset} p + pns <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + MountPointReparseBuffer.PrintNameLength} p + pn <- peekName buf pni pns + pure (Win32_MOUNT_POINT_REPARSE_DATA_BUFFER sn pn) + | tag == win32_iO_REPARSE_TAG_SYMLINK -> do + let buf = #{ptr HsDirectory_REPARSE_DATA_BUFFER, + SymbolicLinkReparseBuffer.PathBuffer} p + sni <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + SymbolicLinkReparseBuffer.SubstituteNameOffset} p + sns <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + SymbolicLinkReparseBuffer.SubstituteNameLength} p + sn <- peekName buf sni sns + pni <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + SymbolicLinkReparseBuffer.PrintNameOffset} p + pns <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + SymbolicLinkReparseBuffer.PrintNameLength} p + pn <- peekName buf pni pns + flags <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + SymbolicLinkReparseBuffer.Flags} p + pure (Win32_SYMLINK_REPARSE_DATA_BUFFER sn pn + (flags .&. win32_sYMLINK_FLAG_RELATIVE /= 0)) + | otherwise -> pure Win32_GENERIC_REPARSE_DATA_BUFFER + where + peekName :: Ptr CWchar -> CUShort -> CUShort -> IO ShortByteString + peekName buf offset size = + packCWStringLen ( buf `plusPtr` fromIntegral offset + , fromIntegral size `div` sizeOf (0 :: CWchar) ) @@ -720,142 +879,6 @@ moveFile from to cm = do - -------------------- - --[ File Reading ]-- - -------------------- - - -foreign import WINAPI unsafe "windows.h DeviceIoControl" - c_DeviceIoControl - :: Win32.HANDLE - -> Win32.DWORD - -> Ptr a - -> Win32.DWORD - -> Ptr b - -> Win32.DWORD - -> Ptr Win32.DWORD - -> Ptr Void - -> IO Win32.BOOL - - --- | Read the target of a symbolic link. --- --- This is mostly stolen from 'directory' package. -readSymbolicLink :: WindowsFilePath -> IO WindowsFilePath -readSymbolicLink path = WS <$> do - let open = WS.createFile path 0 maxShareMode Nothing Win32.oPEN_EXISTING - (Win32.fILE_FLAG_BACKUP_SEMANTICS .|. - win32_fILE_FLAG_OPEN_REPARSE_POINT) Nothing - bracket open Win32.closeHandle $ \ h -> do - win32_alloca_REPARSE_DATA_BUFFER $ \ ptrAndSize@(ptr, _) -> do - result <- deviceIoControl h win32_fSCTL_GET_REPARSE_POINT - (nullPtr, 0) ptrAndSize Nothing - case result of - Left e | e == (#const ERROR_INVALID_FUNCTION) -> do - let msg = "Incorrect function. The file system " <> - "might not support symbolic links." - throwIO (mkIOError illegalOperationErrorType - "DeviceIoControl" Nothing Nothing - `ioeSetErrorString` msg) - | otherwise -> Win32.failWith "DeviceIoControl" e - Right _ -> pure () - rData <- win32_peek_REPARSE_DATA_BUFFER ptr - strip <$> case rData of - Win32_MOUNT_POINT_REPARSE_DATA_BUFFER sn _ -> pure sn - Win32_SYMLINK_REPARSE_DATA_BUFFER sn _ _ -> pure sn - _ -> throwIO (mkIOError InappropriateType - "readSymbolicLink" Nothing Nothing) - where - strip sn = fromMaybe sn (W16.stripPrefix (unWFP $ fromString "\\??\\") sn) - - win32_iO_REPARSE_TAG_MOUNT_POINT, win32_iO_REPARSE_TAG_SYMLINK :: CULong - win32_iO_REPARSE_TAG_MOUNT_POINT = (#const IO_REPARSE_TAG_MOUNT_POINT) - win32_iO_REPARSE_TAG_SYMLINK = (#const IO_REPARSE_TAG_SYMLINK) - - win32_mAXIMUM_REPARSE_DATA_BUFFER_SIZE :: Win32.DWORD - win32_mAXIMUM_REPARSE_DATA_BUFFER_SIZE = - (#const MAXIMUM_REPARSE_DATA_BUFFER_SIZE) - - win32_sYMLINK_FLAG_RELATIVE :: CULong - win32_sYMLINK_FLAG_RELATIVE = 0x00000001 - - - win32_fILE_FLAG_OPEN_REPARSE_POINT :: Win32.FileAttributeOrFlag - win32_fILE_FLAG_OPEN_REPARSE_POINT = 0x00200000 - - win32_fSCTL_GET_REPARSE_POINT :: Win32.DWORD - win32_fSCTL_GET_REPARSE_POINT = 0x900a8 - - deviceIoControl - :: Win32.HANDLE - -> Win32.DWORD - -> (Ptr a, Int) - -> (Ptr b, Int) - -> Maybe Void - -> IO (Either Win32.ErrCode Int) - deviceIoControl h code (inPtr, inSize) (outPtr, outSize) _ = do - with 0 $ \ lenPtr -> do - ok <- c_DeviceIoControl h code inPtr (fromIntegral inSize) outPtr - (fromIntegral outSize) lenPtr nullPtr - if ok - then Right . fromIntegral <$> peek lenPtr - else Left <$> Win32.getLastError - - win32_alloca_REPARSE_DATA_BUFFER - :: ((Ptr Win32_REPARSE_DATA_BUFFER, Int) -> IO a) -> IO a - win32_alloca_REPARSE_DATA_BUFFER action = - allocaBytesAligned size align $ \ ptr -> - action (ptr, size) - where size = fromIntegral win32_mAXIMUM_REPARSE_DATA_BUFFER_SIZE - -- workaround (hsc2hs for GHC < 8.0 don't support #{alignment ...}) - align = #{size char[alignof(HsDirectory_REPARSE_DATA_BUFFER)]} - - win32_peek_REPARSE_DATA_BUFFER - :: Ptr Win32_REPARSE_DATA_BUFFER -> IO Win32_REPARSE_DATA_BUFFER - win32_peek_REPARSE_DATA_BUFFER p = do - tag <- #{peek HsDirectory_REPARSE_DATA_BUFFER, ReparseTag} p - case () of - _ | tag == win32_iO_REPARSE_TAG_MOUNT_POINT -> do - let buf = #{ptr HsDirectory_REPARSE_DATA_BUFFER, - MountPointReparseBuffer.PathBuffer} p - sni <- #{peek HsDirectory_REPARSE_DATA_BUFFER, - MountPointReparseBuffer.SubstituteNameOffset} p - sns <- #{peek HsDirectory_REPARSE_DATA_BUFFER, - MountPointReparseBuffer.SubstituteNameLength} p - sn <- peekName buf sni sns - pni <- #{peek HsDirectory_REPARSE_DATA_BUFFER, - MountPointReparseBuffer.PrintNameOffset} p - pns <- #{peek HsDirectory_REPARSE_DATA_BUFFER, - MountPointReparseBuffer.PrintNameLength} p - pn <- peekName buf pni pns - pure (Win32_MOUNT_POINT_REPARSE_DATA_BUFFER sn pn) - | tag == win32_iO_REPARSE_TAG_SYMLINK -> do - let buf = #{ptr HsDirectory_REPARSE_DATA_BUFFER, - SymbolicLinkReparseBuffer.PathBuffer} p - sni <- #{peek HsDirectory_REPARSE_DATA_BUFFER, - SymbolicLinkReparseBuffer.SubstituteNameOffset} p - sns <- #{peek HsDirectory_REPARSE_DATA_BUFFER, - SymbolicLinkReparseBuffer.SubstituteNameLength} p - sn <- peekName buf sni sns - pni <- #{peek HsDirectory_REPARSE_DATA_BUFFER, - SymbolicLinkReparseBuffer.PrintNameOffset} p - pns <- #{peek HsDirectory_REPARSE_DATA_BUFFER, - SymbolicLinkReparseBuffer.PrintNameLength} p - pn <- peekName buf pni pns - flags <- #{peek HsDirectory_REPARSE_DATA_BUFFER, - SymbolicLinkReparseBuffer.Flags} p - pure (Win32_SYMLINK_REPARSE_DATA_BUFFER sn pn - (flags .&. win32_sYMLINK_FLAG_RELATIVE /= 0)) - | otherwise -> pure Win32_GENERIC_REPARSE_DATA_BUFFER - where - peekName :: Ptr CWchar -> CUShort -> CUShort -> IO ShortByteString - peekName buf offset size = - packCWStringLen ( buf `plusPtr` fromIntegral offset - , fromIntegral size `div` sizeOf (0 :: CWchar) ) - - - - ----------------------- --[ File Permissions]-- @@ -1167,4 +1190,15 @@ toAbs bs = do +withExistingFile :: WindowsFilePath -> SIO.IOMode -> (SIO.Handle -> IO r) -> IO r +withExistingFile fp iomode = bracket + (openExistingFile fp iomode) + SIO.hClose + +withExistingFile' :: WindowsFilePath -> SIO.IOMode -> (SIO.Handle -> IO r) -> IO r +withExistingFile' fp iomode action = do + h <- openExistingFile fp iomode + action h + + #endif diff --git a/hpath-directory/test/Main.hs b/hpath-directory/test/Main.hs index bdfed40..8e53e13 100644 --- a/hpath-directory/test/Main.hs +++ b/hpath-directory/test/Main.hs @@ -13,7 +13,7 @@ import System.Win32.WindowsString.Info import System.Posix.Temp.PosixString (mkdtemp) import System.Posix.Env.PosixString (getEnvDefault) #endif -import "hpath-directory" System.Directory.AFP +import System.Directory.AbstractFilePath import System.AbstractFilePath import System.OsString.Internal.Types diff --git a/hpath-directory/test/System/Directory/AFP/AppendFileSpec.hs b/hpath-directory/test/System/Directory/AFP/AppendFileSpec.hs index 9d87dce..b5ae423 100644 --- a/hpath-directory/test/System/Directory/AFP/AppendFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/AppendFileSpec.hs @@ -104,5 +104,5 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "appendFile, file does not exist" $ do - appendFile' "gaga" "" + appendExistingFile' "gaga" "" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) diff --git a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveCollectFailuresSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveCollectFailuresSpec.hs index 10ee7b4..477107c 100644 --- a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveCollectFailuresSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveCollectFailuresSpec.hs @@ -6,7 +6,7 @@ module System.Directory.AFP.CopyDirRecursiveCollectFailuresSpec where import Test.Hspec import Data.List (sort) -import "hpath-directory" System.Directory.AFP +import System.Directory.AbstractFilePath hiding (writeFile') import System.Directory.Errors import System.IO.Error ( diff --git a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveOverwriteSpec.hs index 5b3d56d..a1e6b4a 100644 --- a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveOverwriteSpec.hs @@ -5,7 +5,7 @@ module System.Directory.AFP.CopyDirRecursiveOverwriteSpec where import Test.Hspec -import "hpath-directory" System.Directory.AFP +import System.Directory.AbstractFilePath hiding (writeFile') import System.IO.Error ( ioeGetErrorType diff --git a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveSpec.hs index 2d0cb64..39152cb 100644 --- a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveSpec.hs @@ -5,7 +5,7 @@ module System.Directory.AFP.CopyDirRecursiveSpec where import Test.Hspec -import "hpath-directory" System.Directory.AFP +import System.Directory.AbstractFilePath hiding (writeFile') import System.IO.Error ( ioeGetErrorType diff --git a/hpath-directory/test/System/Directory/AFP/CopyFileOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyFileOverwriteSpec.hs index c79139c..fbae046 100644 --- a/hpath-directory/test/System/Directory/AFP/CopyFileOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyFileOverwriteSpec.hs @@ -4,7 +4,7 @@ module System.Directory.AFP.CopyFileOverwriteSpec where import Test.Hspec -import "hpath-directory" System.Directory.AFP +import System.Directory.AbstractFilePath hiding (writeFile') import System.IO.Error ( ioeGetErrorType diff --git a/hpath-directory/test/System/Directory/AFP/CopyFileSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyFileSpec.hs index b24442e..7067e61 100644 --- a/hpath-directory/test/System/Directory/AFP/CopyFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyFileSpec.hs @@ -5,7 +5,7 @@ module System.Directory.AFP.CopyFileSpec where import Test.Hspec -import "hpath-directory" System.Directory.AFP +import System.Directory.AbstractFilePath hiding (writeFile') import System.IO.Error ( ioeGetErrorType diff --git a/hpath-directory/test/System/Directory/AFP/DeleteFileSpec.hs b/hpath-directory/test/System/Directory/AFP/DeleteFileSpec.hs index 44dfbad..52cc4c6 100644 --- a/hpath-directory/test/System/Directory/AFP/DeleteFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/DeleteFileSpec.hs @@ -3,7 +3,7 @@ module System.Directory.AFP.DeleteFileSpec where -import System.Directory.AFP +import System.Directory.AbstractFilePath import Test.Hspec import System.IO.Error ( diff --git a/hpath-directory/test/System/Directory/AFP/GetDirsFilesSpec.hs b/hpath-directory/test/System/Directory/AFP/GetDirsFilesSpec.hs index fbdaa92..6d073c3 100644 --- a/hpath-directory/test/System/Directory/AFP/GetDirsFilesSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/GetDirsFilesSpec.hs @@ -7,7 +7,7 @@ import Data.List ( sort ) -import "hpath-directory" System.Directory.AFP hiding (getDirsFiles') +import System.Directory.AbstractFilePath hiding (getDirsFiles') import Test.Hspec import System.IO.Error ( diff --git a/hpath-directory/test/System/Directory/AFP/MoveFileOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/MoveFileOverwriteSpec.hs index 1e60f2f..fa471dd 100644 --- a/hpath-directory/test/System/Directory/AFP/MoveFileOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/MoveFileOverwriteSpec.hs @@ -4,7 +4,7 @@ module System.Directory.AFP.MoveFileOverwriteSpec where import Test.Hspec -import "hpath-directory" System.Directory.AFP +import System.Directory.AbstractFilePath hiding (writeFile') import System.IO.Error ( ioeGetErrorType diff --git a/hpath-directory/test/System/Directory/AFP/MoveFileSpec.hs b/hpath-directory/test/System/Directory/AFP/MoveFileSpec.hs index 311f78d..df56bfb 100644 --- a/hpath-directory/test/System/Directory/AFP/MoveFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/MoveFileSpec.hs @@ -4,7 +4,7 @@ module System.Directory.AFP.MoveFileSpec where import Test.Hspec -import "hpath-directory" System.Directory.AFP +import System.Directory.AbstractFilePath hiding (writeFile') import System.IO.Error ( ioeGetErrorType diff --git a/hpath-directory/test/System/Directory/AFP/ReadFileSpec.hs b/hpath-directory/test/System/Directory/AFP/ReadFileSpec.hs index 2cfc22e..e2892e3 100644 --- a/hpath-directory/test/System/Directory/AFP/ReadFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/ReadFileSpec.hs @@ -81,7 +81,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "readFile file, no such file" $ do - readFileL "lalala" + readExistingFileL "lalala" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) @@ -113,6 +113,6 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "readFile (Strict) file, no such file" $ do - readFile' "lalala" + readExistingFile' "lalala" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) diff --git a/hpath-directory/test/System/Directory/AFP/RecreateSymlinkOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkOverwriteSpec.hs index 345741f..fac4018 100644 --- a/hpath-directory/test/System/Directory/AFP/RecreateSymlinkOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkOverwriteSpec.hs @@ -7,7 +7,7 @@ module System.Directory.AFP.RecreateSymlinkOverwriteSpec where import Test.Hspec -import "hpath-directory" System.Directory.AFP +import System.Directory.AbstractFilePath hiding (writeFile') import System.IO.Error ( ioeGetErrorType diff --git a/hpath-directory/test/System/Directory/AFP/RecreateSymlinkSpec.hs b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkSpec.hs index 4c9f66a..ae81bc1 100644 --- a/hpath-directory/test/System/Directory/AFP/RecreateSymlinkSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkSpec.hs @@ -6,7 +6,7 @@ module System.Directory.AFP.RecreateSymlinkSpec where import Test.Hspec -import "hpath-directory" System.Directory.AFP +import System.Directory.AbstractFilePath hiding (writeFile') import System.IO.Error ( ioeGetErrorType diff --git a/hpath-directory/test/System/Directory/AFP/ToAbsSpec.hs b/hpath-directory/test/System/Directory/AFP/ToAbsSpec.hs index 37c0f7c..70c9940 100644 --- a/hpath-directory/test/System/Directory/AFP/ToAbsSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/ToAbsSpec.hs @@ -5,7 +5,7 @@ module System.Directory.AFP.ToAbsSpec where import Test.Hspec -import "hpath-directory" System.Directory.AFP +import System.Directory.AbstractFilePath diff --git a/hpath-directory/test/System/Directory/AFP/WriteFileLSpec.hs b/hpath-directory/test/System/Directory/AFP/WriteFileLSpec.hs index 60a0588..35f5a85 100644 --- a/hpath-directory/test/System/Directory/AFP/WriteFileLSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/WriteFileLSpec.hs @@ -104,5 +104,5 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "WriteFileL, file does not exist" $ do - writeFileL' "gaga" "" + writeExistingFileL' "gaga" "" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) diff --git a/hpath-directory/test/System/Directory/AFP/WriteFileSpec.hs b/hpath-directory/test/System/Directory/AFP/WriteFileSpec.hs index 2689aed..a9b75e7 100644 --- a/hpath-directory/test/System/Directory/AFP/WriteFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/WriteFileSpec.hs @@ -104,5 +104,5 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "writeFile, file does not exist" $ do - writeFile' "gaga" "" + writeExistingFile' "gaga" "" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) diff --git a/hpath-directory/test/Utils.hs b/hpath-directory/test/Utils.hs index f20a99d..85aa540 100644 --- a/hpath-directory/test/Utils.hs +++ b/hpath-directory/test/Utils.hs @@ -48,7 +48,8 @@ import System.AbstractFilePath import System.OsString.Internal.Types import qualified System.AbstractFilePath as AFP -import System.Directory.AFP hiding ( getFileType ) +import System.Directory.AbstractFilePath hiding ( getFileType ) +import System.File.AbstractFilePath @@ -261,18 +262,32 @@ canonicalizePath' p = withTmpDir p canonicalizePath writeFile' :: AbstractFilePath -> ByteString -> IO () {-# NOINLINE writeFile' #-} writeFile' ip bs = - withTmpDir ip $ \p -> writeFile p True bs + withTmpDir ip $ \p -> System.File.AbstractFilePath.writeFile' p bs writeFileL' :: AbstractFilePath -> BSL.ByteString -> IO () {-# NOINLINE writeFileL' #-} writeFileL' ip bs = - withTmpDir ip $ \p -> writeFileL p True bs + withTmpDir ip $ \p -> writeFile p bs +writeExistingFile' :: AbstractFilePath -> ByteString -> IO () +{-# NOINLINE writeExistingFile' #-} +writeExistingFile' ip bs = + withTmpDir ip $ \p -> System.Directory.AbstractFilePath.writeExistingFile' p bs + +writeExistingFileL' :: AbstractFilePath -> BSL.ByteString -> IO () +{-# NOINLINE writeExistingFileL' #-} +writeExistingFileL' ip bs = + withTmpDir ip $ \p -> writeExistingFile p bs appendFile' :: AbstractFilePath -> ByteString -> IO () {-# NOINLINE appendFile' #-} appendFile' ip bs = - withTmpDir ip $ \p -> appendFile p bs + withTmpDir ip $ \p -> System.File.AbstractFilePath.appendFile' p bs + +appendExistingFile' :: AbstractFilePath -> ByteString -> IO () +{-# NOINLINE appendExistingFile' #-} +appendExistingFile' ip bs = + withTmpDir ip $ \p -> System.Directory.AbstractFilePath.appendExistingFile' p bs {-# NOINLINE allDirectoryContents' #-} @@ -283,13 +298,20 @@ allDirectoryContents' ip = readFile' :: AbstractFilePath -> IO ByteString {-# NOINLINE readFile' #-} -readFile' p = withTmpDir p readFileStrict +readFile' p = withTmpDir p System.File.AbstractFilePath.readFile' +readExistingFile' :: AbstractFilePath -> IO ByteString +{-# NOINLINE readExistingFile' #-} +readExistingFile' p = withTmpDir p System.Directory.AbstractFilePath.readExistingFile' readFileL :: AbstractFilePath -> IO BSL.ByteString {-# NOINLINE readFileL #-} readFileL p = withTmpDir p readFile +readExistingFileL :: AbstractFilePath -> IO BSL.ByteString +{-# NOINLINE readExistingFileL #-} +readExistingFileL p = withTmpDir p System.Directory.AbstractFilePath.readExistingFile + dirExists :: AbstractFilePath -> IO Bool {-# NOINLINE dirExists #-} dirExists fp = doesDirectoryExist fp diff --git a/hpath/hpath.cabal b/hpath/hpath.cabal index b6edbd1..089d550 100644 --- a/hpath/hpath.cabal +++ b/hpath/hpath.cabal @@ -20,9 +20,6 @@ extra-source-files: README.md CHANGELOG library - if os(windows) - build-depends: unbuildable<0 - buildable: False hs-source-dirs: src/ default-language: Haskell2010 if impl(ghc >= 8.0) From c4f875d8f65e6a299a979dd0028b31e8839db33b Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Fri, 8 Jul 2022 20:50:50 +0200 Subject: [PATCH 17/17] Migrate to filepath-1.4.99.5 --- cabal.project | 17 +- hpath-directory/configure | 2 +- hpath-directory/configure.ac | 2 +- hpath-directory/hpath-directory.cabal | 16 +- hpath-directory/src/System/Directory/HPath.hs | 6 +- .../{AbstractFilePath.hs => OsPath.hs} | 124 ++++++------- hpath-directory/src/System/Directory/Types.hs | 14 +- .../Posix/PosixFilePath/Directory.hs-boot | 15 -- .../{PosixFilePath => PosixPath}/Directory.hs | 138 +++++++------- .../System/Posix/PosixPath/Directory.hs-boot | 15 ++ .../Directory/Errors.hs | 34 ++-- .../Directory.hsc | 173 +++++++++--------- .../utility.h | 0 .../windows_ext.h | 0 hpath-directory/test/Main.hs | 4 +- .../CopyDirRecursiveCollectFailuresSpec.hs | 6 +- .../AFP/CopyDirRecursiveOverwriteSpec.hs | 8 +- .../Directory/AFP/CopyDirRecursiveSpec.hs | 6 +- .../Directory/AFP/CopyFileOverwriteSpec.hs | 8 +- .../test/System/Directory/AFP/CopyFileSpec.hs | 6 +- .../System/Directory/AFP/DeleteFileSpec.hs | 2 +- .../System/Directory/AFP/GetDirsFilesSpec.hs | 4 +- .../Directory/AFP/MoveFileOverwriteSpec.hs | 2 +- .../test/System/Directory/AFP/MoveFileSpec.hs | 2 +- .../AFP/RecreateSymlinkOverwriteSpec.hs | 2 +- .../Directory/AFP/RecreateSymlinkSpec.hs | 2 +- .../test/System/Directory/AFP/ToAbsSpec.hs | 7 +- .../Directory/GetFileTypeSpec.hs | 4 +- hpath-directory/test/Utils.hs | 121 ++++++------ hpath-posix/hpath-posix.cabal | 2 +- hpath-posix/src/System/Posix/FD.hs | 6 +- .../PosixFilePath/Directory/Traversals.hs | 48 ++--- hpath/hpath.cabal | 2 +- hpath/src/HPath.hs | 137 +++++++------- hpath/src/HPath/Internal.hs | 4 +- .../src/Streamly/External/Posix/DirStream.hs | 17 +- streamly-posix/streamly-posix.cabal | 2 +- streamly-posix/test/Main.hs | 6 + 38 files changed, 491 insertions(+), 473 deletions(-) rename hpath-directory/src/System/Directory/{AbstractFilePath.hs => OsPath.hs} (86%) delete mode 100644 hpath-directory/src/System/Posix/PosixFilePath/Directory.hs-boot rename hpath-directory/src/System/Posix/{PosixFilePath => PosixPath}/Directory.hs (90%) create mode 100644 hpath-directory/src/System/Posix/PosixPath/Directory.hs-boot rename hpath-directory/src/System/Posix/{PosixFilePath => PosixPath}/Directory/Errors.hs (87%) rename hpath-directory/src/System/Win32/{WindowsFilePath => WindowsPath}/Directory.hsc (89%) rename hpath-directory/src/System/Win32/{WindowsFilePath => WindowsPath}/utility.h (100%) rename hpath-directory/src/System/Win32/{WindowsFilePath => WindowsPath}/windows_ext.h (100%) diff --git a/cabal.project b/cabal.project index 1643361..54705b2 100644 --- a/cabal.project +++ b/cabal.project @@ -2,23 +2,22 @@ packages: ./hpath ./hpath-directory ./hpath-posix ./streamly-posix - ../../tmp/file-io - https://hackage.haskell.org/package/filepath-2.0.0.0/candidate/filepath-2.0.0.0.tar.gz + https://hackage.haskell.org/package/filepath-1.4.99.5/candidate/filepath-1.4.99.5.tar.gz source-repository-package type: git location: https://github.com/hasufell/unix.git - tag: 4d7bce9d85f077908f699532673e12ae66b178b0 + tag: f3b8ff89e1166df51ae02ce405fc1b3efe3c590f source-repository-package type: git location: https://github.com/hasufell/Win32.git - tag: a2ab9bc501614c48c62f9508488e87f0c2924b7b + tag: 766234a476e9f7b88c72fe13b51e0012f95837e9 --- source-repository-package --- type: git --- location: https://github.com/hasufell/file-io.git --- tag: 6bea7270a224c3357f0866b5e9e3aa91fa39e431 +source-repository-package + type: git + location: https://github.com/hasufell/file-io.git + tag: fbf71938823f98610c4d7f8e647bb4d26c5d0c20 package hpath-io ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 @@ -27,4 +26,4 @@ package hpath-io package streamly ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 -allow-newer: filepath, Win32 +allow-newer: filepath, Win32, unix diff --git a/hpath-directory/configure b/hpath-directory/configure index 730dc2d..9f04169 100755 --- a/hpath-directory/configure +++ b/hpath-directory/configure @@ -585,7 +585,7 @@ PACKAGE_STRING='Haskell directory package 1.0' PACKAGE_BUGREPORT='libraries@haskell.org' PACKAGE_URL='' -ac_unique_file="src/System/Directory/AbstractFilePath.hs" +ac_unique_file="src/System/Directory/OsPath.hs" # Factoring default headers for most tests. ac_includes_default="\ #include diff --git a/hpath-directory/configure.ac b/hpath-directory/configure.ac index 4e86dbc..3630f67 100644 --- a/hpath-directory/configure.ac +++ b/hpath-directory/configure.ac @@ -1,7 +1,7 @@ AC_INIT([Haskell directory package], [1.0], [libraries@haskell.org], [directory]) # Safety check: Ensure that we are in the correct source directory. -AC_CONFIG_SRCDIR([src/System/Directory/AbstractFilePath.hs]) +AC_CONFIG_SRCDIR([src/System/Directory/OsPath.hs]) AC_CONFIG_HEADERS([src/HsDirectoryConfig.h]) diff --git a/hpath-directory/hpath-directory.cabal b/hpath-directory/hpath-directory.cabal index f1d3755..49eeca6 100644 --- a/hpath-directory/hpath-directory.cabal +++ b/hpath-directory/hpath-directory.cabal @@ -2,7 +2,7 @@ cabal-version: >=1.10 name: hpath-directory version: 0.15.2.2 synopsis: - Alternative to 'directory' package with AbstractFilePath based filepaths + Alternative to 'directory' package with OsPath based filepaths description: This provides a safer alternative to the 'directory' @@ -28,7 +28,7 @@ extra-tmp-files: extra-source-files: ./src/HsDirectoryConfig.h.in - ./src/System/Win32/WindowsFilePath/*.h + ./src/System/Win32/WindowsPath/*.h CHANGELOG.md tested-with: @@ -37,7 +37,7 @@ tested-with: library if os(windows) cpp-options: -DWINDOWS - exposed-modules: System.Win32.WindowsFilePath.Directory + exposed-modules: System.Win32.WindowsPath.Directory build-depends: Win32 @@ -45,8 +45,8 @@ library else exposed-modules: - System.Posix.PosixFilePath.Directory - System.Posix.PosixFilePath.Directory.Errors + System.Posix.PosixPath.Directory + System.Posix.PosixPath.Directory.Errors build-depends: hpath-posix >=0.14.0 @@ -55,7 +55,7 @@ library , unix-bytestring >=0.3 exposed-modules: - System.Directory.AbstractFilePath + System.Directory.OsPath System.Directory.HPath System.Directory.Errors System.Directory.Types @@ -66,7 +66,7 @@ library base >=4.8 && <5 , bytestring >=0.10 , exceptions >=0.10 - , filepath >=2.0.0.0 + , filepath >=1.4.99.5 , file-io , IfElse , hpath @@ -138,7 +138,7 @@ test-suite spec , unix-bytestring build-depends: - filepath >=2.0.0.0 + filepath >=1.4.99.5 , base , bytestring >=0.10.0.0 , hpath-directory diff --git a/hpath-directory/src/System/Directory/HPath.hs b/hpath-directory/src/System/Directory/HPath.hs index 2955e6b..230aec7 100644 --- a/hpath-directory/src/System/Directory/HPath.hs +++ b/hpath-directory/src/System/Directory/HPath.hs @@ -81,9 +81,9 @@ module System.Directory.HPath ) where -import System.Directory.AbstractFilePath (Permissions) -import qualified System.Directory.AbstractFilePath as AFP -import System.File.AbstractFilePath +import System.Directory.OsPath (Permissions) +import qualified System.Directory.OsPath as AFP +import System.File.OsPath import Prelude hiding ( appendFile , readFile , writeFile diff --git a/hpath-directory/src/System/Directory/AbstractFilePath.hs b/hpath-directory/src/System/Directory/OsPath.hs similarity index 86% rename from hpath-directory/src/System/Directory/AbstractFilePath.hs rename to hpath-directory/src/System/Directory/OsPath.hs index b96801a..29c528c 100644 --- a/hpath-directory/src/System/Directory/AbstractFilePath.hs +++ b/hpath-directory/src/System/Directory/OsPath.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} -module System.Directory.AbstractFilePath +module System.Directory.OsPath ( -- * Types module System.Directory.Types @@ -88,24 +88,24 @@ module System.Directory.AbstractFilePath ) where -import System.File.AbstractFilePath +import System.File.OsPath import Prelude hiding ( appendFile , readFile , writeFile ) import System.Directory.Types #ifdef WINDOWS -import qualified System.Win32.WindowsFilePath.Directory as Dir +import qualified System.Win32.WindowsPath.Directory as Dir #else import Data.Bits -import qualified System.Posix.PosixFilePath.Directory as Dir +import qualified System.Posix.PosixPath.Directory as Dir import qualified System.Posix as Posix (FileMode) import qualified System.Posix.Files.ByteString as Posix import qualified Data.ByteString.Short as SBS #endif import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as L -import System.AbstractFilePath.Types +import System.OsPath.Types import System.OsString.Internal.Types import Data.Time.Clock import Data.Time.Clock.POSIX @@ -193,7 +193,7 @@ newDirPerms = Permissions { -- permissions, or -- -- * 'isDoesNotExistError' if the file or directory does not exist. -getPermissions :: AbstractFilePath -> IO Permissions +getPermissions :: OsPath -> IO Permissions #ifdef WINDOWS getPermissions (OsString path) = do t <- Dir.getFileType path @@ -222,10 +222,10 @@ getPermissions (OsString (PS path')) = do } #endif -getFileType :: AbstractFilePath -> IO Dir.FileType +getFileType :: OsPath -> IO Dir.FileType getFileType (OsString path) = Dir.getFileType path -setPermissions :: AbstractFilePath -> Permissions -> IO () +setPermissions :: OsPath -> Permissions -> IO () #ifdef WINDOWS setPermissions (OsString path) Permissions{writable = w} = do Dir.setFilePermissions path (Dir.setWriteMode w 0) @@ -250,8 +250,8 @@ setPermissions (OsString (PS path')) (Permissions r w e s) = do -------------------- -copyDirRecursive :: AbstractFilePath -- ^ source dir - -> AbstractFilePath -- ^ destination (parent dirs +copyDirRecursive :: OsPath -- ^ source dir + -> OsPath -- ^ destination (parent dirs -- are not automatically created) -> CopyMode -> RecursiveErrorMode @@ -288,8 +288,8 @@ copyDirRecursive (OsString fromp) (OsString destdirp) cm rm = -- Notes: -- -- - calls `symlink` -recreateSymlink :: AbstractFilePath -- ^ the old symlink file - -> AbstractFilePath -- ^ destination file +recreateSymlink :: OsPath -- ^ the old symlink file + -> OsPath -- ^ destination file -> CopyMode -> IO () recreateSymlink (OsString symsource) (OsString newsym) cm = @@ -330,8 +330,8 @@ recreateSymlink (OsString symsource) (OsString newsym) cm = -- Throws in `Strict` mode only: -- -- - `AlreadyExists` if destination already exists -copyFile :: AbstractFilePath -- ^ source file - -> AbstractFilePath -- ^ destination file +copyFile :: OsPath -- ^ source file + -> OsPath -- ^ destination file -> CopyMode -> IO () copyFile (OsString from) (OsString to) cm = @@ -346,8 +346,8 @@ copyFile (OsString from) (OsString to) cm = -- -- * examines filetypes explicitly -- * calls `copyDirRecursive` for directories -easyCopy :: AbstractFilePath - -> AbstractFilePath +easyCopy :: OsPath + -> OsPath -> CopyMode -> RecursiveErrorMode -> IO () @@ -373,7 +373,7 @@ easyCopy (OsString from) (OsString to) cm rm = -- - `PermissionDenied` if the directory cannot be read -- -- Notes: calls `unlink` -deleteFile :: AbstractFilePath -> IO () +deleteFile :: OsPath -> IO () deleteFile (OsString fp) = Dir.deleteFile fp @@ -389,7 +389,7 @@ deleteFile (OsString fp) = -- - `PermissionDenied` if we can't open or write to parent directory -- -- Notes: calls `rmdir` -deleteDir :: AbstractFilePath -> IO () +deleteDir :: OsPath -> IO () deleteDir (OsString fp) = Dir.deleteDir fp @@ -412,7 +412,7 @@ deleteDir (OsString fp) = Dir.deleteDir fp -- - `InappropriateType` for wrong file type (regular file) -- - `NoSuchThing` if directory does not exist -- - `PermissionDenied` if we can't open or write to parent directory -deleteDirRecursive :: AbstractFilePath -> IO () +deleteDirRecursive :: OsPath -> IO () deleteDirRecursive (OsString p) = Dir.deleteDirRecursive p @@ -425,7 +425,7 @@ deleteDirRecursive (OsString p) = Dir.deleteDirRecursive p -- -- * examines filetypes explicitly -- * calls `deleteDirRecursive` for directories -easyDelete :: AbstractFilePath -> IO () +easyDelete :: OsPath -> IO () easyDelete (OsString p) = Dir.easyDelete p @@ -444,7 +444,7 @@ easyDelete (OsString p) = Dir.easyDelete p -- - `AlreadyExists` if destination already exists -- - `NoSuchThing` if any of the parent components of the path -- do not exist -createRegularFile :: AbstractFilePath -> IO () +createRegularFile :: OsPath -> IO () createRegularFile (OsString destBS) = Dir.createRegularFile Dir.newFilePerms destBS @@ -456,7 +456,7 @@ createRegularFile (OsString destBS) = Dir.createRegularFile Dir.newFilePerms des -- - `AlreadyExists` if destination already exists -- - `NoSuchThing` if any of the parent components of the path -- do not exist -createDir :: AbstractFilePath -> IO () +createDir :: OsPath -> IO () createDir (OsString destBS) = #if WINDOWS Dir.createDir destBS @@ -471,7 +471,7 @@ createDir (OsString destBS) = -- - `PermissionDenied` if output directory cannot be written to -- - `NoSuchThing` if any of the parent components of the path -- do not exist -createDirIfMissing :: AbstractFilePath -> IO () +createDirIfMissing :: OsPath -> IO () createDirIfMissing (OsString destBS) = #if WINDOWS Dir.createDirIfMissing destBS @@ -498,7 +498,7 @@ createDirIfMissing (OsString destBS) = -- exist and cannot be written to -- - `AlreadyExists` if destination already exists and -- is *not* a directory -createDirRecursive :: AbstractFilePath -> IO () +createDirRecursive :: OsPath -> IO () createDirRecursive (OsString p) = #if WINDOWS Dir.createDirRecursive p @@ -517,8 +517,8 @@ createDirRecursive (OsString p) = -- do not exist -- -- Note: calls `symlink` -createSymlink :: AbstractFilePath -- ^ destination file - -> AbstractFilePath -- ^ path the symlink points to +createSymlink :: OsPath -- ^ destination file + -> OsPath -- ^ path the symlink points to -> Bool -- ^ whether this is a dir (irrelevant on posix) -> IO () #if WINDOWS @@ -557,7 +557,7 @@ createSymlink (OsString destBS) (OsString sympoint) _ = -- (`HPathIOException`) -- -- Note: calls `rename` (but does not allow to rename over existing files) -renameFile :: AbstractFilePath -> AbstractFilePath -> IO () +renameFile :: OsPath -> OsPath -> IO () renameFile (OsString fromf) (OsString tof) = Dir.renameFile fromf tof @@ -592,8 +592,8 @@ renameFile (OsString fromf) (OsString tof) = Dir.renameFile fromf tof -- Notes: -- -- - calls `rename` (but does not allow to rename over existing files) -moveFile :: AbstractFilePath -- ^ file to move - -> AbstractFilePath -- ^ destination +moveFile :: OsPath -- ^ file to move + -> OsPath -- ^ destination -> CopyMode -> IO () moveFile (OsString from) (OsString to) cm = Dir.moveFile from to cm @@ -603,31 +603,31 @@ moveFile (OsString from) (OsString to) cm = Dir.moveFile from to cm --[ File Write ]-- ------------------ -appendExistingFile :: AbstractFilePath -> L.ByteString -> IO () +appendExistingFile :: OsPath -> L.ByteString -> IO () appendExistingFile (OsString fp) = Dir.appendExistingFile fp -appendExistingFile' :: AbstractFilePath -> BS.ByteString -> IO () +appendExistingFile' :: OsPath -> BS.ByteString -> IO () appendExistingFile' (OsString fp) = Dir.appendExistingFile' fp -writeExistingFile :: AbstractFilePath -> L.ByteString -> IO () +writeExistingFile :: OsPath -> L.ByteString -> IO () writeExistingFile (OsString fp) = Dir.writeExistingFile fp -writeExistingFile' :: AbstractFilePath -> BS.ByteString -> IO () +writeExistingFile' :: OsPath -> BS.ByteString -> IO () writeExistingFile' (OsString fp) = Dir.writeExistingFile' fp -------------------- --[ File Reading ]-- -------------------- -readExistingFile :: AbstractFilePath -> IO L.ByteString +readExistingFile :: OsPath -> IO L.ByteString readExistingFile (OsString fp) = Dir.readExistingFile fp -readExistingFile' :: AbstractFilePath -> IO BS.ByteString +readExistingFile' :: OsPath -> IO BS.ByteString readExistingFile' (OsString fp) = Dir.readExistingFile' fp -- | Read the target of a symbolic link. -readSymbolicLink :: AbstractFilePath -> IO AbstractFilePath +readSymbolicLink :: OsPath -> IO OsPath readSymbolicLink (OsString fp) = OsString <$> Dir.readSymbolicLink fp @@ -642,7 +642,7 @@ readSymbolicLink (OsString fp) = OsString <$> Dir.readSymbolicLink fp -- Does not follow symlinks. -- -- Only eNOENT is catched (and returns False). -doesExist :: AbstractFilePath -> IO Bool +doesExist :: OsPath -> IO Bool doesExist (OsString bs) = Dir.doesExist bs @@ -650,7 +650,7 @@ doesExist (OsString bs) = Dir.doesExist bs -- Does not follow symlinks. -- -- Only eNOENT is catched (and returns False). -doesFileExist :: AbstractFilePath -> IO Bool +doesFileExist :: OsPath -> IO Bool doesFileExist (OsString bs) = Dir.doesFileExist bs @@ -658,7 +658,7 @@ doesFileExist (OsString bs) = Dir.doesFileExist bs -- Does not follow symlinks. -- -- Only eNOENT is catched (and returns False). -doesDirectoryExist :: AbstractFilePath -> IO Bool +doesDirectoryExist :: OsPath -> IO Bool doesDirectoryExist (OsString bs) = Dir.doesDirectoryExist bs @@ -669,7 +669,7 @@ doesDirectoryExist (OsString bs) = Dir.doesDirectoryExist bs -- Throws: -- -- - `NoSuchThing` if the file does not exist -isReadable :: AbstractFilePath -> IO Bool +isReadable :: OsPath -> IO Bool isReadable (OsString bs) = Dir.isReadable bs -- |Checks whether a file or folder is writable. @@ -679,7 +679,7 @@ isReadable (OsString bs) = Dir.isReadable bs -- Throws: -- -- - `NoSuchThing` if the file does not exist -isWritable :: AbstractFilePath -> IO Bool +isWritable :: OsPath -> IO Bool isWritable (OsString bs) = Dir.isWritable bs @@ -690,14 +690,14 @@ isWritable (OsString bs) = Dir.isWritable bs -- Throws: -- -- - `NoSuchThing` if the file does not exist -isExecutable :: AbstractFilePath -> IO Bool +isExecutable :: OsPath -> IO Bool isExecutable (OsString bs) = Dir.isExecutable bs -- |Checks whether the directory at the given path exists and can be -- opened. This invokes `openDirStream` which follows symlinks. -canOpenDirectory :: AbstractFilePath -> IO Bool +canOpenDirectory :: OsPath -> IO Bool canOpenDirectory (OsString bs) = Dir.canOpenDirectory bs @@ -708,13 +708,13 @@ canOpenDirectory (OsString bs) = Dir.canOpenDirectory bs ------------------ -getModificationTime :: AbstractFilePath -> IO UTCTime +getModificationTime :: OsPath -> IO UTCTime getModificationTime (OsString bs) = Dir.getModificationTime bs -setModificationTime :: AbstractFilePath -> UTCTime -> IO () +setModificationTime :: OsPath -> UTCTime -> IO () setModificationTime (OsString bs) t = Dir.setModificationTime bs t -setModificationTimeHiRes :: AbstractFilePath -> POSIXTime -> IO () +setModificationTimeHiRes :: OsPath -> POSIXTime -> IO () setModificationTimeHiRes (OsString bs) t = #ifdef WINDOWS Dir.setModificationTimeHiRes bs (Dir.posixToWindowsTime t) @@ -741,38 +741,38 @@ setModificationTimeHiRes (OsString bs) t = -- - `InappropriateType` if file type is wrong (symlink to file) -- - `InappropriateType` if file type is wrong (symlink to dir) -- - `PermissionDenied` if directory cannot be opened -getDirsFiles :: AbstractFilePath -- ^ dir to read - -> IO [AbstractFilePath] +getDirsFiles :: OsPath -- ^ dir to read + -> IO [OsPath] getDirsFiles (OsString p) = fmap OsString <$> Dir.getDirsFiles p -getDirsFilesRec :: AbstractFilePath -- ^ dir to read - -> IO [AbstractFilePath] +getDirsFilesRec :: OsPath -- ^ dir to read + -> IO [OsPath] getDirsFilesRec (OsString p) = fmap OsString <$> Dir.getDirsFilesRec p -- | Like 'getDirsFiles', but returns the filename only, instead -- of prepending the base path. -getDirsFiles' :: AbstractFilePath -- ^ dir to read - -> IO [AbstractFilePath] +getDirsFiles' :: OsPath -- ^ dir to read + -> IO [OsPath] getDirsFiles' (OsString fp) = fmap OsString <$> Dir.getDirsFiles' fp -getDirsFilesRec' :: AbstractFilePath -- ^ dir to read - -> IO [AbstractFilePath] +getDirsFilesRec' :: OsPath -- ^ dir to read + -> IO [OsPath] getDirsFilesRec' (OsString p) = fmap OsString <$> Dir.getDirsFilesRec' p getDirsFilesStreamRec :: (MonadCatch m, MonadAsync m, MonadMask m) - => AbstractFilePath - -> IO (SerialT m AbstractFilePath) + => OsPath + -> IO (SerialT m OsPath) getDirsFilesStreamRec (OsString fp) = fmap OsString <$> Dir.getDirsFilesStreamRec fp -- | Like 'getDirsFiles'', except returning a Stream. getDirsFilesStream :: (MonadCatch m, MonadAsync m, MonadMask m) - => AbstractFilePath - -> IO (SerialT m AbstractFilePath) + => OsPath + -> IO (SerialT m OsPath) getDirsFilesStream (OsString fp) = fmap OsString <$> Dir.getDirsFilesStream fp @@ -780,10 +780,10 @@ getDirsFilesStream (OsString fp) = fmap OsString <$> Dir.getDirsFilesStream fp --[ CWD ]-- ----------- -getCurrentDirectory :: IO AbstractFilePath +getCurrentDirectory :: IO OsPath getCurrentDirectory = OsString <$> Dir.getCurrentDirectory -setCurrentDirectory :: AbstractFilePath -> IO () +setCurrentDirectory :: OsPath -> IO () setCurrentDirectory (OsString fp) = Dir.setCurrentDirectory fp @@ -801,7 +801,7 @@ setCurrentDirectory (OsString fp) = Dir.setCurrentDirectory fp -- -- - `NoSuchThing` if the file at the given path does not exist -- - `NoSuchThing` if the symlink is broken -canonicalizePath :: AbstractFilePath -> IO AbstractFilePath +canonicalizePath :: OsPath -> IO OsPath canonicalizePath (OsString fp) = OsString <$> Dir.canonicalizePath fp @@ -810,6 +810,6 @@ canonicalizePath (OsString fp) = OsString <$> Dir.canonicalizePath fp -- -- - if the path is already an absolute one, just return it -- - if it's a relative path, prepend the current directory to it -toAbs :: AbstractFilePath -> IO AbstractFilePath +toAbs :: OsPath -> IO OsPath toAbs (OsString bs) = OsString <$> Dir.toAbs bs diff --git a/hpath-directory/src/System/Directory/Types.hs b/hpath-directory/src/System/Directory/Types.hs index 5063f78..df2f000 100644 --- a/hpath-directory/src/System/Directory/Types.hs +++ b/hpath-directory/src/System/Directory/Types.hs @@ -2,7 +2,7 @@ module System.Directory.Types where import Control.Exception (Exception, IOException) import Data.Typeable (Typeable) -import System.AbstractFilePath.Types +import System.OsPath.Types @@ -14,8 +14,8 @@ import System.AbstractFilePath.Types -- |Additional generic IO exceptions that the posix functions -- do not provide. -data HPathIOException = SameFile AbstractFilePath AbstractFilePath - | DestinationInSource AbstractFilePath AbstractFilePath +data HPathIOException = SameFile OsPath OsPath + | DestinationInSource OsPath OsPath | RecursiveFailure [(RecursiveFailureHint, IOException)] deriving (Eq, Show, Typeable) @@ -26,10 +26,10 @@ data HPathIOException = SameFile AbstractFilePath AbstractFilePath -- -- The first argument to the data constructor is always the -- source and the second the destination. -data RecursiveFailureHint = ReadContentsFailed AbstractFilePath AbstractFilePath - | CreateDirFailed AbstractFilePath AbstractFilePath - | CopyFileFailed AbstractFilePath AbstractFilePath - | RecreateSymlinkFailed AbstractFilePath AbstractFilePath +data RecursiveFailureHint = ReadContentsFailed OsPath OsPath + | CreateDirFailed OsPath OsPath + | CopyFileFailed OsPath OsPath + | RecreateSymlinkFailed OsPath OsPath deriving (Eq, Show) diff --git a/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs-boot b/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs-boot deleted file mode 100644 index 4732ac0..0000000 --- a/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs-boot +++ /dev/null @@ -1,15 +0,0 @@ -module System.Posix.PosixFilePath.Directory where - -import System.AbstractFilePath.Posix (PosixFilePath) - -canonicalizePath :: PosixFilePath -> IO PosixFilePath - -toAbs :: PosixFilePath -> IO PosixFilePath - -doesFileExist :: PosixFilePath -> IO Bool - -doesDirectoryExist :: PosixFilePath -> IO Bool - -isWritable :: PosixFilePath -> IO Bool - -canOpenDirectory :: PosixFilePath -> IO Bool diff --git a/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs b/hpath-directory/src/System/Posix/PosixPath/Directory.hs similarity index 90% rename from hpath-directory/src/System/Posix/PosixFilePath/Directory.hs rename to hpath-directory/src/System/Posix/PosixPath/Directory.hs index 3f19866..95a58c3 100644 --- a/hpath-directory/src/System/Posix/PosixFilePath/Directory.hs +++ b/hpath-directory/src/System/Posix/PosixPath/Directory.hs @@ -1,5 +1,5 @@ -- | --- Module : System.Posix.PosixFilePath.Directory +-- Module : System.Posix.PosixPath.Directory -- Copyright : © 2020 Julian Ospald -- License : BSD3 -- @@ -25,13 +25,13 @@ -- unreliable/unsafe. Check the documentation of those functions for details. -- -- Import as: --- > import System.Posix.PosixFilePath.Directory +-- > import System.Posix.PosixPath.Directory {-# LANGUAGE CPP #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE FlexibleContexts #-} -- streamly -module System.Posix.PosixFilePath.Directory +module System.Posix.PosixPath.Directory ( -- * Types FileType(..) @@ -112,7 +112,7 @@ module System.Posix.PosixFilePath.Directory where -import System.File.PlatformFilePath +import System.File.PlatformPath import Control.Exception.Safe ( IOException , MonadCatch , MonadMask @@ -170,8 +170,8 @@ import System.IO.Error ( catchIOError , ioeGetErrorType ) import System.Posix.ByteString ( exclusive ) -import System.Posix.PosixFilePath.Directory.Errors -import System.Posix.Directory.PosixFilePath +import System.Posix.PosixPath.Directory.Errors +import System.Posix.Directory.PosixPath ( createDirectory , closeDirStream , getWorkingDirectory @@ -208,7 +208,7 @@ import System.Posix.Types ( FileMode ) import System.Posix.Time -import System.AbstractFilePath.Posix +import System.OsPath.Posix import System.OsString.Internal.Types import System.Directory.Types import System.Directory.Errors @@ -288,8 +288,8 @@ data FileType = Directory -- Throws in `Strict` CopyMode only: -- -- - `AlreadyExists` if destination already exists -copyDirRecursive :: PosixFilePath -- ^ source dir - -> PosixFilePath -- ^ destination (parent dirs +copyDirRecursive :: PosixPath -- ^ source dir + -> PosixPath -- ^ destination (parent dirs -- are not automatically created) -> CopyMode -> RecursiveErrorMode @@ -305,17 +305,17 @@ copyDirRecursive fromp destdirp cm rm = do (throwIO . RecursiveFailure $ collectedExceptions) where #if MIN_VERSION_base(4,9,0) - basename :: Fail.MonadFail m => PosixFilePath -> m PosixFilePath + basename :: Fail.MonadFail m => PosixPath -> m PosixPath #else - basename :: Fail.Monad m => PosixFilePath -> m PosixFilePath + basename :: Fail.Monad m => PosixPath -> m PosixPath #endif basename x = let b = takeBaseName x in if b == mempty then Fail.fail ("No base name" :: String) else pure b go :: IORef [(RecursiveFailureHint, IOException)] - -> PosixFilePath - -> PosixFilePath + -> PosixPath + -> PosixPath -> IO () go ce from destdir = do @@ -396,8 +396,8 @@ copyDirRecursive fromp destdirp cm rm = do -- Notes: -- -- - calls `symlink` -recreateSymlink :: PosixFilePath -- ^ the old symlink file - -> PosixFilePath -- ^ destination file +recreateSymlink :: PosixPath -- ^ the old symlink file + -> PosixPath -- ^ destination file -> CopyMode -> IO () recreateSymlink symsource newsym cm = do @@ -450,8 +450,8 @@ recreateSymlink symsource newsym cm = do -- Throws in `Strict` mode only: -- -- - `AlreadyExists` if destination already exists -copyFile :: PosixFilePath -- ^ source file - -> PosixFilePath -- ^ destination file +copyFile :: PosixPath -- ^ source file + -> PosixPath -- ^ destination file -> CopyMode -> IO () copyFile from to cm = do @@ -503,8 +503,8 @@ copyFile from to cm = do -- -- * examines filetypes explicitly -- * calls `copyDirRecursive` for directories -easyCopy :: PosixFilePath - -> PosixFilePath +easyCopy :: PosixPath + -> PosixPath -> CopyMode -> RecursiveErrorMode -> IO () @@ -535,7 +535,7 @@ easyCopy from to cm rm = do -- - `PermissionDenied` if the directory cannot be read -- -- Notes: calls `unlink` -deleteFile :: PosixFilePath -> IO () +deleteFile :: PosixPath -> IO () deleteFile = removeLink @@ -550,7 +550,7 @@ deleteFile = removeLink -- - `PermissionDenied` if we can't open or write to parent directory -- -- Notes: calls `rmdir` -deleteDir :: PosixFilePath -> IO () +deleteDir :: PosixPath -> IO () deleteDir = removeDirectory @@ -573,7 +573,7 @@ deleteDir = removeDirectory -- - `InappropriateType` for wrong file type (regular file) -- - `NoSuchThing` if directory does not exist -- - `PermissionDenied` if we can't open or write to parent directory -deleteDirRecursive :: PosixFilePath -> IO () +deleteDirRecursive :: PosixPath -> IO () deleteDirRecursive p = catchErrno [eNOTEMPTY, eEXIST] (deleteDir p) $ do files <- getDirsFiles p for_ files $ \file -> do @@ -595,7 +595,7 @@ deleteDirRecursive p = catchErrno [eNOTEMPTY, eEXIST] (deleteDir p) $ do -- -- * examines filetypes explicitly -- * calls `deleteDirRecursive` for directories -easyDelete :: PosixFilePath -> IO () +easyDelete :: PosixPath -> IO () easyDelete p = do ftype <- getFileType p case ftype of @@ -609,31 +609,31 @@ easyDelete p = do --[ File Write ]-- ------------------ -appendExistingFile :: PosixFilePath -> L.ByteString -> IO () +appendExistingFile :: PosixPath -> L.ByteString -> IO () appendExistingFile fp contents = withExistingFile fp SIO.AppendMode (`L.hPut` contents) -appendExistingFile' :: PosixFilePath -> BS.ByteString -> IO () +appendExistingFile' :: PosixPath -> BS.ByteString -> IO () appendExistingFile' fp contents = withExistingFile fp SIO.AppendMode (`BS.hPut` contents) -writeExistingFile :: PosixFilePath -> L.ByteString -> IO () +writeExistingFile :: PosixPath -> L.ByteString -> IO () writeExistingFile fp contents = withExistingFile fp SIO.WriteMode (`L.hPut` contents) -writeExistingFile' :: PosixFilePath -> BS.ByteString -> IO () +writeExistingFile' :: PosixPath -> BS.ByteString -> IO () writeExistingFile' fp contents = withExistingFile fp SIO.WriteMode (`BS.hPut` contents) -------------------- --[ File Reading ]-- -------------------- -readExistingFile :: PosixFilePath -> IO L.ByteString +readExistingFile :: PosixPath -> IO L.ByteString readExistingFile fp = withExistingFile' fp SIO.ReadMode L.hGetContents -readExistingFile' :: PosixFilePath -> IO BS.ByteString +readExistingFile' :: PosixPath -> IO BS.ByteString readExistingFile' fp = withExistingFile fp SIO.ReadMode BS.hGetContents -- | Read the target of a symbolic link. -readSymbolicLink :: PosixFilePath -> IO PosixString +readSymbolicLink :: PosixPath -> IO PosixString readSymbolicLink = PF.readSymbolicLink @@ -652,7 +652,7 @@ readSymbolicLink = PF.readSymbolicLink -- - `AlreadyExists` if destination already exists -- - `NoSuchThing` if any of the parent components of the path -- do not exist -createRegularFile :: FileMode -> PosixFilePath -> IO () +createRegularFile :: FileMode -> PosixPath -> IO () createRegularFile fm destBS = bracket (SPI.openFd destBS SPI.WriteOnly @@ -670,7 +670,7 @@ createRegularFile fm destBS = bracket -- - `AlreadyExists` if destination already exists -- - `NoSuchThing` if any of the parent components of the path -- do not exist -createDir :: FileMode -> PosixFilePath -> IO () +createDir :: FileMode -> PosixPath -> IO () createDir fm destBS = createDirectory destBS fm -- |Create an empty directory at the given directory with the given filename. @@ -680,7 +680,7 @@ createDir fm destBS = createDirectory destBS fm -- - `PermissionDenied` if output directory cannot be written to -- - `NoSuchThing` if any of the parent components of the path -- do not exist -createDirIfMissing :: FileMode -> PosixFilePath -> IO () +createDirIfMissing :: FileMode -> PosixPath -> IO () createDirIfMissing fm destBS = hideError AlreadyExists $ createDirectory destBS fm @@ -703,10 +703,10 @@ createDirIfMissing fm destBS = -- exist and cannot be written to -- - `AlreadyExists` if destination already exists and -- is *not* a directory -createDirRecursive :: FileMode -> PosixFilePath -> IO () +createDirRecursive :: FileMode -> PosixPath -> IO () createDirRecursive fm p = go p where - go :: PosixFilePath -> IO () + go :: PosixPath -> IO () go dest = do catchIOError (createDirectory dest fm) $ \e -> do errno <- getErrno @@ -731,8 +731,8 @@ createDirRecursive fm p = go p -- do not exist -- -- Note: calls `symlink` -createSymlink :: PosixFilePath -- ^ destination file - -> PosixFilePath -- ^ path the symlink points to +createSymlink :: PosixPath -- ^ destination file + -> PosixPath -- ^ path the symlink points to -> IO () createSymlink destBS sympoint = createSymbolicLink sympoint destBS @@ -764,7 +764,7 @@ createSymlink destBS sympoint = createSymbolicLink sympoint destBS -- (`HPathIOException`) -- -- Note: calls `rename` (but does not allow to rename over existing files) -renameFile :: PosixFilePath -> PosixFilePath -> IO () +renameFile :: PosixPath -> PosixPath -> IO () renameFile fromf tof = do throwSameFile fromf tof throwFileDoesExist tof @@ -803,8 +803,8 @@ renameFile fromf tof = do -- Notes: -- -- - calls `rename` (but does not allow to rename over existing files) -moveFile :: PosixFilePath -- ^ file to move - -> PosixFilePath -- ^ destination +moveFile :: PosixPath -- ^ file to move + -> PosixPath -- ^ destination -> CopyMode -> IO () moveFile from to cm = do @@ -875,7 +875,7 @@ newDirPerms = -- Does not follow symlinks. -- -- Only eNOENT is catched (and returns False). -doesExist :: PosixFilePath -> IO Bool +doesExist :: PosixPath -> IO Bool doesExist bs = catchErrno [eNOENT] @@ -890,7 +890,7 @@ doesExist bs = -- Does not follow symlinks. -- -- Only eNOENT is catched (and returns False). -doesFileExist :: PosixFilePath -> IO Bool +doesFileExist :: PosixPath -> IO Bool doesFileExist bs = catchErrno [eNOENT] @@ -905,7 +905,7 @@ doesFileExist bs = -- Does not follow symlinks. -- -- Only eNOENT is catched (and returns False). -doesDirectoryExist :: PosixFilePath -> IO Bool +doesDirectoryExist :: PosixPath -> IO Bool doesDirectoryExist bs = catchErrno [eNOENT] @@ -923,7 +923,7 @@ doesDirectoryExist bs = -- Throws: -- -- - `NoSuchThing` if the file does not exist -isReadable :: PosixFilePath -> IO Bool +isReadable :: PosixPath -> IO Bool isReadable bs = fileAccess bs True False False -- |Checks whether a file or folder is writable. @@ -933,7 +933,7 @@ isReadable bs = fileAccess bs True False False -- Throws: -- -- - `NoSuchThing` if the file does not exist -isWritable :: PosixFilePath -> IO Bool +isWritable :: PosixPath -> IO Bool isWritable bs = fileAccess bs False True False @@ -944,14 +944,14 @@ isWritable bs = fileAccess bs False True False -- Throws: -- -- - `NoSuchThing` if the file does not exist -isExecutable :: PosixFilePath -> IO Bool +isExecutable :: PosixPath -> IO Bool isExecutable bs = fileAccess bs False False True -- |Checks whether the directory at the given path exists and can be -- opened. This invokes `openDirStream` which follows symlinks. -canOpenDirectory :: PosixFilePath -> IO Bool +canOpenDirectory :: PosixPath -> IO Bool canOpenDirectory bs = handleIOError (\_ -> return False) $ do bracket (openDirStream bs) closeDirStream (\_ -> return ()) return True @@ -964,18 +964,18 @@ canOpenDirectory bs = handleIOError (\_ -> return False) $ do ------------------ -getModificationTime :: PosixFilePath -> IO UTCTime +getModificationTime :: PosixPath -> IO UTCTime getModificationTime bs = do fs <- PF.getFileStatus bs pure $ posixSecondsToUTCTime $ PF.modificationTimeHiRes fs -setModificationTime :: PosixFilePath -> UTCTime -> IO () +setModificationTime :: PosixPath -> UTCTime -> IO () setModificationTime bs t = do -- TODO: setFileTimes doesn't allow to pass NULL to utime ctime <- epochTime PF.setFileTimes bs ctime (fromInteger . floor . utcTimeToPOSIXSeconds $ t) -setModificationTimeHiRes :: PosixFilePath -> POSIXTime -> IO () +setModificationTimeHiRes :: PosixPath -> POSIXTime -> IO () setModificationTimeHiRes bs t = do -- TODO: setFileTimesHiRes doesn't allow to pass NULL to utimes ctime <- getPOSIXTime @@ -1000,15 +1000,15 @@ setModificationTimeHiRes bs t = do -- - `InappropriateType` if file type is wrong (symlink to file) -- - `InappropriateType` if file type is wrong (symlink to dir) -- - `PermissionDenied` if directory cannot be opened -getDirsFiles :: PosixFilePath -- ^ dir to read - -> IO [PosixFilePath] +getDirsFiles :: PosixPath -- ^ dir to read + -> IO [PosixPath] getDirsFiles p = do contents <- getDirsFiles' p pure $ fmap (p ) contents -getDirsFilesRec :: PosixFilePath -- ^ dir to read - -> IO [PosixFilePath] +getDirsFilesRec :: PosixPath -- ^ dir to read + -> IO [PosixPath] getDirsFilesRec p = do contents <- getDirsFilesRec' p pure $ fmap (p ) contents @@ -1016,19 +1016,19 @@ getDirsFilesRec p = do -- | Like 'getDirsFiles', but returns the filename only, instead -- of prepending the base path. -getDirsFiles' :: PosixFilePath -- ^ dir to read - -> IO [PosixFilePath] +getDirsFiles' :: PosixPath -- ^ dir to read + -> IO [PosixPath] getDirsFiles' fp = getDirsFilesStream fp >>= S.toList -getDirsFilesRec' :: PosixFilePath -- ^ dir to read - -> IO [PosixFilePath] +getDirsFilesRec' :: PosixPath -- ^ dir to read + -> IO [PosixPath] getDirsFilesRec' fp = getDirsFilesStreamRec fp >>= S.toList getDirsFilesStreamRec :: (MonadCatch m, MonadAsync m, MonadMask m) - => PosixFilePath - -> IO (SerialT m PosixFilePath) + => PosixPath + -> IO (SerialT m PosixPath) getDirsFilesStreamRec fp = do stream <- getDirsFilesStream fp pure $ S.concatMapM inner stream @@ -1045,8 +1045,8 @@ getDirsFilesStreamRec fp = do -- | Like 'getDirsFiles'', except returning a Stream. getDirsFilesStream :: (MonadCatch m, MonadAsync m, MonadMask m) - => PosixFilePath - -> IO (SerialT m PosixFilePath) + => PosixPath + -> IO (SerialT m PosixPath) getDirsFilesStream fp = do fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing ds <- SPDT.fdOpendir fd `onException` SPI.closeFd fd @@ -1057,10 +1057,10 @@ getDirsFilesStream fp = do --[ CWD ]-- ----------- -getCurrentDirectory :: IO PosixFilePath +getCurrentDirectory :: IO PosixPath getCurrentDirectory = getWorkingDirectory -setCurrentDirectory :: PosixFilePath -> IO () +setCurrentDirectory :: PosixPath -> IO () setCurrentDirectory = changeWorkingDirectory @@ -1077,7 +1077,7 @@ setCurrentDirectory = changeWorkingDirectory -- -- - `NoSuchThing` if the file does not exist -- - `PermissionDenied` if any part of the path is not accessible -getFileType :: PosixFilePath -> IO FileType +getFileType :: PosixPath -> IO FileType getFileType fp = do fs <- PF.getSymbolicLinkStatus fp decide fs @@ -1105,7 +1105,7 @@ getFileType fp = do -- -- - `NoSuchThing` if the file at the given path does not exist -- - `NoSuchThing` if the symlink is broken -canonicalizePath :: PosixFilePath -> IO PosixFilePath +canonicalizePath :: PosixPath -> IO PosixPath canonicalizePath = SPDT.realpath @@ -1114,7 +1114,7 @@ canonicalizePath = SPDT.realpath -- -- - if the path is already an absolute one, just return it -- - if it's a relative path, prepend the current directory to it -toAbs :: PosixFilePath -> IO PosixFilePath +toAbs :: PosixPath -> IO PosixPath toAbs bs = do case isAbsolute bs of True -> return bs @@ -1123,12 +1123,12 @@ toAbs bs = do return $ cwd bs -withExistingFile :: PosixFilePath -> SIO.IOMode -> (SIO.Handle -> IO r) -> IO r +withExistingFile :: PosixPath -> SIO.IOMode -> (SIO.Handle -> IO r) -> IO r withExistingFile fp iomode = bracket (openExistingFile fp iomode) SIO.hClose -withExistingFile' :: PosixFilePath -> SIO.IOMode -> (SIO.Handle -> IO r) -> IO r +withExistingFile' :: PosixPath -> SIO.IOMode -> (SIO.Handle -> IO r) -> IO r withExistingFile' fp iomode action = do h <- openExistingFile fp iomode action h diff --git a/hpath-directory/src/System/Posix/PosixPath/Directory.hs-boot b/hpath-directory/src/System/Posix/PosixPath/Directory.hs-boot new file mode 100644 index 0000000..3681b34 --- /dev/null +++ b/hpath-directory/src/System/Posix/PosixPath/Directory.hs-boot @@ -0,0 +1,15 @@ +module System.Posix.PosixPath.Directory where + +import System.OsPath.Posix (PosixPath) + +canonicalizePath :: PosixPath -> IO PosixPath + +toAbs :: PosixPath -> IO PosixPath + +doesFileExist :: PosixPath -> IO Bool + +doesDirectoryExist :: PosixPath -> IO Bool + +isWritable :: PosixPath -> IO Bool + +canOpenDirectory :: PosixPath -> IO Bool diff --git a/hpath-directory/src/System/Posix/PosixFilePath/Directory/Errors.hs b/hpath-directory/src/System/Posix/PosixPath/Directory/Errors.hs similarity index 87% rename from hpath-directory/src/System/Posix/PosixFilePath/Directory/Errors.hs rename to hpath-directory/src/System/Posix/PosixPath/Directory/Errors.hs index 45a1984..1e69955 100644 --- a/hpath-directory/src/System/Posix/PosixFilePath/Directory/Errors.hs +++ b/hpath-directory/src/System/Posix/PosixPath/Directory/Errors.hs @@ -1,5 +1,5 @@ -- | --- Module : System.Posix.PosixFilePath.Directory.Errors +-- Module : System.Posix.PosixPath.Directory.Errors -- Copyright : © 2016 Julian Ospald -- License : BSD3 -- @@ -13,7 +13,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiWayIf #-} -module System.Posix.PosixFilePath.Directory.Errors +module System.Posix.PosixPath.Directory.Errors ( -- * Types HPathIOException(..) @@ -52,7 +52,7 @@ import Foreign.C.Error getErrno , Errno ) -import {-# SOURCE #-} System.Posix.PosixFilePath.Directory +import {-# SOURCE #-} System.Posix.PosixPath.Directory ( canonicalizePath , toAbs @@ -69,10 +69,10 @@ import System.Posix.Files.PosixString getFileStatus ) import qualified System.Posix.Files.PosixString as PF -import System.AbstractFilePath.Posix -import qualified System.AbstractFilePath.Posix.Internal as Raw +import System.OsPath.Posix +import qualified System.OsPath.Posix.Internal as Raw import qualified System.OsString.Internal.Types as Raw -import qualified System.AbstractFilePath.Data.ByteString.Short as BS +import qualified System.OsPath.Data.ByteString.Short as BS import System.Directory.Types import System.OsString.Internal.Types @@ -92,9 +92,9 @@ import System.OsString.Internal.Types -- |Throws `AlreadyExists` `IOError` if file exists. -throwFileDoesExist :: PosixFilePath -> IO () +throwFileDoesExist :: PosixPath -> IO () throwFileDoesExist bs = do - locstr <- fromPlatformStringIO bs + locstr <- decodeFS bs whenM (doesFileExist bs) (ioError . mkIOError alreadyExistsErrorType @@ -105,9 +105,9 @@ throwFileDoesExist bs = do -- |Throws `AlreadyExists` `IOError` if directory exists. -throwDirDoesExist :: PosixFilePath -> IO () +throwDirDoesExist :: PosixPath -> IO () throwDirDoesExist bs = do - locstr <- fromPlatformStringIO bs + locstr <- decodeFS bs whenM (doesDirectoryExist bs) (ioError . mkIOError alreadyExistsErrorType @@ -118,8 +118,8 @@ throwDirDoesExist bs = do -- |Uses `isSameFile` and throws `SameFile` if it returns True. -throwSameFile :: PosixFilePath - -> PosixFilePath +throwSameFile :: PosixPath + -> PosixPath -> IO () throwSameFile bs1 bs2 = whenM (sameFile bs1 bs2) @@ -128,7 +128,7 @@ throwSameFile bs1 bs2 = -- |Check if the files are the same by examining device and file id. -- This follows symbolic links. -sameFile :: PosixFilePath -> PosixFilePath -> IO Bool +sameFile :: PosixPath -> PosixPath -> IO Bool sameFile fp1 fp2 = handleIOError (\_ -> return False) $ do fs1 <- getFileStatus fp1 @@ -145,8 +145,8 @@ sameFile fp1 fp2 = -- within the source directory by comparing the device+file ID of the -- source directory with all device+file IDs of the parent directories -- of the destination. -throwDestinationInSource :: PosixFilePath -- ^ source dir - -> PosixFilePath -- ^ full destination, @dirname dest@ +throwDestinationInSource :: PosixPath -- ^ source dir + -> PosixPath -- ^ full destination, @dirname dest@ -- must exist -> IO () throwDestinationInSource sbs dbs = do @@ -164,7 +164,7 @@ throwDestinationInSource sbs dbs = do basename x = let b = takeBaseName x in if b == mempty then Nothing else Just b - takeAllParents :: PosixFilePath -> [PosixFilePath] + takeAllParents :: PosixPath -> [PosixPath] takeAllParents p = let s = splitDirectories p in fmap Raw.PS @@ -182,7 +182,7 @@ throwDestinationInSource sbs dbs = do ) ) ) mempty - . fmap Raw.unPFP + . fmap Raw.unPS $ s where filterEmptyHead :: [BS.ShortByteString] -> [BS.ShortByteString] diff --git a/hpath-directory/src/System/Win32/WindowsFilePath/Directory.hsc b/hpath-directory/src/System/Win32/WindowsPath/Directory.hsc similarity index 89% rename from hpath-directory/src/System/Win32/WindowsFilePath/Directory.hsc rename to hpath-directory/src/System/Win32/WindowsPath/Directory.hsc index 24f04a1..8b02ed1 100644 --- a/hpath-directory/src/System/Win32/WindowsFilePath/Directory.hsc +++ b/hpath-directory/src/System/Win32/WindowsPath/Directory.hsc @@ -1,5 +1,5 @@ -- | --- Module : System.Win32.WindowsFilePath.Directory +-- Module : System.Win32.WindowsPath.Directory -- Copyright : © 2020 Julian Ospald -- License : BSD3 -- @@ -25,14 +25,14 @@ -- unreliable/unsafe. Check the documentation of those functions for details. -- -- Import as: --- > import System.Win32.WindowsFilePath.Directory +-- > import System.Win32.WindowsPath.Directory {-# LANGUAGE CPP #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE FlexibleContexts #-} -- streamly -module System.Win32.WindowsFilePath.Directory +module System.Win32.WindowsPath.Directory ( -- * Types FileType(..) @@ -126,10 +126,10 @@ where ##endif #include #include -#include -#include +#include +#include -import System.File.PlatformFilePath +import System.File.PlatformPath import Control.Exception.Safe ( IOException , MonadCatch , MonadMask @@ -143,6 +143,7 @@ import qualified Control.Monad.Fail as Fail import qualified Control.Monad as Fail #endif import Control.Monad ( when + , forM ) import Control.Monad.IO.Class ( liftIO , MonadIO @@ -165,8 +166,7 @@ import Prelude hiding ( appendFile , readFile , writeFile ) - -import Streamly (MonadAsync, SerialT) +import Streamly.Prelude (MonadAsync, SerialT) import qualified Streamly.Internal.Data.Unfold as SU @@ -176,7 +176,7 @@ import Streamly.Internal.Data.Unfold.Type import qualified Streamly.Internal.Data.Stream.IsStream.Expand as SE import qualified Streamly.Prelude as S -import System.AbstractFilePath.Windows +import System.OsPath.Windows import System.OsString.Internal.Types import System.Directory.Types import System.Directory.Errors @@ -193,10 +193,13 @@ import Foreign.Marshal.Alloc import Foreign.Marshal.Utils import Foreign.Storable import Foreign.C.Types -import System.AbstractFilePath.Data.ByteString.Short.Word16 (packCWStringLen, ShortByteString) -import qualified System.AbstractFilePath.Data.ByteString.Short.Word16 as W16 +import System.OsPath.Data.ByteString.Short.Word16 (packCWStringLen, ShortByteString) +import qualified System.OsPath.Data.ByteString.Short.Word16 as W16 import System.IO.Error import Data.Void +import qualified Data.ByteString.Lazy as L +import qualified System.IO as SIO +import qualified Data.ByteString as BS @@ -286,8 +289,8 @@ data Win32_REPARSE_DATA_BUFFER -- Throws in `Strict` CopyMode only: -- -- - `AlreadyExists` if destination already exists -copyDirRecursive :: WindowsFilePath -- ^ source dir - -> WindowsFilePath -- ^ destination (parent dirs +copyDirRecursive :: WindowsPath -- ^ source dir + -> WindowsPath -- ^ destination (parent dirs -- are not automatically created) -> CopyMode -> RecursiveErrorMode @@ -304,17 +307,17 @@ copyDirRecursive fromp destdirp cm rm = do -- (throwIO . RecursiveFailure $ collectedExceptions) where #if MIN_VERSION_base(4,9,0) - basename :: Fail.MonadFail m => WindowsFilePath -> m WindowsFilePath + basename :: Fail.MonadFail m => WindowsPath -> m WindowsPath #else - basename :: Fail.Monad m => WindowsFilePath -> m WindowsFilePath + basename :: Fail.Monad m => WindowsPath -> m WindowsPath #endif basename x = let b = takeFileName x in if b == mempty then Fail.fail ("No base name" :: String) else pure b go :: IORef [(RecursiveFailureHint, IOException)] - -> WindowsFilePath - -> WindowsFilePath + -> WindowsPath + -> WindowsPath -> IO () go ce from destdir = do @@ -394,8 +397,8 @@ copyDirRecursive fromp destdirp cm rm = do -- Throws in `Overwrite` mode only: -- -- - `UnsatisfiedConstraints` if destination file is non-empty directory -recreateSymlink :: WindowsFilePath -- ^ the old symlink file - -> WindowsFilePath -- ^ destination file +recreateSymlink :: WindowsPath -- ^ the old symlink file + -> WindowsPath -- ^ destination file -> CopyMode -> IO () recreateSymlink symsource newsym cm = do @@ -448,8 +451,8 @@ recreateSymlink symsource newsym cm = do -- Throws in `Strict` mode only: -- -- - `AlreadyExists` if destination already exists -copyFile :: WindowsFilePath -- ^ source file - -> WindowsFilePath -- ^ destination file +copyFile :: WindowsPath -- ^ source file + -> WindowsPath -- ^ destination file -> CopyMode -> IO () copyFile from to cm = WS.copyFile from to (cm == Strict) @@ -463,8 +466,8 @@ copyFile from to cm = WS.copyFile from to (cm == Strict) -- -- * examines filetypes explicitly -- * calls `copyDirRecursive` for directories -easyCopy :: WindowsFilePath - -> WindowsFilePath +easyCopy :: WindowsPath + -> WindowsPath -> CopyMode -> RecursiveErrorMode -> IO () @@ -495,7 +498,7 @@ easyCopy from to cm rm = do -- - `PermissionDenied` if the directory cannot be read -- -- Notes: calls `unlink` -deleteFile :: WindowsFilePath -> IO () +deleteFile :: WindowsPath -> IO () deleteFile = WS.deleteFile @@ -508,7 +511,7 @@ deleteFile = WS.deleteFile -- - `NoSuchThing` if directory does not exist -- - `UnsatisfiedConstraints` if directory is not empty -- - `PermissionDenied` if we can't open or write to parent directory -deleteDir :: WindowsFilePath -> IO () +deleteDir :: WindowsPath -> IO () deleteDir = WS.removeDirectory @@ -527,7 +530,7 @@ deleteDir = WS.removeDirectory -- - `InappropriateType` for wrong file type (regular file) -- - `NoSuchThing` if directory does not exist -- - `PermissionDenied` if we can't open or write to parent directory -deleteDirRecursive :: WindowsFilePath -> IO () +deleteDirRecursive :: WindowsPath -> IO () deleteDirRecursive p = catchIOError (deleteDir p) $ \e -> case ioeGetErrorType e of NoSuchThing -> rmRecursive p @@ -544,7 +547,7 @@ deleteDirRecursive p = catchIOError (deleteDir p) $ \e -> DirectoryLink -> deleteDirRecursive file File -> deleteFile file deleteDir fp - + -- |Deletes a file, directory or symlink. -- In case of directory, performs recursive deletion. In case of @@ -554,7 +557,7 @@ deleteDirRecursive p = catchIOError (deleteDir p) $ \e -> -- -- * examines filetypes explicitly -- * calls `deleteDirRecursive` for directories -easyDelete :: WindowsFilePath -> IO () +easyDelete :: WindowsPath -> IO () easyDelete p = do ftype <- getFileType p case ftype of @@ -569,27 +572,27 @@ easyDelete p = do --[ File Write ]-- ------------------ -appendExistingFile :: WindowsFilePath -> L.ByteString -> IO () +appendExistingFile :: WindowsPath -> L.ByteString -> IO () appendExistingFile fp contents = withExistingFile fp SIO.AppendMode (`L.hPut` contents) -appendExistingFile' :: WindowsFilePath -> BS.ByteString -> IO () +appendExistingFile' :: WindowsPath -> BS.ByteString -> IO () appendExistingFile' fp contents = withExistingFile fp SIO.AppendMode (`BS.hPut` contents) -writeExistingFile :: WindowsFilePath -> L.ByteString -> IO () +writeExistingFile :: WindowsPath -> L.ByteString -> IO () writeExistingFile fp contents = withExistingFile fp SIO.WriteMode (`L.hPut` contents) -writeExistingFile' :: WindowsFilePath -> BS.ByteString -> IO () +writeExistingFile' :: WindowsPath -> BS.ByteString -> IO () writeExistingFile' fp contents = withExistingFile fp SIO.WriteMode (`BS.hPut` contents) -------------------- --[ File Reading ]-- -------------------- -readExistingFile :: WindowsFilePath -> IO L.ByteString +readExistingFile :: WindowsPath -> IO L.ByteString readExistingFile fp = withExistingFile' fp SIO.ReadMode L.hGetContents -readExistingFile' :: WindowsFilePath -> IO BS.ByteString +readExistingFile' :: WindowsPath -> IO BS.ByteString readExistingFile' fp = withExistingFile fp SIO.ReadMode BS.hGetContents @@ -609,7 +612,7 @@ foreign import WINAPI unsafe "windows.h DeviceIoControl" -- | Read the target of a symbolic link. -- -- This is mostly stolen from 'directory' package. -readSymbolicLink :: WindowsFilePath -> IO WindowsFilePath +readSymbolicLink :: WindowsPath -> IO WindowsPath readSymbolicLink path = WS <$> do let open = WS.createFile path 0 maxShareMode Nothing Win32.oPEN_EXISTING (Win32.fILE_FLAG_BACKUP_SEMANTICS .|. @@ -634,7 +637,7 @@ readSymbolicLink path = WS <$> do _ -> throwIO (mkIOError InappropriateType "readSymbolicLink" Nothing Nothing) where - strip sn = fromMaybe sn (W16.stripPrefix (unWFP $ fromString "\\??\\") sn) + strip sn = fromMaybe sn (W16.stripPrefix (fromString "\\??\\") sn) win32_iO_REPARSE_TAG_MOUNT_POINT, win32_iO_REPARSE_TAG_SYMLINK :: CULong win32_iO_REPARSE_TAG_MOUNT_POINT = (#const IO_REPARSE_TAG_MOUNT_POINT) @@ -737,7 +740,7 @@ readSymbolicLink path = WS <$> do -- - `AlreadyExists` if destination already exists -- - `NoSuchThing` if any of the parent components of the path -- do not exist -createRegularFile :: Win32.AccessMode -> WindowsFilePath -> IO () +createRegularFile :: Win32.AccessMode -> WindowsPath -> IO () createRegularFile mode fp = bracket open close (\_ -> return ()) where open = WS.createFile @@ -759,7 +762,7 @@ createRegularFile mode fp = bracket open close (\_ -> return ()) -- - `AlreadyExists` if destination already exists -- - `NoSuchThing` if any of the parent components of the path -- do not exist -createDir :: WindowsFilePath -> IO () +createDir :: WindowsPath -> IO () createDir = flip WS.createDirectory Nothing @@ -770,7 +773,7 @@ createDir = flip WS.createDirectory Nothing -- - `PermissionDenied` if output directory cannot be written to -- - `NoSuchThing` if any of the parent components of the path -- do not exist -createDirIfMissing :: WindowsFilePath -> IO () +createDirIfMissing :: WindowsPath -> IO () createDirIfMissing = hideError AlreadyExists . createDir @@ -793,10 +796,10 @@ createDirIfMissing = hideError AlreadyExists . createDir -- exist and cannot be written to -- - `AlreadyExists` if destination already exists and -- is *not* a directory -createDirRecursive :: WindowsFilePath -> IO () +createDirRecursive :: WindowsPath -> IO () createDirRecursive p = go p where - go :: WindowsFilePath -> IO () + go :: WindowsPath -> IO () go dest = do catchIOError (createDir dest) $ \e -> do case ioeGetErrorType e of @@ -818,8 +821,8 @@ createDirRecursive p = go p -- - `AlreadyExists` if destination file already exists -- - `NoSuchThing` if any of the parent components of the path -- do not exist -createSymlink :: WindowsFilePath -- ^ destination file - -> WindowsFilePath -- ^ path the symlink points to +createSymlink :: WindowsPath -- ^ destination file + -> WindowsPath -- ^ path the symlink points to -> Bool -- ^ whether this is a directory -> IO () createSymlink destBS sympoint dir = @@ -843,7 +846,7 @@ createSymlink destBS sympoint dir = -- - `UnsupportedOperation` if source and destination are on different -- devices -- - `AlreadyExists` if destination already exists -renameFile :: WindowsFilePath -> WindowsFilePath -> IO () +renameFile :: WindowsPath -> WindowsPath -> IO () renameFile from to = WS.moveFileEx from (Just to) 0 @@ -866,8 +869,8 @@ renameFile from to = -- Throws in `Strict` mode only: -- -- - `AlreadyExists` if destination already exists -moveFile :: WindowsFilePath -- ^ file to move - -> WindowsFilePath -- ^ destination +moveFile :: WindowsPath -- ^ file to move + -> WindowsPath -- ^ destination -> CopyMode -> IO () moveFile from to cm = do @@ -892,7 +895,7 @@ setWriteMode True m = m .&. complement Win32.fILE_ATTRIBUTE_READONLY -- | A restricted form of 'setFileMode' that only sets the permission bits. -- For Windows, this means only the "read-only" attribute is affected. -setFilePermissions :: WindowsFilePath -> Win32.FileAttributeOrFlag -> IO () +setFilePermissions :: WindowsPath -> Win32.FileAttributeOrFlag -> IO () setFilePermissions path m = do m' <- Win32.bhfiFileAttributes <$> getFileMetadata path WS.setFileAttributes path ((m' .&. complement Win32.fILE_ATTRIBUTE_READONLY) .|. @@ -914,7 +917,7 @@ newFilePerms = Win32.gENERIC_READ .|. Win32.gENERIC_WRITE -- |Checks if the given file exists. -- -- Only NoSuchThing is catched (and returns False). -doesExist :: WindowsFilePath -> IO Bool +doesExist :: WindowsPath -> IO Bool doesExist bs = handleIO (\e -> if NoSuchThing == ioeGetErrorType e then pure False else ioError e) $ (const True) <$> getFileType bs @@ -924,7 +927,7 @@ doesExist bs = -- Does follow symlinks. -- -- Only NoSuchThing is catched (and returns False). -doesFileExist :: WindowsFilePath -> IO Bool +doesFileExist :: WindowsPath -> IO Bool doesFileExist bs = handleIO (\e -> if NoSuchThing == ioeGetErrorType e then pure False else ioError e) $ (\ft -> ft == File || ft == SymbolicLink) <$> getFileType bs @@ -935,7 +938,7 @@ doesFileExist bs = -- Does follow reparse points. -- -- Only NoSuchThing is catched (and returns False). -doesDirectoryExist :: WindowsFilePath -> IO Bool +doesDirectoryExist :: WindowsPath -> IO Bool doesDirectoryExist bs = handleIO (\e -> if NoSuchThing == ioeGetErrorType e then pure False else ioError e) $ (\ft -> ft == Directory || ft == DirectoryLink) <$> getFileType bs @@ -947,7 +950,7 @@ doesDirectoryExist bs = -- Throws: -- -- - `NoSuchThing` if the file or folder does not exist -isReadable :: WindowsFilePath -> IO Bool +isReadable :: WindowsPath -> IO Bool isReadable bs = (const True) <$> getFileType bs -- |Checks whether a file or folder is writable. @@ -955,7 +958,7 @@ isReadable bs = (const True) <$> getFileType bs -- Throws: -- -- - `NoSuchThing` if the file or folder does not exist -isWritable :: WindowsFilePath -> IO Bool +isWritable :: WindowsPath -> IO Bool isWritable bs = do fi <- getFileMetadata bs pure (hasWriteMode (Win32.bhfiFileAttributes fi)) @@ -970,26 +973,26 @@ isWritable bs = do -- Throws: -- -- - `NoSuchThing` if the file does not exist -isExecutable :: WindowsFilePath -> IO Bool +isExecutable :: WindowsPath -> IO Bool isExecutable bs = do getFileType bs >>= \case Directory -> pure False DirectoryLink -> pure False _ -> do let ext = takeExtension bs - exeExts <- fmap toPlatformString - . (fmap . fmap) toLower + exeExts <- (fmap . fmap) toLower . (wordsBy (==';')) . fromMaybe "" <$> lookupEnv "PATHEXT" - pure $ ext `elem` exeExts + exeExts' <- forM exeExts encodeFS + pure $ ext `elem` exeExts' -- |Checks whether the directory at the given path exists and can be -- opened. Returns 'False' on non-directories. -canOpenDirectory :: WindowsFilePath -> IO Bool +canOpenDirectory :: WindowsPath -> IO Bool canOpenDirectory bs = handleIOError (\_ -> return False) $ do - let query = bs fromString "*" + let query = bs pack [unsafeFromChar '*'] bracket (WS.findFirstFile query) (\(h, _) -> Win32.findClose h) @@ -1003,18 +1006,18 @@ canOpenDirectory bs = handleIOError (\_ -> return False) $ do ------------------ -getModificationTime :: WindowsFilePath -> IO UTCTime +getModificationTime :: WindowsPath -> IO UTCTime getModificationTime bs = do m <- getFileMetadata bs pure $ posixSecondsToUTCTime $ windowsToPosixTime $ Win32.bhfiLastWriteTime m -setModificationTime :: WindowsFilePath -> UTCTime -> IO () +setModificationTime :: WindowsPath -> UTCTime -> IO () setModificationTime fp t = bracket (WS.createFile fp Win32.fILE_WRITE_ATTRIBUTES maxShareMode Nothing Win32.oPEN_EXISTING Win32.fILE_FLAG_BACKUP_SEMANTICS Nothing) Win32.closeHandle $ \h -> do Win32.setFileTime h Nothing Nothing (Just . posixToWindowsTime . utcTimeToPOSIXSeconds $ t) -setModificationTimeHiRes :: WindowsFilePath -> Win32.FILETIME -> IO () +setModificationTimeHiRes :: WindowsPath -> Win32.FILETIME -> IO () setModificationTimeHiRes fp t = bracket (WS.createFile fp Win32.fILE_WRITE_ATTRIBUTES maxShareMode Nothing Win32.oPEN_EXISTING Win32.fILE_FLAG_BACKUP_SEMANTICS Nothing) Win32.closeHandle $ \h -> do Win32.setFileTime h Nothing Nothing (Just t) @@ -1046,15 +1049,15 @@ posixToWindowsTime t = Win32.FILETIME $ -- - `InappropriateType` if file type is wrong (symlink to file) -- - `InappropriateType` if file type is wrong (symlink to dir) -- - `PermissionDenied` if directory cannot be opened -getDirsFiles :: WindowsFilePath -- ^ dir to read - -> IO [WindowsFilePath] +getDirsFiles :: WindowsPath -- ^ dir to read + -> IO [WindowsPath] getDirsFiles p = do contents <- getDirsFiles' p pure $ fmap (p ) contents -getDirsFilesRec :: WindowsFilePath -- ^ dir to read - -> IO [WindowsFilePath] +getDirsFilesRec :: WindowsPath -- ^ dir to read + -> IO [WindowsPath] getDirsFilesRec p = do contents <- getDirsFilesRec' p pure $ fmap (p ) contents @@ -1062,19 +1065,19 @@ getDirsFilesRec p = do -- | Like 'getDirsFiles', but returns the filename only, instead -- of prepending the base path. -getDirsFiles' :: WindowsFilePath -- ^ dir to read - -> IO [WindowsFilePath] +getDirsFiles' :: WindowsPath -- ^ dir to read + -> IO [WindowsPath] getDirsFiles' fp = getDirsFilesStream fp >>= S.toList -getDirsFilesRec' :: WindowsFilePath -- ^ dir to read - -> IO [WindowsFilePath] +getDirsFilesRec' :: WindowsPath -- ^ dir to read + -> IO [WindowsPath] getDirsFilesRec' fp = getDirsFilesStreamRec fp >>= S.toList getDirsFilesStreamRec :: (MonadCatch m, MonadAsync m, MonadMask m) - => WindowsFilePath - -> IO (SerialT m WindowsFilePath) + => WindowsPath + -> IO (SerialT m WindowsPath) getDirsFilesStreamRec fp = do stream <- getDirsFilesStream fp pure $ S.concatMapM inner stream @@ -1091,15 +1094,15 @@ getDirsFilesStreamRec fp = do -- | Like 'getDirsFiles'', except returning a Stream. getDirsFilesStream :: (MonadCatch m, MonadAsync m, MonadMask m) - => WindowsFilePath - -> IO (SerialT m WindowsFilePath) + => WindowsPath + -> IO (SerialT m WindowsPath) getDirsFilesStream fp = do - let query = fp fromString "*" + let query = fp pack [unsafeFromChar '*'] t <- WS.findFirstFile query let stream = S.unfold (SU.finally (liftIO . Win32.findClose . fst) unfoldDirContents) $ (fmap Just t) pure stream where - unfoldDirContents :: MonadIO m => Unfold m (Win32.HANDLE, Maybe Win32.FindData) WindowsFilePath + unfoldDirContents :: MonadIO m => Unfold m (Win32.HANDLE, Maybe Win32.FindData) WindowsPath unfoldDirContents = Unfold step return where {-# INLINE [0] step #-} @@ -1109,8 +1112,8 @@ getDirsFilesStream fp = do more <- liftIO $ Win32.findNextFile handle fd pure $ case () of _ - | [unsafeFromChar '.'] == unpackPlatformString filename -> D.Skip (handle, if more then Just fd else Nothing) - | [unsafeFromChar '.', unsafeFromChar '.'] == unpackPlatformString filename -> D.Skip (handle, if more then Just fd else Nothing) + | [unsafeFromChar '.'] == unpack filename -> D.Skip (handle, if more then Just fd else Nothing) + | [unsafeFromChar '.', unsafeFromChar '.'] == unpack filename -> D.Skip (handle, if more then Just fd else Nothing) | otherwise -> D.Yield filename (handle, if more then Just fd else Nothing) @@ -1119,10 +1122,10 @@ getDirsFilesStream fp = do --[ CWD ]-- ----------- -getCurrentDirectory :: IO WindowsFilePath +getCurrentDirectory :: IO WindowsPath getCurrentDirectory = WS.getCurrentDirectory -setCurrentDirectory :: WindowsFilePath -> IO () +setCurrentDirectory :: WindowsPath -> IO () setCurrentDirectory = WS.setCurrentDirectory @@ -1138,7 +1141,7 @@ setCurrentDirectory = WS.setCurrentDirectory -- -- - `NoSuchThing` if the file does not exist -- - `PermissionDenied` if any part of the path is not accessible -getFileType :: WindowsFilePath -> IO FileType +getFileType :: WindowsPath -> IO FileType getFileType fp = do fi <- getFileMetadata fp pure $ decide fi @@ -1152,7 +1155,7 @@ getFileType fp = do | otherwise = File -getFileMetadata :: WindowsFilePath -> IO Win32.BY_HANDLE_FILE_INFORMATION +getFileMetadata :: WindowsPath -> IO Win32.BY_HANDLE_FILE_INFORMATION getFileMetadata fp = do bracket (WS.createFile fp 0 maxShareMode Nothing Win32.oPEN_EXISTING Win32.fILE_FLAG_BACKUP_SEMANTICS Nothing) Win32.closeHandle $ \h -> Win32.getFileInformationByHandle h @@ -1171,7 +1174,7 @@ getFileMetadata fp = do -- -- - `NoSuchThing` if the file at the given path does not exist -- - `NoSuchThing` if the symlink is broken -canonicalizePath :: WindowsFilePath -> IO WindowsFilePath +canonicalizePath :: WindowsPath -> IO WindowsPath canonicalizePath = WS.getFullPathName @@ -1180,7 +1183,7 @@ canonicalizePath = WS.getFullPathName -- -- - if the path is already an absolute one, just return it -- - if it's a relative path, prepend the current directory to it -toAbs :: WindowsFilePath -> IO WindowsFilePath +toAbs :: WindowsPath -> IO WindowsPath toAbs bs = do case isAbsolute bs of True -> return bs @@ -1190,12 +1193,12 @@ toAbs bs = do -withExistingFile :: WindowsFilePath -> SIO.IOMode -> (SIO.Handle -> IO r) -> IO r +withExistingFile :: WindowsPath -> SIO.IOMode -> (SIO.Handle -> IO r) -> IO r withExistingFile fp iomode = bracket (openExistingFile fp iomode) SIO.hClose -withExistingFile' :: WindowsFilePath -> SIO.IOMode -> (SIO.Handle -> IO r) -> IO r +withExistingFile' :: WindowsPath -> SIO.IOMode -> (SIO.Handle -> IO r) -> IO r withExistingFile' fp iomode action = do h <- openExistingFile fp iomode action h diff --git a/hpath-directory/src/System/Win32/WindowsFilePath/utility.h b/hpath-directory/src/System/Win32/WindowsPath/utility.h similarity index 100% rename from hpath-directory/src/System/Win32/WindowsFilePath/utility.h rename to hpath-directory/src/System/Win32/WindowsPath/utility.h diff --git a/hpath-directory/src/System/Win32/WindowsFilePath/windows_ext.h b/hpath-directory/src/System/Win32/WindowsPath/windows_ext.h similarity index 100% rename from hpath-directory/src/System/Win32/WindowsFilePath/windows_ext.h rename to hpath-directory/src/System/Win32/WindowsPath/windows_ext.h diff --git a/hpath-directory/test/Main.hs b/hpath-directory/test/Main.hs index 8e53e13..81ffd50 100644 --- a/hpath-directory/test/Main.hs +++ b/hpath-directory/test/Main.hs @@ -13,8 +13,8 @@ import System.Win32.WindowsString.Info import System.Posix.Temp.PosixString (mkdtemp) import System.Posix.Env.PosixString (getEnvDefault) #endif -import System.Directory.AbstractFilePath -import System.AbstractFilePath +import System.Directory.OsPath +import System.OsPath import System.OsString.Internal.Types diff --git a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveCollectFailuresSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveCollectFailuresSpec.hs index 477107c..5abf75f 100644 --- a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveCollectFailuresSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveCollectFailuresSpec.hs @@ -6,7 +6,7 @@ module System.Directory.AFP.CopyDirRecursiveCollectFailuresSpec where import Test.Hspec import Data.List (sort) -import System.Directory.AbstractFilePath hiding (writeFile') +import System.Directory.OsPath hiding (writeFile') import System.Directory.Errors import System.IO.Error ( @@ -19,7 +19,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import System.AbstractFilePath +import System.OsPath @@ -120,7 +120,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ -- successes -- it "copyDirRecursive (Strict, CollectFailures), all fine and compare" $ do tmpDir' <- getRawTmpDir - tmpDirS <- fromAbstractFilePathIO tmpDir' + tmpDirS <- decodeFS tmpDir' copyDirRecursive' "inputDir" "outputDir" Strict diff --git a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveOverwriteSpec.hs index a1e6b4a..787d450 100644 --- a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveOverwriteSpec.hs @@ -5,7 +5,7 @@ module System.Directory.AFP.CopyDirRecursiveOverwriteSpec where import Test.Hspec -import System.Directory.AbstractFilePath hiding (writeFile') +import System.Directory.OsPath hiding (writeFile') import System.IO.Error ( ioeGetErrorType @@ -17,7 +17,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import System.AbstractFilePath +import System.OsPath @@ -99,7 +99,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "copyDirRecursive (Overwrite, FailEarly), all fine and compare" $ do tmpDir' <- getRawTmpDir - tmpDirS <- fromAbstractFilePathIO tmpDir' + tmpDirS <- decodeFS tmpDir' copyDirRecursive' "inputDir" "outputDir" Overwrite @@ -113,7 +113,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "copyDirRecursive (Overwrite, FailEarly), destination dir already exists" $ do tmpDir' <- getRawTmpDir - tmpDirS <- fromAbstractFilePathIO tmpDir' + tmpDirS <- decodeFS tmpDir' (system $ "diff -r " ++ tmpDirS ++ "inputDir" ++ " " ++ tmpDirS ++ "alreadyExistsD" diff --git a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveSpec.hs index 39152cb..b65c9c4 100644 --- a/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveSpec.hs @@ -5,7 +5,7 @@ module System.Directory.AFP.CopyDirRecursiveSpec where import Test.Hspec -import System.Directory.AbstractFilePath hiding (writeFile') +import System.Directory.OsPath hiding (writeFile') import System.IO.Error ( ioeGetErrorType @@ -17,7 +17,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import System.AbstractFilePath +import System.OsPath @@ -84,7 +84,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "copyDirRecursive (Strict, FailEarly), all fine and compare" $ do tmpDir' <- getRawTmpDir - tmpDirS <- fromAbstractFilePathIO tmpDir' + tmpDirS <- decodeFS tmpDir' copyDirRecursive' "inputDir" "outputDir" Strict diff --git a/hpath-directory/test/System/Directory/AFP/CopyFileOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyFileOverwriteSpec.hs index fbae046..488a8f3 100644 --- a/hpath-directory/test/System/Directory/AFP/CopyFileOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyFileOverwriteSpec.hs @@ -4,7 +4,7 @@ module System.Directory.AFP.CopyFileOverwriteSpec where import Test.Hspec -import System.Directory.AbstractFilePath hiding (writeFile') +import System.Directory.OsPath hiding (writeFile') import System.IO.Error ( ioeGetErrorType @@ -16,7 +16,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import System.AbstractFilePath +import System.OsPath @@ -69,7 +69,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "copyFile (Overwrite), output file already exists, all clear" $ do tmpDir' <- getRawTmpDir - tmpDirS <- fromAbstractFilePathIO tmpDir' + tmpDirS <- decodeFS tmpDir' copyFile' "alreadyExists" "alreadyExists.bak" Strict copyFile' "inputFile" "alreadyExists" Overwrite (system $ "cmp -s " ++ tmpDirS ++ "inputFile" ++ " " @@ -81,7 +81,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "copyFile (Overwrite), and compare" $ do tmpDir' <- getRawTmpDir - tmpDirS <- fromAbstractFilePathIO tmpDir' + tmpDirS <- decodeFS tmpDir' copyFile' "inputFile" "outputFile" Overwrite diff --git a/hpath-directory/test/System/Directory/AFP/CopyFileSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyFileSpec.hs index 7067e61..1cb598c 100644 --- a/hpath-directory/test/System/Directory/AFP/CopyFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyFileSpec.hs @@ -5,7 +5,7 @@ module System.Directory.AFP.CopyFileSpec where import Test.Hspec -import System.Directory.AbstractFilePath hiding (writeFile') +import System.Directory.OsPath hiding (writeFile') import System.IO.Error ( ioeGetErrorType @@ -17,7 +17,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import System.AbstractFilePath +import System.OsPath @@ -68,7 +68,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "copyFile (Strict), and compare" $ do tmpDir' <- getRawTmpDir - tmpDirS <- fromAbstractFilePathIO tmpDir' + tmpDirS <- decodeFS tmpDir' copyFile' "inputFile" "outputFile" Strict diff --git a/hpath-directory/test/System/Directory/AFP/DeleteFileSpec.hs b/hpath-directory/test/System/Directory/AFP/DeleteFileSpec.hs index 52cc4c6..d3c6833 100644 --- a/hpath-directory/test/System/Directory/AFP/DeleteFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/DeleteFileSpec.hs @@ -3,7 +3,7 @@ module System.Directory.AFP.DeleteFileSpec where -import System.Directory.AbstractFilePath +import System.Directory.OsPath import Test.Hspec import System.IO.Error ( diff --git a/hpath-directory/test/System/Directory/AFP/GetDirsFilesSpec.hs b/hpath-directory/test/System/Directory/AFP/GetDirsFilesSpec.hs index 6d073c3..6668952 100644 --- a/hpath-directory/test/System/Directory/AFP/GetDirsFilesSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/GetDirsFilesSpec.hs @@ -7,7 +7,7 @@ import Data.List ( sort ) -import System.Directory.AbstractFilePath hiding (getDirsFiles') +import System.Directory.OsPath hiding (getDirsFiles') import Test.Hspec import System.IO.Error ( @@ -18,7 +18,7 @@ import GHC.IO.Exception IOErrorType(..) ) import Utils -import System.AbstractFilePath +import System.OsPath upTmpDir :: IO () diff --git a/hpath-directory/test/System/Directory/AFP/MoveFileOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/MoveFileOverwriteSpec.hs index fa471dd..ae31996 100644 --- a/hpath-directory/test/System/Directory/AFP/MoveFileOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/MoveFileOverwriteSpec.hs @@ -4,7 +4,7 @@ module System.Directory.AFP.MoveFileOverwriteSpec where import Test.Hspec -import System.Directory.AbstractFilePath hiding (writeFile') +import System.Directory.OsPath hiding (writeFile') import System.IO.Error ( ioeGetErrorType diff --git a/hpath-directory/test/System/Directory/AFP/MoveFileSpec.hs b/hpath-directory/test/System/Directory/AFP/MoveFileSpec.hs index df56bfb..801282c 100644 --- a/hpath-directory/test/System/Directory/AFP/MoveFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/MoveFileSpec.hs @@ -4,7 +4,7 @@ module System.Directory.AFP.MoveFileSpec where import Test.Hspec -import System.Directory.AbstractFilePath hiding (writeFile') +import System.Directory.OsPath hiding (writeFile') import System.IO.Error ( ioeGetErrorType diff --git a/hpath-directory/test/System/Directory/AFP/RecreateSymlinkOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkOverwriteSpec.hs index fac4018..8d7ad35 100644 --- a/hpath-directory/test/System/Directory/AFP/RecreateSymlinkOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkOverwriteSpec.hs @@ -7,7 +7,7 @@ module System.Directory.AFP.RecreateSymlinkOverwriteSpec where import Test.Hspec -import System.Directory.AbstractFilePath hiding (writeFile') +import System.Directory.OsPath hiding (writeFile') import System.IO.Error ( ioeGetErrorType diff --git a/hpath-directory/test/System/Directory/AFP/RecreateSymlinkSpec.hs b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkSpec.hs index ae81bc1..de8e4ac 100644 --- a/hpath-directory/test/System/Directory/AFP/RecreateSymlinkSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkSpec.hs @@ -6,7 +6,7 @@ module System.Directory.AFP.RecreateSymlinkSpec where import Test.Hspec -import System.Directory.AbstractFilePath hiding (writeFile') +import System.Directory.OsPath hiding (writeFile') import System.IO.Error ( ioeGetErrorType diff --git a/hpath-directory/test/System/Directory/AFP/ToAbsSpec.hs b/hpath-directory/test/System/Directory/AFP/ToAbsSpec.hs index 70c9940..2683f9a 100644 --- a/hpath-directory/test/System/Directory/AFP/ToAbsSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/ToAbsSpec.hs @@ -5,7 +5,8 @@ module System.Directory.AFP.ToAbsSpec where import Test.Hspec -import System.Directory.AbstractFilePath +import System.Directory.OsPath +import System.OsPath (encodeFS) @@ -14,12 +15,12 @@ spec = describe "System.Posix.PosixFilePath.Directory.toAbs" $ do -- successes -- it "toAbs returns absolute paths unchanged" $ do - let p1 = "/a/b/c/d" + p1 <- encodeFS "/a/b/c/d" to <- toAbs p1 p1 `shouldBe` to it "toAbs returns even existing absolute paths unchanged" $ do - let p1 = "/home" + p1 <- encodeFS "/home" to <- toAbs p1 p1 `shouldBe` to diff --git a/hpath-directory/test/System/Directory/Posix/PosixFilePath/Directory/GetFileTypeSpec.hs b/hpath-directory/test/System/Directory/Posix/PosixFilePath/Directory/GetFileTypeSpec.hs index d29de89..8eba941 100644 --- a/hpath-directory/test/System/Directory/Posix/PosixFilePath/Directory/GetFileTypeSpec.hs +++ b/hpath-directory/test/System/Directory/Posix/PosixFilePath/Directory/GetFileTypeSpec.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} module System.Directory.Posix.PosixFilePath.Directory.GetFileTypeSpec where @@ -7,7 +8,8 @@ import Test.Hspec #ifndef WINDOWS -import "hpath-directory" System.Posix.PosixFilePath.Directory +import System.OsPath +import "hpath-directory" System.Posix.PosixPath.Directory import System.IO.Error ( ioeGetErrorType diff --git a/hpath-directory/test/Utils.hs b/hpath-directory/test/Utils.hs index 85aa540..a92c650 100644 --- a/hpath-directory/test/Utils.hs +++ b/hpath-directory/test/Utils.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Utils where @@ -34,32 +35,38 @@ import System.IO.Unsafe ) #ifdef WINDOWS #else -import System.Posix.PosixFilePath.Directory +import System.Posix.PosixPath.Directory ( getFileType ) -import System.AbstractFilePath.Posix (PosixFilePath) +import System.OsPath.Posix (PosixPath) #endif import Data.ByteString ( ByteString ) -import System.AbstractFilePath +import System.OsPath import System.OsString.Internal.Types -import qualified System.AbstractFilePath as AFP +import qualified System.OsPath as AFP +import qualified System.OsPath.Posix as P -import System.Directory.AbstractFilePath hiding ( getFileType ) -import System.File.AbstractFilePath +import System.Directory.OsPath hiding ( getFileType ) +import System.File.OsPath +import Data.String (IsString (fromString)) +instance IsString OsString where + fromString = either (error . show) id . AFP.encodeUtf +instance IsString PosixString where + fromString = either (error . show) id . P.encodeUtf -baseTmpDir :: IORef (Maybe AbstractFilePath) +baseTmpDir :: IORef (Maybe OsPath) {-# NOINLINE baseTmpDir #-} baseTmpDir = unsafePerformIO (newIORef Nothing) -tmpDir :: IORef (Maybe AbstractFilePath) +tmpDir :: IORef (Maybe OsPath) {-# NOINLINE tmpDir #-} tmpDir = unsafePerformIO (newIORef Nothing) @@ -70,7 +77,7 @@ tmpDir = unsafePerformIO (newIORef Nothing) ----------------- -setTmpDir :: AbstractFilePath -> IO () +setTmpDir :: OsPath -> IO () {-# NOINLINE setTmpDir #-} setTmpDir bs = do tmp <- fromJust <$> readIORef baseTmpDir @@ -100,19 +107,19 @@ deleteBaseTmpDir = do void $ deleteDir tmp -withRawTmpDir :: (AbstractFilePath -> IO a) -> IO a +withRawTmpDir :: (OsPath -> IO a) -> IO a {-# NOINLINE withRawTmpDir #-} withRawTmpDir f = do tmp <- fromJust <$> readIORef tmpDir f tmp -getRawTmpDir :: IO AbstractFilePath +getRawTmpDir :: IO OsPath {-# NOINLINE getRawTmpDir #-} -getRawTmpDir = withRawTmpDir (return . packAFP . (++ [unsafeFromChar '/']) . unpackAFP) +getRawTmpDir = withRawTmpDir (return . pack . (++ [unsafeFromChar '/']) . unpack) -withTmpDir :: AbstractFilePath -> (AbstractFilePath -> IO a) -> IO a +withTmpDir :: OsPath -> (OsPath -> IO a) -> IO a {-# NOINLINE withTmpDir #-} withTmpDir ip f = do tmp <- fromJust <$> readIORef tmpDir @@ -120,9 +127,9 @@ withTmpDir ip f = do f p -withTmpDir' :: AbstractFilePath - -> AbstractFilePath - -> (AbstractFilePath -> AbstractFilePath -> IO a) +withTmpDir' :: OsPath + -> OsPath + -> (OsPath -> OsPath -> IO a) -> IO a {-# NOINLINE withTmpDir' #-} withTmpDir' ip1 ip2 f = do @@ -132,55 +139,55 @@ withTmpDir' ip1 ip2 f = do f p1 p2 -removeFileIfExists :: AbstractFilePath -> IO () +removeFileIfExists :: OsPath -> IO () {-# NOINLINE removeFileIfExists #-} removeFileIfExists bs = withTmpDir bs $ \p -> whenM (doesFileExist p) (deleteFile p) -removeDirIfExists :: AbstractFilePath -> IO () +removeDirIfExists :: OsPath -> IO () {-# NOINLINE removeDirIfExists #-} removeDirIfExists bs = withTmpDir bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p) -copyFile' :: AbstractFilePath -> AbstractFilePath -> CopyMode -> IO () +copyFile' :: OsPath -> OsPath -> CopyMode -> IO () {-# NOINLINE copyFile' #-} copyFile' inputFileP outputFileP cm = withTmpDir' inputFileP outputFileP (\p1 p2 -> copyFile p1 p2 cm) -copyDirRecursive' :: AbstractFilePath -> AbstractFilePath +copyDirRecursive' :: OsPath -> OsPath -> CopyMode -> RecursiveErrorMode -> IO () {-# NOINLINE copyDirRecursive' #-} copyDirRecursive' inputDirP outputDirP cm rm = withTmpDir' inputDirP outputDirP (\p1 p2 -> copyDirRecursive p1 p2 cm rm) -createDir' :: AbstractFilePath -> IO () +createDir' :: OsPath -> IO () {-# NOINLINE createDir' #-} createDir' dest = withTmpDir dest createDir -createDirIfMissing' :: AbstractFilePath -> IO () +createDirIfMissing' :: OsPath -> IO () {-# NOINLINE createDirIfMissing' #-} createDirIfMissing' dest = withTmpDir dest createDirIfMissing -createDirRecursive' :: AbstractFilePath -> IO () +createDirRecursive' :: OsPath -> IO () {-# NOINLINE createDirRecursive' #-} createDirRecursive' dest = withTmpDir dest createDirRecursive -createRegularFile' :: AbstractFilePath -> IO () +createRegularFile' :: OsPath -> IO () {-# NOINLINE createRegularFile' #-} createRegularFile' dest = withTmpDir dest createRegularFile -createSymlink' :: AbstractFilePath -> AbstractFilePath -> Bool -> IO () +createSymlink' :: OsPath -> OsPath -> Bool -> IO () {-# NOINLINE createSymlink' #-} createSymlink' dest sympoint b = withTmpDir dest (\x -> createSymlink x sympoint b) -renameFile' :: AbstractFilePath -> AbstractFilePath -> IO () +renameFile' :: OsPath -> OsPath -> IO () {-# NOINLINE renameFile' #-} renameFile' inputFileP outputFileP = withTmpDir' inputFileP outputFileP $ \i o -> do @@ -188,7 +195,7 @@ renameFile' inputFileP outputFileP = renameFile o i -moveFile' :: AbstractFilePath -> AbstractFilePath -> CopyMode -> IO () +moveFile' :: OsPath -> OsPath -> CopyMode -> IO () {-# NOINLINE moveFile' #-} moveFile' inputFileP outputFileP cm = withTmpDir' inputFileP outputFileP $ \i o -> do @@ -196,123 +203,123 @@ moveFile' inputFileP outputFileP cm = moveFile o i Strict -recreateSymlink' :: AbstractFilePath -> AbstractFilePath -> CopyMode -> IO () +recreateSymlink' :: OsPath -> OsPath -> CopyMode -> IO () {-# NOINLINE recreateSymlink' #-} recreateSymlink' inputFileP outputFileP cm = withTmpDir' inputFileP outputFileP (\p1 p2 -> recreateSymlink p1 p2 cm) -noWritableDirPerms :: AbstractFilePath -> IO () +noWritableDirPerms :: OsPath -> IO () {-# NOINLINE noWritableDirPerms #-} noWritableDirPerms path = withTmpDir path $ \p -> setPermissions p (setOwnerWritable False newDirPerms) -noPerms :: AbstractFilePath -> IO () +noPerms :: OsPath -> IO () {-# NOINLINE noPerms #-} noPerms path = withTmpDir path $ \p -> setPermissions p emptyPermissions -normalDirPerms :: AbstractFilePath -> IO () +normalDirPerms :: OsPath -> IO () {-# NOINLINE normalDirPerms #-} normalDirPerms path = withTmpDir path $ \p -> setPermissions p newDirPerms -normalFilePerms :: AbstractFilePath -> IO () +normalFilePerms :: OsPath -> IO () {-# NOINLINE normalFilePerms #-} normalFilePerms path = withTmpDir path $ \p -> setPermissions p newFilePerms #ifndef WINDOWS -getFileType' :: PosixFilePath -> IO FileType +getFileType' :: PosixPath -> IO FileType {-# NOINLINE getFileType' #-} getFileType' path = withTmpDir (OsString path) $ \(OsString p) -> getFileType p #endif -getDirsFiles' :: AbstractFilePath -> IO [AbstractFilePath] +getDirsFiles' :: OsPath -> IO [OsPath] {-# NOINLINE getDirsFiles' #-} getDirsFiles' path = withTmpDir path getDirsFiles -deleteFile' :: AbstractFilePath -> IO () +deleteFile' :: OsPath -> IO () {-# NOINLINE deleteFile' #-} deleteFile' p = withTmpDir p deleteFile -deleteDir' :: AbstractFilePath -> IO () +deleteDir' :: OsPath -> IO () {-# NOINLINE deleteDir' #-} deleteDir' p = withTmpDir p deleteDir -deleteDirRecursive' :: AbstractFilePath -> IO () +deleteDirRecursive' :: OsPath -> IO () {-# NOINLINE deleteDirRecursive' #-} deleteDirRecursive' p = withTmpDir p deleteDirRecursive -canonicalizePath' :: AbstractFilePath -> IO AbstractFilePath +canonicalizePath' :: OsPath -> IO OsPath {-# NOINLINE canonicalizePath' #-} canonicalizePath' p = withTmpDir p canonicalizePath -writeFile' :: AbstractFilePath -> ByteString -> IO () +writeFile' :: OsPath -> ByteString -> IO () {-# NOINLINE writeFile' #-} writeFile' ip bs = - withTmpDir ip $ \p -> System.File.AbstractFilePath.writeFile' p bs + withTmpDir ip $ \p -> System.File.OsPath.writeFile' p bs -writeFileL' :: AbstractFilePath -> BSL.ByteString -> IO () +writeFileL' :: OsPath -> BSL.ByteString -> IO () {-# NOINLINE writeFileL' #-} writeFileL' ip bs = withTmpDir ip $ \p -> writeFile p bs -writeExistingFile' :: AbstractFilePath -> ByteString -> IO () +writeExistingFile' :: OsPath -> ByteString -> IO () {-# NOINLINE writeExistingFile' #-} writeExistingFile' ip bs = - withTmpDir ip $ \p -> System.Directory.AbstractFilePath.writeExistingFile' p bs + withTmpDir ip $ \p -> System.Directory.OsPath.writeExistingFile' p bs -writeExistingFileL' :: AbstractFilePath -> BSL.ByteString -> IO () +writeExistingFileL' :: OsPath -> BSL.ByteString -> IO () {-# NOINLINE writeExistingFileL' #-} writeExistingFileL' ip bs = withTmpDir ip $ \p -> writeExistingFile p bs -appendFile' :: AbstractFilePath -> ByteString -> IO () +appendFile' :: OsPath -> ByteString -> IO () {-# NOINLINE appendFile' #-} appendFile' ip bs = - withTmpDir ip $ \p -> System.File.AbstractFilePath.appendFile' p bs + withTmpDir ip $ \p -> System.File.OsPath.appendFile' p bs -appendExistingFile' :: AbstractFilePath -> ByteString -> IO () +appendExistingFile' :: OsPath -> ByteString -> IO () {-# NOINLINE appendExistingFile' #-} appendExistingFile' ip bs = - withTmpDir ip $ \p -> System.Directory.AbstractFilePath.appendExistingFile' p bs + withTmpDir ip $ \p -> System.Directory.OsPath.appendExistingFile' p bs {-# NOINLINE allDirectoryContents' #-} -allDirectoryContents' :: AbstractFilePath -> IO [AbstractFilePath] +allDirectoryContents' :: OsPath -> IO [OsPath] allDirectoryContents' ip = withTmpDir ip $ \p -> getDirsFilesRec p -readFile' :: AbstractFilePath -> IO ByteString +readFile' :: OsPath -> IO ByteString {-# NOINLINE readFile' #-} -readFile' p = withTmpDir p System.File.AbstractFilePath.readFile' +readFile' p = withTmpDir p System.File.OsPath.readFile' -readExistingFile' :: AbstractFilePath -> IO ByteString +readExistingFile' :: OsPath -> IO ByteString {-# NOINLINE readExistingFile' #-} -readExistingFile' p = withTmpDir p System.Directory.AbstractFilePath.readExistingFile' +readExistingFile' p = withTmpDir p System.Directory.OsPath.readExistingFile' -readFileL :: AbstractFilePath -> IO BSL.ByteString +readFileL :: OsPath -> IO BSL.ByteString {-# NOINLINE readFileL #-} readFileL p = withTmpDir p readFile -readExistingFileL :: AbstractFilePath -> IO BSL.ByteString +readExistingFileL :: OsPath -> IO BSL.ByteString {-# NOINLINE readExistingFileL #-} -readExistingFileL p = withTmpDir p System.Directory.AbstractFilePath.readExistingFile +readExistingFileL p = withTmpDir p System.Directory.OsPath.readExistingFile -dirExists :: AbstractFilePath -> IO Bool +dirExists :: OsPath -> IO Bool {-# NOINLINE dirExists #-} dirExists fp = doesDirectoryExist fp diff --git a/hpath-posix/hpath-posix.cabal b/hpath-posix/hpath-posix.cabal index b12c095..c0fcb21 100644 --- a/hpath-posix/hpath-posix.cabal +++ b/hpath-posix/hpath-posix.cabal @@ -31,7 +31,7 @@ library -- other-modules: -- other-extensions: c-sources: cbits/dirutils.c - build-depends: filepath >= 2.0.0.0 + build-depends: filepath >=1.4.99.5 , base >= 4.8 && <5 , bytestring >= 0.10 , hpath-filepath >= 0.10.4 diff --git a/hpath-posix/src/System/Posix/FD.hs b/hpath-posix/src/System/Posix/FD.hs index d67b9c4..e266b23 100644 --- a/hpath-posix/src/System/Posix/FD.hs +++ b/hpath-posix/src/System/Posix/FD.hs @@ -28,8 +28,8 @@ import Foreign.C.String import Foreign.C.Types import System.Posix.Foreign import qualified System.Posix as Posix -import System.Posix.PosixFilePath.FilePath -import System.AbstractFilePath.Types +import System.Posix.PosixPath.FilePath +import System.OsPath.Types foreign import ccall unsafe "open" @@ -64,7 +64,7 @@ open_ str how optional_flags maybe_mode = do -- 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 :: PosixFilePath +openFd :: PosixPath -> 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. diff --git a/hpath-posix/src/System/Posix/PosixFilePath/Directory/Traversals.hs b/hpath-posix/src/System/Posix/PosixFilePath/Directory/Traversals.hs index 3e0a97d..6b4b1c1 100644 --- a/hpath-posix/src/System/Posix/PosixFilePath/Directory/Traversals.hs +++ b/hpath-posix/src/System/Posix/PosixFilePath/Directory/Traversals.hs @@ -16,6 +16,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE QuasiQuotes #-} {-# OPTIONS_GHC -Wall #-} @@ -43,14 +44,15 @@ module System.Posix.PosixFilePath.Directory.Traversals ( import Control.Applicative ((<$>)) #endif import Control.Monad -import System.AbstractFilePath.Posix ((), fromPlatformString) +import System.OsPath.Posix ((), decodeFS, pstr) +import qualified System.OsPath.Posix as AFP import System.Posix.Foreign import qualified System.Posix as Posix import System.IO.Error import Control.Exception -import System.Posix.PosixFilePath.FilePath -import System.Posix.Directory.PosixFilePath as PosixBS +import System.Posix.PosixPath.FilePath +import System.Posix.Directory.PosixPath as PosixBS import System.Posix.Files.PosixString import System.IO.Unsafe @@ -63,7 +65,7 @@ import Foreign.Marshal.Alloc (alloca,allocaBytes) import Foreign.Ptr import Foreign.Storable -import System.AbstractFilePath.Types +import System.OsPath.Types import qualified System.OsString.Internal.Types as T import qualified Data.ByteString.Short as SBS @@ -81,10 +83,10 @@ import qualified Data.ByteString.Short as SBS -- be accessed on demand. -- -- Follows symbolic links for the input dir. -allDirectoryContents :: PosixFilePath -> IO [PosixFilePath] +allDirectoryContents :: PosixPath -> IO [PosixPath] allDirectoryContents topdir = do namesAndTypes <- getDirectoryContents topdir - let properNames = filter ((`notElem` [".", ".."]) . snd) namesAndTypes + let properNames = filter ((`notElem` [[pstr|.|], [pstr|..|]]) . snd) namesAndTypes paths <- forM properNames $ \(typ,name) -> unsafeInterleaveIO $ do let path = topdir name case () of @@ -100,7 +102,7 @@ allDirectoryContents topdir = do -- | Get all files from a directory and its subdirectories strictly. -- -- Follows symbolic links for the input dir. -allDirectoryContents' :: PosixFilePath -> IO [PosixFilePath] +allDirectoryContents' :: PosixPath -> IO [PosixPath] allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp:acc)) [] -- this uses traverseDirectory because it's more efficient than forcing the -- lazy version. @@ -111,7 +113,7 @@ allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp: -- This function allows for memory-efficient traversals. -- -- Follows symbolic links for the input dir. -traverseDirectory :: (s -> PosixFilePath -> IO s) -> s -> PosixFilePath -> IO s +traverseDirectory :: (s -> PosixPath -> IO s) -> s -> PosixPath -> IO s traverseDirectory act s0 topdir = toploop where toploop = do @@ -128,12 +130,12 @@ traverseDirectory act s0 topdir = toploop then act acc path >>= \acc' -> actOnDirContents path acc' loop else act acc path -actOnDirContents :: PosixFilePath +actOnDirContents :: PosixPath -> b - -> (DirType -> PosixFilePath -> b -> IO b) + -> (DirType -> PosixPath -> b -> IO b) -> IO b actOnDirContents pathRelToTop b f = do - locstr <- fromPlatformString pathRelToTop + locstr <- decodeFS pathRelToTop modifyIOError ((`ioeSetFileName` locstr) . (`ioeSetLocation` "findBSTypRel")) $ bracket @@ -143,10 +145,10 @@ actOnDirContents pathRelToTop b f = do where loop dirp b' = do (typ,e) <- readDirEnt dirp - if (e == "") + if e == AFP.pack [] then return b' else - if (e == "." || e == "..") + if e == [pstr|.|] || e == [pstr|..|] then loop dirp b' else f typ (pathRelToTop e) b' >>= loop dirp @@ -194,17 +196,17 @@ foreign import capi unsafe "dirent.h fdopendir" -- less dodgy but still lower-level -readDirEnt :: DirStream -> IO (DirType, PosixFilePath) +readDirEnt :: DirStream -> IO (DirType, PosixPath) readDirEnt (unpackDirStream -> dirp) = alloca $ \ptr_dEnt -> loop ptr_dEnt where loop ptr_dEnt = do resetErrno r <- c_readdir dirp ptr_dEnt - if (r == 0) + if r == 0 then do dEnt <- peek ptr_dEnt - if (dEnt == nullPtr) + if dEnt == nullPtr then return (dtUnknown, mempty) else do dName <- c_name dEnt >>= peekFilePath @@ -213,19 +215,19 @@ readDirEnt (unpackDirStream -> dirp) = return (dType, dName) else do errno <- getErrno - if (errno == eINTR) + if errno == eINTR then loop ptr_dEnt else do let (Errno eo) = errno - if (eo == 0) + if eo == 0 then return (dtUnknown, mempty) else throwErrno "readDirEnt" -- |Gets all directory contents (not recursively). -getDirectoryContents :: PosixFilePath -> IO [(DirType, PosixFilePath)] +getDirectoryContents :: PosixPath -> IO [(DirType, PosixPath)] getDirectoryContents path = do - locstr <- fromPlatformString path + locstr <- decodeFS path modifyIOError ((`ioeSetFileName` locstr) . (`ioeSetLocation` "System.Posix.RawFilePath.Directory.Traversals.getDirectoryContents")) $ bracket @@ -247,7 +249,7 @@ fdOpendir fd = -- 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, PosixFilePath)] +getDirectoryContents' :: Posix.Fd -> IO [(DirType, PosixPath)] getDirectoryContents' fd = do dirstream <- fdOpendir fd `catchIOError` \e -> do closeFd fd @@ -256,7 +258,7 @@ getDirectoryContents' fd = do finally (_dirloop dirstream) (PosixBS.closeDirStream dirstream) -_dirloop :: DirStream -> IO [(DirType, PosixFilePath)] +_dirloop :: DirStream -> IO [(DirType, PosixPath)] {-# INLINE _dirloop #-} _dirloop dirp = do t@(_typ, e) <- readDirEnt dirp @@ -268,7 +270,7 @@ _dirloop dirp = do -- | return the canonicalized absolute pathname -- -- like canonicalizePath, but uses @realpath(3)@ -realpath :: PosixFilePath -> IO PosixFilePath +realpath :: PosixPath -> IO PosixPath realpath (T.PS inp) = fmap T.PS $ allocaBytes pathMax $ \tmp -> do void $ SBS.useAsCString inp $ \cstr -> throwErrnoIfNull "realpath" $ c_realpath cstr tmp diff --git a/hpath/hpath.cabal b/hpath/hpath.cabal index 089d550..58d3bbb 100644 --- a/hpath/hpath.cabal +++ b/hpath/hpath.cabal @@ -28,7 +28,7 @@ library ghc-options: -Wall exposed-modules: HPath HPath.Internal - build-depends: filepath >= 2.0.0.0 + build-depends: filepath >=1.4.99.5 , base >= 4.8 && <5 , bytestring >= 0.10.0.0 , deepseq diff --git a/hpath/src/HPath.hs b/hpath/src/HPath.hs index a4cd49c..e258b70 100644 --- a/hpath/src/HPath.hs +++ b/hpath/src/HPath.hs @@ -19,6 +19,7 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE MultiWayIf #-} module HPath ( @@ -39,7 +40,6 @@ module HPath ,parseRel' ,parseAny ,parseAny' - ,rootPath ,pwdPath -- * Path Conversion ,fromAbs @@ -57,7 +57,6 @@ module HPath ,stripDir -- * Path Examination ,isParentOf - ,isRootPath ,isPwdPath -- * Path IO helpers ,withAbsPath @@ -68,8 +67,8 @@ module HPath ) where -import System.AbstractFilePath hiding (()) -import qualified System.AbstractFilePath as AFP +import System.OsPath hiding (()) +import qualified System.OsPath as AFP import Control.Exception (Exception) import Control.Monad.Catch (MonadThrow(..)) import qualified Data.List as L @@ -82,11 +81,11 @@ import Language.Haskell.TH.Quote (QuasiQuoter(..)) import Prelude hiding (abs, any) import System.OsString.Internal.Types #if defined(mingw32_HOST_OS) || defined(__MINGW32__) -import qualified System.AbstractFilePath.Windows.Internal as Raw -import qualified System.AbstractFilePath.Data.ByteString.Short.Word16 as BS +import qualified System.OsPath.Windows.Internal as Raw +import qualified System.OsPath.Data.ByteString.Short.Word16 as BS #else -import qualified System.AbstractFilePath.Posix.Internal as Raw -import qualified System.AbstractFilePath.Data.ByteString.Short as BS +import qualified System.OsPath.Posix.Internal as Raw +import qualified System.OsPath.Data.ByteString.Short as BS #endif -- $setup @@ -94,6 +93,9 @@ import qualified System.AbstractFilePath.Data.ByteString.Short as BS -- >>> :set -XOverloadedStrings -- >>> import Prelude hiding (abs, any) -- >>> import HPath +-- >>> import qualified System.OsPath as AFP +-- >>> import Data.String +-- >>> instance IsString OsString where fromString = either (error . show) id . AFP.encodeUtf -------------------------------------------------------------------------------- @@ -102,14 +104,14 @@ import qualified System.AbstractFilePath.Data.ByteString.Short as BS -- | An absolute path. data Abs deriving (Typeable) --- | A relative path; one without a root. +-- | A relative path; one without a drive. data Rel deriving (Typeable) -- | Exception when parsing a location. data PathParseException - = InvalidAbs AbstractFilePath - | InvalidRel AbstractFilePath - | Couldn'tStripPrefixTPS AbstractFilePath AbstractFilePath + = InvalidAbs OsPath + | InvalidRel OsPath + | Couldn'tStripPrefixTPS OsPath OsPath deriving (Show,Typeable) instance Exception PathParseException @@ -122,7 +124,7 @@ instance Exception PathException -- PatternSynonyms #if __GLASGOW_HASKELL__ >= 710 -pattern Path :: AbstractFilePath -> Path a +pattern Path :: OsPath -> Path a #endif #if __GLASGOW_HASKELL__ >= 708 pattern Path x <- (MkPath x) @@ -152,18 +154,20 @@ pattern Path x <- (MkPath x) -- >>> parseAbs "/abc/../foo" -- *** Exception: InvalidAbs "/abc/../foo" parseAbs :: MonadThrow m - => AbstractFilePath -> m (Path Abs) + => OsPath -> m (Path Abs) parseAbs filepath = do - if isAbsolute filepath && - isValid filepath && - not (hasParentDir filepath) - then pure . MkPath . dropTrailingPathSeparator . normalise $ filepath - else throwM (InvalidAbs filepath) + if | isAbsolute filepath + , hasDrive filepath + , isValid filepath + , not (hasParentDir filepath) -> pure . MkPath . dropTrailingPathSeparator . normalise $ filepath + | otherwise -> throwM (InvalidAbs filepath) parseAbs' :: MonadThrow m => String -> m (Path Abs) -parseAbs' = parseAbs . toAbstractFilePath +parseAbs' str = do + fp <- AFP.encodeUtf str + parseAbs fp -- | Get a location for a relative path. Produces a normalised @@ -197,18 +201,22 @@ parseAbs' = parseAbs . toAbstractFilePath -- >>> parseRel ".." -- *** Exception: InvalidRel ".." parseRel :: MonadThrow m - => AbstractFilePath -> m (Path Rel) + => OsPath -> m (Path Rel) parseRel filepath = do - if not (isAbsolute filepath) && - filepath /= [afp|..|] && - not (hasParentDir filepath) && - isValid filepath - then return . MkPath . dropTrailingPathSeparator . normalise $ filepath - else throwM (InvalidRel filepath) + if | not (isAbsolute filepath) + , not (hasDrive filepath) + , filepath /= [osp|..|] + , not (hasParentDir filepath) + , isValid filepath + -> return . MkPath . dropTrailingPathSeparator . normalise $ filepath + | otherwise + -> throwM (InvalidRel filepath) parseRel' :: MonadThrow m => String -> m (Path Rel) -parseRel' = parseRel . toAbstractFilePath +parseRel' str = do + fp <- AFP.encodeUtf str + parseRel fp -- | Parses a path, whether it's relative or absolute. @@ -233,7 +241,7 @@ parseRel' = parseRel . toAbstractFilePath -- Right "." -- >>> parseAny ".." -- *** Exception: InvalidRel ".." -parseAny :: MonadThrow m => AbstractFilePath -> m (Either (Path Abs) (Path Rel)) +parseAny :: MonadThrow m => OsPath -> m (Either (Path Abs) (Path Rel)) parseAny filepath = case parseAbs filepath of Just p -> pure $ Left p Nothing -> case parseRel filepath of @@ -242,34 +250,32 @@ parseAny filepath = case parseAbs filepath of parseAny' :: MonadThrow m => String -> m (Either (Path Abs) (Path Rel)) -parseAny' = parseAny . toAbstractFilePath +parseAny' str = do + fp <- AFP.encodeUtf str + parseAny fp --- | The @"/"@ root path. -rootPath :: Path Abs -rootPath = MkPath [afp|/|] - -- | The @"."@ pwd path. pwdPath :: Path Rel -pwdPath = MkPath [afp|.|] +pwdPath = MkPath [osp|.|] -------------------------------------------------------------------------------- -- Path Conversion --- | Convert any Path to an AbstractFilePath type. -toFilePath :: Path b -> AbstractFilePath +-- | Convert any Path to an OsPath type. +toFilePath :: Path b -> OsPath toFilePath (MkPath l) = l --- | Convert an absolute Path to a AbstractFilePath type. -fromAbs :: Path Abs -> AbstractFilePath +-- | Convert an absolute Path to a OsPath type. +fromAbs :: Path Abs -> OsPath fromAbs = toFilePath --- | Convert a relative Path to a AbstractFilePath type. -fromRel :: Path Rel -> AbstractFilePath +-- | Convert a relative Path to a OsPath type. +fromRel :: Path Rel -> OsPath fromRel = toFilePath -fromAny :: Either (Path Abs) (Path Rel) -> AbstractFilePath +fromAny :: Either (Path Abs) (Path Rel) -> OsPath fromAny = either toFilePath toFilePath @@ -324,9 +330,9 @@ fromAny = either toFilePath toFilePath stripDir :: MonadThrow m => Path b -> Path b -> m (Path Rel) stripDir (MkPath p) (MkPath l) | p == l = return pwdPath - | otherwise = case L.stripPrefix (unpackAFP $ addTrailingPathSeparator p) (unpackAFP l) of + | otherwise = case L.stripPrefix (AFP.unpack $ addTrailingPathSeparator p) (AFP.unpack l) of Nothing -> throwM (Couldn'tStripPrefixTPS p l) - Just ok -> return (MkPath $ packAFP ok) + Just ok -> return (MkPath $ AFP.pack ok) -- |Get all parents of a path. @@ -339,7 +345,7 @@ stripDir (MkPath p) (MkPath l) -- [] getAllParents :: Path Abs -> [Path Abs] getAllParents (MkPath p) - | np == [afp|/|] = [] + | np == [osp|/|] = [] | otherwise = dirname (MkPath np) : getAllParents (dirname $ MkPath np) where np = normalise p @@ -357,14 +363,14 @@ getAllComponents :: Path Rel -> [Path Rel] getAllComponents (MkPath p) = fmap MkPath . splitDirectories $ p --- | Gets all path components after the "/" root directory. +-- | Gets all path components after the drive. -- -- >>> getAllComponentsAfterRoot [abs|/abs/def/dod|] -- ["abs","def","dod"] -- >>> getAllComponentsAfterRoot [abs|/abs|] -- ["abs"] getAllComponentsAfterRoot :: Path Abs -> [Path Rel] -getAllComponentsAfterRoot p = getAllComponents (fromJust $ stripDir rootPath p) +getAllComponentsAfterRoot (MkPath p) = getAllComponents (MkPath $ dropDrive p) -- | Extract the directory name of a path. @@ -383,7 +389,7 @@ dirname (MkPath fp) = MkPath (takeDirectory fp) -- -- @basename (p \<\/> a) == basename a@ -- --- Throws: `PathException` if given the root path "/" +-- Throws: `PathException` if given a drive (e.g. "/") -- -- >>> basename [abs|/abc/def/dod|] -- "dod" @@ -444,15 +450,6 @@ isParentOf p l = case stripDir p l :: Maybe (Path Rel) of | otherwise -> True --- | Check whether the given Path is the root "/" path. --- --- >>> isRootPath [abs|/lal/lad|] --- False --- >>> isRootPath [abs|/|] --- True -isRootPath :: Path Abs -> Bool -isRootPath = (== rootPath) - -- | Check whether the given Path is the pwd "." path. -- -- >>> isPwdPath [rel|lal/lad|] @@ -467,11 +464,11 @@ isPwdPath = (== pwdPath) -- Path IO helpers -withAbsPath :: Path Abs -> (AbstractFilePath -> IO a) -> IO a +withAbsPath :: Path Abs -> (OsPath -> IO a) -> IO a withAbsPath (MkPath p) action = action p -withRelPath :: Path Rel -> (AbstractFilePath -> IO a) -> IO a +withRelPath :: Path Rel -> (OsPath -> IO a) -> IO a withRelPath (MkPath p) action = action p @@ -489,10 +486,10 @@ stripPrefix a b = BS.pack `fmap` L.stripPrefix (BS.unpack a) (BS.unpack b) ------------------------ -- QuasiQuoters -qq :: (AbstractFilePath -> Q Exp) -> QuasiQuoter +qq :: (String -> Q Exp) -> QuasiQuoter qq quoteExp' = QuasiQuoter - { quoteExp = (\s -> quoteExp' . toAbstractFilePath $ s) + { quoteExp = quoteExp' , quotePat = \_ -> fail "illegal QuasiQuote (allowed as expression only, used as a pattern)" , quoteType = \_ -> @@ -501,11 +498,11 @@ qq quoteExp' = fail "illegal QuasiQuote (allowed as expression only, used as a declaration)" } -mkAbs :: AbstractFilePath -> Q Exp -mkAbs = either (error . show) lift . parseAbs +mkAbs :: String -> Q Exp +mkAbs = either (fail . show) lift . parseAbs' -mkRel :: AbstractFilePath -> Q Exp -mkRel = either (error . show) lift . parseRel +mkRel :: String -> Q Exp +mkRel = either (fail . show) lift . parseRel' -- | Quasiquote an absolute Path. This accepts Unicode Chars and will encode as UTF-8. -- @@ -513,8 +510,8 @@ mkRel = either (error . show) lift . parseRel -- "/etc/profile" -- >>> [abs|/|] :: Path Abs -- "/" --- >>> [abs|/|] :: Path Abs --- "/" +-- >>> (\(MkPath p) -> decodeUtf p) ([abs|/ƛ|] :: Path Abs) +-- "/\411" abs :: QuasiQuoter abs = qq mkAbs @@ -524,13 +521,13 @@ abs = qq mkAbs -- "etc" -- >>> [rel|bar/baz|] :: Path Rel -- "bar/baz" --- >>> [rel||] :: Path Rel --- "" +-- >>> (\(MkPath p) -> decodeUtf p) ([rel|ƛ|] :: Path Rel) +-- "\411" rel :: QuasiQuoter rel = qq mkRel -hasParentDir :: AbstractFilePath -> Bool +hasParentDir :: OsPath -> Bool #if defined(mingw32_HOST_OS) || defined(__MINGW32__) hasParentDir (OsString (WS fp)) = #else diff --git a/hpath/src/HPath/Internal.hs b/hpath/src/HPath/Internal.hs index 7f09d68..fbca932 100644 --- a/hpath/src/HPath/Internal.hs +++ b/hpath/src/HPath/Internal.hs @@ -10,7 +10,7 @@ module HPath.Internal (Path(..)) where -import System.AbstractFilePath +import System.OsPath import Control.DeepSeq (NFData (..)) import Data.Data import GHC.Generics (Generic) @@ -38,7 +38,7 @@ import qualified Language.Haskell.TH.Syntax as TH -- -- The constructor is not exposed. Instead, use the smart constructors -- 'HPath.parseAbs', 'HPath.parseRel' and 'HPath.parseAny'. -data Path b = MkPath AbstractFilePath +data Path b = MkPath OsPath deriving (Typeable, Generic, NFData) -- | ByteString equality. diff --git a/streamly-posix/src/Streamly/External/Posix/DirStream.hs b/streamly-posix/src/Streamly/External/Posix/DirStream.hs index 0ea81fa..fcc00e7 100644 --- a/streamly-posix/src/Streamly/External/Posix/DirStream.hs +++ b/streamly-posix/src/Streamly/External/Posix/DirStream.hs @@ -47,21 +47,22 @@ import Streamly.Internal.Data.Unfold.Types import qualified Streamly.Internal.Prelude as S #endif -import System.AbstractFilePath.Posix +import System.OsPath.Posix -- | Create an 'Unfold' of directory contents. -unfoldDirContents :: MonadIO m => Unfold m DirStream (DirType, PosixFilePath) +unfoldDirContents :: MonadIO m => Unfold m DirStream (DirType, PosixPath) unfoldDirContents = Unfold step return where {-# INLINE [0] step #-} step dirstream = do (typ, e) <- liftIO $ readDirEnt dirstream return $ if - | e == mempty -> D.Stop - | [unsafeFromChar '.'] == unpackPlatformString e -> D.Skip dirstream - | [unsafeFromChar '.', unsafeFromChar '.'] == unpackPlatformString e -> D.Skip dirstream - | otherwise -> D.Yield (typ, e) dirstream + | e == mempty -> D.Stop + | [unsafeFromChar '.'] == unpack e -> D.Skip dirstream + | [unsafeFromChar '.', unsafeFromChar '.'] + == unpack e -> D.Skip dirstream + | otherwise -> D.Yield (typ, e) dirstream -- | Read the directory contents as a stream. @@ -71,7 +72,7 @@ unfoldDirContents = Unfold step return -- The stream must not be used after the dirstream is closed. dirContentsStream :: (MonadCatch m, MonadAsync m, MonadMask m) => DirStream - -> SerialT m (DirType, PosixFilePath) + -> SerialT m (DirType, PosixPath) dirContentsStream ds = #if MIN_VERSION_streamly(0,8,0) unfold (SIU.finally (liftIO . PosixBS.closeDirStream) unfoldDirContents) $ ds @@ -89,7 +90,7 @@ dirContentsStream ds = -- The DirStream is closed automatically. dirContents :: (MonadCatch m, MonadAsync m, MonadMask m) => DirStream - -> m [(DirType, PosixFilePath)] + -> m [(DirType, PosixPath)] #if MIN_VERSION_streamly(0,8,0) dirContents = toList . dirContentsStream #else diff --git a/streamly-posix/streamly-posix.cabal b/streamly-posix/streamly-posix.cabal index dd8a978..b3d98f6 100644 --- a/streamly-posix/streamly-posix.cabal +++ b/streamly-posix/streamly-posix.cabal @@ -27,7 +27,7 @@ library build-depends: base >=4.8 && <5 , hpath-posix >=0.14 && <0.15 - , filepath >=2.0.0.0 + , filepath >=1.4.99.5 , safe-exceptions >=0.1 && <0.2 , streamly >=0.7 && <0.9 , streamly-bytestring >=0.1.0.1 && <0.2 diff --git a/streamly-posix/test/Main.hs b/streamly-posix/test/Main.hs index f47f2cf..b847684 100644 --- a/streamly-posix/test/Main.hs +++ b/streamly-posix/test/Main.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Main where @@ -13,7 +14,12 @@ import System.IO.Temp import System.Posix.Directory as Posix import System.Posix.Foreign import Test.Hspec +import System.OsString.Internal.Types +import qualified System.OsPath.Posix as P +import Data.String +instance IsString PosixString where + fromString = either (error . show) id . P.encodeUtf checkDirContents :: FilePath -> IO ()