summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Debootstrap.hs
diff options
context:
space:
mode:
authorJoey Hess2015-10-20 12:01:59 -0400
committerJoey Hess2015-10-20 12:06:24 -0400
commit05d35eb568e74deafc936e6735171291410b5f0b (patch)
tree3d1f25930948f59c96b942ec296b11094f3f20c3 /src/Propellor/Property/Debootstrap.hs
parentbfcc5a7666f817fbfe9c149480ca0359e3e744ec (diff)
Chroot: Converted to use a ChrootBootstrapper type class
So other ways to bootstrap chroots can easily be added in separate modules. (API change)
Diffstat (limited to 'src/Propellor/Property/Debootstrap.hs')
-rw-r--r--src/Propellor/Property/Debootstrap.hs18
1 files changed, 2 insertions, 16 deletions
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index bb177007..f8981591 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -48,19 +48,8 @@ toParams (c1 :+ c2) = toParams c1 <> toParams c2
--
-- The System can be any OS and architecture that debootstrap
-- and the kernel support.
---
--- Reverting this property deletes the chroot and all its contents.
--- Anything mounted under the filesystem is first unmounted.
---
--- Note that reverting this property does not stop any processes
--- currently running in the chroot.
-built :: FilePath -> System -> DebootstrapConfig -> RevertableProperty
-built target system config = built' (toProp installed) target system config <!> teardown
- where
- teardown = check (not <$> unpopulated target) teardownprop
-
- teardownprop = property ("removed debootstrapped " ++ target) $
- makeChange (removeChroot target)
+built :: FilePath -> System -> DebootstrapConfig -> Property HasInfo
+built target system config = built' (toProp installed) target system config
built' :: (Combines (Property NoInfo) (Property i)) => Property i -> FilePath -> System -> DebootstrapConfig -> Property (CInfo NoInfo i)
built' installprop target system@(System _ arch) config =
@@ -100,9 +89,6 @@ built' installprop target system@(System _ arch) config =
, return False
)
-unpopulated :: FilePath -> IO Bool
-unpopulated d = null <$> catchDefaultIO [] (dirContents d)
-
extractSuite :: System -> Maybe String
extractSuite (System (Debian s) _) = Just $ Apt.showSuite s
extractSuite (System (Ubuntu r) _) = Just r