From e9d5d9aff1cc2046149d3e5dcd9f4ef0f2a334a1 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Sun, 25 Jan 2015 14:45:14 -0400
Subject: remove toSimpleProp

It didn't do what I thought it did with a RevertableProperty; it always
returned Nothing because even if the input properties to <!> are NoInfo, it
casts them to HasInfo.

Even if it had worked, it lost type safety. Better to export the
Property NoInfo that is used in a RevertableProperty, so it can be used
directly.
---
 src/Propellor/Property/Debootstrap.hs | 41 +++++++++++++++++++----------------
 1 file changed, 22 insertions(+), 19 deletions(-)

(limited to 'src/Propellor/Property/Debootstrap.hs')

diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index 3feb280c..d4947ab7 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleContexts #-}
+
 module Propellor.Property.Debootstrap (
 	Url,
 	DebootstrapConfig(..),
@@ -56,18 +58,18 @@ toParams (c1 :+ c2) = toParams c1 <> toParams c2
 -- Note that reverting this property does not stop any processes
 -- currently running in the chroot.
 built :: FilePath -> System -> DebootstrapConfig -> RevertableProperty
-built = built' (toProp installed)
-
-built' :: Property HasInfo -> FilePath -> System -> DebootstrapConfig -> RevertableProperty
-built' installprop target system@(System _ arch) config = setup <!> teardown
+built target system config = built' (toProp installed) target system config <!> teardown
   where
-	setup = check (unpopulated target <||> ispartial) setupprop
-		`requires` installprop
-	
 	teardown = check (not <$> unpopulated target) teardownprop
 	
-	unpopulated d = null <$> catchDefaultIO [] (dirContents d)
+	teardownprop = property ("removed debootstrapped " ++ target) $
+		makeChange (removetarget target)
 
+built' :: (Combines (Property NoInfo) (Property i)) => Property i -> FilePath -> System -> DebootstrapConfig -> Property (CInfo NoInfo i)
+built' installprop target system@(System _ arch) config = 
+	check (unpopulated target <||> ispartial) setupprop
+		`requires` installprop
+  where
 	setupprop = property ("debootstrapped " ++ target) $ liftIO $ do
 		createDirectoryIfMissing True target
 		-- Don't allow non-root users to see inside the chroot,
@@ -92,24 +94,25 @@ built' installprop target system@(System _ arch) config = setup <!> teardown
 			, return FailedChange
 			)
 
-	teardownprop = property ("removed debootstrapped " ++ target) $
-		makeChange removetarget
-
-	removetarget = do
-		submnts <- filter (\p -> simplifyPath p /= simplifyPath target)
-			. filter (dirContains target)
-			<$> mountPoints
-		forM_ submnts umountLazy
-		removeDirectoryRecursive target
-
 	-- A failed debootstrap run will leave a debootstrap directory;
 	-- recover by deleting it and trying again.
 	ispartial = ifM (doesDirectoryExist (target </> "debootstrap"))
 		( do
-			removetarget
+			removetarget target
 			return True
 		, return False
 		)
+	
+unpopulated :: FilePath -> IO Bool
+unpopulated d = null <$> catchDefaultIO [] (dirContents d)	
+
+removetarget :: FilePath -> IO ()
+removetarget target = do
+	submnts <- filter (\p -> simplifyPath p /= simplifyPath target)
+		. filter (dirContains target)
+		<$> mountPoints
+	forM_ submnts umountLazy
+	removeDirectoryRecursive target
 
 extractSuite :: System -> Maybe String
 extractSuite (System (Debian s) _) = Just $ Apt.showSuite s
-- 
cgit v1.3-2-g0d8e