Merge remote-tracking branch 'origin/streamly'

.travis.yml

@@ -7,16 +7,16 @@ dist: trusty
 
 matrix:
   include:
-    - env: CABALVER=1.18 GHCVER=7.6.3
-      addons: {apt: {packages: [cabal-install-1.18,ghc-7.6.3], sources: [hvr-ghc]}}
-    - env: CABALVER=1.22 GHCVER=7.8.4
-      addons: {apt: {packages: [cabal-install-1.22,ghc-7.8.4], sources: [hvr-ghc]}}
-    - env: CABALVER=1.24 GHCVER=7.10.2
-      addons: {apt: {packages: [cabal-install-1.24,ghc-7.10.2], sources: [hvr-ghc]}}
-    - env: CABALVER=1.24 GHCVER=8.0.1
-      addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}
-    - env: CABALVER=2.0 GHCVER=8.2.2
-      addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.2], sources: [hvr-ghc]}}
+    - env: CABALVER=2.2 GHCVER=7.6.3
+      addons: {apt: {packages: [cabal-install-2.2,ghc-7.6.3], sources: [hvr-ghc]}}
+    - env: CABALVER=2.2 GHCVER=7.8.4
+      addons: {apt: {packages: [cabal-install-2.2,ghc-7.8.4], sources: [hvr-ghc]}}
+    - env: CABALVER=2.2 GHCVER=7.10.2
+      addons: {apt: {packages: [cabal-install-2.2,ghc-7.10.2], sources: [hvr-ghc]}}
+    - env: CABALVER=2.2 GHCVER=8.0.1
+      addons: {apt: {packages: [cabal-install-2.2,ghc-8.0.1], sources: [hvr-ghc]}}
+    - env: CABALVER=2.2 GHCVER=8.2.2
+      addons: {apt: {packages: [cabal-install-2.2,ghc-8.2.2], sources: [hvr-ghc]}}
     - env: CABALVER=2.2 GHCVER=8.4.1
       addons: {apt: {packages: [cabal-install-2.2,ghc-8.4.1], sources: [hvr-ghc]}}
     - env: CABALVER=head GHCVER=head

hpath.cabal

@@ -41,12 +41,14 @@ library
                    , deepseq
                    , exceptions
                    , hspec
-                   , simple-sendfile >= 0.2.24
                    , unix >= 2.5
                    , unix-bytestring
                    , utf8-string
                    , word8
-
+  if impl(ghc >= 8.2)
+    build-depends:     streamly >= 0.7
+  else
+    build-depends:     simple-sendfile >= 0.2.24
 
 test-suite doctests-hpath
   if os(windows)

src/HPath/IO.hs

@@ -150,12 +150,14 @@ import Data.Word
 import Foreign.C.Error
   (
     eEXIST
-  , eINVAL
   , eNOENT
-  , eNOSYS
   , eNOTEMPTY
   , eXDEV
   , getErrno
+#if __GLASGOW_HASKELL__ < 802
+  , eINVAL
+  , eNOSYS
+#endif
   )
 import Foreign.C.Types
   (
@@ -177,16 +179,23 @@ import HPath
 import HPath.Internal
 import HPath.IO.Errors
 import Prelude hiding (appendFile, readFile, writeFile)
-import System.IO.Error
-  (
-    catchIOError
-  , ioeGetErrorType
-  )
+#if __GLASGOW_HASKELL__ >= 802
+import qualified Streamly.FileSystem.Handle as FH
+import qualified Streamly.Internal.FileSystem.Handle as IFH
+import qualified Streamly.Prelude as S
+import qualified System.IO as SIO
+#else
 import System.Linux.Sendfile
   (
     sendfileFd
   , FileRange(..)
   )
+#endif
+import System.IO.Error
+  (
+    catchIOError
+  , ioeGetErrorType
+  )
 import System.Posix.ByteString
   (
     exclusive
@@ -466,6 +475,7 @@ recreateSymlink symsource@(MkPath symsourceBS) newsym@(MkPath newsymBS) cm
 -- instead.
 --
 -- In `Overwrite` copy mode only overwrites actual files, not directories.
+-- In `Strict` mode the destination file must not exist.
 --
 -- Safety/reliability concerns:
 --
@@ -493,12 +503,45 @@ recreateSymlink symsource@(MkPath symsourceBS) newsym@(MkPath newsymBS) cm
 --
 -- Notes:
 --
---    - calls `sendfile` and possibly `read`/`write` as fallback
+--    - on GHC < 8.2: calls `sendfile` and possibly `read`/`write` as fallback
+--    - on GHC >= 8.2: uses streamly for file copying
 --    - may call `getcwd` in Overwrite mode (if destination is a relative path)
 copyFile :: Path b1   -- ^ source file
          -> Path b2   -- ^ destination file
          -> CopyMode
          -> IO ()
+#if __GLASGOW_HASKELL__ >= 802
+copyFile fp@(MkPath from) tp@(MkPath to) cm = do
+  throwSameFile fp tp
+  bracket (do
+            fd <- openFd from SPI.ReadOnly [SPDF.oNofollow] Nothing
+            handle <- SPI.fdToHandle fd
+            pure (fd, handle))
+    (\(_, handle) -> SIO.hClose handle)
+    $ \(fromFd, fH) -> do
+                   sourceFileMode <- System.Posix.Files.ByteString.fileMode <$> getFdStatus fromFd
+                   let dflags = [SPDF.oNofollow, case cm of
+                                                      Strict    -> SPDF.oExcl
+                                                      Overwrite -> SPDF.oTrunc]
+                   bracketeer (do
+                                fd <- openFd to SPI.WriteOnly dflags $ Just sourceFileMode
+                                handle <- SPI.fdToHandle fd
+                                pure (fd, handle))
+                              (\(_, handle) -> SIO.hClose handle)
+                              (\(_, handle) -> do
+                                                 SIO.hClose handle
+                                                 case cm of
+                                                      -- if we created the file and copying failed, it's
+                                                      -- safe to clean up
+                                                      Strict -> deleteFile tp
+                                                      Overwrite -> pure ())
+                              $ \(_, tH) -> do
+                                           SIO.hSetBinaryMode fH True
+                                           SIO.hSetBinaryMode tH True
+                                           streamlyCopy (fH, tH)
+  where
+    streamlyCopy (fH, tH) = S.fold (FH.writeChunks tH) $ IFH.toChunksWithBufferOf (256*1024) fH
+#else
 copyFile from to cm = do
   throwSameFile from to
 
@@ -569,7 +612,7 @@ _copyFile sflags dflags (MkPath fromBS) to@(MkPath toBS)
                       when (rsize /= size) (ioError $ userError
                                                       "wrong size!")
                       write' sfd dfd buf (totalsize + fromIntegral size)
-
+#endif
 
 -- |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.