summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJoey Hess2015-08-27 12:21:55 -0700
committerJoey Hess2015-08-27 13:55:46 -0700
commite413bed2c1cb15dcb8ce721a2801021e39f3ba86 (patch)
tree25c093cff2a1ec7fb300c96cb4aa9665a57fbe98 /src
parent7087a94b21a086a98784d17b45dd2b7779e320e9 (diff)
implement dirsizes
Used Data.Map.Strict, so bumped versions. Don't want to support the ghc in debian oldstable..
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/Property/DiskImage.hs31
1 files changed, 27 insertions, 4 deletions
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index 691f79bc..5bdd8f1a 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -17,6 +17,9 @@ import Propellor.Property.Chroot
import Propellor.Property.Parted
import qualified Propellor.Property.Grub as Grub
+import qualified Data.Map.Strict as M
+import System.Posix.Files
+
-- | Creates a bootable disk image.
--
-- First the specified Chroot is set up, and its properties are satisfied.
@@ -48,6 +51,30 @@ rebuilt = built' True
built' :: Bool -> (FilePath -> Chroot) -> MkPartTable -> DiskImageFinalization -> RevertableProperty
built' rebuild mkparttable mkchroot final = undefined
+-- TODO tie the knot
+-- let f = fitChrootSize MSDOS [(Just "/", mkPartition EXT2)]
+-- let (mnts, t) = f (map (MegaBytes . fromIntegral . length . show) mnts)
+
+-- | Generates a map of the sizes of the contents of
+-- every directory in a filesystem tree.
+--
+-- Should be same values as du -b
+dirSizes :: FilePath -> IO (M.Map FilePath Integer)
+dirSizes top = go M.empty top [top]
+ where
+ go m _ [] = return m
+ go m dir (i:is) = do
+ s <- getSymbolicLinkStatus i
+ let sz = fromIntegral (fileSize s)
+ if isDirectory s
+ then do
+ subm <- go M.empty i =<< dirContents i
+ let sz' = M.foldr' (+) sz
+ (M.filterWithKey (const . subdirof i) subm)
+ go (M.insertWith (+) i sz' (M.union m subm)) dir is
+ else go (M.insertWith (+) dir sz m) dir is
+ subdirof parent i = not (i `equalFilePath` parent) && takeDirectory i `equalFilePath` parent
+
-- | Where a partition is mounted. Use Nothing for eg, LinuxSwap.
type MountPoint = Maybe FilePath
@@ -60,10 +87,6 @@ type MountPoint = Maybe FilePath
-- provided as a default size.)
type MkPartTable = [PartSize] -> ([MountPoint], PartTable)
--- TODO tie the knot
--- let f = fitChrootSize MSDOS [(Just "/", mkPartition EXT2)]
--- let (mnts, t) = f (map (MegaBytes . fromIntegral . length . show) mnts)
-
-- | The constructor for each Partition is passed the size of the files
-- from the chroot that will be put in that partition.
--