diff options
| author | Joey Hess <joey@kitenet.net> | 2014-11-21 15:55:27 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2014-11-21 15:55:27 -0400 |
| commit | 9e611d87cd95999eb6b3e5e7f6c855f7c092f57c (patch) | |
| tree | bea58430eeb0ab69286d95c6dd57795d46e7e04b /src/Propellor/Property/Debootstrap.hs | |
| parent | fbce215f3381b36df64c0e268bb816b1b0a4fd0d (diff) | |
add debootstrap parameters
Diffstat (limited to 'src/Propellor/Property/Debootstrap.hs')
| -rw-r--r-- | src/Propellor/Property/Debootstrap.hs | 28 |
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 |