[commit: packages/directory] Mistuke-bump-win32-version-bounds, bgamari-patch-1, master: Add getFileSize (1ec1ea8)
git at git.haskell.org
git at git.haskell.org
Mon Apr 17 21:34:15 UTC 2017
- Previous message: [commit: packages/containers] changelog-foldtree, cleaned_bugfix394, develop-0.6, develop-0.6-questionable, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-184-generic, revert-408-bugfix_394, zip-devel: Merge pull request #59 from strout/patch-1 (b9bd228)
- Next message: [commit: packages/containers] changelog-foldtree, cleaned_bugfix394, develop-0.6, develop-0.6-questionable, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-184-generic, revert-408-bugfix_394, zip-devel: Define some new Foldable methods for containers (61b9066)
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
Repository : ssh://git@git.haskell.org/directory
On branches: Mistuke-bump-win32-version-bounds,bgamari-patch-1,master
Link : http://ghc.haskell.org/trac/ghc/changeset/1ec1ea8e4210d55d8d6e0e5fc8dd543340004b92/directory
>---------------------------------------------------------------
commit 1ec1ea8e4210d55d8d6e0e5fc8dd543340004b92
Author: Phil Ruffwind <rf at rufflewind.com>
Date: Mon Jun 13 06:56:32 2016 -0400
Add getFileSize
Fixes #57.
>---------------------------------------------------------------
1ec1ea8e4210d55d8d6e0e5fc8dd543340004b92
System/Directory.hs | 12 ++++++++++++
changelog.md | 2 +-
directory.cabal | 1 +
tests/GetFileSize.hs | 19 +++++++++++++++++++
tests/Main.hs | 2 ++
5 files changed, 35 insertions(+), 1 deletion(-)
diff --git a/System/Directory.hs b/System/Directory.hs
index 4ce0a86..f33ba7c 100644
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -63,6 +63,8 @@ module System.Directory
, findFilesWith
, exeExtension
+ , getFileSize
+
-- * Existence tests
, doesPathExist
, doesFileExist
@@ -1320,6 +1322,16 @@ withCurrentDirectory dir action =
setCurrentDirectory dir
action
+-- | Obtain the size of a file in bytes.
+getFileSize :: FilePath -> IO Integer
+getFileSize path =
+ (`ioeSetLocation` "getFileSize") `modifyIOError` do
+#ifdef mingw32_HOST_OS
+ fromIntegral <$> withFileStatus "" path st_size
+#else
+ fromIntegral . Posix.fileSize <$> Posix.getFileStatus path
+#endif
+
-- | Test whether the given path points to an existing filesystem object. If
-- the user lacks necessary permissions to search the parent directories, this
-- function may return false even if the file does actually exist.
diff --git a/changelog.md b/changelog.md
index f6bf91c..cfd6fc4 100644
--- a/changelog.md
+++ b/changelog.md
@@ -7,7 +7,7 @@ Changelog for the [`directory`][1] package
are no longer available.
([#50](https://github.com/haskell/directory/issues/50))
- * Add `doesPathExist`
+ * Add `doesPathExist` and `getFileSize`
([#57](https://github.com/haskell/directory/issues/57))
## 1.2.6.3 (May 2016)
diff --git a/directory.cabal b/directory.cabal
index 628ec06..b7bdf17 100644
--- a/directory.cabal
+++ b/directory.cabal
@@ -92,6 +92,7 @@ test-suite test
FindFile001
GetDirContents001
GetDirContents002
+ GetFileSize
GetHomeDirectory001
GetPermissions001
IsSymbolicLink
diff --git a/tests/GetFileSize.hs b/tests/GetFileSize.hs
new file mode 100644
index 0000000..413fd16
--- /dev/null
+++ b/tests/GetFileSize.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE CPP #-}
+module GetFileSize where
+#include "util.inl"
+import System.Directory
+import qualified System.IO as IO
+
+main :: TestEnv -> IO ()
+main _t = do
+
+ IO.withBinaryFile "emptyfile" IO.WriteMode $ \ _ -> do
+ return ()
+ IO.withBinaryFile "testfile" IO.WriteMode $ \ h -> do
+ IO.hPutStr h string
+
+ T(expectEq) () 0 =<< getFileSize "emptyfile"
+ T(expectEq) () (fromIntegral (length string)) =<< getFileSize "testfile"
+
+ where
+ string = "The quick brown fox jumps over the lazy dog."
diff --git a/tests/Main.hs b/tests/Main.hs
index da8b50b..2b9227f 100644
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -14,6 +14,7 @@ import qualified FileTime
import qualified FindFile001
import qualified GetDirContents001
import qualified GetDirContents002
+import qualified GetFileSize
import qualified GetHomeDirectory001
import qualified GetPermissions001
import qualified IsSymbolicLink
@@ -40,6 +41,7 @@ main = T.testMain $ \ _t -> do
T.isolatedRun _t "FindFile001" FindFile001.main
T.isolatedRun _t "GetDirContents001" GetDirContents001.main
T.isolatedRun _t "GetDirContents002" GetDirContents002.main
+ T.isolatedRun _t "GetFileSize" GetFileSize.main
T.isolatedRun _t "GetHomeDirectory001" GetHomeDirectory001.main
T.isolatedRun _t "GetPermissions001" GetPermissions001.main
T.isolatedRun _t "IsSymbolicLink" IsSymbolicLink.main
- Previous message: [commit: packages/containers] changelog-foldtree, cleaned_bugfix394, develop-0.6, develop-0.6-questionable, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-184-generic, revert-408-bugfix_394, zip-devel: Merge pull request #59 from strout/patch-1 (b9bd228)
- Next message: [commit: packages/containers] changelog-foldtree, cleaned_bugfix394, develop-0.6, develop-0.6-questionable, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-184-generic, revert-408-bugfix_394, zip-devel: Define some new Foldable methods for containers (61b9066)
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
More information about the ghc-commits
mailing list