-- |
-- Mostly effectful functions to assemble artifacts.
module B9.Artifact.Readable.Interpreter
  ( buildArtifacts,
    assemble,
    getArtifactOutputFiles,
    runArtifactGenerator,
    runArtifactAssembly,
    InstanceGenerator (..),
    runInstanceGenerator,
    InstanceSources (..),
  )
where

import B9.Artifact.Content
import B9.Artifact.Content.Readable
import B9.Artifact.Content.StringTemplate
import B9.Artifact.Readable
import B9.B9Config
import B9.B9Error
import B9.B9Exec
import B9.B9Logging
import B9.B9Monad
import B9.BuildInfo
import B9.DiskImageBuilder
import B9.Environment
import B9.Text
import B9.Vm
import B9.VmBuilder
import Control.Arrow
import Control.Eff as Eff
import Control.Eff.Reader.Lazy as Eff
import Control.Eff.Writer.Lazy as Eff
import Control.Exception
  ( SomeException,
    displayException,
  )
import Control.Monad
import Control.Monad.IO.Class
import Data.Data
import Data.Generics.Aliases
import Data.Generics.Schemes
import Data.List
import Data.String
import System.Directory
import System.FilePath
import System.IO.B9Extras
  ( ensureDir,
    getDirectoryFiles,
  )
import Text.Printf
import Text.Show.Pretty (ppShow)

-- | Execute an 'ArtifactGenerator' and return a 'B9Invocation' that returns
-- the build id obtained by 'getBuildId'.
buildArtifacts :: ArtifactGenerator -> B9 String
buildArtifacts :: ArtifactGenerator -> B9 String
buildArtifacts ArtifactGenerator
artifactGenerator = do
  String -> Eff B9Eff ()
forall (e :: [* -> *]). CommandIO e => String -> Eff e ()
traceL (String -> Eff B9Eff ())
-> (String -> String) -> String -> Eff B9Eff ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"CWD: " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> Eff B9Eff ()) -> B9 String -> Eff B9Eff ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String -> B9 String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getCurrentDirectory
  String -> Eff B9Eff ()
forall (e :: [* -> *]). CommandIO e => String -> Eff e ()
infoL String
"BUILDING ARTIFACTS"
  Eff B9Eff B9Config
forall (e :: [* -> *]). Member B9ConfigReader e => Eff e B9Config
getConfig Eff B9Eff B9Config -> (B9Config -> Eff B9Eff ()) -> Eff B9Eff ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Eff B9Eff ()
forall (e :: [* -> *]). CommandIO e => String -> Eff e ()
traceL (String -> Eff B9Eff ())
-> (B9Config -> String) -> B9Config -> Eff B9Eff ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall r. PrintfType r => String -> r
printf String
"USING BUILD CONFIGURATION: %v" (String -> String) -> (B9Config -> String) -> B9Config -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. B9Config -> String
forall a. Show a => a -> String
ppShow
  [AssembledArtifact]
_ <- ArtifactGenerator -> B9 [AssembledArtifact]
assemble ArtifactGenerator
artifactGenerator
  B9 String
forall (e :: [* -> *]). Member BuildInfoReader e => Eff e String
getBuildId

-- | Return a list of relative paths for the /local/ files to be generated
-- by the ArtifactGenerator. This excludes 'Shared' and Transient image targets.
getArtifactOutputFiles :: ArtifactGenerator -> Either SomeException [FilePath]
getArtifactOutputFiles :: ArtifactGenerator -> Either SomeException [String]
getArtifactOutputFiles ArtifactGenerator
g =
  (InstanceGenerator [TextFileWriter] -> [String])
-> [InstanceGenerator [TextFileWriter]] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap InstanceGenerator [TextFileWriter] -> [String]
getOutputs
    ([InstanceGenerator [TextFileWriter]] -> [String])
