Rewrote free disk space checking code
Moving the portability handling into a small C library cleans up things a lot, avoiding the pain of unpacking structs from inside haskell code.
This commit is contained in:
parent
f1398b5583
commit
e38a839a80
13 changed files with 124 additions and 237 deletions
32
Utility/DiskFree.hs
Normal file
32
Utility/DiskFree.hs
Normal file
|
@ -0,0 +1,32 @@
|
|||
{- disk free space checking
|
||||
-
|
||||
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE ForeignFunctionInterface #-}
|
||||
|
||||
module Utility.DiskFree ( getDiskFree ) where
|
||||
|
||||
import Common
|
||||
|
||||
import Foreign.C.Types
|
||||
import Foreign.C.String
|
||||
import Foreign.C.Error
|
||||
|
||||
foreign import ccall unsafe "diskfree.h diskfree" c_diskfree
|
||||
:: CString -> IO CULLong
|
||||
|
||||
getDiskFree :: String -> IO (Maybe Integer)
|
||||
getDiskFree path = withFilePath path $ \c_path -> do
|
||||
free <- c_diskfree c_path
|
||||
ifM (safeErrno <$> getErrno)
|
||||
( return $ Just $ toInteger free
|
||||
, do
|
||||
Errno i <- getErrno
|
||||
print i
|
||||
return Nothing
|
||||
)
|
||||
where
|
||||
safeErrno (Errno v) = v == 0
|
Loading…
Add table
Add a link
Reference in a new issue