summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Partition.hs
diff options
context:
space:
mode:
authorJoey Hess2016-03-26 14:28:38 -0400
committerJoey Hess2016-03-26 14:28:38 -0400
commit3218e344d117701066ced6c13927318ea2938ad4 (patch)
treeb8980b2f3c51b4d81d37779608750cdfd1bf562e /src/Propellor/Property/Partition.hs
parent2962f5c783db7a0f7014a8745768948c15d6a8ea (diff)
more porting
Diffstat (limited to 'src/Propellor/Property/Partition.hs')
-rw-r--r--src/Propellor/Property/Partition.hs11
1 files changed, 6 insertions, 5 deletions
diff --git a/src/Propellor/Property/Partition.hs b/src/Propellor/Property/Partition.hs
index b2f50339..5aff4ba4 100644
--- a/src/Propellor/Property/Partition.hs
+++ b/src/Propellor/Property/Partition.hs
@@ -16,7 +16,7 @@ data Fs = EXT2 | EXT3 | EXT4 | BTRFS | REISERFS | XFS | FAT | VFAT | NTFS | Linu
data Eep = YesReallyFormatPartition
-- | Formats a partition.
-formatted :: Eep -> Fs -> FilePath -> Property NoInfo
+formatted :: Eep -> Fs -> FilePath -> Property DebianLike
formatted = formatted' []
-- | Options passed to a mkfs.* command when making a filesystem.
@@ -24,7 +24,7 @@ formatted = formatted' []
-- Eg, ["-m0"]
type MkfsOpts = [String]
-formatted' :: MkfsOpts -> Eep -> Fs -> FilePath -> Property NoInfo
+formatted' :: MkfsOpts -> Eep -> Fs -> FilePath -> Property DebianLike
formatted' opts YesReallyFormatPartition fs dev = cmdProperty cmd opts'
`assume` MadeChange
`requires` Apt.installed [pkg]
@@ -64,17 +64,18 @@ isLoopDev' f
-- within a disk image file. The resulting loop devices are passed to the
-- property, which can operate on them. Always cleans up after itself,
-- by removing the device maps after the property is run.
-kpartx :: FilePath -> ([LoopDev] -> Property NoInfo) -> Property NoInfo
+kpartx :: FilePath -> ([LoopDev] -> Property DebianLike) -> Property DebianLike
kpartx diskimage mkprop = go `requires` Apt.installed ["kpartx"]
where
- go = property (propertyDesc (mkprop [])) $ do
+ go :: Property DebianLike
+ go = property' (propertyDesc (mkprop [])) $ \w -> do
cleanup -- idempotency
loopdevs <- liftIO $ kpartxParse
<$> readProcess "kpartx" ["-avs", diskimage]
bad <- liftIO $ filterM (not <$$> isLoopDev) loopdevs
unless (null bad) $
error $ "kpartx output seems to include non-loop-devices (possible parse failure): " ++ show bad
- r <- ensureProperty (mkprop loopdevs)
+ r <- ensureProperty w (mkprop loopdevs)
cleanup
return r
cleanup = void $ liftIO $ boolSystem "kpartx" [Param "-d", File diskimage]