-> Either SomeException [InstanceGenerator [TextFileWriter]]
-> Either SomeException [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Environment
-> String
-> String
-> ArtifactGenerator
-> Either SomeException [InstanceGenerator [TextFileWriter]]
runArtifactGenerator Environment
forall a. Monoid a => a
mempty String
"no build-id" String
"no build-date" ArtifactGenerator
g
  where
    getOutputs :: InstanceGenerator [TextFileWriter] -> [String]
getOutputs (IG InstanceId
_ [TextFileWriter]
sgs ArtifactAssembly
a) =
      let toOutFile :: AssemblyOutput -> [String]
toOutFile (AssemblyGeneratesOutputFiles [String]
fs) = [String]
fs
          toOutFile (AssemblyCopiesSourcesToDirectory String
pd) =
            let sourceFiles :: [String]
sourceFiles = TextFileWriter -> String
textFileWriterOutputFile (TextFileWriter -> String) -> [TextFileWriter] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TextFileWriter]
sgs
             in (String
pd String -> String -> String
</>) (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
sourceFiles
       in ArtifactAssembly -> [AssemblyOutput]
getAssemblyOutput ArtifactAssembly
a [AssemblyOutput] -> (AssemblyOutput -> [String]) -> [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AssemblyOutput -> [String]
toOutFile

-- | Run an artifact generator to produce the artifacts.
assemble :: ArtifactGenerator -> B9 [AssembledArtifact]
assemble :: ArtifactGenerator -> B9 [AssembledArtifact]
assemble ArtifactGenerator
artGen = do
  Environment
b9cfgEnvVars <- Eff B9Eff Environment
forall (e :: [* -> *]).
Member EnvironmentReader e =>
Eff e Environment
askEnvironment
  String
buildId <- B9 String
forall (e :: [* -> *]). Member BuildInfoReader e => Eff e String
getBuildId
  String
buildDate <- B9 String
forall (e :: [* -> *]). Member BuildInfoReader e => Eff e String
getBuildDate
  InstanceSources
-> Eff (ArtifactSourcesReader : B9Eff) [AssembledArtifact]
-> B9 [AssembledArtifact]
forall (e :: [* -> *]) a.
Member EnvironmentReader e =>
InstanceSources -> Eff (ArtifactSourcesReader : e) a -> Eff e a
runArtifactSourcesReader (Environment -> [ArtifactSource] -> InstanceSources
InstanceSources Environment
b9cfgEnvVars [ArtifactSource]
forall a. Monoid a => a
mempty) (Eff (ArtifactSourcesReader : B9Eff) [AssembledArtifact]
 -> B9 [AssembledArtifact])
-> Eff (ArtifactSourcesReader : B9Eff) [AssembledArtifact]
-> B9 [AssembledArtifact]
forall a b. (a -> b) -> a -> b
$ do
    [InstanceGenerator [TextFileWriter]]
is <- String
-> String
-> ArtifactGenerator
-> Eff
     (ArtifactSourcesReader : B9Eff)
     [InstanceGenerator [TextFileWriter]]
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
String
-> String
-> ArtifactGenerator
-> Eff
     (ArtifactSourcesReader : e) [InstanceGenerator [TextFileWriter]]
evalArtifactGenerator String
buildId String
buildDate ArtifactGenerator
artGen
    [InstanceGenerator [TextFileWriter]]
-> Eff (ArtifactSourcesReader : B9Eff) [AssembledArtifact]
forall (e :: [* -> *]).
IsB9 e =>
[InstanceGenerator [TextFileWriter]] -> Eff e [AssembledArtifact]
createAssembledArtifacts [InstanceGenerator [TextFileWriter]]
is

-- | Interpret an 'ArtifactGenerator' into a list of simple commands, i.e. 'InstanceGenerator's
--
-- @since 0.5.65
runArtifactGenerator ::
  Environment ->
  String ->
  String ->
  ArtifactGenerator ->
  Either SomeException [InstanceGenerator [TextFileWriter]]
runArtifactGenerator :: Environment
-> String
-> String
-> ArtifactGenerator
-> Either SomeException [InstanceGenerator [TextFileWriter]]
runArtifactGenerator Environment
initialEnvironment String
buildId String
buildData ArtifactGenerator
generator =
  Eff '[] (Either SomeException [InstanceGenerator [TextFileWriter]])
-> Either SomeException [InstanceGenerator [TextFileWriter]]
forall w. Eff '[] w -> w
Eff.run
    ( Eff '[ExcB9] [InstanceGenerator [TextFileWriter]]
-> Eff
     '[] (Either SomeException [InstanceGenerator [TextFileWriter]])
forall (e :: [* -> *]) a.
Eff (ExcB9 : e) a -> Eff e (Either SomeException a)
runExcB9
        ( Environment
-> Eff
     '[EnvironmentReader, ExcB9] [InstanceGenerator [TextFileWriter]]
-> Eff '[ExcB9] [InstanceGenerator [TextFileWriter]]
forall (e :: [* -> *]) a.
Environment -> Eff (EnvironmentReader : e) a -> Eff e a
runEnvironmentReader
            Environment
initialEnvironment
            ( InstanceSources
-> Eff
     '[ArtifactSourcesReader, EnvironmentReader, ExcB9]
     [InstanceGenerator [TextFileWriter]]
-> Eff
     '[EnvironmentReader, ExcB9] [InstanceGenerator [TextFileWriter]]
forall (e :: [* -> *]) a.
Member EnvironmentReader e =>
InstanceSources -> Eff (ArtifactSourcesReader : e) a -> Eff e a
runArtifactSourcesReader
                (Environment -> [ArtifactSource] -> InstanceSources
InstanceSources Environment
initialEnvironment [ArtifactSource]
forall a. Monoid a => a
mempty)
                (String
-> String
-> ArtifactGenerator
-> Eff
     '[ArtifactSourcesReader, EnvironmentReader, ExcB9]
     [InstanceGenerator [TextFileWriter]]
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
String
-> String
-> ArtifactGenerator
-> Eff
     (ArtifactSourcesReader : e) [InstanceGenerator [TextFileWriter]]
evalArtifactGenerator String
buildId String
buildData ArtifactGenerator
generator)
            )
        )
    )

-- | Evaluate an 'ArtifactGenerator' into a list of low-level build instructions
-- that can be built with 'createAssembledArtifacts'.
evalArtifactGenerator ::
  (Member ExcB9 e, Member EnvironmentReader e) =>
  String ->
  String ->
  ArtifactGenerator ->
  Eff
    (ArtifactSourcesReader ': e)
    [InstanceGenerator [TextFileWriter]]
evalArtifactGenerator :: String
-> String
-> ArtifactGenerator
-> Eff
     (ArtifactSourcesReader : e) [InstanceGenerator [TextFileWriter]]
evalArtifactGenerator String
buildId String
buildDate ArtifactGenerator
artGen =
  [(String, String)]
-> Eff
     (ArtifactSourcesReader : e) [InstanceGenerator [TextFileWriter]]
-> Eff
     (ArtifactSourcesReader : e) [InstanceGenerator [TextFileWriter]]
forall (e :: [* -> *]) s.
(Member EnvironmentReader e, Member ExcB9 e) =>
[(String, String)] -> Eff e s -> Eff e s
withSubstitutedStringBindings
    [(String
buildDateKey, String
buildDate), (String
buildIdKey, String
buildId)]
    (Eff (ArtifactInterpreter e) ()
-> Eff
     (ArtifactSourcesReader : e) [InstanceGenerator [TextFileWriter]]
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
Eff (ArtifactInterpreter e) ()
-> Eff
     (ArtifactSourcesReader : e) [InstanceGenerator [TextFileWriter]]
runArtifactInterpreter (ArtifactGenerator -> Eff (ArtifactInterpreter e) ()
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
ArtifactGenerator -> Eff (ArtifactInterpreter e) ()
interpretGenerator ArtifactGenerator
artGen))
    Eff
  (ArtifactSourcesReader : e) [InstanceGenerator [TextFileWriter]]
-> (SomeException
    -> Eff
         (ArtifactSourcesReader : e) [InstanceGenerator [TextFileWriter]])
-> Eff
     (ArtifactSourcesReader : e) [InstanceGenerator [TextFileWriter]]
forall (e :: [* -> *]) a.
Member ExcB9 e =>
Eff e a -> (SomeException -> Eff e a) -> Eff e a
`catchB9Error` ( String
-> Eff
     (ArtifactSourcesReader : e) [InstanceGenerator [TextFileWriter]]
forall (e :: [* -> *]) a. Member ExcB9 e => String -> Eff e a
throwB9Error
                       (String
 -> Eff
      (ArtifactSourcesReader : e) [InstanceGenerator [TextFileWriter]])
-> (SomeException -> String)
-> SomeException
-> Eff
     (ArtifactSourcesReader : e) [InstanceGenerator [TextFileWriter]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Failed to eval:\n%s\nError: %s" (ArtifactGenerator -> String
forall a. Show a => a -> String
ppShow ArtifactGenerator
artGen)
                       (String -> String)
-> (SomeException -> String) -> SomeException -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall e. Exception e => e -> String
displayException
                   )

type ArtifactSourcesReader = Reader [ArtifactSource]

runArtifactSourcesReader ::
  Member EnvironmentReader e =>
  InstanceSources ->
  Eff (ArtifactSourcesReader ': e) a ->
  Eff e a
runArtifactSourcesReader :: InstanceSources -> Eff (ArtifactSourcesReader : e) a -> Eff e a
runArtifactSourcesReader InstanceSources
x Eff (ArtifactSourcesReader : e) a
y =
  [ArtifactSource] -> Eff (ArtifactSourcesReader : e) a -> Eff e a
forall e (r :: [* -> *]) w. e -> Eff (Reader e : r) w -> Eff r w
runReader (InstanceSources -> [ArtifactSource]
isSources InstanceSources
x) ((Environment -> Environment)
-> Eff (ArtifactSourcesReader : e) a
-> Eff (ArtifactSourcesReader : e) a
forall (e :: [* -> *]) a.
Member EnvironmentReader e =>
(Environment -> Environment) -> Eff e a -> Eff e a
localEnvironment (Environment -> Environment -> Environment
forall a b. a -> b -> a
const (InstanceSources -> Environment
isEnv InstanceSources
x)) Eff (ArtifactSourcesReader : e) a
y)

-- | Monad for creating Instance generators.
type ArtifactInterpreter e =
  Writer [InstanceGenerator InstanceSources] : ArtifactSourcesReader : e

runArtifactInterpreter ::
  (Member ExcB9 e, Member EnvironmentReader e) =>
  Eff (ArtifactInterpreter e) () ->
  Eff (ArtifactSourcesReader : e) [InstanceGenerator [TextFileWriter]]
runArtifactInterpreter :: Eff (ArtifactInterpreter e) ()
-> Eff
     (ArtifactSourcesReader : e) [InstanceGenerator [TextFileWriter]]
runArtifactInterpreter Eff (ArtifactInterpreter e) ()
ai = do
  ((), [InstanceGenerator InstanceSources]
igs) <- Eff (ArtifactInterpreter e) ()
-> Eff
     (ArtifactSourcesReader : e)
     ((), [InstanceGenerator InstanceSources])
forall w (r :: [* -> *]) a.
Monoid w =>
Eff (Writer w : r) a -> Eff r (a, w)
runMonoidWriter Eff (ArtifactInterpreter e) ()
ai
  (InstanceGenerator InstanceSources
 -> Eff
      (ArtifactSourcesReader : e) (InstanceGenerator [TextFileWriter]))
-> [InstanceGenerator InstanceSources]
-> Eff
     (ArtifactSourcesReader : e) [InstanceGenerator [TextFileWriter]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse InstanceGenerator InstanceSources
-> Eff
     (ArtifactSourcesReader : e) (InstanceGenerator [TextFileWriter])
forall (e :: [* -> *]).
Member ExcB9 e =>
InstanceGenerator InstanceSources
-> Eff e (InstanceGenerator [TextFileWriter])
toFileInstanceGenerator [InstanceGenerator InstanceSources]
igs

-- | Parse an 'ArtifactGenerator' inside the 'ArtifactInterpreter' effect.
interpretGenerator ::
  (Member ExcB9 e, Member EnvironmentReader e) =>
  ArtifactGenerator ->
  Eff (ArtifactInterpreter e) ()
interpretGenerator :: ArtifactGenerator -> Eff (ArtifactInterpreter e) ()
interpretGenerator ArtifactGenerator
generatorIn = case ArtifactGenerator
generatorIn of
  Sources [ArtifactSource]
sources [ArtifactGenerator]
generators ->
    [ArtifactSource]
-> Eff (ArtifactInterpreter e) () -> Eff (ArtifactInterpreter e) ()
forall (e :: [* -> *]) s.
(Member ExcB9 e, Member EnvironmentReader e) =>
[ArtifactSource]
-> Eff (ArtifactInterpreter e) s -> Eff (ArtifactInterpreter e) s
withArtifactSources [ArtifactSource]
sources ((ArtifactGenerator -> Eff (ArtifactInterpreter e) ())
-> [ArtifactGenerator] -> Eff (ArtifactInterpreter e) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ArtifactGenerator -> Eff (ArtifactInterpreter e) ()
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
ArtifactGenerator -> Eff (ArtifactInterpreter e) ()
interpretGenerator [ArtifactGenerator]
generators)
  Let [(String, String)]
bindings [ArtifactGenerator]
generators ->
    [(String, String)]
-> Eff (ArtifactInterpreter e) () -> Eff (ArtifactInterpreter e) ()
forall (e :: [* -> *]) s.
(Member EnvironmentReader e, Member ExcB9 e) =>
[(String, String)] -> Eff e s -> Eff e s
withSubstitutedStringBindings [(String, String)]
bindings ((ArtifactGenerator -> Eff (ArtifactInterpreter e) ())
-> [ArtifactGenerator] -> Eff (ArtifactInterpreter e) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ArtifactGenerator -> Eff (ArtifactInterpreter e) ()
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
ArtifactGenerator -> Eff (ArtifactInterpreter e) ()
interpretGenerator [ArtifactGenerator]
generators)
  LetX [(String, [String])]
bindings [ArtifactGenerator]
generators ->
    [(String, [String])]
-> Eff (ArtifactInterpreter e) () -> Eff (ArtifactInterpreter e) ()
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
[(String, [String])]
-> Eff (ArtifactInterpreter e) () -> Eff (ArtifactInterpreter e) ()
withXBindings [(String, [String])]
bindings ((ArtifactGenerator -> Eff (ArtifactInterpreter e) ())
-> [ArtifactGenerator] -> Eff (ArtifactInterpreter e) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ArtifactGenerator -> Eff (ArtifactInterpreter e) ()
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
ArtifactGenerator -> Eff (ArtifactInterpreter e) ()
interpretGenerator [ArtifactGenerator]
generators)
  EachT [String]
keySet [[String]]
valueSets [ArtifactGenerator]
generators -> do
    [[(String, String)]]
allBindings <- ArtifactGenerator
-> [String]
-> [[String]]
-> Eff (ArtifactInterpreter e) [[(String, String)]]
forall (e :: [* -> *]).
Member ExcB9 e =>
ArtifactGenerator
-> [String]
-> [[String]]
-> Eff (ArtifactInterpreter e) [[(String, String)]]
eachBindingSetT ArtifactGenerator
generatorIn [String]
keySet [[String]]
valueSets
    [Eff (ArtifactInterpreter e) ()] -> Eff (ArtifactInterpreter e) ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
      ( ([(String, String)]
 -> Eff (ArtifactInterpreter e) ()
 -> Eff (ArtifactInterpreter e) ())
-> Eff (ArtifactInterpreter e) ()
-> [(String, String)]
-> Eff (ArtifactInterpreter e) ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip [(String, String)]
-> Eff (ArtifactInterpreter e) () -> Eff (ArtifactInterpreter e) ()
forall (e :: [* -> *]) s.
(Member EnvironmentReader e, Member ExcB9 e) =>
[(String, String)] -> Eff e s -> Eff e s
withSubstitutedStringBindings ((ArtifactGenerator -> Eff (ArtifactInterpreter e) ())
-> [ArtifactGenerator] -> Eff (ArtifactInterpreter e) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ArtifactGenerator -> Eff (ArtifactInterpreter e) ()
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
ArtifactGenerator -> Eff (ArtifactInterpreter e) ()
interpretGenerator [ArtifactGenerator]
generators)
          ([(String, String)] -> Eff (ArtifactInterpreter e) ())
-> [[(String, String)]] -> [Eff (ArtifactInterpreter e) ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[(String, String)]]
allBindings
      )
  Each [(String, [String])]
kvs [ArtifactGenerator]
generators -> do
    [[(String, String)]]
allBindings <- ArtifactGenerator
-> [(String, [String])]
-> Eff (ArtifactInterpreter e) [[(String, String)]]
forall (e :: [* -> *]).
Member ExcB9 e =>
ArtifactGenerator
-> [(String, [String])]
-> Eff (ArtifactInterpreter e) [[(String, String)]]
eachBindingSet ArtifactGenerator
generatorIn [(String, [String])]
kvs
    [Eff (ArtifactInterpreter e) ()] -> Eff (ArtifactInterpreter e) ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([Eff (ArtifactInterpreter e) ()]
 -> Eff (ArtifactInterpreter e) ())
-> [Eff (ArtifactInterpreter e) ()]
-> Eff (ArtifactInterpreter e) ()
forall a b. (a -> b) -> a -> b
$ do
      [(String, String)]
b <- [[(String, String)]]
allBindings
      Eff (ArtifactInterpreter e) () -> [Eff (ArtifactInterpreter e) ()]
forall (m :: * -> *) a. Monad m => a -> m a
return
        ([(String, String)]
-> Eff (ArtifactInterpreter e) () -> Eff (ArtifactInterpreter e) ()
forall (e :: [* -> *]) s.
(Member EnvironmentReader e, Member ExcB9 e) =>
[(String, String)] -> Eff e s -> Eff e s
withSubstitutedStringBindings [(String, String)]
b ((ArtifactGenerator -> Eff (ArtifactInterpreter e) ())
-> [ArtifactGenerator] -> Eff (ArtifactInterpreter e) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ArtifactGenerator -> Eff (ArtifactInterpreter e) ()
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
ArtifactGenerator -> Eff (ArtifactInterpreter e) ()
interpretGenerator [ArtifactGenerator]
generators))
  Artifact InstanceId
iid ArtifactAssembly
assembly -> InstanceId -> ArtifactAssembly -> Eff (ArtifactInterpreter e) ()
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
InstanceId -> ArtifactAssembly -> Eff (ArtifactInterpreter e) ()
interpretAssembly InstanceId
iid ArtifactAssembly
assembly
  ArtifactGenerator
EmptyArtifact -> () -> Eff (ArtifactInterpreter e) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    withArtifactSources ::
      (Member ExcB9 e, Member EnvironmentReader e) =>
      [ArtifactSource] ->
      Eff (ArtifactInterpreter e) s ->
      Eff (ArtifactInterpreter e) s
    withArtifactSources :: [ArtifactSource]
-> Eff (ArtifactInterpreter e) s -> Eff (ArtifactInterpreter e) s
withArtifactSources [ArtifactSource]
sources = ([ArtifactSource] -> [ArtifactSource])
-> Eff (ArtifactInterpreter e) s -> Eff (ArtifactInterpreter e) s
forall e a (r :: [* -> *]).
Member (Reader e) r =>
(e -> e) -> Eff r a -> Eff r a
local ([ArtifactSource] -> [ArtifactSource] -> [ArtifactSource]
forall a. [a] -> [a] -> [a]
++ [ArtifactSource]
sources)
    withXBindings ::
      (Member ExcB9 e, Member EnvironmentReader e) =>
      [(String, [String])] ->
      Eff (ArtifactInterpreter e) () ->
      Eff (ArtifactInterpreter e) ()
    withXBindings :: [(String, [String])]
-> Eff (ArtifactInterpreter e) () -> Eff (ArtifactInterpreter e) ()
withXBindings [(String, [String])]
bindings Eff (ArtifactInterpreter e) ()
cp =
      ([(String, String)]
-> Eff (ArtifactInterpreter e) () -> Eff (ArtifactInterpreter e) ()
forall (e :: [* -> *]) s.
(Member EnvironmentReader e, Member ExcB9 e) =>
[(String, String)] -> Eff e s -> Eff e s
`withSubstitutedStringBindings` Eff (ArtifactInterpreter e) ()
cp)
        ([(String, String)] -> Eff (ArtifactInterpreter e) ())
-> [[(String, String)]] -> Eff (ArtifactInterpreter e) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
`mapM_` [(String, [String])] -> [[(String, String)]]
forall a b. [(a, [b])] -> [[(a, b)]]
allXBindings [(String, [String])]
bindings
      where
        allXBindings :: [(a, [b])] -> [[(a, b)]]
allXBindings ((a
k, [b]
vs) : [(a, [b])]
rest) =
          [(a
k, b
v) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
c | b
v <- [b]
vs, [(a, b)]
c <- [(a, [b])] -> [[(a, b)]]
allXBindings [(a, [b])]
rest]
        allXBindings [] = [[]]
    eachBindingSetT ::
      (Member ExcB9 e) =>
      ArtifactGenerator ->
      [String] ->
      [[String]] ->
      Eff (ArtifactInterpreter e) [[(String, String)]]
    eachBindingSetT :: ArtifactGenerator
-> [String]
-> [[String]]
-> Eff (ArtifactInterpreter e) [[(String, String)]]
eachBindingSetT ArtifactGenerator
g [String]
vars [[String]]
valueSets =
      if ([String] -> Bool) -> [[String]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
vars) (Int -> Bool) -> ([String] -> Int) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) [[String]]
valueSets
        then [[(String, String)]]
-> Eff (ArtifactInterpreter e) [[(String, String)]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
vars ([String] -> [(String, String)])
-> [[String]] -> [[(String, String)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[String]]
valueSets)
        else
          String -> Eff (ArtifactInterpreter e) [[(String, String)]]
forall (e :: [* -> *]) a. Member ExcB9 e => String -> Eff e a
throwB9Error
            ( String -> String -> String -> Int -> String -> String
forall r. PrintfType r => String -> r
printf
                String
"Error in 'Each' binding during artifact generation in:\n '%s'.\n\nThe variable list\n%s\n has %i entries, but this binding set\n%s\n\nhas a different number of entries!\n"
                (ArtifactGenerator -> String
forall a. Show a => a -> String
ppShow ArtifactGenerator
g)
                ([String] -> String
forall a. Show a => a -> String
ppShow [String]
vars)
                ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
vars)
                ([String] -> String
forall a. Show a => a -> String
ppShow ([[String]] -> [String]
forall a. [a] -> a
head (([String] -> Bool) -> [[String]] -> [[String]]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
vars) (Int -> Bool) -> ([String] -> Int) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) [[String]]
valueSets)))
            )
    eachBindingSet ::
      (Member ExcB9 e) =>
      ArtifactGenerator ->
      [(String, [String])] ->
      Eff (ArtifactInterpreter e) [[(String, String)]]
    eachBindingSet :: ArtifactGenerator
-> [(String, [String])]
-> Eff (ArtifactInterpreter e) [[(String, String)]]
eachBindingSet ArtifactGenerator
g [(String, [String])]
kvs = do
      Eff (ArtifactInterpreter e) ()
checkInput
      [[(String, String)]]
-> Eff (ArtifactInterpreter e) [[(String, String)]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[(String, String)]]
bindingSets
      where
        bindingSets :: [[(String, String)]]
bindingSets = [[(String, String)]] -> [[(String, String)]]
forall a. [[a]] -> [[a]]
transpose [String -> [String]
forall a. a -> [a]
repeat String
k [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [String]
vs | (String
k, [String]
vs) <- [(String, [String])]
kvs]
        checkInput :: Eff (ArtifactInterpreter e) ()
checkInput =
          Bool
-> Eff (ArtifactInterpreter e) () -> Eff (ArtifactInterpreter e) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
            (Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int] -> [Int]
forall a. Eq a => [a] -> [a]
nub ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int)
-> ((String, [String]) -> [String]) -> (String, [String]) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [String]) -> [String]
forall a b. (a, b) -> b
snd ((String, [String]) -> Int) -> [(String, [String])] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, [String])]
kvs))
            ( String -> Eff (ArtifactInterpreter e) ()
forall (e :: [* -> *]) a. Member ExcB9 e => String -> Eff e a
throwB9Error
                ( String -> String -> String
forall r. PrintfType r => String -> r
printf
                    String
"Error in 'Each' binding: \n%s\nAll value lists must have the same length!"
                    (ArtifactGenerator -> String
forall a. Show a => a -> String
ppShow ArtifactGenerator
g)
                )
            )

