summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Debootstrap.hs
diff options
context:
space:
mode:
authorJoey Hess2014-11-21 15:55:27 -0400
committerJoey Hess2014-11-21 15:55:27 -0400
commit9e611d87cd95999eb6b3e5e7f6c855f7c092f57c (patch)
treebea58430eeb0ab69286d95c6dd57795d46e7e04b /src/Propellor/Property/Debootstrap.hs
parentfbce215f3381b36df64c0e268bb816b1b0a4fd0d (diff)
add debootstrap parameters
Diffstat (limited to 'src/Propellor/Property/Debootstrap.hs')
-rw-r--r--src/Propellor/Property/Debootstrap.hs28
1 files changed, 25 insertions, 3 deletions
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index 5f521c32..747662c5 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -1,5 +1,6 @@
module Propellor.Property.Debootstrap (
Url,
+ DebootstrapConfig(..),
built,
installed,
programPath,
@@ -18,6 +19,27 @@ import System.Posix.Directory
type Url = String
+-- | A monoid for debootstrap configuration.
+-- mempty is a default debootstrapped system.
+data DebootstrapConfig
+ = DefaultConfig
+ | MinBase
+ | BuilddD
+ | DebootstrapParam String
+ | DebootstrapConfig :+ DebootstrapConfig
+ deriving (Show)
+
+instance Monoid DebootstrapConfig where
+ mempty = DefaultConfig
+ mappend = (:+)
+
+toParams :: DebootstrapConfig -> [CommandParam]
+toParams DefaultConfig = []
+toParams MinBase = [Param "--variant=minbase"]
+toParams BuilddD = [Param "--variant=buildd"]
+toParams (DebootstrapParam p) = [Param p]
+toParams (c1 :+ c2) = toParams c1 <> toParams c2
+
-- | Builds a chroot in the given directory using debootstrap.
--
-- The System can be any OS and architecture that debootstrap
@@ -28,8 +50,8 @@ type Url = String
--
-- Note that reverting this property does not stop any processes
-- currently running in the chroot.
-built :: FilePath -> System -> [CommandParam] -> RevertableProperty
-built target system@(System _ arch) extraparams =
+built :: FilePath -> System -> DebootstrapConfig -> RevertableProperty
+built target system@(System _ arch) config =
RevertableProperty setup teardown
where
setup = check (unpopulated target <||> ispartial) setupprop
@@ -44,7 +66,7 @@ built target system@(System _ arch) extraparams =
suite <- case extractSuite system of
Nothing -> errorMessage $ "don't know how to debootstrap " ++ show system
Just s -> pure s
- let params = extraparams ++
+ let params = toParams config ++
[ Param $ "--arch=" ++ arch
, Param suite
, Param target