From af45dd5862285da8b85b8ea8cef95391d1b2567a Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 20 May 2016 07:04:48 +0900 Subject: fix builtFor and updatedFor --- src/Propellor/Property/Sbuild.hs | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) (limited to 'src/Propellor/Property/Sbuild.hs') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 8b0748e4..7bf13a64 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -86,9 +86,16 @@ instance Show SbuildSchroot where -- This function is a convenience wrapper around 'Sbuild.builtFor', allowing the -- user to identify the schroot and distribution using the 'System' type builtFor :: System -> RevertableProperty DebianLike UnixLike -builtFor system = case schrootFromSystem system of - Just s -> built s (stdMirror system) - Nothing -> errorMessage ("don't know how to debootstrap " ++ show system) +builtFor system = go deleted + where + go = property' ("sbuild schroot for " ++ show system) $ + \w -> case schrootFromSystem system of + Just s -> ensureProperty w $ setupRevertableProperty (built s (stdMirror system)) + Nothing -> errorMessage ("don't know how to debootstrap " ++ show system) + deleted = property' ("no sbuild schroot for " ++ show system) $ + \w -> case schrootFromSystem system of + Just s -> ensureProperty w $ undoRevertableProperty $ built s "dummy" + Nothing -> return NoChange -- | Build and configure a schroot for use with sbuild built :: SbuildSchroot -> Apt.Url -> RevertableProperty DebianLike UnixLike @@ -131,9 +138,10 @@ built s@(SbuildSchroot suite arch) mirror = built deleted -- This function is a convenience wrapper around 'Sbuild.updated', allowing the -- user to identify the schroot using the 'System' type updatedFor :: System -> Property DebianLike -updatedFor system = case schrootFromSystem system of - Just s -> updated s - Nothing -> errorMessage ("don't know how to debootstrap " ++ show system) +updatedFor system = property' ("updated sbuild schroot for " ++ show system) $ + \w -> case schrootFromSystem system of + Just s -> ensureProperty w $ updated s + Nothing -> errorMessage ("don't know how to debootstrap " ++ show system) -- | Ensure that an sbuild schroot's packages and apt indexes are updated updated :: SbuildSchroot -> Property DebianLike -- cgit v1.2.3