interpretAssembly ::
  (Member ExcB9 e, Member EnvironmentReader e) =>
  InstanceId ->
  ArtifactAssembly ->
  Eff (ArtifactInterpreter e) ()
interpretAssembly :: InstanceId -> ArtifactAssembly -> Eff (ArtifactInterpreter e) ()
interpretAssembly (IID String
iidStrTemplate) ArtifactAssembly
assembly = do
  iid :: InstanceId
iid@(IID String
iidStr) <- String -> InstanceId
IID (String -> InstanceId)
-> Eff (ArtifactInterpreter e) String
-> Eff (ArtifactInterpreter e) InstanceId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Eff (ArtifactInterpreter e) String
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
String -> Eff e String
substStr String
iidStrTemplate
  InstanceSources
env <- Environment -> [ArtifactSource] -> InstanceSources
InstanceSources (Environment -> [ArtifactSource] -> InstanceSources)
-> Eff (ArtifactInterpreter e) Environment
-> Eff
     (ArtifactInterpreter e) ([ArtifactSource] -> InstanceSources)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff (ArtifactInterpreter e) Environment
forall (e :: [* -> *]).
Member EnvironmentReader e =>
Eff e Environment
askEnvironment Eff (ArtifactInterpreter e) ([ArtifactSource] -> InstanceSources)
-> Eff (ArtifactInterpreter e) [ArtifactSource]
-> Eff (ArtifactInterpreter e) InstanceSources
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Eff (ArtifactInterpreter e) [ArtifactSource]
forall e (r :: [* -> *]). Member (Reader e) r => Eff r e
ask
  [(String, String)]
