From 87e1d1810e351c0458ad93942d98538a3c05516c Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Wed, 29 Jan 2020 22:42:23 +0100 Subject: [PATCH] Fix build for windows --- .../External/FileSystem/DirStream/Posix.hs | 78 +++++++++++++++++++ .../FileSystem/{Handle/Posix.hs => Handle.hs} | 62 ++------------- streamly-filesystem.cabal | 20 +++-- test/Main.hs | 38 +++++++-- 4 files changed, 125 insertions(+), 73 deletions(-) create mode 100644 src/Streamly/External/FileSystem/DirStream/Posix.hs rename src/Streamly/External/FileSystem/{Handle/Posix.hs => Handle.hs} (68%) diff --git a/src/Streamly/External/FileSystem/DirStream/Posix.hs b/src/Streamly/External/FileSystem/DirStream/Posix.hs new file mode 100644 index 0000000..888537f --- /dev/null +++ b/src/Streamly/External/FileSystem/DirStream/Posix.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiWayIf #-} + +-- | +-- Module : Streamly.External.FileSystem.DirStream.Posix +-- 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.FileSystem.DirStream.Posix + ( + -- * Directory listing + unfoldDirContents + , dirContentsStream + , dirContents + ) +where + +import Control.Exception.Safe +import Control.Monad.IO.Class ( liftIO + , MonadIO + ) +import Data.Word8 +import Prelude hiding ( readFile ) +import Streamly +import Streamly.Internal.Data.Unfold.Types +import System.Posix.ByteString +import System.Posix.Directory.ByteString + as PosixBS +import System.Posix.Foreign ( DirType ) +import System.Posix.RawFilePath.Directory.Traversals + hiding ( getDirectoryContents ) +import qualified Data.ByteString as BS +import qualified Streamly.Internal.Data.Stream.StreamD.Type + as D +import qualified Streamly.Internal.Data.Unfold as SIU +import qualified Streamly.Internal.Prelude as S + + +-- | Create an 'Unfold' of directory contents. +unfoldDirContents :: MonadIO m => Unfold m DirStream (DirType, RawFilePath) +unfoldDirContents = Unfold step return + where + {-# INLINE [0] step #-} + step dirstream = do + (typ, e) <- liftIO $ readDirEnt dirstream + return if + | BS.null e -> D.Stop + | BS.pack [_period] == e -> D.Skip dirstream + | BS.pack [_period, _period] == 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, RawFilePath) +dirContentsStream = + S.unfold (SIU.finallyIO (liftIO . PosixBS.closeDirStream) unfoldDirContents) + + +-- | Read the directory contents strictly as a list. +-- +-- The DirStream is closed automatically. +dirContents :: (MonadCatch m, MonadAsync m, MonadMask m) + => DirStream + -> m [(DirType, RawFilePath)] +dirContents = S.toList . dirContentsStream + diff --git a/src/Streamly/External/FileSystem/Handle/Posix.hs b/src/Streamly/External/FileSystem/Handle.hs similarity index 68% rename from src/Streamly/External/FileSystem/Handle/Posix.hs rename to src/Streamly/External/FileSystem/Handle.hs index b5a9afd..a2847d8 100644 --- a/src/Streamly/External/FileSystem/Handle/Posix.hs +++ b/src/Streamly/External/FileSystem/Handle.hs @@ -1,8 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MultiWayIf #-} -- | --- Module : Streamly.External.FileSystem.Handle.Posix +-- Module : Streamly.External.FileSystem.Handle -- Copyright : © 2020 Julian Ospald -- License : BSD3 -- @@ -10,8 +9,9 @@ -- Stability : experimental -- Portability : portable -- --- This module provides high-level file streaming API. -module Streamly.External.FileSystem.Handle.Posix +-- This module provides high-level file streaming API, working +-- with file handles. +module Streamly.External.FileSystem.Handle ( -- * File reading readFileLBS @@ -25,42 +25,25 @@ module Streamly.External.FileSystem.Handle.Posix , copyFileStream' , copyLBS , copyLBS' - -- * Directory listing - , unfoldDirContents - , dirContentsStream - , dirContents ) where import Control.Exception.Safe -import Control.Monad.IO.Class ( liftIO - , MonadIO - ) +import Control.Monad.IO.Class ( liftIO ) import Data.Word ( Word8 ) -import Data.Word8 import Prelude hiding ( readFile ) import Streamly -import Streamly.Internal.Data.Unfold.Types import Streamly.Memory.Array import System.IO ( Handle , hClose ) import System.IO.Unsafe -import System.Posix.ByteString -import System.Posix.Directory.ByteString - as PosixBS -import System.Posix.Foreign ( DirType ) -import System.Posix.RawFilePath.Directory.Traversals - hiding ( getDirectoryContents ) -import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Internal as BSLI import qualified Streamly.External.ByteString as Strict import qualified Streamly.External.ByteString.Lazy as Lazy import qualified Streamly.FileSystem.Handle as FH -import qualified Streamly.Internal.Data.Stream.StreamD.Type - as D import qualified Streamly.Internal.Data.Unfold as SIU import qualified Streamly.Internal.Prelude as S @@ -161,38 +144,3 @@ copyLBS' :: (MonadCatch m, MonadAsync m, MonadMask m) -> Handle -- ^ file handle to copy to, must be writable -> m () copyLBS' lbs = copyFileStream' (Lazy.toChunks lbs) - - --- | Create an 'Unfold' of directory contents. -unfoldDirContents :: MonadIO m => Unfold m DirStream (DirType, RawFilePath) -unfoldDirContents = Unfold step return - where - {-# INLINE [0] step #-} - step dirstream = do - (typ, e) <- liftIO $ readDirEnt dirstream - return if - | BS.null e -> D.Stop - | BS.pack [_period] == e -> D.Skip dirstream - | BS.pack [_period, _period] == 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, RawFilePath) -dirContentsStream = - S.unfold (SIU.finallyIO (liftIO . PosixBS.closeDirStream) unfoldDirContents) - - --- | Read the directory contents strictly as a list. --- --- The DirStream is closed automatically. -dirContents :: (MonadCatch m, MonadAsync m, MonadMask m) - => DirStream - -> m [(DirType, RawFilePath)] -dirContents = S.toList . dirContentsStream diff --git a/streamly-filesystem.cabal b/streamly-filesystem.cabal index eba01a8..83c9442 100644 --- a/streamly-filesystem.cabal +++ b/streamly-filesystem.cabal @@ -15,34 +15,33 @@ build-type: Simple extra-source-files: CHANGELOG.md library streamly-filesystem - if os(windows) -- not supported yet - build-depends: unbuildable<0 - buildable: False - exposed-modules: Streamly.External.FileSystem.Handle.Posix + if os(linux) + exposed-modules: Streamly.External.FileSystem.DirStream.Posix + build-depends: hpath-directory >= 0.13 + , unix >= 2.7 + exposed-modules: Streamly.External.FileSystem.Handle -- other-modules: -- other-extensions: build-depends: base >= 4.12 && < 5 , bytestring >= 0.10 - , hpath-directory >= 0.13 , safe-exceptions >= 0.1 , streamly >= 0.7 , streamly-bytestring >= 0.1.0.1 - , unix >= 2.7 , word8 >= 0.1.3 hs-source-dirs: src default-language: Haskell2010 GHC-Options: -Wall -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 test-suite sf-test - if os(windows) -- not supported yet - build-depends: unbuildable<0 - buildable: False + if os(linux) + build-depends: hpath-directory >= 0.13 + , unix >= 2.7 type: exitcode-stdio-1.0 main-is: Main.hs hs-source-dirs: test build-depends: base >= 4.12 && < 5 , bytestring - , hpath-directory >= 0.13 + , filepath , hspec , hspec-discover , safe-exceptions >= 0.1 @@ -50,7 +49,6 @@ test-suite sf-test , streamly-bytestring >= 0.1.0.1 , streamly-filesystem , temporary - , unix >= 2.7 , word8 >= 0.1.3 default-language: Haskell2010 GHC-Options: -Wall -threaded -rtsopts -with-rtsopts=-N diff --git a/test/Main.hs b/test/Main.hs index c0fc217..56befc5 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -1,17 +1,42 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} module Main where +import Data.Foldable +import Data.List ( sortBy ) import GHC.IO.Handle ( Handle ) -import System.IO ( openFile - , IOMode(ReadMode) - ) -import System.IO.Temp ( withSystemTempFile ) +import System.IO +import System.IO.Temp import Test.Hspec import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL -import Streamly.External.FileSystem.Handle.Posix +import Streamly.External.FileSystem.Handle +import System.FilePath +#if !defined(mingw32_HOST_OS) +import Streamly.External.FileSystem.DirStream.Posix +import System.Posix.Directory as Posix +import System.Posix.Foreign + + + +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") + ] +#endif checkCopyLBS :: FilePath -> Handle -> IO () @@ -50,3 +75,6 @@ main = hspec $ do it "copyFileHandle" $ withSystemTempFile "x" (\_ h1 -> withSystemTempFile "y" $ (\_ h2 -> checkCopyFileHandle h1 h2)) +#if !defined(mingw32_HOST_OS) + it "dirContents" $ withSystemTempDirectory "y" checkDirContents +#endif