Fix build for windows

This commit is contained in:
Julian Ospald 2020-01-29 22:42:23 +01:00
parent d5b4010c28
commit 87e1d1810e
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
4 changed files with 125 additions and 73 deletions

View File

@ -0,0 +1,78 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiWayIf #-}
-- |
-- Module : Streamly.External.FileSystem.DirStream.Posix
-- Copyright : © 2020 Julian Ospald
-- License : BSD3
--
-- Maintainer : Julian Ospald <hasufell@posteo.de>
-- 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

View File

@ -1,8 +1,7 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiWayIf #-}
-- | -- |
-- Module : Streamly.External.FileSystem.Handle.Posix -- Module : Streamly.External.FileSystem.Handle
-- Copyright : © 2020 Julian Ospald -- Copyright : © 2020 Julian Ospald
-- License : BSD3 -- License : BSD3
-- --
@ -10,8 +9,9 @@
-- Stability : experimental -- Stability : experimental
-- Portability : portable -- Portability : portable
-- --
-- This module provides high-level file streaming API. -- This module provides high-level file streaming API, working
module Streamly.External.FileSystem.Handle.Posix -- with file handles.
module Streamly.External.FileSystem.Handle
( (
-- * File reading -- * File reading
readFileLBS readFileLBS
@ -25,42 +25,25 @@ module Streamly.External.FileSystem.Handle.Posix
, copyFileStream' , copyFileStream'
, copyLBS , copyLBS
, copyLBS' , copyLBS'
-- * Directory listing
, unfoldDirContents
, dirContentsStream
, dirContents
) )
where where
import Control.Exception.Safe import Control.Exception.Safe
import Control.Monad.IO.Class ( liftIO import Control.Monad.IO.Class ( liftIO )
, MonadIO
)
import Data.Word ( Word8 ) import Data.Word ( Word8 )
import Data.Word8
import Prelude hiding ( readFile ) import Prelude hiding ( readFile )
import Streamly import Streamly
import Streamly.Internal.Data.Unfold.Types
import Streamly.Memory.Array import Streamly.Memory.Array
import System.IO ( Handle import System.IO ( Handle
, hClose , hClose
) )
import System.IO.Unsafe 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 as L
import qualified Data.ByteString.Lazy.Internal as BSLI import qualified Data.ByteString.Lazy.Internal as BSLI
import qualified Streamly.External.ByteString as Strict import qualified Streamly.External.ByteString as Strict
import qualified Streamly.External.ByteString.Lazy import qualified Streamly.External.ByteString.Lazy
as Lazy as Lazy
import qualified Streamly.FileSystem.Handle as FH 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.Data.Unfold as SIU
import qualified Streamly.Internal.Prelude as S 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 -> Handle -- ^ file handle to copy to, must be writable
-> m () -> m ()
copyLBS' lbs = copyFileStream' (Lazy.toChunks lbs) 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

View File

@ -15,34 +15,33 @@ build-type: Simple
extra-source-files: CHANGELOG.md extra-source-files: CHANGELOG.md
library streamly-filesystem library streamly-filesystem
if os(windows) -- not supported yet if os(linux)
build-depends: unbuildable<0 exposed-modules: Streamly.External.FileSystem.DirStream.Posix
buildable: False build-depends: hpath-directory >= 0.13
exposed-modules: Streamly.External.FileSystem.Handle.Posix , unix >= 2.7
exposed-modules: Streamly.External.FileSystem.Handle
-- other-modules: -- other-modules:
-- other-extensions: -- other-extensions:
build-depends: base >= 4.12 && < 5 build-depends: base >= 4.12 && < 5
, bytestring >= 0.10 , bytestring >= 0.10
, hpath-directory >= 0.13
, safe-exceptions >= 0.1 , safe-exceptions >= 0.1
, streamly >= 0.7 , streamly >= 0.7
, streamly-bytestring >= 0.1.0.1 , streamly-bytestring >= 0.1.0.1
, unix >= 2.7
, word8 >= 0.1.3 , word8 >= 0.1.3
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
GHC-Options: -Wall -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 GHC-Options: -Wall -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
test-suite sf-test test-suite sf-test
if os(windows) -- not supported yet if os(linux)
build-depends: unbuildable<0 build-depends: hpath-directory >= 0.13
buildable: False , unix >= 2.7
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
main-is: Main.hs main-is: Main.hs
hs-source-dirs: test hs-source-dirs: test
build-depends: base >= 4.12 && < 5 build-depends: base >= 4.12 && < 5
, bytestring , bytestring
, hpath-directory >= 0.13 , filepath
, hspec , hspec
, hspec-discover , hspec-discover
, safe-exceptions >= 0.1 , safe-exceptions >= 0.1
@ -50,7 +49,6 @@ test-suite sf-test
, streamly-bytestring >= 0.1.0.1 , streamly-bytestring >= 0.1.0.1
, streamly-filesystem , streamly-filesystem
, temporary , temporary
, unix >= 2.7
, word8 >= 0.1.3 , word8 >= 0.1.3
default-language: Haskell2010 default-language: Haskell2010
GHC-Options: -Wall -threaded -rtsopts -with-rtsopts=-N GHC-Options: -Wall -threaded -rtsopts -with-rtsopts=-N

View File

@ -1,17 +1,42 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Main where module Main where
import Data.Foldable
import Data.List ( sortBy )
import GHC.IO.Handle ( Handle ) import GHC.IO.Handle ( Handle )
import System.IO ( openFile import System.IO
, IOMode(ReadMode) import System.IO.Temp
)
import System.IO.Temp ( withSystemTempFile )
import Test.Hspec import Test.Hspec
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL 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 () checkCopyLBS :: FilePath -> Handle -> IO ()
@ -50,3 +75,6 @@ main = hspec $ do
it "copyFileHandle" $ withSystemTempFile it "copyFileHandle" $ withSystemTempFile
"x" "x"
(\_ h1 -> withSystemTempFile "y" $ (\_ h2 -> checkCopyFileHandle h1 h2)) (\_ h1 -> withSystemTempFile "y" $ (\_ h2 -> checkCopyFileHandle h1 h2))
#if !defined(mingw32_HOST_OS)
it "dirContents" $ withSystemTempDirectory "y" checkDirContents
#endif