-> Eff (ArtifactInterpreter e) () -> Eff (ArtifactInterpreter e) ()
forall (e :: [* -> *]) s.
(Member EnvironmentReader e, Member ExcB9 e) =>
[(String, String)] -> Eff e s -> Eff e s
withSubstitutedStringBindings
    [(String -> String
forall a. IsString a => String -> a
fromString String
instanceIdKey, String -> String
forall a. IsString a => String -> a
fromString String
iidStr)]
    ([InstanceGenerator InstanceSources]
-> Eff (ArtifactInterpreter e) ()
forall w (r :: [* -> *]). Member (Writer w) r => w -> Eff r ()
tell [InstanceId
-> InstanceSources
-> ArtifactAssembly
-> InstanceGenerator InstanceSources
forall e.
InstanceId -> e -> ArtifactAssembly -> InstanceGenerator e
IG InstanceId
iid InstanceSources
env ArtifactAssembly
assembly])

-- | Internal data structure. Only exposed for unit testing.
data InstanceSources
  = InstanceSources
      { InstanceSources -> Environment
isEnv :: Environment,
        InstanceSources -> [ArtifactSource]
isSources :: [ArtifactSource]
      }
  deriving (Int -> InstanceSources -> String -> String
[InstanceSources] -> String -> String
InstanceSources -> String
(Int -> InstanceSources -> String -> String)
-> (InstanceSources -> String)
-> ([InstanceSources] -> String -> String)
-> Show InstanceSources
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [InstanceSources] -> String -> String
$cshowList :: [InstanceSources] -> String -> String
show :: InstanceSources -> String
$cshow :: InstanceSources -> String
showsPrec :: Int -> InstanceSources -> String -> String
$cshowsPrec :: Int -> InstanceSources -> String -> String
Show, InstanceSources -> InstanceSources -> Bool
(InstanceSources -> InstanceSources -> Bool)
-> (InstanceSources -> InstanceSources -> Bool)
-> Eq InstanceSources
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstanceSources -> InstanceSources -> Bool
$c/= :: InstanceSources -> InstanceSources -> Bool
== :: InstanceSources -> InstanceSources -> Bool
$c== :: InstanceSources -> InstanceSources -> Bool
Eq)

data InstanceGenerator e
  = IG
      InstanceId
      e
      ArtifactAssembly
  deriving (ReadPrec [InstanceGenerator e]
ReadPrec (InstanceGenerator e)
Int -> ReadS (InstanceGenerator e)
ReadS [InstanceGenerator e]
(Int -> ReadS (InstanceGenerator e))
-> ReadS [InstanceGenerator e]
-> ReadPrec (InstanceGenerator e)
-> ReadPrec [InstanceGenerator e]
-> Read (InstanceGenerator e)
forall e. Read e => ReadPrec [InstanceGenerator e]
forall e. Read e => ReadPrec (InstanceGenerator e)
forall e. Read e => Int -> ReadS (InstanceGenerator e)
forall e. Read e => ReadS [InstanceGenerator e]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InstanceGenerator e]
$creadListPrec :: forall e. Read e => ReadPrec [InstanceGenerator e]
readPrec :: ReadPrec (InstanceGenerator e)
$creadPrec :: forall e. Read e => ReadPrec (InstanceGenerator e)
readList :: ReadS [InstanceGenerator e]
$creadList :: forall e. Read e => ReadS [InstanceGenerator e]
readsPrec :: Int -> ReadS (InstanceGenerator e)
$creadsPrec :: forall e. Read e => Int -> ReadS (InstanceGenerator e)
Read, Int -> InstanceGenerator e -> String -> String
[InstanceGenerator e] -> String -> String
InstanceGenerator e -> String
(Int -> InstanceGenerator e -> String -> String)
-> (InstanceGenerator e -> String)
-> ([InstanceGenerator e] -> String -> String)
-> Show (InstanceGenerator e)
forall e. Show e => Int -> InstanceGenerator e -> String -> String
forall e. Show e => [InstanceGenerator e] -> String -> String
forall e. Show e => InstanceGenerator e -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [InstanceGenerator e] -> String -> String
$cshowList :: forall e. Show e => [InstanceGenerator e] -> String -> String
show :: InstanceGenerator e -> String
$cshow :: forall e. Show e => InstanceGenerator e -> String
showsPrec :: Int -> InstanceGenerator e -> String -> String
$cshowsPrec :: forall e. Show e => Int -> InstanceGenerator e -> String -> String
Show, Typeable, Typeable (InstanceGenerator e)
DataType
Constr
Typeable (InstanceGenerator e)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> InstanceGenerator e
    -> c (InstanceGenerator e))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (InstanceGenerator e))
-> (InstanceGenerator e -> Constr)
-> (InstanceGenerator e -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (InstanceGenerator e)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (InstanceGenerator e)))
-> ((forall b. Data b => b -> b)
    -> InstanceGenerator e -> InstanceGenerator e)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> InstanceGenerator e -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> InstanceGenerator e -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> InstanceGenerator e -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> InstanceGenerator e -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> InstanceGenerator e -> m (InstanceGenerator e))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InstanceGenerator e -> m (InstanceGenerator e))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InstanceGenerator e -> m (InstanceGenerator e))
-> Data (InstanceGenerator e)
InstanceGenerator e -> DataType
InstanceGenerator e -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (InstanceGenerator e))
(forall b. Data b => b -> b)
-> InstanceGenerator e -> InstanceGenerator e
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InstanceGenerator e
-> c (InstanceGenerator e)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (InstanceGenerator e)
forall e. Data e => Typeable (InstanceGenerator e)
forall e. Data e => InstanceGenerator e -> DataType
forall e. Data e => InstanceGenerator e -> Constr
forall e.
Data e =>
(forall b. Data b => b -> b)
-> InstanceGenerator e -> InstanceGenerator e
forall e u.
Data e =>
Int -> (forall d. Data d => d -> u) -> InstanceGenerator e -> u
forall e u.
Data e =>
(forall d. Data d => d -> u) -> InstanceGenerator e -> [u]
forall e r r'.
Data e =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InstanceGenerator e -> r
forall e r r'.
Data e =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InstanceGenerator e -> r
forall e (m :: * -> *).
(Data e, Monad m) =>
(forall d. Data d => d -> m d)
-> InstanceGenerator e -> m (InstanceGenerator e)
forall e (m :: * -> *).
(Data e, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> InstanceGenerator e -> m (InstanceGenerator e)
forall e (c :: * -> *).
Data e =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (InstanceGenerator e)
forall e (c :: * -> *).
Data e =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InstanceGenerator e
-> c (InstanceGenerator e)
forall e (t :: * -> *) (c :: * -> *).
(Data e, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (InstanceGenerator e))
forall e (t :: * -> * -> *) (c :: * -> *).
(Data e, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (InstanceGenerator e))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> InstanceGenerator e -> u
forall u.
(forall d. Data d => d -> u) -> InstanceGenerator e -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InstanceGenerator e -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InstanceGenerator e -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InstanceGenerator e -> m (InstanceGenerator e)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InstanceGenerator e -> m (InstanceGenerator e)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (InstanceGenerator e)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InstanceGenerator e
-> c (InstanceGenerator e)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (InstanceGenerator e))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (InstanceGenerator e))
$cIG :: Constr
$tInstanceGenerator :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> InstanceGenerator e -> m (InstanceGenerator e)
$cgmapMo :: forall e (m :: * -> *).
(Data e, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> InstanceGenerator e -> m (InstanceGenerator e)
gmapMp :: (forall d. Data d => d -> m d)
-> InstanceGenerator e -> m (InstanceGenerator e)
$cgmapMp :: forall e (m :: * -> *).
(Data e, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> InstanceGenerator e -> m (InstanceGenerator e)
gmapM :: (forall d. Data d => d -> m d)
-> InstanceGenerator e -> m (InstanceGenerator e)
$cgmapM :: forall e (m :: * -> *).
(Data e, Monad m) =>
(forall d. Data d => d -> m d)
-> InstanceGenerator e -> m (InstanceGenerator e)
gmapQi :: Int -> (forall d. Data d => d -> u) -> InstanceGenerator e -> u
$cgmapQi :: forall e u.
Data e =>
Int -> (forall d. Data d => d -> u) -> InstanceGenerator e -> u
gmapQ :: (forall d. Data d => d -> u) -> InstanceGenerator e -> [u]
$cgmapQ :: forall e u.
Data e =>
(forall d. Data d => d -> u) -> InstanceGenerator e -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InstanceGenerator e -> r
$cgmapQr :: forall e r r'.
Data e =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InstanceGenerator e -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InstanceGenerator e -> r
$cgmapQl :: forall e r r'.
Data e =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InstanceGenerator e -> r
gmapT :: (forall b. Data b => b -> b)
-> InstanceGenerator e -> InstanceGenerator e
$cgmapT :: forall e.
Data e =>
(forall b. Data b => b -> b)
-> InstanceGenerator e -> InstanceGenerator e
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (InstanceGenerator e))
$cdataCast2 :: forall e (t :: * -> * -> *) (c :: * -> *).
(Data e, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (InstanceGenerator e))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (InstanceGenerator e))
$cdataCast1 :: forall e (t :: * -> *) (c :: * -> *).
(Data e, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (InstanceGenerator e))
dataTypeOf :: InstanceGenerator e -> DataType
$cdataTypeOf :: forall e. Data e => InstanceGenerator e -> DataType
toConstr :: InstanceGenerator e -> Constr
$ctoConstr :: forall e. Data e => InstanceGenerator e -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (InstanceGenerator e)
$cgunfold :: forall e (c :: * -> *).
Data e =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (InstanceGenerator e)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InstanceGenerator e
-> c (InstanceGenerator e)
$cgfoldl :: forall e (c :: * -> *).
Data e =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InstanceGenerator e
-> c (InstanceGenerator e)
$cp1Data :: forall e. Data e => Typeable (InstanceGenerator e)
Data, InstanceGenerator e -> InstanceGenerator e -> Bool
(InstanceGenerator e -> InstanceGenerator e -> Bool)
-> (InstanceGenerator e -> InstanceGenerator e -> Bool)
-> Eq (InstanceGenerator e)
forall e.
Eq e =>
InstanceGenerator e -> InstanceGenerator e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstanceGenerator e -> InstanceGenerator e -> Bool
$c/= :: forall e.
Eq e =>
InstanceGenerator e -> InstanceGenerator e -> Bool
== :: InstanceGenerator e -> InstanceGenerator e -> Bool
$c== :: forall e.
Eq e =>
InstanceGenerator e -> InstanceGenerator e -> Bool
Eq)

