{-# LANGUAGE NumericUnderscores #-}

-- |
-- Static B9 configuration. Read, write and merge configurable properties.
-- The properties are independent of specific build targets.
module B9.B9Config
  ( B9Config (..),
    Timeout (..),
    runB9ConfigReader,
    B9ConfigReader,
    getB9Config,
    getConfig,
    getLogVerbosity,
    getProjectRoot,
    getRemoteRepos,
    B9ConfigWriter,
    verbosity,
    logFile,
    ext4Attributes,
    projectRoot,
    keepTempDirs,
    uniqueBuildDirs,
    repositoryCache,
    repository,
    defaultTimeout,
    libVirtLXCConfigs,
    dockerConfigs,
    podmanConfigs,
    systemdNspawnConfigs,
    remoteRepos,
    timeoutFactor,
    maxLocalSharedImageRevisionsK,
    maxLocalSharedImageRevisions,
    B9ConfigOverride (..),
    noB9ConfigOverride,
    B9ConfigAction (),
    runB9ConfigActionWithOverrides,
    runB9ConfigAction,
    localB9Config,
    modifyPermanentConfig,
    customB9Config,
    customB9ConfigPath,
    customEnvironment,
    customDefaulB9ConfigPath,
    overrideB9ConfigPath,
    overrideDefaultB9ConfigPath,
    overrideB9Config,
    overrideWorkingDirectory,
    overrideDefaultTimeout,
    overrideTimeoutFactor,
    overrideVerbosity,
    overrideKeepBuildDirs,
    overrideExt4Attributes,
    defaultB9ConfigFile,
    defaultRepositoryCache,
    defaultB9Config,
    openOrCreateB9Config,
    writeB9CPDocument,
    readB9Config,
    parseB9Config,
    modifyCPDocument,
    b9ConfigToCPDocument,
    LogLevel (..),
    Environment,
    module X,
  )
where

import B9.B9Config.Container as X
import B9.B9Config.Docker as X
import B9.B9Config.LibVirtLXC as X
import B9.B9Config.Podman as X
import B9.B9Config.Repository as X
import B9.B9Config.SystemdNspawn as X
import B9.Environment
import B9.QCUtil (smaller)
import Control.Eff
import Control.Eff.Reader.Lazy
import Control.Eff.Writer.Lazy
import Control.Exception
import Control.Lens as Lens ((<>~), (?~), (.~), (^.), makeLenses, set)
import Control.Monad ((>=>), filterM)
import Control.Monad.IO.Class
import Data.ConfigFile.B9Extras
  ( CPDocument,
    CPError,
    CPGet,
    CPOptionSpec,
    CPReadException (..),
    addSectionCP,
    emptyCP,
    mergeCP,
    readCP,
    readCPDocument,
    setShowCP,
    toStringCP,
  )
import Data.Function (on)
import Data.List (inits)
import Data.Maybe (listToMaybe, fromMaybe)
import Data.Monoid
import Data.Semigroup as Semigroup hiding (Last (..))
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Version
import GHC.Stack
import qualified Paths_b9 as My
import System.Directory
import System.FilePath ((<.>))
import System.IO.B9Extras (SystemPath (..), ensureDir, resolve)
import Text.Printf (printf)
import Test.QuickCheck (Arbitrary(arbitrary))
import qualified Test.QuickCheck as QuickCheck

-- | A way to specify a time intervall for example for the timeouts
-- of system commands.
--
-- @since 1.1.0
newtype Timeout = TimeoutMicros Int
  deriving (Int -> Timeout -> ShowS
[Timeout] -> ShowS
Timeout -> String
(Int -> Timeout -> ShowS)
-> (Timeout -> String) -> ([Timeout] -> ShowS) -> Show Timeout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Timeout] -> ShowS
$cshowList :: [Timeout] -> ShowS
show :: Timeout -> String
$cshow :: Timeout -> String
showsPrec :: Int -> Timeout -> ShowS
$cshowsPrec :: Int -> Timeout -> ShowS
Show, Timeout -> Timeout -> Bool
(Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool) -> Eq Timeout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Timeout -> Timeout -> Bool
$c/= :: Timeout -> Timeout -> Bool
== :: Timeout -> Timeout -> Bool
$c== :: Timeout -> Timeout -> Bool
Eq, Eq Timeout
Eq Timeout
-> (Timeout -> Timeout -> Ordering)
-> (Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Timeout)
-> (Timeout -> Timeout -> Timeout)
-> Ord Timeout
Timeout -> Timeout -> Bool
Timeout -> Timeout -> Ordering
Timeout -> Timeout -> Timeout
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Timeout -> Timeout -> Timeout
$cmin :: Timeout -> Timeout -> Timeout
max :: Timeout -> Timeout -> Timeout
$cmax :: Timeout -> Timeout -> Timeout
>= :: Timeout -> Timeout -> Bool
$c>= :: Timeout -> Timeout -> Bool
> :: Timeout -> Timeout -> Bool
$c> :: Timeout -> Timeout -> Bool
<= :: Timeout -> Timeout -> Bool
$c<= :: Timeout -> Timeout -> Bool
< :: Timeout -> Timeout -> Bool
$c< :: Timeout -> Timeout -> Bool
compare :: Timeout -> Timeout -> Ordering
$ccompare :: Timeout -> Timeout -> Ordering
$cp1Ord :: Eq Timeout
Ord, ReadPrec [Timeout]
ReadPrec Timeout
Int -> ReadS Timeout
ReadS [Timeout]
(Int -> ReadS Timeout)
-> ReadS [Timeout]
-> ReadPrec Timeout
-> ReadPrec [Timeout]
-> Read Timeout
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Timeout]
$creadListPrec :: ReadPrec [Timeout]
readPrec :: ReadPrec Timeout
$creadPrec :: ReadPrec Timeout
readList :: ReadS [Timeout]
$creadList :: ReadS [Timeout]
readsPrec :: Int -> ReadS Timeout
$creadsPrec :: Int -> ReadS Timeout
Read)

instance Arbitrary Timeout where
  arbitrary :: Gen Timeout
arbitrary = do 
    QuickCheck.Positive Int
t <- Gen (Positive Int)
forall a. Arbitrary a => Gen a
arbitrary 
    Timeout -> Gen Timeout
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Timeout
TimeoutMicros (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1_000_000))

data LogLevel
  = LogTrace
  | LogDebug
  | LogInfo
  | LogError
  | LogNothing
  deriving (LogLevel -> LogLevel -> Bool
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c== :: LogLevel -> LogLevel -> Bool
Eq, Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
(Int -> LogLevel -> ShowS)
-> (LogLevel -> String) -> ([LogLevel] -> ShowS) -> Show LogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogLevel] -> ShowS
$cshowList :: [LogLevel] -> ShowS
show :: LogLevel -> String
$cshow :: LogLevel -> String
showsPrec :: Int -> LogLevel -> ShowS
$cshowsPrec :: Int -> LogLevel -> ShowS
Show, Eq LogLevel
Eq LogLevel
-> (LogLevel -> LogLevel -> Ordering)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> LogLevel)
-> (LogLevel -> LogLevel -> LogLevel)
-> Ord LogLevel
LogLevel -> LogLevel -> Bool
LogLevel -> LogLevel -> Ordering
LogLevel -> LogLevel -> LogLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LogLevel -> LogLevel -> LogLevel
$cmin :: LogLevel -> LogLevel -> LogLevel
max :: LogLevel -> LogLevel -> LogLevel
$cmax :: LogLevel -> LogLevel -> LogLevel
>= :: LogLevel -> LogLevel -> Bool
$c>= :: LogLevel -> LogLevel -> Bool
> :: LogLevel -> LogLevel -> Bool
$c> :: LogLevel -> LogLevel -> Bool
<= :: LogLevel -> LogLevel -> Bool
$c<= :: LogLevel -> LogLevel -> Bool
< :: LogLevel -> LogLevel -> Bool
$c< :: LogLevel -> LogLevel -> Bool
compare :: LogLevel -> LogLevel -> Ordering
$ccompare :: LogLevel -> LogLevel -> Ordering
$cp1Ord :: Eq LogLevel
Ord, ReadPrec [LogLevel]
ReadPrec LogLevel
Int -> ReadS LogLevel
ReadS [LogLevel]
(Int -> ReadS LogLevel)
-> ReadS [LogLevel]
-> ReadPrec LogLevel
-> ReadPrec [LogLevel]
-> Read LogLevel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LogLevel]
$creadListPrec :: ReadPrec [LogLevel]
readPrec :: ReadPrec LogLevel
$creadPrec :: ReadPrec LogLevel
readList :: ReadS [LogLevel]
$creadList :: ReadS [LogLevel]
readsPrec :: Int -> ReadS LogLevel
$creadsPrec :: Int -> ReadS LogLevel
Read)

instance Arbitrary LogLevel where 
  arbitrary :: Gen LogLevel
arbitrary = [LogLevel] -> Gen LogLevel
forall a. [a] -> Gen a
QuickCheck.elements [LogLevel
LogTrace, LogLevel
LogDebug, LogLevel
LogInfo, LogLevel
LogError, LogLevel
LogNothing]

data B9Config
  = B9Config
      { B9Config -> Maybe LogLevel
_verbosity :: Maybe LogLevel,
        B9Config -> Maybe String
_logFile :: Maybe FilePath,
        B9Config -> Maybe String
_projectRoot :: Maybe FilePath,
        B9Config -> Bool
_keepTempDirs :: Bool,
        B9Config -> Bool
_uniqueBuildDirs :: Bool,
        B9Config -> Maybe SystemPath
_repositoryCache :: Maybe SystemPath,
        B9Config -> Maybe String
_repository :: Maybe String,
        B9Config -> Maybe Int
_maxLocalSharedImageRevisions :: Maybe Int,
        B9Config -> Maybe SystemdNspawnConfig
_systemdNspawnConfigs :: Maybe SystemdNspawnConfig,
        B9Config -> Maybe PodmanConfig
_podmanConfigs :: Maybe PodmanConfig,
        B9Config -> Maybe DockerConfig
_dockerConfigs :: Maybe DockerConfig,
        B9Config -> Maybe LibVirtLXCConfig
_libVirtLXCConfigs :: Maybe LibVirtLXCConfig,
        B9Config -> Set RemoteRepo
_remoteRepos :: Set RemoteRepo,
        B9Config -> Maybe Timeout
_defaultTimeout :: Maybe Timeout,
        B9Config -> Maybe Int
_timeoutFactor :: Maybe Int,
        B9Config -> [String]
_ext4Attributes :: [String]
      }
  deriving (Int -> B9Config -> ShowS
[B9Config] -> ShowS
B9Config -> String
(Int -> B9Config -> ShowS)
-> (B9Config -> String) -> ([B9Config] -> ShowS) -> Show B9Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [B9Config] -> ShowS
$cshowList :: [B9Config] -> ShowS
show :: B9Config -> String
$cshow :: B9Config -> String
showsPrec :: Int -> B9Config -> ShowS
$cshowsPrec :: Int -> B9Config -> ShowS
Show, B9Config -> B9Config -> Bool
(B9Config -> B9Config -> Bool)
-> (B9Config -> B9Config -> Bool) -> Eq B9Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: B9Config -> B9Config -> Bool
$c/= :: B9Config -> B9Config -> Bool
== :: B9Config -> B9Config -> Bool
$c== :: B9Config -> B9Config -> Bool
Eq)

instance Arbitrary B9Config where 
  arbitrary :: Gen B9Config
arbitrary = 
    Maybe LogLevel
-> Maybe String
-> Maybe String
-> Bool
-> Bool
-> Maybe SystemPath
-> Maybe String
-> Maybe Int
-> Maybe SystemdNspawnConfig
-> Maybe PodmanConfig
-> Maybe DockerConfig
-> Maybe LibVirtLXCConfig
-> Set RemoteRepo
-> Maybe Timeout
-> Maybe Int
-> [String]
-> B9Config
B9Config 
      (Maybe LogLevel
 -> Maybe String
 -> Maybe String
 -> Bool
 -> Bool
 -> Maybe SystemPath
 -> Maybe String
 -> Maybe Int
 -> Maybe SystemdNspawnConfig
 -> Maybe PodmanConfig
 -> Maybe DockerConfig
 -> Maybe LibVirtLXCConfig
 -> Set RemoteRepo
 -> Maybe Timeout
 -> Maybe Int
 -> [String]
 -> B9Config)
