{-# LANGUAGE DeriveDataTypeable #-}
module Propellor.Bootstrap (
Bootstrapper(..),
Builder(..),
defaultBootstrapper,
getBootstrapper,
bootstrapPropellorCommand,
checkBinaryCommand,
installGitCommand,
buildPropellor,
checkDepsCommand,
buildCommand,
) where
import Propellor.Base
import Propellor.Types.Info
import Propellor.Git.Config
import System.Posix.Files
import Data.List
type ShellCommand = String
data Bootstrapper = Robustly Builder | OSOnly
deriving (Show, Typeable)
data Builder = Cabal | Stack
deriving (Show, Typeable)
defaultBootstrapper :: Bootstrapper
defaultBootstrapper = Robustly Cabal
getBootstrapper :: Propellor Bootstrapper
getBootstrapper = go <$> askInfo
where
go NoInfoVal = defaultBootstrapper
go (InfoVal bs) = bs
getBuilder :: Bootstrapper -> Builder
getBuilder (Robustly b) = b
getBuilder OSOnly = Cabal
bootstrapPropellorCommand :: Bootstrapper -> Maybe System -> ShellCommand
bootstrapPropellorCommand bs msys = checkDepsCommand bs msys ++
"&& if ! test -x ./propellor; then "
++ buildCommand bs ++
"; fi;" ++ checkBinaryCommand bs
checkBinaryCommand :: Bootstrapper -> ShellCommand
checkBinaryCommand bs = "if test -x ./propellor && ! ./propellor --check; then " ++ go (getBuilder bs) ++ "; fi"
where
go Cabal = intercalate " && "
[ "cabal clean"
, buildCommand bs
]
go Stack = intercalate " && "
[ "stack clean"
, buildCommand bs
]
buildCommand :: Bootstrapper -> ShellCommand
buildCommand bs = intercalate " && " (go (getBuilder bs))
where
go Cabal =
[ "cabal configure"
, "cabal build -j1 propellor-config"
, "ln -sf dist/build/propellor-config/propellor-config propellor"
]
go Stack =
[ "stack build :propellor-config"
, "ln -sf $(stack path --dist-dir)/build/propellor-config/propellor-config propellor"
]
checkDepsCommand :: Bootstrapper -> Maybe System -> ShellCommand
checkDepsCommand bs sys = go (getBuilder bs)
where
go Cabal = "if ! cabal configure >/dev/null 2>&1; then " ++ depsCommand bs sys ++ "; fi"
go Stack = "if ! stack build --dry-run >/dev/null 2>&1; then " ++ depsCommand bs sys ++ "; fi"
data Dep = Dep String | OldDep String
depsCommand :: Bootstrapper -> Maybe System -> ShellCommand
depsCommand bs msys = "( " ++ intercalate " ; " (go bs) ++ ") || true"
where
go (Robustly Cabal) = osinstall Cabal ++
[ "cabal update"
, "cabal install --only-dependencies"
]
go (Robustly Stack) = osinstall Stack ++
[ "stack setup"
, "stack build --only-dependencies :propellor-config"
]
go OSOnly = osinstall Cabal
osinstall builder = case msys of
Just (System (FreeBSD _) _) -> map pkginstall (fbsddeps builder)
Just (System (ArchLinux) _) -> map pacmaninstall (archlinuxdeps builder)
Just (System (Debian _ _) _) -> useapt builder
Just (System (Buntish _) _) -> useapt builder
Nothing -> useapt builder
useapt builder = "apt-get update" : map aptinstall (debdeps builder)
aptinstall (Dep p) = "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-install-recommends -y install " ++ p
aptinstall (OldDep p) = "if LANG=C apt-cache policy " ++ p ++ "| grep -q Candidate:; then " ++ aptinstall (Dep p) ++ "; fi"
pkginstall p = "ASSUME_ALWAYS_YES=yes pkg install " ++ p
pacmaninstall p = "pacman -S --noconfirm --needed " ++ p
debdeps Cabal =
[ Dep "gnupg"
, Dep "ghc"
, Dep "cabal-install"
, Dep "libghc-async-dev"
, Dep "libghc-split-dev"
, Dep "libghc-hslogger-dev"
, Dep "libghc-unix-compat-dev"
, Dep "libghc-ansi-terminal-dev"
, Dep "libghc-ifelse-dev"
, Dep "libghc-network-dev"
, Dep "libghc-mtl-dev"
, Dep "libghc-transformers-dev"
, Dep "libghc-exceptions-dev"
, Dep "libghc-text-dev"
, Dep "libghc-hashable-dev"
, OldDep "libghc-stm-dev"
]
debdeps Stack =
[ Dep "gnupg"
, Dep "haskell-stack"
]
fbsddeps Cabal =
[ "gnupg"
, "ghc"
, "hs-cabal-install"
, "hs-async"
, "hs-split"
, "hs-hslogger"
, "hs-unix-compat"
, "hs-ansi-terminal"
, "hs-IfElse"
, "hs-network"
, "hs-mtl"
, "hs-transformers-base"
, "hs-exceptions"
, "hs-stm"
, "hs-text"
, "hs-hashable"
]
fbsddeps Stack =
[ "gnupg"
, "stack"
]
archlinuxdeps Cabal =
[ "gnupg"
, "ghc"
, "cabal-install"
, "haskell-async"
, "haskell-split"
, "haskell-hslogger"
, "haskell-unix-compat"
, "haskell-ansi-terminal"
, "haskell-hackage-security"
, "haskell-ifelse"
, "haskell-network"
, "haskell-mtl"
, "haskell-transformers-base"
, "haskell-exceptions"
, "haskell-stm"
, "haskell-text"
, "hashell-hashable"
]
archlinuxdeps Stack =
[ "gnupg"
, "stack"
]
installGitCommand :: Maybe System -> ShellCommand
installGitCommand msys = case msys of
(Just (System (Debian _ _) _)) -> use apt
(Just (System (Buntish _) _)) -> use apt
(Just (System (FreeBSD _) _)) -> use
[ "ASSUME_ALWAYS_YES=yes pkg update"
, "ASSUME_ALWAYS_YES=yes pkg install git"
]
(Just (System (ArchLinux) _)) -> use
[ "pacman -S --noconfirm --needed git"]
Nothing -> use apt
where
use cmds = "if ! git --version >/dev/null 2>&1; then " ++ intercalate " && " cmds ++ "; fi"
apt =
[ "apt-get update"
, "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-install-recommends --no-upgrade -y install git"
]
buildPropellor :: Maybe Host -> IO ()
buildPropellor mh = unlessM (actionMessage "Propellor build" build) $
errorMessage "Propellor build failed!"
where
msys = case fmap (fromInfo . hostInfo) mh of
Just (InfoVal sys) -> Just sys
_ -> Nothing
build = catchBoolIO $ do
case fromInfo (maybe mempty hostInfo mh) of
NoInfoVal -> do
bs <- getGitConfigValue "propellor.buildsystem"
case bs of
Just "stack" -> stackBuild msys
_ -> cabalBuild msys
InfoVal bs -> case getBuilder bs of
Cabal -> cabalBuild msys
Stack -> stackBuild msys
cabalBuild :: Maybe System -> IO Bool
cabalBuild msys = do
make "dist/setup-config" ["propellor.cabal"] cabal_configure
unlessM cabal_build $
unlessM (cabal_configure <&&> cabal_build) $
error "cabal build failed"
unlessM (boolSystem "cp" [Param "-pfRL", Param cabalbuiltbin, Param (tmpfor safetycopy)]) $
error "cp of binary failed"
rename (tmpfor safetycopy) safetycopy
symlinkPropellorBin safetycopy
return True
where
cabalbuiltbin = "dist/build/propellor-config/propellor-config"
safetycopy = cabalbuiltbin ++ ".built"
cabal_configure = ifM (cabal ["configure"])
( return True
, case msys of
Nothing -> return False
Just sys ->
boolSystem "sh" [Param "-c", Param (depsCommand (Robustly Cabal) (Just sys))]
<&&> cabal ["configure"]
)
cabal_build = cabal ["build", "-j1", "propellor-config"]
stackBuild :: Maybe System -> IO Bool
stackBuild _msys = do
createDirectoryIfMissing True builddest
ifM (stack buildparams)
( do
symlinkPropellorBin (builddest </> "propellor-config")
return True
, return False
)
where
builddest = ".built"
buildparams =
[ "--local-bin-path", builddest
, "build"
, ":propellor-config"
, "--copy-bins"
]
symlinkPropellorBin :: FilePath -> IO ()
symlinkPropellorBin bin = do
createSymbolicLink bin (tmpfor dest)
rename (tmpfor dest) dest
where
dest = "propellor"
tmpfor :: FilePath -> FilePath
tmpfor f = f ++ ".propellortmp"
make :: FilePath -> [FilePath] -> IO Bool -> IO ()
make dest srcs builder = do
dt <- getmtime dest
st <- mapM getmtime srcs
when (dt == Nothing || any (> dt) st) $
unlessM builder $
error $ "failed to make " ++ dest
where
getmtime = catchMaybeIO . getModificationTime
cabal :: [String] -> IO Bool
cabal = boolSystem "cabal" . map Param
stack :: [String] -> IO Bool
stack = boolSystem "stack" . map Param