toFileInstanceGenerator ::
  Member ExcB9 e =>
  InstanceGenerator InstanceSources ->
  Eff e (InstanceGenerator [TextFileWriter])
toFileInstanceGenerator :: InstanceGenerator InstanceSources
-> Eff e (InstanceGenerator [TextFileWriter])
toFileInstanceGenerator (IG InstanceId
iid (InstanceSources Environment
env [ArtifactSource]
sources) ArtifactAssembly
assembly) =
  Environment
-> Eff (EnvironmentReader : e) (InstanceGenerator [TextFileWriter])
-> Eff e (InstanceGenerator [TextFileWriter])
forall (e :: [* -> *]) a.
Environment -> Eff (EnvironmentReader : e) a -> Eff e a
runEnvironmentReader Environment
env (Eff (EnvironmentReader : e) (InstanceGenerator [TextFileWriter])
 -> Eff e (InstanceGenerator [TextFileWriter]))
-> Eff (EnvironmentReader : e) (InstanceGenerator [TextFileWriter])
-> Eff e (InstanceGenerator [TextFileWriter])
forall a b. (a -> b) -> a -> b
$ do
    ArtifactAssembly
assembly' <- ArtifactAssembly -> Eff (EnvironmentReader : e) ArtifactAssembly
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
ArtifactAssembly -> Eff e ArtifactAssembly
substAssembly ArtifactAssembly
assembly
    [TextFileWriter]
sourceGenerators <- [[TextFileWriter]] -> [TextFileWriter]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[TextFileWriter]] -> [TextFileWriter])
-> Eff (EnvironmentReader : e) [[TextFileWriter]]
-> Eff (EnvironmentReader : e) [TextFileWriter]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ArtifactSource -> Eff (EnvironmentReader : e) [TextFileWriter])
-> [ArtifactSource]
-> Eff (EnvironmentReader : e) [[TextFileWriter]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ArtifactSource -> Eff (EnvironmentReader : e) [TextFileWriter]
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
ArtifactSource -> Eff e [TextFileWriter]
toSourceGen [ArtifactSource]
sources
    InstanceGenerator [TextFileWriter]
-> Eff (EnvironmentReader : e) (InstanceGenerator [TextFileWriter])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InstanceId
-> [TextFileWriter]
-> ArtifactAssembly
-> InstanceGenerator [TextFileWriter]
forall e.
InstanceId -> e -> ArtifactAssembly -> InstanceGenerator e
IG InstanceId
iid [TextFileWriter]
sourceGenerators ArtifactAssembly
assembly')

substAssembly ::
  forall e.
  (Member ExcB9 e, Member EnvironmentReader e) =>
  ArtifactAssembly ->
  Eff e ArtifactAssembly
substAssembly :: ArtifactAssembly -> Eff e ArtifactAssembly
substAssembly = GenericM (Eff e) -> GenericM (Eff e)
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
everywhereM GenericM (Eff e)
gsubst
  where
    gsubst :: Data a => a -> Eff e a
    gsubst :: a -> Eff e a
gsubst = (ArtifactAssembly -> Eff e ArtifactAssembly) -> a -> Eff e a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
mkM ArtifactAssembly -> Eff e ArtifactAssembly
forall (e :: [* -> *]).
(FindElem ExcB9 e, FindElem EnvironmentReader e) =>
ArtifactAssembly -> Eff e ArtifactAssembly
substAssembly_ (a -> Eff e a)
-> (ImageTarget -> Eff e ImageTarget) -> a -> Eff e a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m a) -> (b -> m b) -> a -> m a
`extM` ImageTarget -> Eff e ImageTarget
forall (e :: [* -> *]).
(HasCallStack, Member EnvironmentReader e, Member ExcB9 e) =>
ImageTarget -> Eff e ImageTarget
substImageTarget (a -> Eff e a) -> (VmScript -> Eff e VmScript) -> a -> Eff e a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m a) -> (b -> m b) -> a -> m a
`extM` VmScript -> Eff e VmScript
forall (e :: [* -> *]).
(Member EnvironmentReader e, Member ExcB9 e) =>
VmScript -> Eff e VmScript
substVmScript
    substAssembly_ :: ArtifactAssembly -> Eff e ArtifactAssembly
substAssembly_ (CloudInit [CloudInitType]
ts String
f) = [CloudInitType] -> String -> ArtifactAssembly
CloudInit [CloudInitType]
ts (String -> ArtifactAssembly)
-> Eff e String -> Eff e ArtifactAssembly
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Eff e String
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
String -> Eff e String
substStr String
f
    substAssembly_ ArtifactAssembly
vm = ArtifactAssembly -> Eff e ArtifactAssembly
forall (f :: * -> *) a. Applicative f => a -> f a
pure ArtifactAssembly
vm

toSourceGen ::
  (Member ExcB9 e, Member EnvironmentReader e) =>
  ArtifactSource ->
  Eff e [TextFileWriter]
toSourceGen :: ArtifactSource -> Eff e [TextFileWriter]
toSourceGen ArtifactSource
src = do
  Environment
env <- Eff e Environment
forall (e :: [* -> *]).
Member EnvironmentReader e =>
Eff e Environment
askEnvironment
  case ArtifactSource
src of
    FromFile String
t (Source SourceFileConversion
conv String
f) -> do
      String
t' <- String -> Eff e String
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
String -> Eff e String
substStr String
t
      String
f' <- String -> Eff e String
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
String -> Eff e String
substStr String
f
      [TextFileWriter] -> Eff e [TextFileWriter]
forall (m :: * -> *) a. Monad m => a -> m a
return
        [ Environment
-> TextFileWriterInput
-> FilePermissionAction
-> String
-> TextFileWriter
MkTextFileWriter
            Environment
env
            ([SourceFile] -> TextFileWriterInput
ExternalFiles [SourceFileConversion -> String -> SourceFile
Source SourceFileConversion
conv String
f'])
            FilePermissionAction
KeepPermissions
            String
t'
        ]
    FromContent String
t Content
c -> do
      String
t' <- String -> Eff e String
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
String -> Eff e String
substStr String
t
      [TextFileWriter] -> Eff e [TextFileWriter]
forall (m :: * -> *) a. Monad m => a -> m a
return [Environment
-> TextFileWriterInput
-> FilePermissionAction
-> String
-> TextFileWriter
MkTextFileWriter Environment
env (Content -> TextFileWriterInput
StaticContent Content
c) FilePermissionAction
KeepPermissions String
t']
    SetPermissions Int
o Int
g Int
a [ArtifactSource]
src' -> do
      [TextFileWriter]
sgs <- [[TextFileWriter]] -> [TextFileWriter]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[TextFileWriter]] -> [TextFileWriter])
-> Eff e [[TextFileWriter]] -> Eff e [TextFileWriter]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ArtifactSource -> Eff e [TextFileWriter])
-> [ArtifactSource] -> Eff e [[TextFileWriter]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ArtifactSource -> Eff e [TextFileWriter]
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
ArtifactSource -> Eff e [TextFileWriter]
toSourceGen [ArtifactSource]
src'
      (TextFileWriter -> Eff e TextFileWriter)
-> [TextFileWriter] -> Eff e [TextFileWriter]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Int -> Int -> Int -> TextFileWriter -> Eff e TextFileWriter
forall (e :: [* -> *]).
Member ExcB9 e =>
Int -> Int -> Int -> TextFileWriter -> Eff e TextFileWriter
setFilePermissionAction Int
o Int
g Int
a) [TextFileWriter]
sgs
    FromDirectory String
fromDir [ArtifactSource]
src' -> do
      [TextFileWriter]
sgs <- [[TextFileWriter]] -> [TextFileWriter]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[TextFileWriter]] -> [TextFileWriter])
-> Eff e [[TextFileWriter]] -> Eff e [TextFileWriter]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ArtifactSource -> Eff e [TextFileWriter])
-> [ArtifactSource] -> Eff e [[TextFileWriter]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ArtifactSource -> Eff e [TextFileWriter]
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
ArtifactSource -> Eff e [TextFileWriter]
toSourceGen [ArtifactSource]
src'
      String
fromDir' <- String -> Eff e String
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
String -> Eff e String
substStr String
fromDir
      [TextFileWriter] -> Eff e [TextFileWriter]
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> TextFileWriter -> TextFileWriter
prefixExternalSourcesPaths String
fromDir' (TextFileWriter -> TextFileWriter)
-> [TextFileWriter] -> [TextFileWriter]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TextFileWriter]
sgs)
    IntoDirectory String
toDir [ArtifactSource]
src' -> do
      [TextFileWriter]
sgs <- [[TextFileWriter]] -> [TextFileWriter]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[TextFileWriter]] -> [TextFileWriter])
-> Eff e [[TextFileWriter]] -> Eff e [TextFileWriter]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ArtifactSource -> Eff e [TextFileWriter])
-> [ArtifactSource] -> Eff e [[TextFileWriter]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ArtifactSource -> Eff e [TextFileWriter]
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
ArtifactSource -> Eff e [TextFileWriter]
toSourceGen [ArtifactSource]
src'
      String
toDir' <- String -> Eff e String
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
String -> Eff e String
substStr String
toDir
      [TextFileWriter] -> Eff e [TextFileWriter]
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> TextFileWriter -> TextFileWriter
prefixOutputFilePaths String
toDir' (TextFileWriter -> TextFileWriter)
-> [TextFileWriter] -> [TextFileWriter]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TextFileWriter]
sgs)