-> Gen (Maybe LogLevel)
-> Gen
     (Maybe String
      -> Maybe String
      -> Bool
      -> Bool
      -> Maybe SystemPath
      -> Maybe String
      -> Maybe Int
      -> Maybe SystemdNspawnConfig
      -> Maybe PodmanConfig
      -> Maybe DockerConfig
      -> Maybe LibVirtLXCConfig
      -> Set RemoteRepo
      -> Maybe Timeout
      -> Maybe Int
      -> [String]
      -> B9Config)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe LogLevel) -> Gen (Maybe LogLevel)
forall a. Gen a -> Gen a
smaller Gen (Maybe LogLevel)
forall a. Arbitrary a => Gen a
arbitrary 
      Gen
  (Maybe String
   -> Maybe String
   -> Bool
   -> Bool
   -> Maybe SystemPath
   -> Maybe String
   -> Maybe Int
   -> Maybe SystemdNspawnConfig
   -> Maybe PodmanConfig
   -> Maybe DockerConfig
   -> Maybe LibVirtLXCConfig
   -> Set RemoteRepo
   -> Maybe Timeout
   -> Maybe Int
   -> [String]
   -> B9Config)
-> Gen (Maybe String)
-> Gen
     (Maybe String
      -> Bool
      -> Bool
      -> Maybe SystemPath
      -> Maybe String
      -> Maybe Int
      -> Maybe SystemdNspawnConfig
      -> Maybe PodmanConfig
      -> Maybe DockerConfig
      -> Maybe LibVirtLXCConfig
      -> Set RemoteRepo
      -> Maybe Timeout
      -> Maybe Int
      -> [String]
      -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe String) -> Gen (Maybe String)
forall a. Gen a -> Gen a
smaller Gen (Maybe String)
forall a. Arbitrary a => Gen a
arbitrary 
      Gen
  (Maybe String
   -> Bool
   -> Bool
   -> Maybe SystemPath
   -> Maybe String
   -> Maybe Int
   -> Maybe SystemdNspawnConfig
   -> Maybe PodmanConfig
   -> Maybe DockerConfig
   -> Maybe LibVirtLXCConfig
   -> Set RemoteRepo
   -> Maybe Timeout
   -> Maybe Int
   -> [String]
   -> B9Config)
-> Gen (Maybe String)
-> Gen
     (Bool
      -> Bool
      -> Maybe SystemPath
      -> Maybe String
      -> Maybe Int
      -> Maybe SystemdNspawnConfig
      -> Maybe PodmanConfig
      -> Maybe DockerConfig
      -> Maybe LibVirtLXCConfig
      -> Set RemoteRepo
      -> Maybe Timeout
      -> Maybe Int
      -> [String]
      -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe String) -> Gen (Maybe String)
forall a. Gen a -> Gen a
smaller Gen (Maybe String)
forall a. Arbitrary a => Gen a
arbitrary 
      Gen
  (Bool
   -> Bool
   -> Maybe SystemPath
   -> Maybe String
   -> Maybe Int
   -> Maybe SystemdNspawnConfig
   -> Maybe PodmanConfig
   -> Maybe DockerConfig
   -> Maybe LibVirtLXCConfig
   -> Set RemoteRepo
   -> Maybe Timeout
   -> Maybe Int
   -> [String]
   -> B9Config)
