{-# 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

-- | Different ways that Propellor's dependencies can be installed,
-- and propellor can be built. The default is `Robustly Cabal`
--
-- `Robustly Cabal` and `Robustly Stack` use the OS's native packages
-- as much as possible to install Cabal, Stack, and propellor's build
-- dependencies. When necessary, dependencies are built from source
-- using Cabal or Stack rather than using the OS's native packages.
--
-- `OSOnly` uses the OS's native packages of Cabal and all of propellor's
-- build dependencies. It may not work on all systems.
data Bootstrapper = Robustly Builder | OSOnly
	deriving (Int -> Bootstrapper -> ShowS
[Bootstrapper] -> ShowS
Bootstrapper -> String
(Int -> Bootstrapper -> ShowS)
-> (Bootstrapper -> String)
-> ([Bootstrapper] -> ShowS)
-> Show Bootstrapper
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bootstrapper] -> ShowS
$cshowList :: [Bootstrapper] -> ShowS
show :: Bootstrapper -> String
$cshow :: Bootstrapper -> String
showsPrec :: Int -> Bootstrapper -> ShowS
$cshowsPrec :: Int -> Bootstrapper -> ShowS
Show, Typeable)

data Builder = Cabal | Stack
	deriving (Int -> Builder -> ShowS
[Builder] -> ShowS
Builder -> String
(Int -> Builder -> ShowS)
-> (Builder -> String) -> ([Builder] -> ShowS) -> Show Builder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Builder] -> ShowS
$cshowList :: [Builder] -> ShowS
show :: Builder -> String
$cshow :: Builder -> String
showsPrec :: Int -> Builder -> ShowS
$cshowsPrec :: Int -> Builder -> ShowS
Show, Typeable)

defaultBootstrapper :: Bootstrapper
defaultBootstrapper :: Bootstrapper
defaultBootstrapper = Builder -> Bootstrapper
Robustly Builder
Cabal

-- | Gets the Bootstrapper for the Host propellor is running on.
getBootstrapper :: Propellor Bootstrapper
getBootstrapper :: Propellor Bootstrapper
getBootstrapper = InfoVal Bootstrapper -> Bootstrapper
go (InfoVal Bootstrapper -> Bootstrapper)
-> Propellor (InfoVal Bootstrapper) -> Propellor Bootstrapper
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Propellor (InfoVal Bootstrapper)
forall v. IsInfo v => Propellor v
askInfo
  where
	go :: InfoVal Bootstrapper -> Bootstrapper
go NoInfoVal = Bootstrapper
defaultBootstrapper
	go (InfoVal bs :: Bootstrapper
bs) = Bootstrapper
bs

getBuilder :: Bootstrapper -> Builder
getBuilder :: Bootstrapper -> Builder
getBuilder (Robustly b :: Builder
b) = Builder
b
getBuilder OSOnly = Builder
Cabal

-- Shell command line to ensure propellor is bootstrapped and ready to run.
-- Should be run inside the propellor config dir, and will install
-- all necessary build dependencies and build propellor.
bootstrapPropellorCommand :: Bootstrapper -> Maybe System -> ShellCommand
bootstrapPropellorCommand :: Bootstrapper -> Maybe System -> String
bootstrapPropellorCommand bs :: Bootstrapper
bs msys :: Maybe System
msys = Bootstrapper -> Maybe System -> String
checkDepsCommand Bootstrapper
bs Maybe System
msys String -> ShowS
forall a. [a] -> [a] -> [a]
++
	"&& if ! test -x ./propellor; then "
		String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bootstrapper -> String
buildCommand Bootstrapper
bs String -> ShowS
forall a. [a] -> [a] -> [a]
++
	"; fi;" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bootstrapper -> String
checkBinaryCommand Bootstrapper
bs