createAssembledArtifacts ::
  IsB9 e => [InstanceGenerator [TextFileWriter]] -> Eff e [AssembledArtifact]
createAssembledArtifacts :: [InstanceGenerator [TextFileWriter]] -> Eff e [AssembledArtifact]
createAssembledArtifacts [InstanceGenerator [TextFileWriter]]
igs = do
  String
buildDir <- Eff e String
forall (e :: [* -> *]). Member BuildInfoReader e => Eff e String
getBuildDir
  let outDir :: String
outDir = String
buildDir String -> String -> String
</> String
"artifact-instances"
  String -> Eff e ()
forall (m :: * -> *). MonadIO m => String -> m ()
ensureDir (String
outDir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/")
  [InstanceGenerator String]
generated <- String
-> InstanceGenerator [TextFileWriter]
-> Eff e (InstanceGenerator String)
forall (e :: [* -> *]).
IsB9 e =>
String
-> InstanceGenerator [TextFileWriter]
-> Eff e (InstanceGenerator String)
generateSources String
outDir (InstanceGenerator [TextFileWriter]
 -> Eff e (InstanceGenerator String))
-> [InstanceGenerator [TextFileWriter]]
-> Eff e [InstanceGenerator String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
`mapM` [InstanceGenerator [TextFileWriter]]
igs
  InstanceGenerator String -> Eff e AssembledArtifact
forall (e :: [* -> *]).
IsB9 e =>
InstanceGenerator String -> Eff e AssembledArtifact
runInstanceGenerator (InstanceGenerator String -> Eff e AssembledArtifact)
-> [InstanceGenerator String] -> Eff e [AssembledArtifact]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
`mapM` [InstanceGenerator String]
generated

generateSources ::
  IsB9 e =>
  FilePath ->
  InstanceGenerator [TextFileWriter] ->
  Eff e (InstanceGenerator FilePath)
generateSources :: String
-> InstanceGenerator [TextFileWriter]
-> Eff e (InstanceGenerator String)
generateSources String
outDir (IG InstanceId
iid [TextFileWriter]
sgs ArtifactAssembly
assembly) = do
  uiid :: InstanceId
uiid@(IID String
uiidStr) <- InstanceId -> Eff e InstanceId
forall (e :: [* -> *]). IsB9 e => InstanceId -> Eff e InstanceId
generateUniqueIID InstanceId
iid
  String -> Eff e ()
forall (e :: [* -> *]). CommandIO e => String -> Eff e ()
dbgL (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"generating sources for %s" String
uiidStr)
  let instanceDir :: String
instanceDir = String
outDir String -> String -> String
</> String
uiidStr
  String -> Eff e ()
forall (e :: [* -> *]). CommandIO e => String -> Eff e ()
traceL (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"generating sources for %s:\n%s\n" String
uiidStr ([TextFileWriter] -> String
forall a. Show a => a -> String
ppShow [TextFileWriter]
sgs))
  String -> TextFileWriter -> Eff e ()
forall (e :: [* -> *]).
IsB9 e =>
String -> TextFileWriter -> Eff e ()
generateSourceTo String
instanceDir (TextFileWriter -> Eff e ()) -> [TextFileWriter] -> Eff e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
`mapM_` [TextFileWriter]
sgs
  InstanceGenerator String -> Eff e (InstanceGenerator String)
forall (m :: * -> *) a. Monad m => a -> m a
return (InstanceId
-> String -> ArtifactAssembly -> InstanceGenerator String
forall e.
InstanceId -> e -> ArtifactAssembly -> InstanceGenerator e
IG InstanceId
uiid String
instanceDir ArtifactAssembly
assembly)

-- | Run an
runInstanceGenerator ::
  IsB9 e => InstanceGenerator FilePath -> Eff e AssembledArtifact
runInstanceGenerator :: InstanceGenerator String -> Eff e AssembledArtifact
runInstanceGenerator (IG uiid :: InstanceId
uiid@(IID String
uiidStr) String
instanceDir ArtifactAssembly
assembly) = do
  [ArtifactTarget]
targets <- InstanceId -> String -> ArtifactAssembly -> Eff e [ArtifactTarget]
forall (e :: [* -> *]).
IsB9 e =>
InstanceId -> String -> ArtifactAssembly -> Eff e [ArtifactTarget]
runArtifactAssembly InstanceId
uiid String
instanceDir ArtifactAssembly
assembly
  String -> Eff e ()
forall (e :: [* -> *]). CommandIO e => String -> Eff e ()
dbgL (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"assembled artifact %s" String
uiidStr)
  AssembledArtifact -> Eff e AssembledArtifact
forall (m :: * -> *) a. Monad m => a -> m a
return (InstanceId -> [ArtifactTarget] -> AssembledArtifact
AssembledArtifact InstanceId
uiid [ArtifactTarget]
targets)

generateUniqueIID :: IsB9 e => InstanceId -> Eff e InstanceId
generateUniqueIID :: InstanceId -> Eff e InstanceId
generateUniqueIID (IID String
iid) = String -> InstanceId
IID (String -> InstanceId)
-> (String -> String) -> String -> InstanceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s-%s" String
iid (String -> InstanceId) -> Eff e String -> Eff e InstanceId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff e String
forall (e :: [* -> *]). Member BuildInfoReader e => Eff e String
getBuildId

generateSourceTo :: IsB9 e => FilePath -> TextFileWriter -> Eff e ()
generateSourceTo :: String -> TextFileWriter -> Eff e ()
generateSourceTo String
instanceDir (MkTextFileWriter Environment
env TextFileWriterInput
sgSource FilePermissionAction
p String
to) =
  (Environment -> Environment) -> Eff e () -> Eff e ()
forall (e :: [* -> *]) a.
Member EnvironmentReader e =>
(Environment -> Environment) -> Eff e a -> Eff e a
localEnvironment (Environment -> Environment -> Environment
forall a b. a -> b -> a
const Environment
env) (Eff e () -> Eff e ()) -> Eff e () -> Eff e ()
forall a b. (a -> b) -> a -> b
$ do
    let toAbs :: String
toAbs = String
instanceDir String -> String -> String
</> String
to
    String -> Eff e ()
forall (m :: * -> *). MonadIO m => String -> m ()
ensureDir String
toAbs
    Text
result <- case TextFileWriterInput
sgSource of
      ExternalFiles [SourceFile]
froms -> do
        [Text]
sources <- (SourceFile -> Eff e Text) -> [SourceFile] -> Eff e [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SourceFile -> Eff e Text
forall (e :: [* -> *]).
(MonadIO (Eff e), '[ExcB9, EnvironmentReader] <:: e) =>
SourceFile -> Eff e Text
readTemplateFile [SourceFile]
froms
        Text -> Eff e Text
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text]
sources)
      StaticContent Content
c -> Content -> Eff e Text
forall c (e :: [* -> *]).
(ToContentGenerator c, HasCallStack, IsB9 e) =>
c -> Eff e Text
toContentGenerator Content
c
    String -> Eff e ()
forall (e :: [* -> *]). CommandIO e => String -> Eff e ()
traceL (String -> Text -> String
forall r. PrintfType r => String -> r
printf String
"rendered: \n%s\n" Text
result)
    IO () -> Eff e ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> Text -> IO ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> Text -> m ()
writeTextFile String
toAbs Text
result)
    String -> FilePermissionAction -> Eff e ()
forall (e :: [* -> *]).
IsB9 e =>
String -> FilePermissionAction -> Eff e ()
runFilePermissionAction String
toAbs FilePermissionAction
p

runFilePermissionAction ::
  IsB9 e => FilePath -> FilePermissionAction -> Eff e ()
runFilePermissionAction :: String -> FilePermissionAction -> Eff e ()
runFilePermissionAction String
_ FilePermissionAction
KeepPermissions = () -> Eff e ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
runFilePermissionAction String
f (ChangePermissions (Int
o, Int
g, Int
a)) =
  String -> Eff e ()
forall (e :: [* -> *]).
(HasCallStack, Member ExcB9 e, CommandIO e) =>
String -> Eff e ()
cmd (String -> Int -> Int -> Int -> String -> String
forall r. PrintfType r => String -> r
printf String
"chmod 0%i%i%i '%s'" Int
o Int
g Int
a String
f)

-- | Internal data type simplifying the rather complex source generation by
--   boiling down 'ArtifactSource's to a flat list of uniform 'TextFileWriter's.
data TextFileWriter
  = MkTextFileWriter
      Environment
      TextFileWriterInput
      FilePermissionAction
      FilePath
  deriving (Int -> TextFileWriter -> String -> String
[TextFileWriter] -> String -> String
TextFileWriter -> String
(Int -> TextFileWriter -> String -> String)
-> (TextFileWriter -> String)
-> ([TextFileWriter] -> String -> String)
-> Show TextFileWriter
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TextFileWriter] -> String -> String
$cshowList :: [TextFileWriter] -> String -> String
show :: TextFileWriter -> String
$cshow :: TextFileWriter -> String
showsPrec :: Int -> TextFileWriter -> String -> String
$cshowsPrec :: Int -> TextFileWriter -> String -> String
Show, TextFileWriter -> TextFileWriter -> Bool
(TextFileWriter -> TextFileWriter -> Bool)
-> (TextFileWriter -> TextFileWriter -> Bool) -> Eq TextFileWriter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextFileWriter -> TextFileWriter -> Bool
$c/= :: TextFileWriter -> TextFileWriter -> Bool
== :: TextFileWriter -> TextFileWriter -> Bool
$c== :: TextFileWriter -> TextFileWriter -> Bool
Eq)

-- | Return the (internal-)output file of the source file that is generated.
textFileWriterOutputFile :: TextFileWriter -> FilePath
textFileWriterOutputFile :: TextFileWriter -> String
textFileWriterOutputFile (MkTextFileWriter Environment
_ TextFileWriterInput
_ FilePermissionAction
_ String
f) = String
f

