summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Apt.hs
diff options
context:
space:
mode:
authorJoey Hess2014-10-10 11:36:47 -0400
committerJoey Hess2014-10-10 11:36:47 -0400
commit07f745ef9ca23982d7ef7e89bd6a638077a65ded (patch)
tree9acc6ddda92f98d4c951045d4dcf406207c809ba /src/Propellor/Property/Apt.hs
parent2028464268c9e4696c59ee6626a9e315c88ad935 (diff)
parent31f84270fddbf07221a6c1ea30e7a8c05db29115 (diff)
Merge branch 'joeyconfig'
Conflicts: debian/changelog privdata/privdata.gpg
Diffstat (limited to 'src/Propellor/Property/Apt.hs')
-rw-r--r--src/Propellor/Property/Apt.hs32
1 files changed, 19 insertions, 13 deletions
diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index 92de09a3..7cf6c2b0 100644
--- a/src/Propellor/Property/Apt.hs
+++ b/src/Propellor/Property/Apt.hs
@@ -20,14 +20,14 @@ type Section = String
type SourcesGenerator = DebianSuite -> [Line]
showSuite :: DebianSuite -> String
-showSuite Stable = "stable"
+showSuite (Stable s) = s
showSuite Testing = "testing"
showSuite Unstable = "unstable"
showSuite Experimental = "experimental"
-showSuite (DebianRelease r) = r
-backportSuite :: String
-backportSuite = showSuite stableRelease ++ "-backports"
+backportSuite :: DebianSuite -> Maybe String
+backportSuite (Stable s) = Just (s ++ "-backports")
+backportSuite _ = Nothing
debLine :: String -> Url -> [Section] -> Line
debLine suite mirror sections = unwords $
@@ -42,12 +42,17 @@ stdSections :: [Section]
stdSections = ["main", "contrib", "non-free"]
binandsrc :: String -> SourcesGenerator
-binandsrc url suite
- | isStable suite = [l, srcLine l, bl, srcLine bl]
- | otherwise = [l, srcLine l]
+binandsrc url suite = catMaybes
+ [ Just l
+ , Just $ srcLine l
+ , bl
+ , srcLine <$> bl
+ ]
where
l = debLine (showSuite suite) url stdSections
- bl = debLine backportSuite url stdSections
+ bl = do
+ bs <- backportSuite suite
+ return $ debLine bs url stdSections
debCdn :: SourcesGenerator
debCdn = binandsrc "http://http.debian.net/debian"
@@ -128,13 +133,14 @@ installed' params ps = robustly $ check (isInstallable ps) go
installedBackport :: [Package] -> Property
installedBackport ps = trivial $ withOS desc $ \o -> case o of
Nothing -> error "cannot install backports; os not declared"
- (Just (System (Debian suite) _))
- | isStable suite ->
- ensureProperty $ runApt $
- ["install", "-t", backportSuite, "-y"] ++ ps
- _ -> error $ "backports not supported on " ++ show o
+ (Just (System (Debian suite) _)) -> case backportSuite suite of
+ Nothing -> notsupported o
+ Just bs -> ensureProperty $ runApt $
+ ["install", "-t", bs, "-y"] ++ ps
+ _ -> notsupported o
where
desc = (unwords $ "apt installed backport":ps)
+ notsupported o = error $ "backports not supported on " ++ show o
-- | Minimal install of package, without recommends.
installedMin :: [Package] -> Property