-- Use propellor --check to detect if the local propellor binary has
-- stopped working (eg due to library changes), and must be rebuilt.
checkBinaryCommand :: Bootstrapper -> ShellCommand
checkBinaryCommand :: Bootstrapper -> String
checkBinaryCommand bs :: Bootstrapper
bs = "if test -x ./propellor && ! ./propellor --check; then " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Builder -> String
go (Bootstrapper -> Builder
getBuilder Bootstrapper
bs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "; fi"
  where
	go :: Builder -> String
go Cabal = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " && "
		[ "cabal clean"
		, Bootstrapper -> String
buildCommand Bootstrapper
bs
		]
	go Stack = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " && "
		[ "stack clean"
		, Bootstrapper -> String
buildCommand Bootstrapper
bs
		]

buildCommand :: Bootstrapper -> ShellCommand
buildCommand :: Bootstrapper -> String
buildCommand bs :: Bootstrapper
bs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " && " (Builder -> [String]
go (Bootstrapper -> Builder
getBuilder Bootstrapper
bs))
  where
	go :: Builder -> [String]
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"
		]

-- Check if all dependencies are installed; if not, run the depsCommand.
checkDepsCommand :: Bootstrapper -> Maybe System -> ShellCommand
checkDepsCommand :: Bootstrapper -> Maybe System -> String
checkDepsCommand bs :: Bootstrapper
bs sys :: Maybe System
sys = Builder -> String
go (Bootstrapper -> Builder
getBuilder Bootstrapper
bs)
  where
	go :: Builder -> String
go Cabal = "if ! cabal configure >/dev/null 2>&1; then " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bootstrapper -> Maybe System -> String
depsCommand Bootstrapper
bs Maybe System
sys String -> ShowS
forall a. [a] -> [a] -> [a]
++ "; fi"
	go Stack = "if ! stack build --dry-run >/dev/null 2>&1; then " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bootstrapper -> Maybe System -> String
depsCommand Bootstrapper
bs Maybe System
sys String -> ShowS
forall a. [a] -> [a] -> [a]
++ "; fi"

data Dep = Dep String | OldDep String