data TextFileWriterInput
  = ExternalFiles [SourceFile]
  | StaticContent Content
  deriving (ReadPrec [TextFileWriterInput]
ReadPrec TextFileWriterInput
Int -> ReadS TextFileWriterInput
ReadS [TextFileWriterInput]
(Int -> ReadS TextFileWriterInput)
-> ReadS [TextFileWriterInput]
-> ReadPrec TextFileWriterInput
-> ReadPrec [TextFileWriterInput]
-> Read TextFileWriterInput
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TextFileWriterInput]
$creadListPrec :: ReadPrec [TextFileWriterInput]
readPrec :: ReadPrec TextFileWriterInput
$creadPrec :: ReadPrec TextFileWriterInput
readList :: ReadS [TextFileWriterInput]
$creadList :: ReadS [TextFileWriterInput]
readsPrec :: Int -> ReadS TextFileWriterInput
$creadsPrec :: Int -> ReadS TextFileWriterInput
Read, Int -> TextFileWriterInput -> String -> String
[TextFileWriterInput] -> String -> String
TextFileWriterInput -> String
(Int -> TextFileWriterInput -> String -> String)
-> (TextFileWriterInput -> String)
-> ([TextFileWriterInput] -> String -> String)
-> Show TextFileWriterInput
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TextFileWriterInput] -> String -> String
$cshowList :: [TextFileWriterInput] -> String -> String
show :: TextFileWriterInput -> String
$cshow :: TextFileWriterInput -> String
showsPrec :: Int -> TextFileWriterInput -> String -> String
$cshowsPrec :: Int -> TextFileWriterInput -> String -> String
Show, TextFileWriterInput -> TextFileWriterInput -> Bool
(TextFileWriterInput -> TextFileWriterInput -> Bool)
-> (TextFileWriterInput -> TextFileWriterInput -> Bool)
-> Eq TextFileWriterInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextFileWriterInput -> TextFileWriterInput -> Bool
$c/= :: TextFileWriterInput -> TextFileWriterInput -> Bool
== :: TextFileWriterInput -> TextFileWriterInput -> Bool
$c== :: TextFileWriterInput -> TextFileWriterInput -> Bool
Eq)

data FilePermissionAction
  = ChangePermissions (Int, Int, Int)
  | KeepPermissions
  deriving (ReadPrec [FilePermissionAction]
ReadPrec FilePermissionAction
Int -> ReadS FilePermissionAction
ReadS [FilePermissionAction]
(Int -> ReadS FilePermissionAction)
-> ReadS [FilePermissionAction]
-> ReadPrec FilePermissionAction
-> ReadPrec [FilePermissionAction]
-> Read FilePermissionAction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FilePermissionAction]
$creadListPrec :: ReadPrec [FilePermissionAction]
readPrec :: ReadPrec FilePermissionAction
$creadPrec :: ReadPrec FilePermissionAction
readList :: ReadS [FilePermissionAction]
$creadList :: ReadS [FilePermissionAction]
readsPrec :: Int -> ReadS FilePermissionAction
$creadsPrec :: Int -> ReadS FilePermissionAction
Read, Int -> FilePermissionAction -> String -> String
[FilePermissionAction] -> String -> String
FilePermissionAction -> String
(Int -> FilePermissionAction -> String -> String)
-> (FilePermissionAction -> String)
-> ([FilePermissionAction] -> String -> String)
-> Show FilePermissionAction
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [FilePermissionAction] -> String -> String
$cshowList :: [FilePermissionAction] -> String -> String
show :: FilePermissionAction -> String
$cshow :: FilePermissionAction -> String
showsPrec :: Int -> FilePermissionAction -> String -> String
$cshowsPrec :: Int -> FilePermissionAction -> String -> String
Show, Typeable, Typeable FilePermissionAction
DataType
Constr
Typeable FilePermissionAction
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> FilePermissionAction
    -> c FilePermissionAction)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FilePermissionAction)
-> (FilePermissionAction -> Constr)
-> (FilePermissionAction -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FilePermissionAction))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FilePermissionAction))
-> ((forall b. Data b => b -> b)
    -> FilePermissionAction -> FilePermissionAction)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FilePermissionAction -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FilePermissionAction -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> FilePermissionAction -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FilePermissionAction -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> FilePermissionAction -> m FilePermissionAction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FilePermissionAction -> m FilePermissionAction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FilePermissionAction -> m FilePermissionAction)
-> Data FilePermissionAction
FilePermissionAction -> DataType
FilePermissionAction -> Constr
(forall b. Data b => b -> b)
-> FilePermissionAction -> FilePermissionAction
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FilePermissionAction
-> c FilePermissionAction
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FilePermissionAction
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> FilePermissionAction -> u
forall u.
(forall d. Data d => d -> u) -> FilePermissionAction -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FilePermissionAction -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FilePermissionAction -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FilePermissionAction -> m FilePermissionAction
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FilePermissionAction -> m FilePermissionAction
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FilePermissionAction
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FilePermissionAction
-> c FilePermissionAction
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FilePermissionAction)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FilePermissionAction)
$cKeepPermissions :: Constr
$cChangePermissions :: Constr
$tFilePermissionAction :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> FilePermissionAction -> m FilePermissionAction
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FilePermissionAction -> m FilePermissionAction
gmapMp :: (forall d. Data d => d -> m d)
-> FilePermissionAction -> m FilePermissionAction
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FilePermissionAction -> m FilePermissionAction
gmapM :: (forall d. Data d => d -> m d)
-> FilePermissionAction -> m FilePermissionAction
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FilePermissionAction -> m FilePermissionAction
gmapQi :: Int -> (forall d. Data d => d -> u) -> FilePermissionAction -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FilePermissionAction -> u
gmapQ :: (forall d. Data d => d -> u) -> FilePermissionAction -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> FilePermissionAction -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FilePermissionAction -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FilePermissionAction -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FilePermissionAction -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FilePermissionAction -> r
gmapT :: (forall b. Data b => b -> b)
-> FilePermissionAction -> FilePermissionAction
$cgmapT :: (forall b. Data b => b -> b)
-> FilePermissionAction -> FilePermissionAction
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FilePermissionAction)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FilePermissionAction)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c FilePermissionAction)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FilePermissionAction)
dataTypeOf :: FilePermissionAction -> DataType
$cdataTypeOf :: FilePermissionAction -> DataType
toConstr :: FilePermissionAction -> Constr
$ctoConstr :: FilePermissionAction -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FilePermissionAction
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FilePermissionAction
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FilePermissionAction
-> c FilePermissionAction
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FilePermissionAction
-> c FilePermissionAction
$cp1Data :: Typeable FilePermissionAction
Data, FilePermissionAction -> FilePermissionAction -> Bool
(FilePermissionAction -> FilePermissionAction -> Bool)
-> (FilePermissionAction -> FilePermissionAction -> Bool)
-> Eq FilePermissionAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilePermissionAction -> FilePermissionAction -> Bool
$c/= :: FilePermissionAction -> FilePermissionAction -> Bool
== :: FilePermissionAction -> FilePermissionAction -> Bool
$c== :: FilePermissionAction -> FilePermissionAction -> Bool
Eq)

setFilePermissionAction ::
  Member ExcB9 e =>
  Int ->
  Int ->
  Int ->
  TextFileWriter ->
  Eff e TextFileWriter
setFilePermissionAction :: Int -> Int -> Int -> TextFileWriter -> Eff e TextFileWriter
setFilePermissionAction Int
o Int
g Int
a (MkTextFileWriter Environment
env TextFileWriterInput
from FilePermissionAction
KeepPermissions String
dest) =
  TextFileWriter -> Eff e TextFileWriter
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Environment
-> TextFileWriterInput
-> FilePermissionAction
-> String
-> TextFileWriter
MkTextFileWriter Environment
env TextFileWriterInput
from ((Int, Int, Int) -> FilePermissionAction
ChangePermissions (Int
o, Int
g, Int
a)) String
dest)
setFilePermissionAction Int
o Int
g Int
a TextFileWriter
sg
  | Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
7 =
    String -> Eff e TextFileWriter
forall (e :: [* -> *]) a. Member ExcB9 e => String -> Eff e a
throwB9Error
      (String -> Int -> String -> String
forall r. PrintfType r => String -> r
printf String
"Bad 'owner' permission %i in \n%s" Int
o (TextFileWriter -> String
forall a. Show a => a -> String
ppShow TextFileWriter
sg))
  | Int
g Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
g Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
7 =
    String -> Eff e TextFileWriter
forall (e :: [* -> *]) a. Member ExcB9 e => String -> Eff e a
throwB9Error
      (String -> Int -> String -> String
forall r. PrintfType r => String -> r
printf String
"Bad 'group' permission %i in \n%s" Int
g (TextFileWriter -> String
forall a. Show a => a -> String
ppShow TextFileWriter
sg))
  | Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
7 =
    String -> Eff e TextFileWriter
forall (e :: [* -> *]) a. Member ExcB9 e => String -> Eff e a
throwB9Error
      (String -> Int -> String -> String
forall r. PrintfType r => String -> r
printf String
"Bad 'all' permission %i in \n%s" Int
a (TextFileWriter -> String
forall a. Show a => a -> String
ppShow TextFileWriter
sg))
  | Bool
otherwise =
    String -> Eff e TextFileWriter
forall (e :: [* -> *]) a. Member ExcB9 e => String -> Eff e a
throwB9Error
      (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Permission for source already defined:\n %s" (TextFileWriter -> String
forall a. Show a => a -> String
ppShow TextFileWriter
sg))

prefixExternalSourcesPaths :: FilePath -> TextFileWriter -> TextFileWriter
prefixExternalSourcesPaths :: String -> TextFileWriter -> TextFileWriter
prefixExternalSourcesPaths String
fromDir (MkTextFileWriter Environment
e (ExternalFiles [SourceFile]
fs) FilePermissionAction
p String
d) =
  Environment