-> Gen Bool
-> Gen
     (Bool
      -> Maybe SystemPath
      -> Maybe String
      -> Maybe Int
      -> Maybe SystemdNspawnConfig
      -> Maybe PodmanConfig
      -> Maybe DockerConfig
      -> Maybe LibVirtLXCConfig
      -> Set RemoteRepo
      -> Maybe Timeout
      -> Maybe Int
      -> [String]
      -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool -> Gen Bool
forall a. Gen a -> Gen a
smaller Gen Bool
forall a. Arbitrary a => Gen a
arbitrary 
      Gen
  (Bool
   -> Maybe SystemPath
   -> Maybe String
   -> Maybe Int
   -> Maybe SystemdNspawnConfig
   -> Maybe PodmanConfig
   -> Maybe DockerConfig
   -> Maybe LibVirtLXCConfig
   -> Set RemoteRepo
   -> Maybe Timeout
   -> Maybe Int
   -> [String]
   -> B9Config)
-> Gen Bool
-> Gen
     (Maybe SystemPath
      -> Maybe String
      -> Maybe Int
      -> Maybe SystemdNspawnConfig
      -> Maybe PodmanConfig
      -> Maybe DockerConfig
      -> Maybe LibVirtLXCConfig
      -> Set RemoteRepo
      -> Maybe Timeout
      -> Maybe Int
      -> [String]
      -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool -> Gen Bool
forall a. Gen a -> Gen a
smaller Gen Bool
forall a. Arbitrary a => Gen a
arbitrary 
      Gen
  (Maybe SystemPath
   -> Maybe String
   -> Maybe Int
   -> Maybe SystemdNspawnConfig
   -> Maybe PodmanConfig
   -> Maybe DockerConfig
   -> Maybe LibVirtLXCConfig
   -> Set RemoteRepo
   -> Maybe Timeout
   -> Maybe Int
   -> [String]
   -> B9Config)
-> Gen (Maybe SystemPath)
-> Gen
     (Maybe String
      -> Maybe Int
      -> Maybe SystemdNspawnConfig
      -> Maybe PodmanConfig
      -> Maybe DockerConfig
      -> Maybe LibVirtLXCConfig
      -> Set RemoteRepo
      -> Maybe Timeout
      -> Maybe Int
      -> [String]
      -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Maybe SystemPath] -> Gen (Maybe SystemPath)
forall a. [a] -> Gen a
QuickCheck.elements [Maybe SystemPath
forall a. Maybe a
Nothing, SystemPath -> Maybe SystemPath
forall a. a -> Maybe a
Just (String -> SystemPath
InTempDir String
"xxx")])
      Gen
  (Maybe String
   -> Maybe Int
   -> Maybe SystemdNspawnConfig
   -> Maybe PodmanConfig
   -> Maybe DockerConfig
   -> Maybe LibVirtLXCConfig
   -> Set RemoteRepo
   -> Maybe Timeout
   -> Maybe Int
   -> [String]
   -> B9Config)
-> Gen (Maybe String)
-> Gen
     (Maybe Int
      -> Maybe SystemdNspawnConfig
      -> Maybe PodmanConfig
      -> Maybe DockerConfig
      -> Maybe LibVirtLXCConfig
      -> Set RemoteRepo
      -> Maybe Timeout
      -> Maybe Int
      -> [String]
      -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe String) -> Gen (Maybe String)
forall a. Gen a -> Gen a
smaller Gen (Maybe String)
forall a. Arbitrary a => Gen a
arbitrary 
      Gen
  (Maybe Int
   -> Maybe SystemdNspawnConfig
   -> Maybe PodmanConfig
   -> Maybe DockerConfig
   -> Maybe LibVirtLXCConfig
   -> Set RemoteRepo
   -> Maybe Timeout
   -> Maybe Int
   -> [String]
   -> B9Config)
-> Gen (Maybe Int)
-> Gen
     (Maybe SystemdNspawnConfig
      -> Maybe PodmanConfig
      -> Maybe DockerConfig
      -> Maybe LibVirtLXCConfig
      -> Set RemoteRepo
      -> Maybe Timeout
      -> Maybe Int
      -> [String]
      -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Int) -> Gen (Maybe Int)
forall a. Gen a -> Gen a
smaller ((Positive Int -> Int) -> Maybe (Positive Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Positive Int -> Int
forall a. Positive a -> a
QuickCheck.getPositive (Maybe (Positive Int) -> Maybe Int)
-> Gen (Maybe (Positive Int)) -> Gen (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe (Positive Int))
forall a. Arbitrary a => Gen a
arbitrary)
      Gen
  (Maybe SystemdNspawnConfig
   -> Maybe PodmanConfig
   -> Maybe DockerConfig
   -> Maybe LibVirtLXCConfig
   -> Set RemoteRepo
   -> Maybe Timeout
   -> Maybe Int
   -> [String]
   -> B9Config)
-> Gen (Maybe SystemdNspawnConfig)
-> Gen
     (Maybe PodmanConfig
      -> Maybe DockerConfig
      -> Maybe LibVirtLXCConfig
      -> Set RemoteRepo
      -> Maybe Timeout
      -> Maybe Int
      -> [String]
      -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe SystemdNspawnConfig) -> Gen (Maybe SystemdNspawnConfig)
forall a. Gen a -> Gen a
smaller Gen (Maybe SystemdNspawnConfig)
forall a. Arbitrary a => Gen a
arbitrary 
      Gen
  (Maybe PodmanConfig
   -> Maybe DockerConfig
   -> Maybe LibVirtLXCConfig
   -> Set RemoteRepo
   -> Maybe Timeout
   -> Maybe Int
   -> [String]
   -> B9Config)
-> Gen (Maybe PodmanConfig)
-> Gen
     (Maybe DockerConfig
      -> Maybe LibVirtLXCConfig
      -> Set RemoteRepo
      -> Maybe Timeout
      -> Maybe Int
      -> [String]
      -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe PodmanConfig -> Gen (Maybe PodmanConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PodmanConfig
forall a. Maybe a
Nothing
      Gen
  (Maybe DockerConfig
   -> Maybe LibVirtLXCConfig
   -> Set RemoteRepo
   -> Maybe Timeout
   -> Maybe Int
   -> [String]
   -> B9Config)
-> Gen (Maybe DockerConfig)
-> Gen
     (Maybe LibVirtLXCConfig
      -> Set RemoteRepo
      -> Maybe Timeout
      -> Maybe Int
      -> [String]
      -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe DockerConfig -> Gen (Maybe DockerConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe DockerConfig
forall a. Maybe a
Nothing
      Gen
  (Maybe LibVirtLXCConfig
   -> Set RemoteRepo
   -> Maybe Timeout
   -> Maybe Int
   -> [String]
   -> B9Config)
-> Gen (Maybe LibVirtLXCConfig)
-> Gen
     (Set RemoteRepo
      -> Maybe Timeout -> Maybe Int -> [String] -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe LibVirtLXCConfig) -> Gen (Maybe LibVirtLXCConfig)
forall a. Gen a -> Gen a
smaller Gen (Maybe LibVirtLXCConfig)
forall a. Arbitrary a => Gen a
arbitrary 
      Gen
  (Set RemoteRepo
   -> Maybe Timeout -> Maybe Int -> [String] -> B9Config)
-> Gen (Set RemoteRepo)
-> Gen (Maybe Timeout -> Maybe Int -> [String] -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Set RemoteRepo) -> Gen (Set RemoteRepo)
forall a. Gen a -> Gen a
smaller Gen (Set RemoteRepo)
forall a. Arbitrary a => Gen a
arbitrary 
      Gen (Maybe Timeout -> Maybe Int -> [String] -> B9Config)
-> Gen (Maybe Timeout) -> Gen (Maybe Int -> [String] -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Timeout) -> Gen (Maybe Timeout)
forall a. Gen a -> Gen a
smaller Gen (Maybe Timeout)
forall a. Arbitrary a => Gen a
arbitrary 
      Gen (Maybe Int -> [String] -> B9Config)
-> Gen (Maybe Int) -> Gen ([String] -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Positive Int -> Int) -> Maybe (Positive Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Positive Int -> Int
forall a. Positive a -> a
QuickCheck.getPositive (Maybe (Positive Int) -> Maybe Int)
-> Gen (Maybe (Positive Int)) -> Gen (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe (Positive Int)) -> Gen (Maybe (Positive Int))
forall a. Gen a -> Gen a
smaller Gen (Maybe (Positive Int))
forall a. Arbitrary a => Gen a
arbitrary)
      Gen ([String] -> B9Config) -> Gen [String] -> Gen B9Config
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [String] -> Gen [String]
forall a. Gen a -> Gen a
smaller ([String] -> Gen [String]
forall a. [a] -> Gen [a]
QuickCheck.sublistOf [String
"opt1",String
"opt2",String
"opt3"])

instance Semigroup B9Config where
  B9Config
c <> :: B9Config -> B9Config -> B9Config
<> B9Config
c' =
    B9Config :: Maybe LogLevel
-> Maybe String
-> Maybe String
-> Bool
-> Bool
-> Maybe SystemPath
-> Maybe String
-> Maybe Int
-> Maybe SystemdNspawnConfig
-> Maybe PodmanConfig
-> Maybe DockerConfig
-> Maybe LibVirtLXCConfig
-> Set RemoteRepo
-> Maybe Timeout
-> Maybe Int
-> [String]
-> B9Config
B9Config
      { _verbosity :: Maybe LogLevel
_verbosity = Last LogLevel -> Maybe LogLevel
forall a. Last a -> Maybe a
getLast (Last LogLevel -> Maybe LogLevel)
-> Last LogLevel -> Maybe LogLevel
forall a b. (a -> b) -> a -> b
$ (Last LogLevel -> Last LogLevel -> Last LogLevel)
-> (B9Config -> Last LogLevel)
-> B9Config
-> B9Config
-> Last LogLevel
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Last LogLevel -> Last LogLevel -> Last LogLevel
forall a. Monoid a => a -> a -> a
mappend (Maybe LogLevel -> Last LogLevel
forall a. Maybe a -> Last a
Last (Maybe LogLevel -> Last LogLevel)
-> (B9Config -> Maybe LogLevel) -> B9Config -> Last LogLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. B9Config -> Maybe LogLevel
_verbosity) B9Config
c B9Config
c',
        _logFile :: Maybe String
_logFile = Last String -> Maybe String
forall a. Last a -> Maybe a
getLast (Last String -> Maybe String) -> Last String -> Maybe String
forall a b. (a -> b) -> a -> b
$ (Last String -> Last String -> Last String)
-> (B9Config -> Last String) -> B9Config -> B9Config -> Last String
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Last String -> Last String -> Last String
forall a. Monoid a => a -> a -> a
mappend (Maybe String -> Last String
forall a. Maybe a -> Last a
Last (Maybe String -> Last String)
-> (B9Config -> Maybe String) -> B9Config -> Last String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. B9Config -> Maybe String
_logFile) B9Config
c B9Config
c',
        _projectRoot :: Maybe String
_projectRoot = Last String -> Maybe String
forall a. Last a -> Maybe a
getLast (Last String -> Maybe String) -> Last String -> Maybe String
forall a b. (a -> b) -> a -> b
$ (Last String -> Last String -> Last String)
-> (B9Config -> Last String) -> B9Config -> B9Config -> Last String
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Last String -> Last String -> Last String
forall a. Monoid a => a -> a -> a
mappend (Maybe String -> Last String
forall a. Maybe a -> Last a
Last (Maybe String -> Last String)
-> (B9Config -> Maybe String) -> B9Config -> Last String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. B9Config -> Maybe String
_projectRoot) B9Config
c B9Config
c',
        _keepTempDirs :: Bool
_keepTempDirs = Any -> Bool
getAny (Any -> Bool) -> Any -> Bool
forall a b. (a -> b) -> a -> b
$ (Any -> Any -> Any)
-> (B9Config -> Any) -> B9Config -> B9Config -> Any
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Any -> Any -> Any
forall a. Monoid a => a -> a -> a
mappend (Bool -> Any
Any (Bool -> Any) -> (B9Config -> Bool) -> B9Config -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. B9Config -> Bool
_keepTempDirs) B9Config
c B9Config
c',
        _uniqueBuildDirs :: Bool
_uniqueBuildDirs = All -> Bool
getAll ((All -> All -> All
forall a. Monoid a => a -> a -> a
mappend (All -> All -> All)
-> (B9Config -> All) -> B9Config -> B9Config -> All
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Bool -> All
All (Bool -> All) -> (B9Config -> Bool) -> B9Config -> All
forall b c a. (b -> c) -> (a -> b) -> a -> c
. B9Config -> Bool
_uniqueBuildDirs)) B9Config
c B9Config
c'),
        _repositoryCache :: Maybe SystemPath
_repositoryCache = Last SystemPath -> Maybe SystemPath
forall a. Last a -> Maybe a
getLast (Last SystemPath -> Maybe SystemPath)
-> Last SystemPath -> Maybe SystemPath
forall a b. (a -> b) -> a -> b
$ (Last SystemPath -> Last SystemPath -> Last SystemPath)
-> (B9Config -> Last SystemPath)
-> B9Config
-> B9Config
-> Last SystemPath
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Last SystemPath -> Last SystemPath -> Last SystemPath
forall a. Monoid a => a -> a -> a
mappend (Maybe SystemPath -> Last SystemPath
forall a. Maybe a -> Last a
Last (Maybe SystemPath -> Last SystemPath)
-> (B9Config -> Maybe SystemPath) -> B9Config -> Last SystemPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. B9Config -> Maybe SystemPath
_repositoryCache) B9Config
c B9Config
c',
        _repository :: Maybe String
_repository = Last String -> Maybe String
forall a. Last a -> Maybe a
getLast ((Last String -> Last String -> Last String
forall a. Monoid a => a -> a -> a
mappend (Last String -> Last String -> Last String)
-> (B9Config -> Last String) -> B9Config -> B9Config -> Last String
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Maybe String -> Last String
forall a. Maybe a -> Last a
Last (Maybe String -> Last String)
-> (B9Config -> Maybe String) -> B9Config -> Last String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. B9Config -> Maybe String
_repository)) B9Config
c B9Config
c'),
        _maxLocalSharedImageRevisions :: Maybe Int
_maxLocalSharedImageRevisions = Last Int -> Maybe Int
forall a. Last a -> Maybe a
getLast ((Last Int -> Last Int -> Last Int
forall a. Monoid a => a -> a -> a
mappend (Last Int -> Last Int -> Last Int)
-> (B9Config -> Last Int) -> B9Config -> B9Config -> Last Int
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Maybe Int -> Last Int
forall a. Maybe a -> Last a
Last (Maybe Int -> Last Int)
-> (B9Config -> Maybe Int) -> B9Config -> Last Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. B9Config -> Maybe Int
_maxLocalSharedImageRevisions)) B9Config
c B9Config
c'),
        _systemdNspawnConfigs :: Maybe SystemdNspawnConfig
_systemdNspawnConfigs = Last SystemdNspawnConfig -> Maybe SystemdNspawnConfig
forall a. Last a -> Maybe a
getLast ((Last SystemdNspawnConfig
-> Last SystemdNspawnConfig -> Last SystemdNspawnConfig
forall a. Monoid a => a -> a -> a
mappend (Last SystemdNspawnConfig
 -> Last SystemdNspawnConfig -> Last SystemdNspawnConfig)
-> (B9Config -> Last SystemdNspawnConfig)
-> B9Config
-> B9Config
-> Last SystemdNspawnConfig
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Maybe SystemdNspawnConfig -> Last SystemdNspawnConfig
forall a. Maybe a -> Last a
Last (Maybe SystemdNspawnConfig -> Last SystemdNspawnConfig)
-> (B9Config -> Maybe SystemdNspawnConfig)
-> B9Config
-> Last SystemdNspawnConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. B9Config -> Maybe SystemdNspawnConfig
_systemdNspawnConfigs)) B9Config
c B9Config
c'),
        _podmanConfigs :: Maybe PodmanConfig
_podmanConfigs = Last PodmanConfig -> Maybe PodmanConfig
forall a. Last a -> Maybe a
getLast ((Last PodmanConfig -> Last PodmanConfig -> Last PodmanConfig
forall a. Monoid a => a -> a -> a
mappend (Last PodmanConfig -> Last PodmanConfig -> Last PodmanConfig)
-> (B9Config -> Last PodmanConfig)
-> B9Config
-> B9Config
-> Last PodmanConfig
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Maybe PodmanConfig -> Last PodmanConfig
forall a. Maybe a -> Last a
Last (Maybe PodmanConfig -> Last PodmanConfig)
-> (B9Config -> Maybe PodmanConfig)
-> B9Config
-> Last PodmanConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. B9Config -> Maybe PodmanConfig
_podmanConfigs)) B9Config
c B9Config
c'),
        _dockerConfigs :: Maybe DockerConfig
_dockerConfigs = Last DockerConfig -> Maybe DockerConfig
forall a. Last a -> Maybe a
getLast ((Last DockerConfig -> Last DockerConfig -> Last DockerConfig
forall a. Monoid a => a -> a -> a
mappend (Last DockerConfig -> Last DockerConfig -> Last DockerConfig)
-> (B9Config -> Last DockerConfig)
-> B9Config
-> B9Config
-> Last DockerConfig
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Maybe DockerConfig -> Last DockerConfig
forall a. Maybe a -> Last a
Last (Maybe DockerConfig -> Last DockerConfig)
-> (B9Config -> Maybe DockerConfig)
-> B9Config
-> Last DockerConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. B9Config -> Maybe DockerConfig
_dockerConfigs)) B9Config
c B9Config
c'),
        _libVirtLXCConfigs :: Maybe LibVirtLXCConfig
_libVirtLXCConfigs = Last LibVirtLXCConfig -> Maybe LibVirtLXCConfig
forall a. Last a -> Maybe a
getLast ((Last LibVirtLXCConfig
-> Last LibVirtLXCConfig -> Last LibVirtLXCConfig
forall a. Monoid a => a -> a -> a
mappend (Last LibVirtLXCConfig
 -> Last LibVirtLXCConfig -> Last LibVirtLXCConfig)
-> (B9Config -> Last LibVirtLXCConfig)
-> B9Config
-> B9Config
-> Last LibVirtLXCConfig
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Maybe LibVirtLXCConfig -> Last LibVirtLXCConfig
forall a. Maybe a -> Last a
Last (Maybe LibVirtLXCConfig -> Last LibVirtLXCConfig)
-> (B9Config -> Maybe LibVirtLXCConfig)
-> B9Config
-> Last LibVirtLXCConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. B9Config -> Maybe LibVirtLXCConfig
_libVirtLXCConfigs)) B9Config
c B9Config
c'),
        _remoteRepos :: Set RemoteRepo
_remoteRepos = (Set RemoteRepo -> Set RemoteRepo -> Set RemoteRepo
forall a. Monoid a => a -> a -> a
mappend (Set RemoteRepo -> Set RemoteRepo -> Set RemoteRepo)
-> (B9Config -> Set RemoteRepo)
-> B9Config
-> B9Config
-> Set RemoteRepo
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` B9Config -> Set RemoteRepo
_remoteRepos) B9Config
c B9Config
c',
        _defaultTimeout :: Maybe Timeout
_defaultTimeout = Last Timeout -> Maybe Timeout
forall a. Last a -> Maybe a
getLast (Last Timeout -> Maybe Timeout) -> Last Timeout -> Maybe Timeout
forall a b. (a -> b) -> a -> b
$ (Last Timeout -> Last Timeout -> Last Timeout)
-> (B9Config -> Last Timeout)
-> B9Config
-> B9Config
-> Last Timeout
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Last Timeout -> Last Timeout -> Last Timeout
forall a. Monoid a => a -> a -> a
mappend (Maybe Timeout -> Last Timeout
forall a. Maybe a -> Last a
Last (Maybe Timeout -> Last Timeout)
-> (B9Config -> Maybe Timeout) -> B9Config -> Last Timeout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. B9Config -> Maybe Timeout
_defaultTimeout) B9Config
c B9Config
c',
        _timeoutFactor :: Maybe Int
_timeoutFactor = Last Int -> Maybe Int
forall a. Last a -> Maybe a
getLast (Last Int -> Maybe Int) -> Last Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ (Last Int -> Last Int -> Last Int)
-> (B9Config -> Last Int) -> B9Config -> B9Config -> Last Int
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Last Int -> Last Int -> Last Int
forall a. Monoid a => a -> a -> a
mappend (Maybe Int -> Last Int
forall a. Maybe a -> Last a
Last (Maybe Int -> Last Int)
-> (B9Config -> Maybe Int) -> B9Config -> Last Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. B9Config -> Maybe Int
_timeoutFactor) B9Config
c B9Config
c',
        _ext4Attributes :: [String]
_ext4Attributes = ([String] -> [String] -> [String])
-> (B9Config -> [String]) -> B9Config -> B9Config -> [String]
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on [String] -> [String] -> [String]
forall a. Monoid a => a -> a -> a
mappend B9Config -> [String]
_ext4Attributes B9Config
c B9Config
c'
      }

instance Monoid B9Config where
  mappend :: B9Config -> B9Config -> B9Config
mappend = B9Config -> B9Config -> B9Config
forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: B9Config
mempty = Maybe LogLevel
-> Maybe String
-> Maybe String
-> Bool
-> Bool
-> Maybe SystemPath
-> Maybe String
-> Maybe Int
-> Maybe SystemdNspawnConfig
-> Maybe PodmanConfig
-> Maybe DockerConfig
-> Maybe LibVirtLXCConfig
-> Set RemoteRepo
-> Maybe Timeout
-> Maybe Int
-> [String]
-> B9Config
B9Config Maybe LogLevel
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Bool
False Bool
True Maybe SystemPath
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe SystemdNspawnConfig
forall a. Maybe a
Nothing Maybe PodmanConfig
forall a. Maybe a
Nothing Maybe DockerConfig
forall a. Maybe a
Nothing Maybe LibVirtLXCConfig
forall a. Maybe a
Nothing Set RemoteRepo
forall a. Monoid a => a
mempty (Timeout -> Maybe Timeout
forall a. a -> Maybe a
Just (Int -> Timeout
TimeoutMicros (Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1_000_000))) Maybe Int
forall a. Maybe a
Nothing []

-- | Reader for 'B9Config'. See 'getB9Config' and 'localB9Config'.
--
-- @since 0.5.65
type B9ConfigReader = Reader B9Config

-- | Run a 'B9ConfigReader'.
--
-- @since 0.5.65
runB9ConfigReader :: HasCallStack => B9Config -> Eff (B9ConfigReader ': e) a -> Eff e a
runB9ConfigReader :: B9Config -> Eff (B9ConfigReader : e) a -> Eff e a
runB9ConfigReader = B9Config -> Eff (B9ConfigReader : e) a -> Eff e a
forall e (r :: [* -> *]) w. e -> Eff (Reader e : r) w -> Eff r w
runReader

-- | Return the runtime configuration, that should be the configuration merged
-- from all configuration sources. This is the configuration to be used during
-- a VM image build.
--
-- @since 0.5.65
getB9Config :: Member B9ConfigReader e => Eff e B9Config
getB9Config :: Eff e B9Config
getB9Config = Eff e B9Config
forall e (r :: [* -> *]). Member (Reader e) r => Eff r e
ask

-- | Run an action with an updated runtime configuration.
--
-- @since 0.5.65
localB9Config :: Member B9ConfigReader e => (B9Config -> B9Config) -> Eff e a -> Eff e a
localB9Config :: (B9Config -> B9Config) -> Eff e a -> Eff e a
localB9Config = (B9Config -> B9Config) -> Eff e a -> Eff e a
forall e a (r :: [* -> *]).
Member (Reader e) r =>
(e -> e) -> Eff r a -> Eff r a
local

-- | An alias for 'getB9Config'.
--
-- @deprecated
--
-- @since 0.5.65
getConfig :: Member B9ConfigReader e => Eff e B9Config
getConfig :: Eff e B9Config
getConfig = Eff e B9Config
forall (e :: [* -> *]). Member B9ConfigReader e => Eff e B9Config
getB9Config

-- | Ask for the 'RemoteRepo's.
--
-- @since 0.5.65
getRemoteRepos :: Member B9ConfigReader e => Eff e (Set RemoteRepo)
getRemoteRepos :: Eff e (Set RemoteRepo)
getRemoteRepos = B9Config -> Set RemoteRepo
_remoteRepos (B9Config -> Set RemoteRepo)
-> Eff e B9Config -> Eff e (Set RemoteRepo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff e B9Config
forall (e :: [* -> *]). Member B9ConfigReader e => Eff e B9Config
getB9Config

-- | Ask for the 'LogLevel'.
--
-- @since 0.5.65
getLogVerbosity :: Member B9ConfigReader e => Eff e (Maybe LogLevel)
getLogVerbosity :: Eff e (Maybe LogLevel)
getLogVerbosity = B9Config -> Maybe LogLevel
_verbosity (B9Config -> Maybe LogLevel)
-> Eff e B9Config -> Eff e (Maybe LogLevel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff e B9Config
forall (e :: [* -> *]). Member B9ConfigReader e => Eff e B9Config
getB9Config

-- | Ask for the project root directory.
--
-- @since 0.5.65
getProjectRoot :: Member B9ConfigReader e => Eff e FilePath
getProjectRoot :: Eff e String
getProjectRoot = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"." (Maybe String -> String)
-> (B9Config -> Maybe String) -> B9Config -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. B9Config -> Maybe String
_projectRoot (B9Config -> String) -> Eff e B9Config -> Eff e String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff e B9Config
forall e (r :: [* -> *]). Member (Reader e) r => Eff r e
ask

-- | Override b9 configuration items and/or the path of the b9 configuration file.
-- This is useful, i.e. when dealing with command line parameters.
data B9ConfigOverride
  = B9ConfigOverride
      { B9ConfigOverride -> [SystemPath]
_customB9ConfigPath :: [SystemPath],
        B9ConfigOverride -> Endo B9Config
_customB9Config :: Endo B9Config,
        B9ConfigOverride -> Environment
_customEnvironment :: Environment,
        B9ConfigOverride -> Maybe SystemPath
_customDefaulB9ConfigPath :: Maybe SystemPath
      }

instance Show B9ConfigOverride where
  show :: B9ConfigOverride -> String
show B9ConfigOverride
x =
    [String] -> String
unlines
      [ String
"config file path:    " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [SystemPath] -> String
forall a. Show a => a -> String
show (B9ConfigOverride -> [SystemPath]
_customB9ConfigPath B9ConfigOverride
x),
        String
"config modification: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ B9Config -> String
forall a. Show a => a -> String
show (Endo B9Config -> B9Config -> B9Config
forall a. Endo a -> a -> a
appEndo (B9ConfigOverride -> Endo B9Config
_customB9Config B9ConfigOverride
x) B9Config
forall a. Monoid a => a
mempty),
        String
"environment:         " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Environment -> String
forall a. Show a => a -> String
show (B9ConfigOverride -> Environment
_customEnvironment B9ConfigOverride
x),
        String
"default config file: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe SystemPath -> String
forall a. Show a => a -> String
show (B9ConfigOverride -> Maybe SystemPath
_customDefaulB9ConfigPath B9ConfigOverride
x)
      ]

-- | An empty default 'B9ConfigOverride' value, that will neither apply any
-- additional 'B9Config' nor change the path of the configuration file.
noB9ConfigOverride :: B9ConfigOverride
noB9ConfigOverride :: B9ConfigOverride
noB9ConfigOverride = [SystemPath]
-> Endo B9Config
-> Environment
-> Maybe SystemPath
-> B9ConfigOverride
B9ConfigOverride [] Endo B9Config
forall a. Monoid a => a
mempty Environment
forall a. Monoid a => a
mempty Maybe SystemPath
forall a. Maybe a
Nothing

makeLenses ''B9Config

makeLenses ''B9ConfigOverride

-- | Convenience utility to override the B9 configuration file path.
overrideB9ConfigPath :: SystemPath -> B9ConfigOverride -> B9ConfigOverride
overrideB9ConfigPath :: SystemPath -> B9ConfigOverride -> B9ConfigOverride
overrideB9ConfigPath SystemPath
p = ([SystemPath] -> Identity [SystemPath])
-> B9ConfigOverride -> Identity B9ConfigOverride
Lens' B9ConfigOverride [SystemPath]
customB9ConfigPath (([SystemPath] -> Identity [SystemPath])
 -> B9ConfigOverride -> Identity B9ConfigOverride)
-> [SystemPath] -> B9ConfigOverride -> B9ConfigOverride
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [SystemPath
p]

-- | Modify the runtime configuration.
overrideB9Config :: (B9Config -> B9Config) -> B9ConfigOverride -> B9ConfigOverride
overrideB9Config :: (B9Config -> B9Config) -> B9ConfigOverride -> B9ConfigOverride
overrideB9Config B9Config -> B9Config
e = (Endo B9Config -> Identity (Endo B9Config))
-> B9ConfigOverride -> Identity B9ConfigOverride
Lens' B9ConfigOverride (Endo B9Config)
customB9Config ((Endo B9Config -> Identity (Endo B9Config))
 -> B9ConfigOverride -> Identity B9ConfigOverride)
-> Endo B9Config -> B9ConfigOverride -> B9ConfigOverride
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ (B9Config -> B9Config) -> Endo B9Config
forall a. (a -> a) -> Endo a
Endo B9Config -> B9Config
e

-- | Convenience utility to override the *default* B9 configuration file path.
--
-- @since 1.1.0
overrideDefaultB9ConfigPath :: SystemPath -> B9ConfigOverride -> B9ConfigOverride
overrideDefaultB9ConfigPath :: SystemPath -> B9ConfigOverride -> B9ConfigOverride
overrideDefaultB9ConfigPath SystemPath
p = (Maybe SystemPath -> Identity (Maybe SystemPath))
-> B9ConfigOverride -> Identity B9ConfigOverride
Lens' B9ConfigOverride (Maybe SystemPath)
customDefaulB9ConfigPath ((Maybe SystemPath -> Identity (Maybe SystemPath))
 -> B9ConfigOverride -> Identity B9ConfigOverride)
-> SystemPath -> B9ConfigOverride -> B9ConfigOverride
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SystemPath
p

-- | Define the current working directory to be used when building.
overrideWorkingDirectory :: FilePath -> B9ConfigOverride -> B9ConfigOverride
overrideWorkingDirectory :: String -> B9ConfigOverride -> B9ConfigOverride
overrideWorkingDirectory String
p = (B9Config -> B9Config) -> B9ConfigOverride -> B9ConfigOverride
overrideB9Config ((Maybe String -> Identity (Maybe String))
-> B9Config -> Identity B9Config
Lens' B9Config (Maybe String)
projectRoot ((Maybe String -> Identity (Maybe String))
 -> B9Config -> Identity B9Config)
-> String -> B9Config -> B9Config
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ String
p)

-- | Define the default timeout for external commands.
--
-- @since 1.1.0
overrideDefaultTimeout :: Maybe Timeout -> B9ConfigOverride -> B9ConfigOverride
overrideDefaultTimeout :: Maybe Timeout -> B9ConfigOverride -> B9ConfigOverride
overrideDefaultTimeout = (B9Config -> B9Config) -> B9ConfigOverride -> B9ConfigOverride
overrideB9Config ((B9Config -> B9Config) -> B9ConfigOverride -> B9ConfigOverride)
-> (Maybe Timeout -> B9Config -> B9Config)
-> Maybe Timeout
-> B9ConfigOverride
-> B9ConfigOverride
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter B9Config B9Config (Maybe Timeout) (Maybe Timeout)
-> Maybe Timeout -> B9Config -> B9Config
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter B9Config B9Config (Maybe Timeout) (Maybe Timeout)
Lens' B9Config (Maybe Timeout)
defaultTimeout

-- | Define the timeout factor for external commands.
--
-- @since 1.1.0
overrideTimeoutFactor :: Maybe Int -> B9ConfigOverride -> B9ConfigOverride
overrideTimeoutFactor :: Maybe Int -> B9ConfigOverride -> B9ConfigOverride
overrideTimeoutFactor = (B9Config -> B9Config) -> B9ConfigOverride -> B9ConfigOverride
overrideB9Config ((B9Config -> B9Config) -> B9ConfigOverride -> B9ConfigOverride)
-> (Maybe Int -> B9Config -> B9Config)
-> Maybe Int
-> B9ConfigOverride
-> B9ConfigOverride
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter B9Config B9Config (Maybe Int) (Maybe Int)
-> Maybe Int -> B9Config -> B9Config
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter B9Config B9Config (Maybe Int) (Maybe Int)
Lens' B9Config (Maybe Int)
timeoutFactor

-- | Overwrite the 'verbosity' settings in the configuration with those given.
overrideVerbosity :: LogLevel -> B9ConfigOverride -> B9ConfigOverride
overrideVerbosity :: LogLevel -> B9ConfigOverride -> B9ConfigOverride
overrideVerbosity = (B9Config -> B9Config) -> B9ConfigOverride -> B9ConfigOverride
overrideB9Config ((B9Config -> B9Config) -> B9ConfigOverride -> B9ConfigOverride)
-> (LogLevel -> B9Config -> B9Config)
-> LogLevel
-> B9ConfigOverride
-> B9ConfigOverride
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter B9Config B9Config (Maybe LogLevel) (Maybe LogLevel)
-> Maybe LogLevel -> B9Config -> B9Config
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter B9Config B9Config (Maybe LogLevel) (Maybe LogLevel)
Lens' B9Config (Maybe LogLevel)
verbosity (Maybe LogLevel -> B9Config -> B9Config)
-> (LogLevel -> Maybe LogLevel) -> LogLevel -> B9Config -> B9Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just

-- | Overwrite the 'keepTempDirs' flag in the configuration with those given.
overrideKeepBuildDirs :: Bool -> B9ConfigOverride -> B9ConfigOverride
overrideKeepBuildDirs :: Bool -> B9ConfigOverride -> B9ConfigOverride
overrideKeepBuildDirs = (B9Config -> B9Config) -> B9ConfigOverride -> B9ConfigOverride
overrideB9Config ((B9Config -> B9Config) -> B9ConfigOverride -> B9ConfigOverride)
-> (Bool -> B9Config -> B9Config)
-> Bool
-> B9ConfigOverride
-> B9ConfigOverride
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter B9Config B9Config Bool Bool -> Bool -> B9Config -> B9Config
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter B9Config B9Config Bool Bool
Lens' B9Config Bool
keepTempDirs

-- | Overwrite the 'ext4Attributes'
overrideExt4Attributes :: [String] -> B9ConfigOverride -> B9ConfigOverride
overrideExt4Attributes :: [String] -> B9ConfigOverride -> B9ConfigOverride
overrideExt4Attributes = (B9Config -> B9Config) -> B9ConfigOverride -> B9ConfigOverride
overrideB9Config ((B9Config -> B9Config) -> B9ConfigOverride -> B9ConfigOverride)
-> ([String] -> B9Config -> B9Config)
-> [String]
-> B9ConfigOverride
-> B9ConfigOverride
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter B9Config B9Config [String] [String]
-> [String] -> B9Config -> B9Config
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter B9Config B9Config [String] [String]
Lens' B9Config [String]
ext4Attributes


-- | A monad that gives access to the (transient) 'B9Config' to be used at
-- _runtime_ with 'getB9Config' or 'localB9Config', and that allows
-- to write permanent 'B9Config' changes back to the configuration file using
-- 'modifyPermanentConfig'. This is the amalgamation of 'B9ConfigWriter'
-- 'B9ConfigReader' and 'IO'.
--
-- @since 0.5.65
type B9ConfigAction a = Eff '[B9ConfigWriter, B9ConfigReader, EnvironmentReader, Lift IO] a

-- | Accumulate 'B9Config' changes that go back to the config file. See
-- 'B9ConfigAction' and 'modifyPermanentConfig'.
--
-- @since 0.5.65
type B9ConfigWriter = Writer (Semigroup.Endo B9Config)

-- | Add a modification to the permanent configuration file.
modifyPermanentConfig :: (HasCallStack, Member B9ConfigWriter e) => Endo B9Config -> Eff e ()
modifyPermanentConfig :: Endo B9Config -> Eff e ()
modifyPermanentConfig = Endo B9Config -> Eff e ()
forall w (r :: [* -> *]). Member (Writer w) r => w -> Eff r ()
tell

-- | Execute a 'B9ConfigAction'.
-- It will take a 'B9ConfigOverride' as input. The 'B9Config' in that value is
-- treated as the _runtime_ configuration, and the '_customConfigPath' is used
-- as the alternative location of the configuration file.
-- The configuration file is read from either the path in '_customB9ConfigPath'
-- or from 'defaultB9ConfigFile'.
-- Every modification done via 'modifyPermanentConfig' is applied to
-- the **contents** of the configuration file
-- and written back to that file, note that these changes are ONLY reflected
-- in the configuration file and **not** in the _runtime configuration_.
--
-- See also 'runB9ConfigAction', which does not need the 'B9ConfigOverride' parameter.
--
-- @since 0.5.65
runB9ConfigActionWithOverrides :: HasCallStack => B9ConfigAction a -> B9ConfigOverride -> IO a
runB9ConfigActionWithOverrides :: B9ConfigAction a -> B9ConfigOverride -> IO a
runB9ConfigActionWithOverrides B9ConfigAction a
act B9ConfigOverride
cfg = do
  [String]
configuredCfgPaths <- (SystemPath -> IO String) -> [SystemPath] -> IO [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SystemPath -> IO String
forall (m :: * -> *). MonadIO m => SystemPath -> m String
resolve (B9ConfigOverride
cfg B9ConfigOverride
-> Getting [SystemPath] B9ConfigOverride [SystemPath]
-> [SystemPath]
forall s a. s -> Getting a s a -> a
^. Getting [SystemPath] B9ConfigOverride [SystemPath]
Lens' B9ConfigOverride [SystemPath]
customB9ConfigPath)
  String
defCfgPath <- SystemPath -> IO String
forall (m :: * -> *). MonadIO m => SystemPath -> m String
resolve (SystemPath -> Maybe SystemPath -> SystemPath
forall a. a -> Maybe a -> a
fromMaybe SystemPath
defaultB9ConfigFile (B9ConfigOverride
cfg B9ConfigOverride
-> Getting (Maybe SystemPath) B9ConfigOverride (Maybe SystemPath)
-> Maybe SystemPath
forall s a. s -> Getting a s a -> a
^. Getting (Maybe SystemPath) B9ConfigOverride (Maybe SystemPath)
Lens' B9ConfigOverride (Maybe SystemPath)
customDefaulB9ConfigPath))
  let (Version [Int]
myVer [String]
_) = Version
My.version
      appendVersionVariations :: String -> [String]
appendVersionVariations String
name =
        (\[Int]
v' -> String
name String -> ShowS
<.> Version -> String
showVersion ([Int] -> Version
makeVersion [Int]
v')) ([Int] -> String) -> [[Int]] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Int]] -> [[Int]]
forall a. [a] -> [a]
reverse ([Int] -> [[Int]]
forall a. [a] -> [[a]]
inits [Int]
myVer)
      ([String]
pathsToTry, Maybe String
pathsToCreate) =
        case [String]
configuredCfgPaths of
          [] ->
            (String -> [String]
appendVersionVariations String
defCfgPath, String -> Maybe String
forall a. a -> Maybe a
Just String
defCfgPath)
          [String
configuredCfgPath] ->
            (String -> [String]
appendVersionVariations String
configuredCfgPath, Maybe String
forall a. Maybe a
Nothing)
          (String
_:String
_:[String]
_) ->
            ([String]
configuredCfgPaths, Maybe String
forall a. Maybe a
Nothing)
  [String]
existingCfgPaths <- (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesFileExist [String]
pathsToTry
  String
cfgPath <-
    case [String]
existingCfgPaths of
      (String
cfgPath : [String]
_) ->
        String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
cfgPath
      [] -> do
        String -> IO ()
putStrLn (String
"B9 config file resolver: None of these files exists " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
pathsToTry)
        case Maybe String
pathsToCreate of
          Just String
c -> do
            String -> IO ()
putStrLn (String
"creating a new config file with defaults at: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
c)
            String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
c
          Maybe String
Nothing ->
            String -> IO String
forall a. HasCallStack => String -> a
error String
"Please provide a valid config file path."
  CPDocument
cp <- String -> IO CPDocument
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> m CPDocument
openOrCreateB9Config String
cfgPath
  case HasCallStack => CPDocument -> Either CPError B9Config
CPDocument -> Either CPError B9Config
parseB9Config CPDocument
cp of
    Left CPError
e -> String -> IO a
forall a. HasCallStack => String -> a
error (String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Internal configuration load error, please report this: %s\n" (CPError -> String
forall a. Show a => a -> String
show CPError
e))
    Right B9Config
permanentConfigIn -> do
      let runtimeCfg :: B9Config
runtimeCfg = Endo B9Config -> B9Config -> B9Config
forall a. Endo a -> a -> a
appEndo (B9ConfigOverride
cfg B9ConfigOverride
-> Getting (Endo B9Config) B9ConfigOverride (Endo B9Config)
-> Endo B9Config
forall s a. s -> Getting a s a -> a
^. Getting (Endo B9Config) B9ConfigOverride (Endo B9Config)
Lens' B9ConfigOverride (Endo B9Config)
customB9Config) B9Config
permanentConfigIn
      (a
res, Endo B9Config
permanentB9ConfigUpdates) <-
        Eff '[Lift IO] (a, Endo B9Config) -> IO (a, Endo B9Config)
forall (m :: * -> *) w. Monad m => Eff '[Lift m] w -> m w
runLift (Environment
-> Eff '[EnvironmentReader, Lift IO] (a, Endo B9Config)
-> Eff '[Lift IO] (a, Endo B9Config)
forall (e :: [* -> *]) a.
Environment -> Eff (EnvironmentReader : e) a -> Eff e a
runEnvironmentReader (B9ConfigOverride
cfg B9ConfigOverride
-> Getting Environment B9ConfigOverride Environment -> Environment
forall s a. s -> Getting a s a -> a
^. Getting Environment B9ConfigOverride Environment
Lens' B9ConfigOverride Environment
customEnvironment) (B9Config
-> Eff
     '[B9ConfigReader, EnvironmentReader, Lift IO] (a, Endo B9Config)
-> Eff '[EnvironmentReader, Lift IO] (a, Endo B9Config)
forall e (r :: [* -> *]) w. e -> Eff (Reader e : r) w -> Eff r w
runReader B9Config
runtimeCfg (B9ConfigAction a
-> Eff
     '[B9ConfigReader, EnvironmentReader, Lift IO] (a, Endo B9Config)
forall w (r :: [* -> *]) a.
Monoid w =>
Eff (Writer w : r) a -> Eff r (a, w)
runMonoidWriter B9ConfigAction a
act)))
      let cpExtErr :: Maybe (Either CPError CPDocument)
cpExtErr = CPDocument -> Endo B9Config -> Either CPError CPDocument
modifyCPDocument CPDocument
cp (Endo B9Config -> Either CPError CPDocument)
-> Maybe (Endo B9Config) -> Maybe (Either CPError CPDocument)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Endo B9Config)
permanentB9ConfigUpdateMaybe
          permanentB9ConfigUpdateMaybe :: Maybe (Endo B9Config)
permanentB9ConfigUpdateMaybe =
            if Endo B9Config -> B9Config -> B9Config
forall a. Endo a -> a -> a
appEndo Endo B9Config
permanentB9ConfigUpdates B9Config
permanentConfigIn B9Config -> B9Config -> Bool
forall a. Eq a => a -> a -> Bool
== B9Config
permanentConfigIn
              then Maybe (Endo B9Config)
forall a. Maybe a
Nothing
              else Endo B9Config -> Maybe (Endo B9Config)
forall a. a -> Maybe a
Just Endo B9Config
permanentB9ConfigUpdates
      Maybe CPDocument
cpExt <-
        IO (Maybe CPDocument)
-> (Either CPError CPDocument -> IO (Maybe CPDocument))
-> Maybe (Either CPError CPDocument)
-> IO (Maybe CPDocument)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (Maybe CPDocument -> IO (Maybe CPDocument)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CPDocument
forall a. Maybe a
Nothing)
          ((CPError -> IO (Maybe CPDocument))
-> (CPDocument -> IO (Maybe CPDocument))
-> Either CPError CPDocument
-> IO (Maybe CPDocument)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> IO (Maybe CPDocument)
forall a. HasCallStack => String -> a
error (String -> IO (Maybe CPDocument))
-> (CPError -> String) -> CPError -> IO (Maybe CPDocument)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Internal configuration update error! Please report this: %s\n" ShowS -> (CPError -> String) -> CPError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CPError -> String
forall a. Show a => a -> String
show) (Maybe CPDocument -> IO (Maybe CPDocument)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CPDocument -> IO (Maybe CPDocument))
-> (CPDocument -> Maybe CPDocument)
-> CPDocument
-> IO (Maybe CPDocument)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CPDocument -> Maybe CPDocument
forall a. a -> Maybe a
Just))
          Maybe (Either CPError CPDocument)
cpExtErr
      (CPDocument -> IO ()) -> Maybe CPDocument -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Maybe SystemPath -> CPDocument -> IO ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe SystemPath -> CPDocument -> m ()
writeB9CPDocument ([SystemPath] -> Maybe SystemPath
forall a. [a] -> Maybe a
listToMaybe (B9ConfigOverride
cfg B9ConfigOverride
-> Getting [SystemPath] B9ConfigOverride [SystemPath]
-> [SystemPath]
forall s a. s -> Getting a s a -> a
^. Getting [SystemPath] B9ConfigOverride [SystemPath]
Lens' B9ConfigOverride [SystemPath]
customB9ConfigPath))) Maybe CPDocument
cpExt
      a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

-- | Run a 'B9ConfigAction' using 'noB9ConfigOverride'.
-- See 'runB9ConfigActionWithOverrides' for more details.
--
-- @since 0.5.65
runB9ConfigAction :: HasCallStack => B9ConfigAction a -> IO a
runB9ConfigAction :: B9ConfigAction a -> IO a
runB9ConfigAction = (B9ConfigAction a -> B9ConfigOverride -> IO a)
-> B9ConfigOverride -> B9ConfigAction a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip B9ConfigAction a -> B9ConfigOverride -> IO a
forall a.
HasCallStack =>
B9ConfigAction a -> B9ConfigOverride -> IO a
runB9ConfigActionWithOverrides B9ConfigOverride
noB9ConfigOverride

-- | Open the configuration file that contains the 'B9Config'.
-- If the configuration does not exist, write a default configuration file,
-- and create a all missing directories.
openOrCreateB9Config :: (HasCallStack, MonadIO m) => FilePath -> m CPDocument
openOrCreateB9Config :: String -> m CPDocument
openOrCreateB9Config String
cfgFile = do
  String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
ensureDir String
cfgFile
  IO CPDocument -> m CPDocument
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CPDocument -> m CPDocument) -> IO CPDocument -> m CPDocument
forall a b. (a -> b) -> a -> b
$ do
    Bool
exists <- String -> IO Bool
doesFileExist String
cfgFile
    if Bool
exists
      then SystemPath -> IO CPDocument
forall (m :: * -> *). MonadIO m => SystemPath -> m CPDocument
readCPDocument (String -> SystemPath
Path String
cfgFile)
      else
        let res :: Either CPError CPDocument
res = HasCallStack => B9Config -> Either CPError CPDocument
B9Config -> Either CPError CPDocument
b9ConfigToCPDocument B9Config
defaultB9Config
         in case Either CPError CPDocument
res of
              Left CPError
e -> CPReadException -> IO CPDocument
forall e a. Exception e => e -> IO a
throwIO (String -> CPError -> CPReadException
CPReadException String
cfgFile CPError
e)
              Right CPDocument
cp -> String -> String -> IO ()
writeFile String
cfgFile (CPDocument -> String
toStringCP CPDocument
cp) IO () -> IO CPDocument -> IO CPDocument
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CPDocument -> IO CPDocument
forall (m :: * -> *) a. Monad m => a -> m a
return CPDocument
cp

-- | Write the configuration in the 'CPDocument' to either the user supplied
-- configuration file path or to 'defaultB9ConfigFile'.
-- Create all missing (parent) directories.
writeB9CPDocument :: (HasCallStack, MonadIO m) => Maybe SystemPath -> CPDocument -> m ()
writeB9CPDocument :: Maybe SystemPath -> CPDocument -> m ()
writeB9CPDocument Maybe SystemPath
cfgFileIn CPDocument
cp = do
  String
cfgFile <- SystemPath -> m String
forall (m :: * -> *). MonadIO m => SystemPath -> m String
resolve (SystemPath -> Maybe SystemPath -> SystemPath
forall a. a -> Maybe a -> a
fromMaybe SystemPath
defaultB9ConfigFile Maybe SystemPath
cfgFileIn)
  String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
ensureDir String
cfgFile
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> String -> IO ()
writeFile String
cfgFile (CPDocument -> String
toStringCP CPDocument
cp))

defaultB9Config :: B9Config
defaultB9Config :: B9Config
defaultB9Config =
  B9Config :: Maybe LogLevel
-> Maybe String
-> Maybe String
-> Bool
-> Bool
-> Maybe SystemPath
-> Maybe String
-> Maybe Int
-> Maybe SystemdNspawnConfig
-> Maybe PodmanConfig
-> Maybe DockerConfig
-> Maybe LibVirtLXCConfig
-> Set RemoteRepo
-> Maybe Timeout
-> Maybe Int
-> [String]
-> B9Config
B9Config
    { _verbosity :: Maybe LogLevel
_verbosity = LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LogInfo,
      _logFile :: Maybe String
_logFile = Maybe String
forall a. Maybe a
Nothing,
      _projectRoot :: Maybe String
_projectRoot = Maybe String
forall a. Maybe a
Nothing,
      _keepTempDirs :: Bool
_keepTempDirs = Bool
False,
      _uniqueBuildDirs :: Bool
_uniqueBuildDirs = Bool
True,
      _repository :: Maybe String
_repository = Maybe String
forall a. Maybe a
Nothing,
      _repositoryCache :: Maybe SystemPath
_repositoryCache = SystemPath -> Maybe SystemPath
forall a. a -> Maybe a
Just SystemPath
defaultRepositoryCache,
      _maxLocalSharedImageRevisions :: Maybe Int
_maxLocalSharedImageRevisions = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2,
      _systemdNspawnConfigs :: Maybe SystemdNspawnConfig
_systemdNspawnConfigs = SystemdNspawnConfig -> Maybe SystemdNspawnConfig
forall a. a -> Maybe a
Just SystemdNspawnConfig
defaultSystemdNspawnConfig,
      _podmanConfigs :: Maybe PodmanConfig
_podmanConfigs = PodmanConfig -> Maybe PodmanConfig
forall a. a -> Maybe a
Just PodmanConfig
defaultPodmanConfig,
      _libVirtLXCConfigs :: Maybe LibVirtLXCConfig
_libVirtLXCConfigs = LibVirtLXCConfig -> Maybe LibVirtLXCConfig
forall a. a -> Maybe a
Just LibVirtLXCConfig
defaultLibVirtLXCConfig,
      _dockerConfigs :: Maybe DockerConfig
_dockerConfigs = DockerConfig -> Maybe DockerConfig
forall a. a -> Maybe a
Just DockerConfig
defaultDockerConfig,
      _remoteRepos :: Set RemoteRepo
_remoteRepos = Set RemoteRepo
forall a. Monoid a => a
mempty,
      _defaultTimeout :: Maybe Timeout
_defaultTimeout = Timeout -> Maybe Timeout
forall a. a -> Maybe a
Just (Int -> Timeout
TimeoutMicros (Int
3_600_000_000)),
      _timeoutFactor :: Maybe Int
_timeoutFactor = Maybe Int
forall a. Maybe a
Nothing,
      _ext4Attributes :: [String]
_ext4Attributes = []
    }

defaultRepositoryCache :: SystemPath
defaultRepositoryCache :: SystemPath
defaultRepositoryCache = String -> SystemPath
InB9UserDir String
"repo-cache"

defaultB9ConfigFile :: SystemPath
defaultB9ConfigFile :: SystemPath
defaultB9ConfigFile = String -> SystemPath
InB9UserDir String
"b9.conf"

verbosityK :: String
verbosityK :: String
verbosityK = String
"verbosity"

logFileK :: String
logFileK :: String
logFileK = String
"log_file"

projectRootK :: String
projectRootK :: String
projectRootK = String
"build_dir_root"

keepTempDirsK :: String
keepTempDirsK :: String
keepTempDirsK = String
"keep_temp_dirs"

uniqueBuildDirsK :: String
uniqueBuildDirsK :: String
uniqueBuildDirsK = String
"unique_build_dirs"

repositoryCacheK :: String
repositoryCacheK :: String
repositoryCacheK = String
"repository_cache"

maxLocalSharedImageRevisionsK :: String
maxLocalSharedImageRevisionsK :: String
maxLocalSharedImageRevisionsK = String
"max_cached_shared_images"

repositoryK :: String
repositoryK :: String
repositoryK = String
"repository"

defaultTimeoutK :: String
defaultTimeoutK :: String
defaultTimeoutK = String
"default_timeout_seconds"

timeoutFactorK :: String
timeoutFactorK :: String
timeoutFactorK = String
"timeout_factor"

cfgFileSection :: String
cfgFileSection :: String
cfgFileSection = String
"global"

ext4AttributesK :: String
ext4AttributesK :: String
ext4AttributesK = String
"ext4_attributes"


-- | Parse a 'B9Config', modify it, and merge it back to the given 'CPDocument'.
modifyCPDocument :: CPDocument -> Endo B9Config -> Either CPError CPDocument
modifyCPDocument :: CPDocument -> Endo B9Config -> Either CPError CPDocument
modifyCPDocument CPDocument
cp Endo B9Config
f = do
  B9Config
cfg <- HasCallStack => CPDocument -> Either CPError B9Config
CPDocument -> Either CPError B9Config
parseB9Config CPDocument
cp
  CPDocument
cp2 <- HasCallStack => B9Config -> Either CPError CPDocument
B9Config -> Either CPError CPDocument
b9ConfigToCPDocument (Endo B9Config -> B9Config -> B9Config
forall a. Endo a -> a -> a
appEndo Endo B9Config
f B9Config
cfg)
  CPDocument -> Either CPError CPDocument
forall (m :: * -> *) a. Monad m => a -> m a
return (CPDocument -> CPDocument -> CPDocument
mergeCP CPDocument
cp CPDocument
cp2)

-- | Append a config file section for the 'B9Config' to an empty 'CPDocument'.
b9ConfigToCPDocument :: HasCallStack => B9Config -> Either CPError CPDocument
b9ConfigToCPDocument :: B9Config -> Either CPError CPDocument
b9ConfigToCPDocument B9Config
c = do
  CPDocument
cp1 <- CPDocument -> String -> Either CPError CPDocument
forall (m :: * -> *).
MonadError CPError m =>
CPDocument -> String -> m CPDocument
addSectionCP CPDocument
emptyCP String
cfgFileSection
  CPDocument
cp2 <- CPDocument
-> String -> String -> Maybe LogLevel -> Either CPError CPDocument
forall a (m :: * -> *).
(Show a, MonadError CPError m) =>
CPDocument -> String -> String -> a -> m CPDocument
setShowCP CPDocument
cp1 String
cfgFileSection String
verbosityK (B9Config -> Maybe LogLevel
_verbosity B9Config
c)
  CPDocument
cp3 <- CPDocument
-> String -> String -> Maybe String -> Either CPError CPDocument
forall a (m :: * -> *).
(Show a, MonadError CPError m) =>
CPDocument -> String -> String -> a -> m CPDocument
setShowCP CPDocument
cp2 String
cfgFileSection String
logFileK (B9Config -> Maybe String
_logFile B9Config
c)
  CPDocument
cp4 <- CPDocument
-> String -> String -> Maybe String -> Either CPError CPDocument
forall a (m :: * -> *).
(Show a, MonadError CPError m) =>
CPDocument -> String -> String -> a -> m CPDocument
setShowCP CPDocument
cp3 String
cfgFileSection String
projectRootK (B9Config -> Maybe String
_projectRoot B9Config
c)
  CPDocument
cp5 <- CPDocument -> String -> String -> Bool -> Either CPError CPDocument
forall a (m :: * -> *).
(Show a, MonadError CPError m) =>
CPDocument -> String -> String -> a -> m CPDocument
setShowCP CPDocument
cp4 String
cfgFileSection String
keepTempDirsK (B9Config -> Bool
_keepTempDirs B9Config
c)
  CPDocument
cp7 <- CPDocument -> String -> String -> Bool -> Either CPError CPDocument
forall a (m :: * -> *).
(Show a, MonadError CPError m) =>
CPDocument -> String -> String -> a -> m CPDocument
setShowCP CPDocument
cp5 String
cfgFileSection String
uniqueBuildDirsK (B9Config -> Bool
_uniqueBuildDirs B9Config
c)
  CPDocument
cp8 <- CPDocument
-> String -> String -> Maybe Int -> Either CPError CPDocument
forall a (m :: * -> *).
(Show a, MonadError CPError m) =>
CPDocument -> String -> String -> a -> m CPDocument
setShowCP CPDocument
cp7 String
cfgFileSection String
maxLocalSharedImageRevisionsK (B9Config -> Maybe Int
_maxLocalSharedImageRevisions B9Config
c)
  CPDocument
cp9 <- CPDocument
-> String
-> String
-> Maybe SystemPath
-> Either CPError CPDocument
forall a (m :: * -> *).
(Show a, MonadError CPError m) =>
CPDocument -> String -> String -> a -> m CPDocument
setShowCP CPDocument
cp8 String
cfgFileSection String
repositoryCacheK (B9Config -> Maybe SystemPath
_repositoryCache B9Config
c)
  CPDocument
cpA <- ((CPDocument -> Either CPError CPDocument)
 -> (CPDocument -> Either CPError CPDocument)
 -> CPDocument
 -> Either CPError CPDocument)
-> (CPDocument -> Either CPError CPDocument)
-> Maybe (CPDocument -> Either CPError CPDocument)
-> CPDocument
-> Either CPError CPDocument
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (CPDocument -> Either CPError CPDocument)
-> (CPDocument -> Either CPError CPDocument)
-> CPDocument
-> Either CPError CPDocument
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
(>=>) CPDocument -> Either CPError CPDocument
forall (m :: * -> *) a. Monad m => a -> m a
return (SystemdNspawnConfig -> CPDocument -> Either CPError CPDocument
systemdNspawnConfigToCPDocument (SystemdNspawnConfig -> CPDocument -> Either CPError CPDocument)
-> Maybe SystemdNspawnConfig
-> Maybe (CPDocument -> Either CPError CPDocument)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> B9Config -> Maybe SystemdNspawnConfig
_systemdNspawnConfigs B9Config
c) CPDocument
cp9
  CPDocument
cpB <- ((CPDocument -> Either CPError CPDocument)
 -> (CPDocument -> Either CPError CPDocument)
 -> CPDocument
 -> Either CPError CPDocument)
-> (CPDocument -> Either CPError CPDocument)
-> Maybe (CPDocument -> Either CPError CPDocument)
-> CPDocument
-> Either CPError CPDocument
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (CPDocument -> Either CPError CPDocument)
-> (CPDocument -> Either CPError CPDocument)
-> CPDocument
-> Either CPError CPDocument
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
(>=>) CPDocument -> Either CPError CPDocument
forall (m :: * -> *) a. Monad m => a -> m a
return (PodmanConfig -> CPDocument -> Either CPError CPDocument
podmanConfigToCPDocument (PodmanConfig -> CPDocument -> Either CPError CPDocument)
-> Maybe PodmanConfig
-> Maybe (CPDocument -> Either CPError CPDocument)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> B9Config -> Maybe PodmanConfig
_podmanConfigs B9Config
c) CPDocument
cpA
  CPDocument
cpC <- ((CPDocument -> Either CPError CPDocument)
 -> (CPDocument -> Either CPError CPDocument)
 -> CPDocument
 -> Either CPError CPDocument)
-> (CPDocument -> Either CPError CPDocument)
-> Maybe (CPDocument -> Either CPError CPDocument)
-> CPDocument
-> Either CPError CPDocument
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (CPDocument -> Either CPError CPDocument)
-> (CPDocument -> Either CPError CPDocument)
-> CPDocument
-> Either CPError CPDocument
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
(>=>) CPDocument -> Either CPError CPDocument
forall (m :: * -> *) a. Monad m => a -> m a
return (DockerConfig -> CPDocument -> Either CPError CPDocument
dockerConfigToCPDocument (DockerConfig -> CPDocument -> Either CPError CPDocument)
-> Maybe DockerConfig
-> Maybe (CPDocument -> Either CPError CPDocument)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> B9Config -> Maybe DockerConfig
_dockerConfigs B9Config
c) CPDocument
cpB
  CPDocument
cpD <- ((CPDocument -> Either CPError CPDocument)
 -> (CPDocument -> Either CPError CPDocument)
 -> CPDocument
 -> Either CPError CPDocument)
-> (CPDocument -> Either CPError CPDocument)
-> Maybe (CPDocument -> Either CPError CPDocument)
-> CPDocument
-> Either CPError CPDocument
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (CPDocument -> Either CPError CPDocument)
-> (CPDocument -> Either CPError CPDocument)
-> CPDocument
-> Either CPError CPDocument
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
(>=>) CPDocument -> Either CPError CPDocument
forall (m :: * -> *) a. Monad m => a -> m a
return (LibVirtLXCConfig -> CPDocument -> Either CPError CPDocument
libVirtLXCConfigToCPDocument (LibVirtLXCConfig -> CPDocument -> Either CPError CPDocument)
-> Maybe LibVirtLXCConfig
-> Maybe (CPDocument -> Either CPError CPDocument)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> B9Config -> Maybe LibVirtLXCConfig
_libVirtLXCConfigs B9Config
c) CPDocument
cpC
  CPDocument
cpE <- ((CPDocument -> Either CPError CPDocument)
 -> (CPDocument -> Either CPError CPDocument)
 -> CPDocument
 -> Either CPError CPDocument)
-> (CPDocument -> Either CPError CPDocument)
-> [CPDocument -> Either CPError CPDocument]
-> CPDocument
-> Either CPError CPDocument
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (CPDocument -> Either CPError CPDocument)
-> (CPDocument -> Either CPError CPDocument)
-> CPDocument
-> Either CPError CPDocument
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
(>=>) CPDocument -> Either CPError CPDocument
forall (m :: * -> *) a. Monad m => a -> m a
return ( RemoteRepo -> CPDocument -> Either CPError CPDocument
remoteRepoToCPDocument (RemoteRepo -> CPDocument -> Either CPError CPDocument)
-> [RemoteRepo] -> [CPDocument -> Either CPError CPDocument]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set RemoteRepo -> [RemoteRepo]
forall a. Set a -> [a]
Set.toList (B9Config -> Set RemoteRepo
_remoteRepos B9Config
c)) CPDocument
cpD
  CPDocument
cpF <- CPDocument
-> String -> String -> Maybe String -> Either CPError CPDocument
forall a (m :: * -> *).
(Show a, MonadError CPError m) =>
CPDocument -> String -> String -> a -> m CPDocument
setShowCP CPDocument
cpE String
cfgFileSection String
repositoryK (B9Config -> Maybe String
_repository B9Config
c)  
  CPDocument
cpG <- Either CPError CPDocument
-> (Int -> Either CPError CPDocument)
-> Maybe Int
-> Either CPError CPDocument
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CPDocument -> Either CPError CPDocument
forall (f :: * -> *) a. Applicative f => a -> f a
pure CPDocument
cpF) (CPDocument -> String -> String -> Int -> Either CPError CPDocument
forall a (m :: * -> *).
(Show a, MonadError CPError m) =>
CPDocument -> String -> String -> a -> m CPDocument
setShowCP CPDocument
cpF String
cfgFileSection String
defaultTimeoutK) 
              ( case B9Config -> Maybe Timeout
_defaultTimeout B9Config
c of 
                    Just (TimeoutMicros Int
t) ->
                      Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
t Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
1_000_000)
                    Maybe Timeout
Nothing -> Maybe Int
forall a. Maybe a
Nothing
              )
  CPDocument
cpH <- Either CPError CPDocument
-> (Int -> Either CPError CPDocument)
-> Maybe Int
-> Either CPError CPDocument
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CPDocument -> Either CPError CPDocument
forall (f :: * -> *) a. Applicative f => a -> f a
pure CPDocument
cpG) (CPDocument -> String -> String -> Int -> Either CPError CPDocument
forall a (m :: * -> *).
(Show a, MonadError CPError m) =>
CPDocument -> String -> String -> a -> m CPDocument
setShowCP CPDocument
cpG String
cfgFileSection String
timeoutFactorK) (B9Config -> Maybe Int
_timeoutFactor B9Config
c)
  CPDocument
cpFinal <- CPDocument
-> String -> String -> [String] -> Either CPError CPDocument
forall a (m :: * -> *).
(Show a, MonadError CPError m) =>
CPDocument -> String -> String -> a -> m CPDocument
setShowCP CPDocument
cpH String
cfgFileSection String
ext4AttributesK (B9Config -> [String]
_ext4Attributes B9Config
c)
  CPDocument -> Either CPError CPDocument
forall (m :: * -> *) a. Monad m => a -> m a
return CPDocument
cpFinal

readB9Config :: (HasCallStack, MonadIO m) => Maybe SystemPath -> m CPDocument
readB9Config :: Maybe SystemPath -> m CPDocument
readB9Config Maybe SystemPath
cfgFile = SystemPath -> m CPDocument
forall (m :: * -> *). MonadIO m => SystemPath -> m CPDocument
readCPDocument (SystemPath -> Maybe SystemPath -> SystemPath
forall a. a -> Maybe a -> a
fromMaybe SystemPath
defaultB9ConfigFile Maybe SystemPath
cfgFile)

defaultExt4Attributes :: [String]
defaultExt4Attributes :: [String]
defaultExt4Attributes = [String
"^64bit"]

parseB9Config :: HasCallStack => CPDocument -> Either CPError B9Config
parseB9Config :: CPDocument -> Either CPError B9Config
parseB9Config CPDocument
cp =
  let getr :: (CPGet a) => CPOptionSpec -> Either CPError a
      getr :: String -> Either CPError a
getr = CPDocument -> String -> String -> Either CPError a
forall a (m :: * -> *).
(CPGet a, MonadError CPError m) =>
CPDocument -> String -> String -> m a
readCP CPDocument
cp String
cfgFileSection
   in Maybe LogLevel
-> Maybe String
-> Maybe String
-> Bool
-> Bool
-> Maybe SystemPath
-> Maybe String
-> Maybe Int
-> Maybe SystemdNspawnConfig
-> Maybe PodmanConfig
-> Maybe DockerConfig
-> Maybe LibVirtLXCConfig
-> Set RemoteRepo
-> Maybe Timeout
-> Maybe Int
-> [String]
-> B9Config
B9Config 
        (Maybe LogLevel
 -> Maybe String
 -> Maybe String
 -> Bool
 -> Bool
 -> Maybe SystemPath
 -> Maybe String
 -> Maybe Int
 -> Maybe SystemdNspawnConfig
 -> Maybe PodmanConfig
 -> Maybe DockerConfig
 -> Maybe LibVirtLXCConfig
 -> Set RemoteRepo
 -> Maybe Timeout
 -> Maybe Int
 -> [String]
 -> B9Config)
-> Either CPError (Maybe LogLevel)
-> Either
     CPError
     (Maybe String
      -> Maybe String
      -> Bool
      -> Bool
      -> Maybe SystemPath
      -> Maybe String
      -> Maybe Int
      -> Maybe SystemdNspawnConfig
      -> Maybe PodmanConfig
      -> Maybe DockerConfig
      -> Maybe LibVirtLXCConfig
      -> Set RemoteRepo
      -> Maybe Timeout
      -> Maybe Int
      -> [String]
      -> B9Config)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either CPError (Maybe LogLevel)
forall a. CPGet a => String -> Either CPError a
getr String
verbosityK 
        Either
  CPError
  (Maybe String
   -> Maybe String
   -> Bool
   -> Bool
   -> Maybe SystemPath
   -> Maybe String
   -> Maybe Int
   -> Maybe SystemdNspawnConfig
   -> Maybe PodmanConfig
   -> Maybe DockerConfig
   -> Maybe LibVirtLXCConfig
   -> Set RemoteRepo
   -> Maybe Timeout
   -> Maybe Int
   -> [String]
   -> B9Config)
-> Either CPError (Maybe String)
-> Either
     CPError
     (Maybe String
      -> Bool
      -> Bool
      -> Maybe SystemPath
      -> Maybe String
      -> Maybe Int
      -> Maybe SystemdNspawnConfig
      -> Maybe PodmanConfig
      -> Maybe DockerConfig
      -> Maybe LibVirtLXCConfig
      -> Set RemoteRepo
      -> Maybe Timeout
      -> Maybe Int
      -> [String]
      -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Either CPError (Maybe String)
forall a. CPGet a => String -> Either CPError a
getr String
logFileK 
        Either
  CPError
  (Maybe String
   -> Bool
   -> Bool
   -> Maybe SystemPath
   -> Maybe String
   -> Maybe Int
   -> Maybe SystemdNspawnConfig
   -> Maybe PodmanConfig
   -> Maybe DockerConfig
   -> Maybe LibVirtLXCConfig
   -> Set RemoteRepo
   -> Maybe Timeout
   -> Maybe Int
   -> [String]
   -> B9Config)
-> Either CPError (Maybe String)
-> Either
     CPError
     (Bool
      -> Bool
      -> Maybe SystemPath
      -> Maybe String
      -> Maybe Int
      -> Maybe SystemdNspawnConfig
      -> Maybe PodmanConfig
      -> Maybe DockerConfig
      -> Maybe LibVirtLXCConfig
      -> Set RemoteRepo
      -> Maybe Timeout
      -> Maybe Int
      -> [String]
      -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Either CPError (Maybe String)
forall a. CPGet a => String -> Either CPError a
getr String
projectRootK 
        Either
  CPError
  (Bool
   -> Bool
   -> Maybe SystemPath
   -> Maybe String
   -> Maybe Int
   -> Maybe SystemdNspawnConfig
   -> Maybe PodmanConfig
   -> Maybe DockerConfig
   -> Maybe LibVirtLXCConfig
   -> Set RemoteRepo
   -> Maybe Timeout
   -> Maybe Int
   -> [String]
   -> B9Config)
-> Either CPError Bool
-> Either
     CPError
     (Bool
      -> Maybe SystemPath
      -> Maybe String
      -> Maybe Int
      -> Maybe SystemdNspawnConfig
      -> Maybe PodmanConfig
      -> Maybe DockerConfig
      -> Maybe LibVirtLXCConfig
      -> Set RemoteRepo
      -> Maybe Timeout
      -> Maybe Int
      -> [String]
      -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Either CPError Bool
forall a. CPGet a => String -> Either CPError a
getr String
keepTempDirsK
        Either
  CPError
  (Bool
   -> Maybe SystemPath
   -> Maybe String
   -> Maybe Int
   -> Maybe SystemdNspawnConfig
   -> Maybe PodmanConfig
   -> Maybe DockerConfig
   -> Maybe LibVirtLXCConfig
   -> Set RemoteRepo
   -> Maybe Timeout
   -> Maybe Int
   -> [String]
   -> B9Config)
-> Either CPError Bool
-> Either
     CPError
     (Maybe SystemPath
      -> Maybe String
      -> Maybe Int
      -> Maybe SystemdNspawnConfig
      -> Maybe PodmanConfig
      -> Maybe DockerConfig
      -> Maybe LibVirtLXCConfig
      -> Set RemoteRepo
      -> Maybe Timeout
      -> Maybe Int
      -> [String]
      -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Either CPError Bool
forall a. CPGet a => String -> Either CPError a
getr String
uniqueBuildDirsK
        Either
  CPError
  (Maybe SystemPath
   -> Maybe String
   -> Maybe Int
   -> Maybe SystemdNspawnConfig
   -> Maybe PodmanConfig
   -> Maybe DockerConfig
   -> Maybe LibVirtLXCConfig
   -> Set RemoteRepo
   -> Maybe Timeout
   -> Maybe Int
   -> [String]
   -> B9Config)
-> Either CPError (Maybe SystemPath)
-> Either
     CPError
     (Maybe String
      -> Maybe Int
      -> Maybe SystemdNspawnConfig
      -> Maybe PodmanConfig
      -> Maybe DockerConfig
      -> Maybe LibVirtLXCConfig
      -> Set RemoteRepo
      -> Maybe Timeout
      -> Maybe Int
      -> [String]
      -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Either CPError (Maybe SystemPath)
forall a. CPGet a => String -> Either CPError a
getr String
repositoryCacheK
        Either
  CPError
  (Maybe String
   -> Maybe Int
   -> Maybe SystemdNspawnConfig
   -> Maybe PodmanConfig
   -> Maybe DockerConfig
   -> Maybe LibVirtLXCConfig
   -> Set RemoteRepo
   -> Maybe Timeout
   -> Maybe Int
   -> [String]
   -> B9Config)
-> Either CPError (Maybe String)
-> Either
     CPError
     (Maybe Int
      -> Maybe SystemdNspawnConfig
      -> Maybe PodmanConfig
      -> Maybe DockerConfig
      -> Maybe LibVirtLXCConfig
      -> Set RemoteRepo
      -> Maybe Timeout
      -> Maybe Int
      -> [String]
      -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Either CPError (Maybe String)
forall a. CPGet a => String -> Either CPError a
getr String
repositoryK
        Either
  CPError
  (Maybe Int
   -> Maybe SystemdNspawnConfig
   -> Maybe PodmanConfig
   -> Maybe DockerConfig
   -> Maybe LibVirtLXCConfig
   -> Set RemoteRepo
   -> Maybe Timeout
   -> Maybe Int
   -> [String]
   -> B9Config)
-> Either CPError (Maybe Int)
-> Either
     CPError
     (Maybe SystemdNspawnConfig
      -> Maybe PodmanConfig
      -> Maybe DockerConfig
      -> Maybe LibVirtLXCConfig
      -> Set RemoteRepo
      -> Maybe Timeout
      -> Maybe Int
      -> [String]
      -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int -> Either CPError (Maybe Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((CPError -> Maybe Int)
-> (Maybe Int -> Maybe Int)
-> Either CPError (Maybe Int)
-> Maybe Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Int -> CPError -> Maybe Int
forall a b. a -> b -> a
const Maybe Int
forall a. Maybe a
Nothing) Maybe Int -> Maybe Int
forall a. a -> a
id (String -> Either CPError (Maybe Int)
forall a. CPGet a => String -> Either CPError a
getr String
maxLocalSharedImageRevisionsK))
        Either
  CPError
  (Maybe SystemdNspawnConfig
   -> Maybe PodmanConfig
   -> Maybe DockerConfig
   -> Maybe LibVirtLXCConfig
   -> Set RemoteRepo
   -> Maybe Timeout
   -> Maybe Int
   -> [String]
   -> B9Config)
-> Either CPError (Maybe SystemdNspawnConfig)
-> Either
     CPError
     (Maybe PodmanConfig
      -> Maybe DockerConfig
      -> Maybe LibVirtLXCConfig
      -> Set RemoteRepo
      -> Maybe Timeout
      -> Maybe Int
      -> [String]
      -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe SystemdNspawnConfig
-> Either CPError (Maybe SystemdNspawnConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((CPError -> Maybe SystemdNspawnConfig)
-> (SystemdNspawnConfig -> Maybe SystemdNspawnConfig)
-> Either CPError SystemdNspawnConfig
-> Maybe SystemdNspawnConfig
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe SystemdNspawnConfig -> CPError -> Maybe SystemdNspawnConfig
forall a b. a -> b -> a
const Maybe SystemdNspawnConfig
forall a. Maybe a
Nothing) SystemdNspawnConfig -> Maybe SystemdNspawnConfig
forall a. a -> Maybe a
Just (CPDocument -> Either CPError SystemdNspawnConfig
parseSystemdNspawnConfig CPDocument
cp))
        Either
  CPError
  (Maybe PodmanConfig
   -> Maybe DockerConfig
   -> Maybe LibVirtLXCConfig
   -> Set RemoteRepo
   -> Maybe Timeout
   -> Maybe Int
   -> [String]
   -> B9Config)
-> Either CPError (Maybe PodmanConfig)
-> Either
     CPError
     (Maybe DockerConfig
      -> Maybe LibVirtLXCConfig
      -> Set RemoteRepo
      -> Maybe Timeout
      -> Maybe Int
      -> [String]
      -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe PodmanConfig -> Either CPError (Maybe PodmanConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((CPError -> Maybe PodmanConfig)
-> (PodmanConfig -> Maybe PodmanConfig)
-> Either CPError PodmanConfig
-> Maybe PodmanConfig
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe PodmanConfig -> CPError -> Maybe PodmanConfig
forall a b. a -> b -> a
const Maybe PodmanConfig
forall a. Maybe a
Nothing) PodmanConfig -> Maybe PodmanConfig
forall a. a -> Maybe a
Just (CPDocument -> Either CPError PodmanConfig
parsePodmanConfig CPDocument
cp))
        Either
  CPError
  (Maybe DockerConfig
   -> Maybe LibVirtLXCConfig
   -> Set RemoteRepo
   -> Maybe Timeout
   -> Maybe Int
   -> [String]
   -> B9Config)
-> Either CPError (Maybe DockerConfig)
-> Either
     CPError
     (Maybe LibVirtLXCConfig
      -> Set RemoteRepo
      -> Maybe Timeout
      -> Maybe Int
      -> [String]
      -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe DockerConfig -> Either CPError (Maybe DockerConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((CPError -> Maybe DockerConfig)
-> (DockerConfig -> Maybe DockerConfig)
-> Either CPError DockerConfig
-> Maybe DockerConfig
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe DockerConfig -> CPError -> Maybe DockerConfig
forall a b. a -> b -> a
const Maybe DockerConfig
forall a. Maybe a
Nothing) DockerConfig -> Maybe DockerConfig
forall a. a -> Maybe a
Just (CPDocument -> Either CPError DockerConfig
parseDockerConfig CPDocument
cp))
        Either
  CPError
  (Maybe LibVirtLXCConfig
   -> Set RemoteRepo
   -> Maybe Timeout
   -> Maybe Int
   -> [String]
   -> B9Config)
-> Either CPError (Maybe LibVirtLXCConfig)
-> Either
     CPError
     (Set RemoteRepo
      -> Maybe Timeout -> Maybe Int -> [String] -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe LibVirtLXCConfig -> Either CPError (Maybe LibVirtLXCConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((CPError -> Maybe LibVirtLXCConfig)
-> (LibVirtLXCConfig -> Maybe LibVirtLXCConfig)
-> Either CPError LibVirtLXCConfig
-> Maybe LibVirtLXCConfig
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe LibVirtLXCConfig -> CPError -> Maybe LibVirtLXCConfig
forall a b. a -> b -> a
const Maybe LibVirtLXCConfig
forall a. Maybe a
Nothing) LibVirtLXCConfig -> Maybe LibVirtLXCConfig
forall a. a -> Maybe a
Just (CPDocument -> Either CPError LibVirtLXCConfig
parseLibVirtLXCConfig CPDocument
cp))
        Either
  CPError
  (Set RemoteRepo
   -> Maybe Timeout -> Maybe Int -> [String] -> B9Config)
-> Either CPError (Set RemoteRepo)
-> Either
     CPError (Maybe Timeout -> Maybe Int -> [String] -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([RemoteRepo] -> Set RemoteRepo
forall a. Ord a => [a] -> Set a
Set.fromList ([RemoteRepo] -> Set RemoteRepo)
-> Either CPError [RemoteRepo] -> Either CPError (Set RemoteRepo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CPDocument -> Either CPError [RemoteRepo]
parseRemoteRepos CPDocument
cp)
        Either CPError (Maybe Timeout -> Maybe Int -> [String] -> B9Config)
-> Either CPError (Maybe Timeout)
-> Either CPError (Maybe Int -> [String] -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Timeout -> Either CPError (Maybe Timeout)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((CPError -> Maybe Timeout)
-> (Timeout -> Maybe Timeout)
-> Either CPError Timeout
-> Maybe Timeout
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Timeout -> CPError -> Maybe Timeout
forall a b. a -> b -> a
const Maybe Timeout
forall a. Maybe a
Nothing) Timeout -> Maybe Timeout
forall a. a -> Maybe a
Just (CPDocument -> Either CPError Timeout
parseDefaultTimeoutConfig CPDocument
cp))
        Either CPError (Maybe Int -> [String] -> B9Config)
-> Either CPError (Maybe Int)
-> Either CPError ([String] -> B9Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int -> Either CPError (Maybe Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((CPError -> Maybe Int)
-> (Int -> Maybe Int) -> Either CPError Int -> Maybe Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Int -> CPError -> Maybe Int
forall a b. a -> b -> a
const Maybe Int
forall a. Maybe a
Nothing) Int -> Maybe Int
forall a. a -> Maybe a
Just (String -> Either CPError Int
forall a. CPGet a => String -> Either CPError a
getr String
timeoutFactorK))
        Either CPError ([String] -> B9Config)
-> Either CPError [String] -> Either CPError B9Config
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [String] -> Either CPError [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((CPError -> [String])
-> ([String] -> [String]) -> Either CPError [String] -> [String]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([String] -> CPError -> [String]
forall a b. a -> b -> a
const [String]
defaultExt4Attributes) [String] -> [String]
forall a. a -> a
id (String -> Either CPError [String]
forall a. CPGet a => String -> Either CPError a
getr String
ext4AttributesK)) -- TODO: Differentiate (NoOption _, _) from others

parseDefaultTimeoutConfig :: CPDocument -> Either CPError Timeout
parseDefaultTimeoutConfig :: CPDocument -> Either CPError Timeout
parseDefaultTimeoutConfig CPDocument
cp = do
  Int
seconds <- CPDocument -> String -> String -> Either CPError Int
forall a (m :: * -> *).
(CPGet a, MonadError CPError m) =>
CPDocument -> String -> String -> m a
readCP CPDocument
cp String
cfgFileSection String
defaultTimeoutK
  let mu :: Int
mu = Int
seconds Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1_000_000
  Timeout -> Either CPError Timeout
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Timeout
TimeoutMicros Int
mu)