diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2014, Marios Titas + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Marios Titas nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/System/DiskSpace.hsc b/System/DiskSpace.hsc new file mode 100644 --- /dev/null +++ b/System/DiskSpace.hsc @@ -0,0 +1,92 @@ +{-# LANGUAGE CPP #-} + +{- | +Module : System.DiskSpace + +Stability : provisional +Portability : portable +-} + +module System.DiskSpace + ( DiskUsage(..) + , getDiskUsage + , getAvailSpace + ) where + +#ifndef CABAL_OS_WINDOWS + +import Foreign +import Foreign.C + +#include + +foreign import ccall unsafe statvfs :: CString -> Ptr a -> IO CInt + +type FsBlkCnt = #type fsblkcnt_t + +getDiskUsage path = + withCString path $ \cPath -> + allocaBytes (#size struct statvfs) $ \stat -> do + throwErrnoPathIfMinus1_ "getDiskUsage" path $ statvfs cPath stat + bsize <- (#peek struct statvfs, f_bsize ) stat :: IO CULong + frsize <- (#peek struct statvfs, f_frsize) stat :: IO CULong + blocks <- (#peek struct statvfs, f_blocks) stat :: IO FsBlkCnt + bfree <- (#peek struct statvfs, f_bfree ) stat :: IO FsBlkCnt + bavail <- (#peek struct statvfs, f_bavail) stat :: IO FsBlkCnt + let frsize' = fromIntegral frsize + return DiskUsage + { diskTotal = frsize' * fromIntegral blocks + , diskFree = frsize' * fromIntegral bfree + , diskAvail = frsize' * fromIntegral bavail + , blockSize = fromIntegral bsize + } + +#else + +import System.Win32 (getDiskFreeSpace) + +getDiskUsage path = do + (lpSectorsPerCluster, + lpBytesPerSector, + lpNumberOfFreeClusters, + lpTotalNumberOfClusters) + <- getDiskFreeSpace (Just path) + let bs = fromIntegral lpSectorsPerCluster * fromIntegral lpBytesPerSector + bs' = fromIntegral bs + to = bs' * fromIntegral lpTotalNumberOfClusters + av = bs' * fromIntegral lpNumberOfFreeClusters + return (DiskUsage to av av bs) + +#endif + +-- | Disk usage information. All fields are in bytes. +data DiskUsage = DiskUsage + { diskTotal :: Integer -- ^ The total size of the file system. + , diskFree :: Integer -- ^ The amount of free space. You probably want to + -- use 'diskAvail' instead. + , diskAvail :: Integer -- ^ The amount of space available to the user. + -- Might be less than 'diskFree'. On Windows, + -- this is always equal to 'diskFree'. + -- This is what most tools report as free + -- space (e.g. the unix @df@ tool). + , blockSize :: Int -- ^ The optimal block size for I/O in this volume. + -- Some operating systems report incorrect values + -- for this field. + } + deriving (Show, Eq) + +-- | Retrieve disk usage information about a volume. The volume is +-- specified with the @FilePath@ argument. The path can refer to the root +-- directory or any other directory inside the volume. +-- Unix systems also accept arbitrary files, but this +-- does not work under Windows and therefore should be avoided if +-- portability is desired. +getDiskUsage :: FilePath -> IO DiskUsage + +-- | A convenience function that directly returns the 'diskAvail' field from +-- the result of 'getDiskUsage'. If a large amount of data is to be written +-- in a directory, calling this function for that directory can be used to +-- determine whether the operation will fail because of insufficient disk +-- space. +getAvailSpace :: FilePath -> IO Integer +getAvailSpace = fmap diskAvail . getDiskUsage diff --git a/disk-free-space.cabal b/disk-free-space.cabal new file mode 100644 --- /dev/null +++ b/disk-free-space.cabal @@ -0,0 +1,29 @@ +name: disk-free-space +version: 0.1.0.0 +synopsis: Retrieve information about disk space usage +description: + Retrieve information about disk space usage. +homepage: https://github.com/redneb/disk-free-space +bug-reports: https://github.com/redneb/disk-free-space/issues +license: BSD3 +license-file: LICENSE +author: Marios Titas +maintainer: Marios Titas +category: System, Filesystem +build-type: Simple +cabal-version: >=1.10 + +source-repository head + type: git + location: https://github.com/redneb/disk-free-space.git + +library + exposed-modules: System.DiskSpace + build-depends: base >=4.6 && <5 + if os(windows) + build-depends: Win32 >=2.2 + cpp-options: -DCABAL_OS_WINDOWS + else + build-tools: hsc2hs + default-language: Haskell2010 + ghc-options: -Wall