-- Install build dependencies of propellor, using the specified
-- Bootstrapper.
--
-- When bootstrapping Robustly, first try to install the builder, 
-- and all haskell libraries that propellor uses from OS packages.
-- Some packages may not be available in some versions of the OS,
-- or propellor may need a newer version. So, as a second step, 
-- ny other dependencies are installed from source using the builder.
--
-- Note: May succeed and leave some deps not installed.
depsCommand :: Bootstrapper -> Maybe System -> ShellCommand
depsCommand :: Bootstrapper -> Maybe System -> String
depsCommand bs :: Bootstrapper
bs msys :: Maybe System
msys = "( " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " ; " (Bootstrapper -> [String]
go Bootstrapper
bs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ") || true"
  where
	go :: Bootstrapper -> [String]
go (Robustly Cabal) = Builder -> [String]
osinstall Builder
Cabal [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
		[ "cabal update"
		, "cabal install --only-dependencies"
		]	
	go (Robustly Stack) = Builder -> [String]
osinstall Builder
Stack [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ 
		[ "stack setup"
		, "stack build --only-dependencies :propellor-config"
		]
	go OSOnly = Builder -> [String]
osinstall Builder
Cabal

	osinstall :: Builder -> [String]
osinstall builder :: Builder
builder = case Maybe System
msys of
		Just (System (FreeBSD _) _) -> ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
pkginstall (Builder -> [String]
fbsddeps Builder
builder)
		Just (System (Distribution
ArchLinux) _) -> ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
pacmaninstall (Builder -> [String]
archlinuxdeps Builder
builder)
		Just (System (Debian _ _) _) -> Builder -> [String]
useapt Builder
builder
		Just (System (Buntish _) _) -> Builder -> [String]
useapt Builder
builder
		-- assume a Debian derived system when not specified
		Nothing -> Builder -> [String]
useapt Builder
builder

	useapt :: Builder -> [String]
useapt builder :: Builder
builder = "apt-get update" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (Dep -> String) -> [Dep] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Dep -> String
aptinstall (Builder -> [Dep]
debdeps Builder
builder)

	aptinstall :: Dep -> String
aptinstall (Dep p :: String
p) = "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-install-recommends -y install " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
p
	aptinstall (OldDep p :: String
p) = "if LANG=C apt-cache policy " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ "| grep -q Candidate:; then " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dep -> String
aptinstall (String -> Dep
Dep String
p) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "; fi"
	pkginstall :: ShowS
pkginstall p :: String
p = "ASSUME_ALWAYS_YES=yes pkg install " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
p
	pacmaninstall :: ShowS
pacmaninstall p :: String
p = "pacman -S --noconfirm --needed " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
p

	debdeps :: Builder -> [Dep]
debdeps Cabal =
		[ String -> Dep
Dep "gnupg"
		-- Below are the same deps listed in debian/control.
		, String -> Dep
Dep "ghc"
		, String -> Dep
Dep "cabal-install"
		, String -> Dep
Dep "libghc-async-dev"
		, String -> Dep
Dep "libghc-split-dev"
		, String -> Dep
Dep "libghc-hslogger-dev"
		, String -> Dep
Dep "libghc-unix-compat-dev"
		, String -> Dep
Dep "libghc-ansi-terminal-dev"
		, String -> Dep
Dep "libghc-ifelse-dev"
		, String -> Dep
Dep "libghc-network-dev"
		, String -> Dep
Dep "libghc-mtl-dev"
		, String -> Dep
Dep "libghc-transformers-dev"
		, String -> Dep
Dep "libghc-exceptions-dev"
		, String -> Dep
Dep "libghc-text-dev"
		, String -> Dep
Dep "libghc-hashable-dev"
		-- Deps that are only needed on old systems.
		, String -> Dep
OldDep "libghc-stm-dev"
		]
	debdeps Stack =
		[ String -> Dep
Dep "gnupg"
		, String -> Dep
Dep "haskell-stack"
		]

	fbsddeps :: Builder -> [String]
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 :: Builder -> [String]
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"
		, "haskell-hashable"
		, "haskell-type-errors"
		]
	archlinuxdeps Stack = 
		[ "gnupg"
		, "stack"
		]

installGitCommand :: Maybe System -> ShellCommand
installGitCommand :: Maybe System -> String
installGitCommand msys :: Maybe System
msys = case Maybe System
msys of
	(Just (System (Debian _ _) _)) -> [String] -> String
use [String]
apt
	(Just (System (Buntish _) _)) -> [String] -> String
use [String]
apt
	(Just (System (FreeBSD _) _)) -> [String] -> String
use
		[ "ASSUME_ALWAYS_YES=yes pkg update"
		, "ASSUME_ALWAYS_YES=yes pkg install git"
		]
	(Just (System (Distribution
ArchLinux) _)) -> [String] -> String
use
		[ "pacman -S --noconfirm --needed git"]
	-- assume a debian derived system when not specified
	Nothing -> [String] -> String
use [String]
apt
  where
	use :: [String] -> String
use cmds :: [String]
cmds = "if ! git --version >/dev/null 2>&1; then " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " && " [String]
cmds String -> ShowS
forall a. [a] -> [a] -> [a]
++ "; fi"
	apt :: [String]
apt =
		[ "apt-get update"
		, "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-install-recommends --no-upgrade -y install git"
		]

-- Build propellor, and symlink the built binary to ./propellor.
--
-- When the Host has a Buildsystem specified it is used. If none is
-- specified, look at git config propellor.buildsystem.
buildPropellor :: Maybe Host -> IO ()
buildPropellor :: Maybe Host -> IO ()
buildPropellor mh :: Maybe Host
mh = IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (String -> IO Bool -> IO Bool
forall (m :: * -> *) r.
(MonadIO m, MonadMask m, ActionResult r, ToResult r) =>
String -> m r -> m r
actionMessage "Propellor build" IO Bool
build) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
	String -> IO ()
forall (m :: * -> *) a. MonadIO m => String -> m a
errorMessage "Propellor build failed!"
  where
	msys :: Maybe System
msys = case (Host -> InfoVal System) -> Maybe Host -> Maybe (InfoVal System)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Info -> InfoVal System
forall v. IsInfo v => Info -> v
fromInfo (Info -> InfoVal System)
-> (Host -> Info) -> Host -> InfoVal System
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Host -> Info
hostInfo) Maybe Host
mh of
		Just (InfoVal sys :: System
sys) -> System -> Maybe System
forall a. a -> Maybe a
Just System
sys
		_ -> Maybe System
forall a. Maybe a
Nothing

	build :: IO Bool
build = IO Bool -> IO Bool
forall (m :: * -> *). MonadCatch m => m Bool -> m Bool
catchBoolIO (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
		case Info -> InfoVal Bootstrapper
forall v. IsInfo v => Info -> v
fromInfo (Info -> (Host -> Info) -> Maybe Host -> Info
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Info
forall a. Monoid a => a
mempty Host -> Info
hostInfo Maybe Host
mh) of
			NoInfoVal -> do			
				Maybe String
bs <- String -> IO (Maybe String)
getGitConfigValue "propellor.buildsystem"
				case Maybe String
bs of
					Just "stack" -> Maybe System -> IO Bool
stackBuild Maybe System
msys
					_ -> Maybe System -> IO Bool
cabalBuild Maybe System
msys
			InfoVal bs :: Bootstrapper
bs -> case Bootstrapper -> Builder
getBuilder Bootstrapper
bs of
				Cabal -> Maybe System -> IO Bool
cabalBuild Maybe System
msys
				Stack -> Maybe System -> IO Bool
stackBuild Maybe System
msys

-- For speed, only runs cabal configure when it's not been run before.
-- If the build fails cabal may need to have configure re-run.
--
-- If the cabal configure fails, and a System is provided, installs
-- dependencies and retries.
cabalBuild :: Maybe System -> IO Bool
cabalBuild :: Maybe System -> IO Bool
cabalBuild msys :: Maybe System
msys = do
	String -> [String] -> IO Bool -> IO ()
make "dist/setup-config" ["propellor.cabal"] IO Bool
cabal_configure
	IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM IO Bool
cabal_build (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
		IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (IO Bool
cabal_configure IO Bool -> IO Bool -> IO Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> IO Bool
cabal_build) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
			String -> IO ()
forall a. HasCallStack => String -> a
error "cabal build failed"
	-- For safety against eg power loss in the middle of the build,
	-- make a copy of the binary, and move it into place atomically.
	-- This ensures that the propellor symlink only ever points at
	-- a binary that is fully built. Also, avoid ever removing
	-- or breaking the symlink.
	--
	-- Need cp -pfRL to make build timestamp checking work.
	IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (String -> [CommandParam] -> IO Bool
boolSystem "cp" [String -> CommandParam
Param "-pfRL", String -> CommandParam
Param String
cabalbuiltbin, String -> CommandParam
Param (ShowS
tmpfor String
safetycopy)]) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
		String -> IO ()
forall a. HasCallStack => String -> a
error "cp of binary failed"
	String -> String -> IO ()
rename (ShowS
tmpfor String
safetycopy) String
safetycopy
	String -> IO ()
symlinkPropellorBin String
safetycopy
	Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  where
	cabalbuiltbin :: String
cabalbuiltbin = "dist/build/propellor-config/propellor-config"
	safetycopy :: String
safetycopy = String
cabalbuiltbin String -> ShowS
forall a. [a] -> [a] -> [a]
++ ".built"
	cabal_configure :: IO Bool
cabal_configure = IO Bool -> (IO Bool, IO Bool) -> IO Bool
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM ([String] -> IO Bool
cabal ["configure"])
		( Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
		, case Maybe System
msys of
			Nothing -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
			Just sys :: System
sys ->
				String -> [CommandParam] -> IO Bool
boolSystem "sh" [String -> CommandParam
Param "-c", String -> CommandParam
Param (Bootstrapper -> Maybe System -> String
depsCommand (Builder -> Bootstrapper
Robustly Builder
Cabal) (System -> Maybe System
forall a. a -> Maybe a
Just System
sys))]
					IO Bool -> IO Bool -> IO Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> [String] -> IO Bool
cabal ["configure"]
		)
	-- The -j1 is to only run one job at a time -- in some situations,
	-- eg in qemu, ghc does not run reliably in parallel.
	cabal_build :: IO Bool
cabal_build = [String] -> IO Bool
cabal ["build", "-j1", "propellor-config"]

stackBuild :: Maybe System -> IO Bool
stackBuild :: Maybe System -> IO Bool
stackBuild _msys :: Maybe System
_msys = do
	Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
builddest
	IO Bool -> (IO Bool, IO Bool) -> IO Bool
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM ([String] -> IO Bool
stack [String]
buildparams)
		( do
			String -> IO ()
symlinkPropellorBin (String
builddest String -> ShowS
</> "propellor-config")
			Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
		, Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
		)
  where
 	builddest :: String
builddest = ".built"
	buildparams :: [String]
buildparams =
		[ "--local-bin-path", String
builddest
		, "build"
		, ":propellor-config" -- only build config program
		, "--copy-bins"
		]

-- Atomic symlink creation/update.
symlinkPropellorBin :: FilePath -> IO ()
symlinkPropellorBin :: String -> IO ()
symlinkPropellorBin bin :: String
bin = do
	String -> String -> IO ()
createSymbolicLink String
bin (ShowS
tmpfor String
dest)
	String -> String -> IO ()
rename (ShowS
tmpfor String
dest) String
dest
  where
	dest :: String
dest = "propellor"

tmpfor :: FilePath -> FilePath
tmpfor :: ShowS
tmpfor f :: String
f = String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ ".propellortmp"

make :: FilePath -> [FilePath] -> IO Bool -> IO ()
make :: String -> [String] -> IO Bool -> IO ()
make dest :: String
dest srcs :: [String]
srcs builder :: IO Bool
builder = do
	Maybe UTCTime
dt <- String -> IO (Maybe UTCTime)
getmtime String
dest
	[Maybe UTCTime]
st <- (String -> IO (Maybe UTCTime)) -> [String] -> IO [Maybe UTCTime]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (Maybe UTCTime)
getmtime [String]
srcs
	Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe UTCTime
dt Maybe UTCTime -> Maybe UTCTime -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe UTCTime
forall a. Maybe a
Nothing Bool -> Bool -> Bool
|| (Maybe UTCTime -> Bool) -> [Maybe UTCTime] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe UTCTime -> Maybe UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
> Maybe UTCTime
dt) [Maybe UTCTime]
st) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
		IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM IO Bool
builder (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
			String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "failed to make " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
dest
  where
	getmtime :: String -> IO (Maybe UTCTime)
getmtime = IO UTCTime -> IO (Maybe UTCTime)
forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO (IO UTCTime -> IO (Maybe UTCTime))
-> (String -> IO UTCTime) -> String -> IO (Maybe UTCTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO UTCTime
getModificationTime

cabal :: [String] -> IO Bool
cabal :: [String] -> IO Bool
cabal = String -> [CommandParam] -> IO Bool
boolSystem "cabal" ([CommandParam] -> IO Bool)
-> ([String] -> [CommandParam]) -> [String] -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> CommandParam) -> [String] -> [CommandParam]
forall a b. (a -> b) -> [a] -> [b]
map String -> CommandParam
Param

stack :: [String] -> IO Bool
stack :: [String] -> IO Bool
stack = String -> [CommandParam] -> IO Bool
boolSystem "stack" ([CommandParam] -> IO Bool)
-> ([String] -> [CommandParam]) -> [String] -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> CommandParam) -> [String] -> [CommandParam]
forall a b. (a -> b) -> [a] -> [b]
map String -> CommandParam
Param