-> TextFileWriterInput
-> FilePermissionAction
-> String
-> TextFileWriter
MkTextFileWriter Environment
e ([SourceFile] -> TextFileWriterInput
ExternalFiles (SourceFile -> SourceFile
prefixExternalSourcePaths (SourceFile -> SourceFile) -> [SourceFile] -> [SourceFile]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SourceFile]
fs)) FilePermissionAction
p String
d
  where
    prefixExternalSourcePaths :: SourceFile -> SourceFile
prefixExternalSourcePaths (Source SourceFileConversion
t String
f) = SourceFileConversion -> String -> SourceFile
Source SourceFileConversion
t (String
fromDir String -> String -> String
</> String
f)
prefixExternalSourcesPaths String
_fromDir TextFileWriter
sg = TextFileWriter
sg

prefixOutputFilePaths :: FilePath -> TextFileWriter -> TextFileWriter
prefixOutputFilePaths :: String -> TextFileWriter -> TextFileWriter
prefixOutputFilePaths String
toDir (MkTextFileWriter Environment
e TextFileWriterInput
fs FilePermissionAction
p String
d) =
  Environment
-> TextFileWriterInput
-> FilePermissionAction
-> String
-> TextFileWriter
MkTextFileWriter Environment
e TextFileWriterInput
fs FilePermissionAction
p (String
toDir String -> String -> String
</> String
d)

-- | Create the 'ArtifactTarget' from an 'ArtifactAssembly' in the directory @instanceDir@
--
-- @since 0.5.65
runArtifactAssembly ::
  IsB9 e =>
  InstanceId ->
  FilePath ->
  ArtifactAssembly ->
  Eff e [ArtifactTarget]
runArtifactAssembly :: InstanceId -> String -> ArtifactAssembly -> Eff e [ArtifactTarget]
runArtifactAssembly InstanceId
iid String
instanceDir (VmImages [ImageTarget]
imageTargets VmScript
vmScript) = do
  String -> Eff e ()
forall (e :: [* -> *]). CommandIO e => String -> Eff e ()
dbgL (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Creating VM-Images in '%s'" String
instanceDir)
  Bool
success <- InstanceId -> [ImageTarget] -> String -> VmScript -> Eff e Bool
forall (e :: [* -> *]).
IsB9 e =>
InstanceId -> [ImageTarget] -> String -> VmScript -> Eff e Bool
buildWithVm InstanceId
iid [ImageTarget]
imageTargets String
instanceDir VmScript
vmScript
  let err_msg :: String
err_msg = String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Error creating 'VmImages' for instance '%s'" String
iidStr
      (IID String
iidStr) = InstanceId
iid
  Bool -> Eff e () -> Eff e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
success (String -> Eff e ()
forall (e :: [* -> *]). CommandIO e => String -> Eff e ()
errorL String
err_msg Eff e () -> Eff e () -> Eff e ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Eff e ()
forall a. HasCallStack => String -> a
error String
err_msg)
  [ArtifactTarget] -> Eff e [ArtifactTarget]
forall (m :: * -> *) a. Monad m => a -> m a
return [ArtifactTarget
VmImagesTarget]
runArtifactAssembly InstanceId
_ String
instanceDir (CloudInit [CloudInitType]
types String
outPath) =
  (CloudInitType -> Eff e ArtifactTarget)
-> [CloudInitType] -> Eff e [ArtifactTarget]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
    CloudInitType -> Eff e ArtifactTarget
create_
    [CloudInitType]
types
  where
    create_ :: CloudInitType -> Eff e ArtifactTarget
create_ CloudInitType
CI_DIR = do
      let ciDir :: String
ciDir = String
outPath
      String -> Eff e ()
forall (m :: * -> *). MonadIO m => String -> m ()
ensureDir (String
ciDir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/")
      String -> Eff e ()
forall (e :: [* -> *]). CommandIO e => String -> Eff e ()
dbgL (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"creating directory '%s'" String
ciDir)
      [String]
files <- String -> Eff e [String]
forall (m :: * -> *). MonadIO m => String -> m [String]
getDirectoryFiles String
instanceDir
      String -> Eff e ()
forall (e :: [* -> *]). CommandIO e => String -> Eff e ()
traceL (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"copying files: %s" ([String] -> String
forall a. Show a => a -> String
show [String]
files))
      IO () -> Eff e ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        ( ((String, String) -> IO ()) -> [(String, String)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
            ( \(String
f, String
t) -> do
                String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
ensureDir String
t
                String -> String -> IO ()
copyFile String
f String
t
            )
            (((String
instanceDir String -> String -> String
</>) (String -> String)
-> (String -> String) -> String -> (String, String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (String
ciDir String -> String -> String
</>)) (String -> (String, String)) -> [String] -> [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
files)
        )
      String -> Eff e ()
forall (e :: [* -> *]). CommandIO e => String -> Eff e ()
infoL (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"CREATED CI_DIR: '%s'" (String -> String
takeFileName String
ciDir))
      ArtifactTarget -> Eff e ArtifactTarget
forall (m :: * -> *) a. Monad m => a -> m a
return (CloudInitType -> String -> ArtifactTarget
CloudInitTarget CloudInitType
CI_DIR String
ciDir)
    create_ CloudInitType
CI_ISO = do
      String
buildDir <- Eff e String
forall (e :: [* -> *]). Member BuildInfoReader e => Eff e String
getBuildDir
      let isoFile :: String
isoFile = String
outPath String -> String -> String
<.> String
"iso"
          tmpFile :: String
tmpFile = String
buildDir String -> String -> String
</> String -> String
takeFileName String
isoFile
      String -> Eff e ()
forall (m :: * -> *). MonadIO m => String -> m ()
ensureDir String
tmpFile
      String -> Eff e ()
forall (e :: [* -> *]). CommandIO e => String -> Eff e ()
dbgL
        ( String -> String -> String -> String
forall r. PrintfType r => String -> r
printf
            String
"creating cloud init iso temp image '%s', destination file: '%s"
            String
tmpFile
            String
isoFile
        )
      String -> Eff e ()
forall (e :: [* -> *]).
(HasCallStack, Member ExcB9 e, CommandIO e) =>
String -> Eff e ()
cmd
        ( String -> String -> String -> String
forall r. PrintfType r => String -> r
printf
            String
"genisoimage -output '%s' -volid cidata -rock -d '%s' 2>&1"
            String
tmpFile
            String
instanceDir
        )
      String -> Eff e ()
forall (e :: [* -> *]). CommandIO e => String -> Eff e ()
dbgL (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"moving iso image '%s' to '%s'" String
tmpFile String
isoFile)
      String -> Eff e ()
forall (m :: * -> *). MonadIO m => String -> m ()
ensureDir String
isoFile
      IO () -> Eff e ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> String -> IO ()
copyFile String
tmpFile String
isoFile)
      String -> Eff e ()
forall (e :: [* -> *]). CommandIO e => String -> Eff e ()
infoL (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"CREATED CI_ISO IMAGE: '%s'" (String -> String
takeFileName String
isoFile))
      ArtifactTarget -> Eff e ArtifactTarget
forall (m :: * -> *) a. Monad m => a -> m a
return (CloudInitType -> String -> ArtifactTarget
CloudInitTarget CloudInitType
CI_ISO String
isoFile)
    create_ CloudInitType
CI_VFAT = do
      String
buildDir <- Eff e String
forall (e :: [* -> *]). Member BuildInfoReader e => Eff e String
getBuildDir
      let vfatFile :: String
vfatFile = String
outPath String -> String -> String
<.> String
"vfat"
          tmpFile :: String
tmpFile = String
buildDir String -> String -> String
</> String -> String
takeFileName String
vfatFile
      String -> Eff e ()
forall (m :: * -> *). MonadIO m => String -> m ()
ensureDir String
tmpFile
      [String]
files <- (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
instanceDir String -> String -> String
</>) ([String] -> [String]) -> Eff e [String] -> Eff e [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Eff e [String]
forall (m :: * -> *). MonadIO m => String -> m [String]
getDirectoryFiles String
instanceDir
      String -> Eff e ()
forall (e :: [* -> *]). CommandIO e => String -> Eff e ()
dbgL (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"creating cloud init vfat image '%s'" String
tmpFile)
      String -> Eff e ()
forall (e :: [* -> *]). CommandIO e => String -> Eff e ()
traceL (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"adding '%s'" ([String] -> String
forall a. Show a => a -> String
show [String]
files))
      String -> Eff e ()
forall (e :: [* -> *]).
(HasCallStack, Member ExcB9 e, CommandIO e) =>
String -> Eff e ()
cmd (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"truncate --size 2M '%s'" String
tmpFile)
      String -> Eff e ()
forall (e :: [* -> *]).
(HasCallStack, Member ExcB9 e, CommandIO e) =>
String -> Eff e ()
cmd (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"mkfs.vfat -n cidata '%s' 2>&1" String
tmpFile)
      String -> Eff e ()
forall (e :: [* -> *]).
(HasCallStack, Member ExcB9 e, CommandIO e) =>
String -> Eff e ()
cmd
        ( [String] -> String
unwords (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"mcopy -oi '%s' " String
tmpFile String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"'%s'" (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
files))
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ::"
        )
      String -> Eff e ()
forall (e :: [* -> *]). CommandIO e => String -> Eff e ()
dbgL (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"moving vfat image '%s' to '%s'" String
tmpFile String
vfatFile)
      String -> Eff e ()
forall (m :: * -> *). MonadIO m => String -> m ()
ensureDir String
vfatFile
      IO () -> Eff e ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> String -> IO ()
copyFile String
tmpFile String
vfatFile)
      String -> Eff e ()
forall (e :: [* -> *]). CommandIO e => String -> Eff e ()
infoL (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"CREATED CI_VFAT IMAGE: '%s'" (String -> String
takeFileName String
vfatFile))
      ArtifactTarget -> Eff e ArtifactTarget
forall (m :: * -> *) a. Monad m => a -> m a
return (CloudInitType -> String -> ArtifactTarget
CloudInitTarget CloudInitType
CI_ISO String
vfatFile)