{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Top-Level data types for B9 build artifacts.
module B9.Artifact.Readable
  ( ArtifactGenerator (..),
    InstanceId (..),
    ArtifactTarget (..),
    CloudInitType (..),
    ArtifactAssembly (..),
    AssembledArtifact (..),
    AssemblyOutput (..),
    instanceIdKey,
    buildIdKey,
    buildDateKey,
    getAssemblyOutput,

    -- ** Re-exports
    ArtifactSource (..),
    getArtifactSourceFiles,
  )
where

import B9.Artifact.Readable.Source
import B9.DiskImages
import B9.QCUtil
import B9.Vm
import Control.Parallel.Strategies
import Data.Binary
import Data.Data
import Data.Hashable
import Data.Semigroup as Sem
import GHC.Generics (Generic)
import System.FilePath ((<.>))
import Test.QuickCheck

-- | Artifacts represent the things B9 can build. A generator specifies howto
-- generate parameterized, multiple artifacts. The general structure is:
--
-- @
--   Let [ ... bindings ... ]
--       [ Sources
--           [ ... list all input files ... ]
--           [ Artifact ...
--           , Artifact ...
--           , Let [ ... ] [ ... ]
--           ]
--       ]
-- @
--
-- The reasons why 'Sources' takes a list of 'ArtifactGenerator's is that
--
--   1. this makes the value easier to read/write for humans
--
--   2. the sources are static files used in all children (e.g. company logo image)
--
--   3. the sources are parameterized by variables that bound to different values
--      for each artifact, e.g. a template network config file which contains
--      the host IP address.
--
-- To bind such variables use 'Let', 'Each', 'LetX' or 'EachT'.
--
-- String substitution of these variables is done by "B9.Artifact.Content.StringTemplate".
-- These variables can be used as value in nested 'Let's, in most file names/paths
-- and in source files added with 'B9.Artifact.Content.StringTemplate.SourceFile'
--
-- -- @deprecated TODO remove this when switching to Dhall
data ArtifactGenerator
  = -- | Add sources available to 'ArtifactAssembly's in
    -- nested artifact generators.
    Sources
      [ArtifactSource]
      [ArtifactGenerator]
  | -- | Bind variables, variables are available in nested
    -- generators.
    -- @deprecated TODO remove this when switching to Dhall
    Let
      [(String, String)]
      [ArtifactGenerator]
  | -- | A 'Let' where each variable is assigned to each
    -- value; the nested generator is executed for each
    -- permutation.
    --
    -- @
    --     LetX [("x", ["1","2","3"]), ("y", ["a","b"])] [..]
    -- @
    -- Is equal to:
    --
    -- @
    --     Let [] [
    --       Let [("x", "1"), ("y", "a")] [..]
    --       Let [("x", "1"), ("y", "b")] [..]
    --       Let [("x", "2"), ("y", "a")] [..]
    --       Let [("x", "2"), ("y", "b")] [..]
    --       Let [("x", "3"), ("y", "a")] [..]
    --       Let [("x", "3"), ("y", "b")] [..]
    --     ]
    -- @
    -- @deprecated TODO remove this when switching to Dhall
    LetX
      [(String, [String])]
      [ArtifactGenerator]
  | -- | Bind each variable to their first value, then each
    -- variable to the second value, etc ... and execute the
    -- nested generator in every step. 'LetX' represents a
    -- product of all variables, whereas 'Each' represents a
    -- sum of variable bindings - 'Each' is more like a /zip/
    -- whereas 'LetX' is more like a list comprehension.
    -- @deprecated TODO remove this when switching to Dhall
    Each
      [(String, [String])]
      [ArtifactGenerator]
  | -- | The transposed version of 'Each': Bind the variables
    -- in the first list to each a set of values from the
    -- second argument; execute the nested generators for
    -- each binding
    -- @deprecated TODO remove this when switching to Dhall
    EachT
      [String]
      [[String]]
      [ArtifactGenerator]
  | -- | Generate an artifact defined by an
    -- 'ArtifactAssembly'; the assembly can access the files
    -- created from the 'Sources' and variables bound by
    -- 'Let'ish elements. An artifact has an instance id,
    -- that is a unique, human readable string describing the
    -- artifact to assemble.
    Artifact
      InstanceId
      ArtifactAssembly
  | EmptyArtifact
  deriving (ReadPrec [ArtifactGenerator]
ReadPrec ArtifactGenerator
Int -> ReadS ArtifactGenerator
ReadS [ArtifactGenerator]
(Int -> ReadS ArtifactGenerator)
-> ReadS [ArtifactGenerator]
-> ReadPrec ArtifactGenerator
-> ReadPrec [ArtifactGenerator]
-> Read ArtifactGenerator
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ArtifactGenerator]
$creadListPrec :: ReadPrec [ArtifactGenerator]
readPrec :: ReadPrec ArtifactGenerator
$creadPrec :: ReadPrec ArtifactGenerator
readList :: ReadS [ArtifactGenerator]
$creadList :: ReadS [ArtifactGenerator]
readsPrec :: Int -> ReadS ArtifactGenerator
$creadsPrec :: Int -> ReadS ArtifactGenerator
Read, Int -> ArtifactGenerator -> ShowS
[ArtifactGenerator] -> ShowS
ArtifactGenerator -> String
(Int -> ArtifactGenerator -> ShowS)
-> (ArtifactGenerator -> String)
-> ([ArtifactGenerator] -> ShowS)
-> Show ArtifactGenerator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArtifactGenerator] -> ShowS
$cshowList :: [ArtifactGenerator] -> ShowS
show :: ArtifactGenerator -> String
$cshow :: ArtifactGenerator -> String
showsPrec :: Int -> ArtifactGenerator -> ShowS
$cshowsPrec :: Int -> ArtifactGenerator -> ShowS
Show, ArtifactGenerator -> ArtifactGenerator -> Bool
(ArtifactGenerator -> ArtifactGenerator -> Bool)
-> (ArtifactGenerator -> ArtifactGenerator -> Bool)
-> Eq ArtifactGenerator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArtifactGenerator -> ArtifactGenerator -> Bool
$c/= :: ArtifactGenerator -> ArtifactGenerator -> Bool
== :: ArtifactGenerator -> ArtifactGenerator -> Bool
$c== :: ArtifactGenerator -> ArtifactGenerator -> Bool
Eq, Typeable ArtifactGenerator
DataType
Constr
Typeable ArtifactGenerator
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> ArtifactGenerator
    -> c ArtifactGenerator)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ArtifactGenerator)
-> (ArtifactGenerator -> Constr)
-> (ArtifactGenerator -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ArtifactGenerator))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ArtifactGenerator))
-> ((forall b. Data b => b -> b)
    -> ArtifactGenerator -> ArtifactGenerator)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ArtifactGenerator -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ArtifactGenerator -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ArtifactGenerator -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ArtifactGenerator -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ArtifactGenerator -> m ArtifactGenerator)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ArtifactGenerator -> m ArtifactGenerator)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ArtifactGenerator -> m ArtifactGenerator)
-> Data ArtifactGenerator
ArtifactGenerator -> DataType
ArtifactGenerator -> Constr
(forall b. Data b => b -> b)
-> ArtifactGenerator -> ArtifactGenerator
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArtifactGenerator -> c ArtifactGenerator
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArtifactGenerator
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) -> ArtifactGenerator -> u
forall u. (forall d. Data d => d -> u) -> ArtifactGenerator -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactGenerator -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactGenerator -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ArtifactGenerator -> m ArtifactGenerator
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArtifactGenerator -> m ArtifactGenerator
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArtifactGenerator
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArtifactGenerator -> c ArtifactGenerator
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArtifactGenerator)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ArtifactGenerator)
$cEmptyArtifact :: Constr
$cArtifact :: Constr
$cEachT :: Constr
$cEach :: Constr
$cLetX :: Constr
$cLet :: Constr
$cSources :: Constr
$tArtifactGenerator :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ArtifactGenerator -> m ArtifactGenerator
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArtifactGenerator -> m ArtifactGenerator
gmapMp :: (forall d. Data d => d -> m d)
-> ArtifactGenerator -> m ArtifactGenerator
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArtifactGenerator -> m ArtifactGenerator
gmapM :: (forall d. Data d => d -> m d)
-> ArtifactGenerator -> m ArtifactGenerator
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ArtifactGenerator -> m ArtifactGenerator
gmapQi :: Int -> (forall d. Data d => d -> u) -> ArtifactGenerator -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ArtifactGenerator -> u
gmapQ :: (forall d. Data d => d -> u) -> ArtifactGenerator -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ArtifactGenerator -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactGenerator -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactGenerator -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactGenerator -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactGenerator -> r
gmapT :: (forall b. Data b => b -> b)
-> ArtifactGenerator -> ArtifactGenerator
$cgmapT :: (forall b. Data b => b -> b)
-> ArtifactGenerator -> ArtifactGenerator
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ArtifactGenerator)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ArtifactGenerator)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ArtifactGenerator)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArtifactGenerator)
dataTypeOf :: ArtifactGenerator -> DataType
$cdataTypeOf :: ArtifactGenerator -> DataType
toConstr :: ArtifactGenerator -> Constr
$ctoConstr :: ArtifactGenerator -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArtifactGenerator
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArtifactGenerator
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArtifactGenerator -> c ArtifactGenerator
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArtifactGenerator -> c ArtifactGenerator
$cp1Data :: Typeable ArtifactGenerator
Data, Typeable, (forall x. ArtifactGenerator -> Rep ArtifactGenerator x)
-> (forall x. Rep ArtifactGenerator x -> ArtifactGenerator)
-> Generic ArtifactGenerator
forall x. Rep ArtifactGenerator x -> ArtifactGenerator
forall x. ArtifactGenerator -> Rep ArtifactGenerator x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ArtifactGenerator x -> ArtifactGenerator
$cfrom :: forall x. ArtifactGenerator -> Rep ArtifactGenerator x
Generic)

--instance Hashable ArtifactGenerator
--instance Binary ArtifactGenerator
instance NFData ArtifactGenerator

instance Sem.Semigroup ArtifactGenerator where
  (Let [] []) <> :: ArtifactGenerator -> ArtifactGenerator -> ArtifactGenerator
<> ArtifactGenerator
x = ArtifactGenerator
x
  ArtifactGenerator
x <> (Let [] []) = ArtifactGenerator
x
  ArtifactGenerator
x <> ArtifactGenerator
y = [(String, String)] -> [ArtifactGenerator] -> ArtifactGenerator
Let [] [ArtifactGenerator
x, ArtifactGenerator
y]

instance Monoid ArtifactGenerator where
  mempty :: ArtifactGenerator
mempty = [(String, String)] -> [ArtifactGenerator] -> ArtifactGenerator
Let [] []
  mappend :: ArtifactGenerator -> ArtifactGenerator -> ArtifactGenerator
mappend = ArtifactGenerator -> ArtifactGenerator -> ArtifactGenerator
forall a. Semigroup a => a -> a -> a
(Sem.<>)

-- | Identify an artifact. __Deprecated__ TODO: B9 does not check if all
-- instances IDs are unique.
newtype InstanceId
  = IID String
  deriving (ReadPrec [InstanceId]
ReadPrec InstanceId
Int -> ReadS InstanceId
ReadS [InstanceId]
(Int -> ReadS InstanceId)
-> ReadS [InstanceId]
-> ReadPrec InstanceId
-> ReadPrec [InstanceId]
-> Read InstanceId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InstanceId]
$creadListPrec :: ReadPrec [InstanceId]
readPrec :: ReadPrec InstanceId
$creadPrec :: ReadPrec InstanceId
readList :: ReadS [InstanceId]
$creadList :: ReadS [InstanceId]
readsPrec :: Int -> ReadS InstanceId
$creadsPrec :: Int -> ReadS InstanceId
Read, Int -> InstanceId -> ShowS
[InstanceId] -> ShowS
InstanceId -> String
(Int -> InstanceId -> ShowS)
-> (InstanceId -> String)
-> ([InstanceId] -> ShowS)
-> Show InstanceId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstanceId] -> ShowS
$cshowList :: [InstanceId] -> ShowS
show :: InstanceId -> String
$cshow :: InstanceId -> String
showsPrec :: Int -> InstanceId -> ShowS
$cshowsPrec :: Int -> InstanceId -> ShowS
Show, Typeable, Typeable InstanceId
DataType
Constr
Typeable InstanceId
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> InstanceId -> c InstanceId)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c InstanceId)
-> (InstanceId -> Constr)
-> (InstanceId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c InstanceId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c InstanceId))
-> ((forall b. Data b => b -> b) -> InstanceId -> InstanceId)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> InstanceId -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> InstanceId -> r)
-> (forall u. (forall d. Data d => d -> u) -> InstanceId -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> InstanceId -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> InstanceId -> m InstanceId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> InstanceId -> m InstanceId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> InstanceId -> m InstanceId)
-> Data InstanceId
InstanceId -> DataType
InstanceId -> Constr
(forall b. Data b => b -> b) -> InstanceId -> InstanceId
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InstanceId -> c InstanceId
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InstanceId
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) -> InstanceId -> u
forall u. (forall d. Data d => d -> u) -> InstanceId -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InstanceId -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InstanceId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InstanceId -> m InstanceId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InstanceId -> m InstanceId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InstanceId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InstanceId -> c InstanceId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InstanceId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InstanceId)
$cIID :: Constr
$tInstanceId :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> InstanceId -> m InstanceId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InstanceId -> m InstanceId
gmapMp :: (forall d. Data d => d -> m d) -> InstanceId -> m InstanceId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InstanceId -> m InstanceId
gmapM :: (forall d. Data d => d -> m d) -> InstanceId -> m InstanceId
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InstanceId -> m InstanceId
gmapQi :: Int -> (forall d. Data d => d -> u) -> InstanceId -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InstanceId -> u
gmapQ :: (forall d. Data d => d -> u) -> InstanceId -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InstanceId -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InstanceId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InstanceId -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InstanceId -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InstanceId -> r
gmapT :: (forall b. Data b => b -> b) -> InstanceId -> InstanceId
$cgmapT :: (forall b. Data b => b -> b) -> InstanceId -> InstanceId
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InstanceId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InstanceId)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c InstanceId)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InstanceId)
dataTypeOf :: InstanceId -> DataType
$cdataTypeOf :: InstanceId -> DataType
toConstr :: InstanceId -> Constr
$ctoConstr :: InstanceId -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InstanceId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InstanceId
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InstanceId -> c InstanceId
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InstanceId -> c InstanceId
$cp1Data :: Typeable InstanceId
Data, InstanceId -> InstanceId -> Bool
(InstanceId -> InstanceId -> Bool)
-> (InstanceId -> InstanceId -> Bool) -> Eq InstanceId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstanceId -> InstanceId -> Bool
$c/= :: InstanceId -> InstanceId -> Bool
== :: InstanceId -> InstanceId -> Bool
$c== :: InstanceId -> InstanceId -> Bool
Eq, InstanceId -> ()
(InstanceId -> ()) -> NFData InstanceId
forall a. (a -> ()) -> NFData a
rnf :: InstanceId -> ()
$crnf :: InstanceId -> ()
NFData, Get InstanceId
[InstanceId] -> Put
InstanceId -> Put
(InstanceId -> Put)
-> Get InstanceId -> ([InstanceId] -> Put) -> Binary InstanceId
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [InstanceId] -> Put
$cputList :: [InstanceId] -> Put
get :: Get InstanceId
$cget :: Get InstanceId
put :: InstanceId -> Put
$cput :: InstanceId -> Put
Binary, Int -> InstanceId -> Int
InstanceId -> Int
(Int -> InstanceId -> Int)
-> (InstanceId -> Int) -> Hashable InstanceId
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: InstanceId -> Int
$chash :: InstanceId -> Int
hashWithSalt :: Int -> InstanceId -> Int
$chashWithSalt :: Int -> InstanceId -> Int
Hashable)

-- | The variable containing the instance id. __Deprecated__
instanceIdKey :: String
instanceIdKey :: String
instanceIdKey = String
"instance_id"

-- | The variable containing the buildId that identifies each execution of
-- B9. For more info about variable substitution in source files see
-- 'B9.Artifact.Content.StringTemplate'
buildIdKey :: String
buildIdKey :: String
buildIdKey = String
"build_id"

-- | The variable containing the date and time a build was started. For more
-- info about variable substitution in source files see
-- 'B9.Artifact.Content.StringTemplate'
buildDateKey :: String
buildDateKey :: String
buildDateKey = String
"build_date"

-- | Define an __output__ of a build. Assemblies are nested into
-- 'ArtifactGenerator's. They contain all the files defined by the 'Sources'
-- they are nested into.
data ArtifactAssembly
  = -- | Generate a __cloud-init__ compatible directory, ISO-
    -- or VFAT image, as specified by the list of
    -- 'CloudInitType's. Every item will use the second
    -- argument to create an appropriate /file name/,
    -- e.g. for the 'CI_ISO' type the output is @second_param.iso@.
    CloudInit
      [CloudInitType]
      FilePath
  | -- | a set of VM-images that were created by executing a
    -- build script on them.
    VmImages
      [ImageTarget]
      VmScript
  deriving (ReadPrec [ArtifactAssembly]
ReadPrec ArtifactAssembly
Int -> ReadS ArtifactAssembly
ReadS [ArtifactAssembly]
(Int -> ReadS ArtifactAssembly)
-> ReadS [ArtifactAssembly]
-> ReadPrec ArtifactAssembly
-> ReadPrec [ArtifactAssembly]
-> Read ArtifactAssembly
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ArtifactAssembly]
$creadListPrec :: ReadPrec [ArtifactAssembly]
readPrec :: ReadPrec ArtifactAssembly
$creadPrec :: ReadPrec ArtifactAssembly
readList :: ReadS [ArtifactAssembly]
$creadList :: ReadS [ArtifactAssembly]
readsPrec :: Int -> ReadS ArtifactAssembly
$creadsPrec :: Int -> ReadS ArtifactAssembly
Read, Int -> ArtifactAssembly -> ShowS
[ArtifactAssembly] -> ShowS
ArtifactAssembly -> String
(Int -> ArtifactAssembly -> ShowS)
-> (ArtifactAssembly -> String)
-> ([ArtifactAssembly] -> ShowS)
-> Show ArtifactAssembly
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArtifactAssembly] -> ShowS
$cshowList :: [ArtifactAssembly] -> ShowS
show :: ArtifactAssembly -> String
$cshow :: ArtifactAssembly -> String
showsPrec :: Int -> ArtifactAssembly -> ShowS
$cshowsPrec :: Int -> ArtifactAssembly -> ShowS
Show, Typeable, Typeable ArtifactAssembly
DataType
Constr
Typeable ArtifactAssembly
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ArtifactAssembly -> c ArtifactAssembly)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ArtifactAssembly)
-> (ArtifactAssembly -> Constr)
-> (ArtifactAssembly -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ArtifactAssembly))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ArtifactAssembly))
-> ((forall b. Data b => b -> b)
    -> ArtifactAssembly -> ArtifactAssembly)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ArtifactAssembly -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ArtifactAssembly -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ArtifactAssembly -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ArtifactAssembly -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ArtifactAssembly -> m ArtifactAssembly)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ArtifactAssembly -> m ArtifactAssembly)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ArtifactAssembly -> m ArtifactAssembly)
-> Data ArtifactAssembly
ArtifactAssembly -> DataType
ArtifactAssembly -> Constr
(forall b. Data b => b -> b)
-> ArtifactAssembly -> ArtifactAssembly
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArtifactAssembly -> c ArtifactAssembly
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArtifactAssembly
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) -> ArtifactAssembly -> u
forall u. (forall d. Data d => d -> u) -> ArtifactAssembly -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactAssembly -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactAssembly -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ArtifactAssembly -> m ArtifactAssembly
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArtifactAssembly -> m ArtifactAssembly
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArtifactAssembly
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArtifactAssembly -> c ArtifactAssembly
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArtifactAssembly)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ArtifactAssembly)
$cVmImages :: Constr
$cCloudInit :: Constr
$tArtifactAssembly :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ArtifactAssembly -> m ArtifactAssembly
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArtifactAssembly -> m ArtifactAssembly
gmapMp :: (forall d. Data d => d -> m d)
-> ArtifactAssembly -> m ArtifactAssembly
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArtifactAssembly -> m ArtifactAssembly
gmapM :: (forall d. Data d => d -> m d)
-> ArtifactAssembly -> m ArtifactAssembly
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ArtifactAssembly -> m ArtifactAssembly
gmapQi :: Int -> (forall d. Data d => d -> u) -> ArtifactAssembly -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ArtifactAssembly -> u
gmapQ :: (forall d. Data d => d -> u) -> ArtifactAssembly -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ArtifactAssembly -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactAssembly -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactAssembly -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactAssembly -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactAssembly -> r
gmapT :: (forall b. Data b => b -> b)
-> ArtifactAssembly -> ArtifactAssembly
$cgmapT :: (forall b. Data b => b -> b)
-> ArtifactAssembly -> ArtifactAssembly
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ArtifactAssembly)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ArtifactAssembly)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ArtifactAssembly)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArtifactAssembly)
dataTypeOf :: ArtifactAssembly -> DataType
$cdataTypeOf :: ArtifactAssembly -> DataType
toConstr :: ArtifactAssembly -> Constr
$ctoConstr :: ArtifactAssembly -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArtifactAssembly
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArtifactAssembly
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArtifactAssembly -> c ArtifactAssembly
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArtifactAssembly -> c ArtifactAssembly
$cp1Data :: Typeable ArtifactAssembly
Data, ArtifactAssembly -> ArtifactAssembly -> Bool
(ArtifactAssembly -> ArtifactAssembly -> Bool)
-> (ArtifactAssembly -> ArtifactAssembly -> Bool)
-> Eq ArtifactAssembly
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArtifactAssembly -> ArtifactAssembly -> Bool
$c/= :: ArtifactAssembly -> ArtifactAssembly -> Bool
== :: ArtifactAssembly -> ArtifactAssembly -> Bool
$c== :: ArtifactAssembly -> ArtifactAssembly -> Bool
Eq, (forall x. ArtifactAssembly -> Rep ArtifactAssembly x)
-> (forall x. Rep ArtifactAssembly x -> ArtifactAssembly)
-> Generic ArtifactAssembly
forall x. Rep ArtifactAssembly x -> ArtifactAssembly
forall x. ArtifactAssembly -> Rep ArtifactAssembly x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ArtifactAssembly x -> ArtifactAssembly
$cfrom :: forall x. ArtifactAssembly -> Rep ArtifactAssembly x
Generic)

instance Hashable ArtifactAssembly

instance Binary ArtifactAssembly

instance NFData ArtifactAssembly

-- | A symbolic representation of the targets assembled by
-- 'B9.Artifact.Readable.Interpreter.assemble' from an 'ArtifactAssembly'. There is a
-- list of 'ArtifactTarget's because e.g. a single 'CloudInit' can produce up to
-- three output files, a directory, an ISO image and a VFAT image.
data AssembledArtifact
  = AssembledArtifact
      InstanceId
      [ArtifactTarget]
  deriving (ReadPrec [AssembledArtifact]
ReadPrec AssembledArtifact
Int -> ReadS AssembledArtifact
ReadS [AssembledArtifact]
(Int -> ReadS AssembledArtifact)
-> ReadS [AssembledArtifact]
-> ReadPrec AssembledArtifact
-> ReadPrec [AssembledArtifact]
-> Read AssembledArtifact
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssembledArtifact]
$creadListPrec :: ReadPrec [AssembledArtifact]
readPrec :: ReadPrec AssembledArtifact
$creadPrec :: ReadPrec AssembledArtifact
readList :: ReadS [AssembledArtifact]
$creadList :: ReadS [AssembledArtifact]
readsPrec :: Int -> ReadS AssembledArtifact
$creadsPrec :: Int -> ReadS AssembledArtifact
Read, Int -> AssembledArtifact -> ShowS
[AssembledArtifact] -> ShowS
AssembledArtifact -> String
(Int -> AssembledArtifact -> ShowS)
-> (AssembledArtifact -> String)
-> ([AssembledArtifact] -> ShowS)
-> Show AssembledArtifact
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssembledArtifact] -> ShowS
$cshowList :: [AssembledArtifact] -> ShowS
show :: AssembledArtifact -> String
$cshow :: AssembledArtifact -> String
showsPrec :: Int -> AssembledArtifact -> ShowS
$cshowsPrec :: Int -> AssembledArtifact -> ShowS
Show, Typeable, Typeable AssembledArtifact
DataType
Constr
Typeable AssembledArtifact
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> AssembledArtifact
    -> c AssembledArtifact)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AssembledArtifact)
-> (AssembledArtifact -> Constr)
-> (AssembledArtifact -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AssembledArtifact))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AssembledArtifact))
-> ((forall b. Data b => b -> b)
    -> AssembledArtifact -> AssembledArtifact)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AssembledArtifact -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AssembledArtifact -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> AssembledArtifact -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AssembledArtifact -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> AssembledArtifact -> m AssembledArtifact)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AssembledArtifact -> m AssembledArtifact)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AssembledArtifact -> m AssembledArtifact)
-> Data AssembledArtifact
AssembledArtifact -> DataType
AssembledArtifact -> Constr
(forall b. Data b => b -> b)
-> AssembledArtifact -> AssembledArtifact
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AssembledArtifact -> c AssembledArtifact
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssembledArtifact
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) -> AssembledArtifact -> u
forall u. (forall d. Data d => d -> u) -> AssembledArtifact -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssembledArtifact -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssembledArtifact -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssembledArtifact -> m AssembledArtifact
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssembledArtifact -> m AssembledArtifact
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssembledArtifact
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AssembledArtifact -> c AssembledArtifact
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssembledArtifact)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssembledArtifact)
$cAssembledArtifact :: Constr
$tAssembledArtifact :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> AssembledArtifact -> m AssembledArtifact
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssembledArtifact -> m AssembledArtifact
gmapMp :: (forall d. Data d => d -> m d)
-> AssembledArtifact -> m AssembledArtifact
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssembledArtifact -> m AssembledArtifact
gmapM :: (forall d. Data d => d -> m d)
-> AssembledArtifact -> m AssembledArtifact
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssembledArtifact -> m AssembledArtifact
gmapQi :: Int -> (forall d. Data d => d -> u) -> AssembledArtifact -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AssembledArtifact -> u
gmapQ :: (forall d. Data d => d -> u) -> AssembledArtifact -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AssembledArtifact -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssembledArtifact -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssembledArtifact -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssembledArtifact -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssembledArtifact -> r
gmapT :: (forall b. Data b => b -> b)
-> AssembledArtifact -> AssembledArtifact
$cgmapT :: (forall b. Data b => b -> b)
-> AssembledArtifact -> AssembledArtifact
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssembledArtifact)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssembledArtifact)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c AssembledArtifact)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssembledArtifact)
dataTypeOf :: AssembledArtifact -> DataType
$cdataTypeOf :: AssembledArtifact -> DataType
toConstr :: AssembledArtifact -> Constr
$ctoConstr :: AssembledArtifact -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssembledArtifact
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssembledArtifact
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AssembledArtifact -> c AssembledArtifact
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AssembledArtifact -> c AssembledArtifact
$cp1Data :: Typeable AssembledArtifact
Data, AssembledArtifact -> AssembledArtifact -> Bool
(AssembledArtifact -> AssembledArtifact -> Bool)
-> (AssembledArtifact -> AssembledArtifact -> Bool)
-> Eq AssembledArtifact
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssembledArtifact -> AssembledArtifact -> Bool
$c/= :: AssembledArtifact -> AssembledArtifact -> Bool
== :: AssembledArtifact -> AssembledArtifact -> Bool
$c== :: AssembledArtifact -> AssembledArtifact -> Bool
Eq, (forall x. AssembledArtifact -> Rep AssembledArtifact x)
-> (forall x. Rep AssembledArtifact x -> AssembledArtifact)
-> Generic AssembledArtifact
forall x. Rep AssembledArtifact x -> AssembledArtifact
forall x. AssembledArtifact -> Rep AssembledArtifact x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AssembledArtifact x -> AssembledArtifact
$cfrom :: forall x. AssembledArtifact -> Rep AssembledArtifact x
Generic)

instance Hashable AssembledArtifact

instance Binary AssembledArtifact

instance NFData AssembledArtifact

data ArtifactTarget
  = CloudInitTarget
      CloudInitType
      FilePath
  | VmImagesTarget
  deriving (ReadPrec [ArtifactTarget]
ReadPrec ArtifactTarget
Int -> ReadS ArtifactTarget
ReadS [ArtifactTarget]
(Int -> ReadS ArtifactTarget)
-> ReadS [ArtifactTarget]
-> ReadPrec ArtifactTarget
-> ReadPrec [ArtifactTarget]
-> Read ArtifactTarget
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ArtifactTarget]
$creadListPrec :: ReadPrec [ArtifactTarget]
readPrec :: ReadPrec ArtifactTarget
$creadPrec :: ReadPrec ArtifactTarget
readList :: ReadS [ArtifactTarget]
$creadList :: ReadS [ArtifactTarget]
readsPrec :: Int -> ReadS ArtifactTarget
$creadsPrec :: Int -> ReadS ArtifactTarget
Read, Int -> ArtifactTarget -> ShowS
[ArtifactTarget] -> ShowS
ArtifactTarget -> String
(Int -> ArtifactTarget -> ShowS)
-> (ArtifactTarget -> String)
-> ([ArtifactTarget] -> ShowS)
-> Show ArtifactTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArtifactTarget] -> ShowS
$cshowList :: [ArtifactTarget] -> ShowS
show :: ArtifactTarget -> String
$cshow :: ArtifactTarget -> String
showsPrec :: Int -> ArtifactTarget -> ShowS
$cshowsPrec :: Int -> ArtifactTarget -> ShowS
Show, Typeable, Typeable ArtifactTarget
DataType
Constr
Typeable ArtifactTarget
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ArtifactTarget -> c ArtifactTarget)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ArtifactTarget)
-> (ArtifactTarget -> Constr)
-> (ArtifactTarget -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ArtifactTarget))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ArtifactTarget))
-> ((forall b. Data b => b -> b)
    -> ArtifactTarget -> ArtifactTarget)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ArtifactTarget -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ArtifactTarget -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ArtifactTarget -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ArtifactTarget -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ArtifactTarget -> m ArtifactTarget)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ArtifactTarget -> m ArtifactTarget)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ArtifactTarget -> m ArtifactTarget)
-> Data ArtifactTarget
ArtifactTarget -> DataType
ArtifactTarget -> Constr
(forall b. Data b => b -> b) -> ArtifactTarget -> ArtifactTarget
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArtifactTarget -> c ArtifactTarget
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArtifactTarget
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) -> ArtifactTarget -> u
forall u. (forall d. Data d => d -> u) -> ArtifactTarget -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactTarget -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactTarget -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ArtifactTarget -> m ArtifactTarget
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArtifactTarget -> m ArtifactTarget
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArtifactTarget
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArtifactTarget -> c ArtifactTarget
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArtifactTarget)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ArtifactTarget)
$cVmImagesTarget :: Constr
$cCloudInitTarget :: Constr
$tArtifactTarget :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ArtifactTarget -> m ArtifactTarget
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArtifactTarget -> m ArtifactTarget
gmapMp :: (forall d. Data d => d -> m d)
-> ArtifactTarget -> m ArtifactTarget
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArtifactTarget -> m ArtifactTarget
gmapM :: (forall d. Data d => d -> m d)
-> ArtifactTarget -> m ArtifactTarget
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ArtifactTarget -> m ArtifactTarget
gmapQi :: Int -> (forall d. Data d => d -> u) -> ArtifactTarget -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ArtifactTarget -> u
gmapQ :: (forall d. Data d => d -> u) -> ArtifactTarget -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ArtifactTarget -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactTarget -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactTarget -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactTarget -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactTarget -> r
gmapT :: (forall b. Data b => b -> b) -> ArtifactTarget -> ArtifactTarget
$cgmapT :: (forall b. Data b => b -> b) -> ArtifactTarget -> ArtifactTarget
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ArtifactTarget)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ArtifactTarget)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ArtifactTarget)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArtifactTarget)
dataTypeOf :: ArtifactTarget -> DataType
$cdataTypeOf :: ArtifactTarget -> DataType
toConstr :: ArtifactTarget -> Constr
$ctoConstr :: ArtifactTarget -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArtifactTarget
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArtifactTarget
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArtifactTarget -> c ArtifactTarget
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArtifactTarget -> c ArtifactTarget
$cp1Data :: Typeable ArtifactTarget
Data, ArtifactTarget -> ArtifactTarget -> Bool
(ArtifactTarget -> ArtifactTarget -> Bool)
-> (ArtifactTarget -> ArtifactTarget -> Bool) -> Eq ArtifactTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArtifactTarget -> ArtifactTarget -> Bool
$c/= :: ArtifactTarget -> ArtifactTarget -> Bool
== :: ArtifactTarget -> ArtifactTarget -> Bool
$c== :: ArtifactTarget -> ArtifactTarget -> Bool
Eq, (forall x. ArtifactTarget -> Rep ArtifactTarget x)
-> (forall x. Rep ArtifactTarget x -> ArtifactTarget)
-> Generic ArtifactTarget
forall x. Rep ArtifactTarget x -> ArtifactTarget
forall x. ArtifactTarget -> Rep ArtifactTarget x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ArtifactTarget x -> ArtifactTarget
$cfrom :: forall x. ArtifactTarget -> Rep ArtifactTarget x
Generic)

instance Hashable ArtifactTarget

instance Binary ArtifactTarget

instance NFData ArtifactTarget

data CloudInitType
  = CI_ISO
  | CI_VFAT
  | CI_DIR
  deriving (ReadPrec [CloudInitType]
ReadPrec CloudInitType
Int -> ReadS CloudInitType
ReadS [CloudInitType]
(Int -> ReadS CloudInitType)
-> ReadS [CloudInitType]
-> ReadPrec CloudInitType
-> ReadPrec [CloudInitType]
-> Read CloudInitType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CloudInitType]
$creadListPrec :: ReadPrec [CloudInitType]
readPrec :: ReadPrec CloudInitType
$creadPrec :: ReadPrec CloudInitType
readList :: ReadS [CloudInitType]
$creadList :: ReadS [CloudInitType]
readsPrec :: Int -> ReadS CloudInitType
$creadsPrec :: Int -> ReadS CloudInitType
Read, Int -> CloudInitType -> ShowS
[CloudInitType] -> ShowS
CloudInitType -> String
(Int -> CloudInitType -> ShowS)
-> (CloudInitType -> String)
-> ([CloudInitType] -> ShowS)
-> Show CloudInitType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CloudInitType] -> ShowS
$cshowList :: [CloudInitType] -> ShowS
show :: CloudInitType -> String
$cshow :: CloudInitType -> String
showsPrec :: Int -> CloudInitType -> ShowS
$cshowsPrec :: Int -> CloudInitType -> ShowS
Show, Typeable, Typeable CloudInitType
DataType
Constr
Typeable CloudInitType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CloudInitType -> c CloudInitType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CloudInitType)
-> (CloudInitType -> Constr)
-> (CloudInitType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CloudInitType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CloudInitType))
-> ((forall b. Data b => b -> b) -> CloudInitType -> CloudInitType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CloudInitType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CloudInitType -> r)
-> (forall u. (forall d. Data d => d -> u) -> CloudInitType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CloudInitType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CloudInitType -> m CloudInitType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CloudInitType -> m CloudInitType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CloudInitType -> m CloudInitType)
-> Data CloudInitType
CloudInitType -> DataType
CloudInitType -> Constr
(forall b. Data b => b -> b) -> CloudInitType -> CloudInitType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CloudInitType -> c CloudInitType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CloudInitType
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) -> CloudInitType -> u
forall u. (forall d. Data d => d -> u) -> CloudInitType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CloudInitType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CloudInitType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CloudInitType -> m CloudInitType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CloudInitType -> m CloudInitType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CloudInitType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CloudInitType -> c CloudInitType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CloudInitType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CloudInitType)
$cCI_DIR :: Constr
$cCI_VFAT :: Constr
$cCI_ISO :: Constr
$tCloudInitType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> CloudInitType -> m CloudInitType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CloudInitType -> m CloudInitType
gmapMp :: (forall d. Data d => d -> m d) -> CloudInitType -> m CloudInitType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CloudInitType -> m CloudInitType
gmapM :: (forall d. Data d => d -> m d) -> CloudInitType -> m CloudInitType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CloudInitType -> m CloudInitType
gmapQi :: Int -> (forall d. Data d => d -> u) -> CloudInitType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CloudInitType -> u
gmapQ :: (forall d. Data d => d -> u) -> CloudInitType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CloudInitType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CloudInitType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CloudInitType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CloudInitType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CloudInitType -> r
gmapT :: (forall b. Data b => b -> b) -> CloudInitType -> CloudInitType
$cgmapT :: (forall b. Data b => b -> b) -> CloudInitType -> CloudInitType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CloudInitType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CloudInitType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CloudInitType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CloudInitType)
dataTypeOf :: CloudInitType -> DataType
$cdataTypeOf :: CloudInitType -> DataType
toConstr :: CloudInitType -> Constr
$ctoConstr :: CloudInitType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CloudInitType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CloudInitType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CloudInitType -> c CloudInitType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CloudInitType -> c CloudInitType
$cp1Data :: Typeable CloudInitType
Data, CloudInitType -> CloudInitType -> Bool
(CloudInitType -> CloudInitType -> Bool)
-> (CloudInitType -> CloudInitType -> Bool) -> Eq CloudInitType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CloudInitType -> CloudInitType -> Bool
$c/= :: CloudInitType -> CloudInitType -> Bool
== :: CloudInitType -> CloudInitType -> Bool
$c== :: CloudInitType -> CloudInitType -> Bool
Eq, (forall x. CloudInitType -> Rep CloudInitType x)
-> (forall x. Rep CloudInitType x -> CloudInitType)
-> Generic CloudInitType
forall x. Rep CloudInitType x -> CloudInitType
forall x. CloudInitType -> Rep CloudInitType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CloudInitType x -> CloudInitType
$cfrom :: forall x. CloudInitType -> Rep CloudInitType x
Generic)

instance Hashable CloudInitType

instance Binary CloudInitType

instance NFData CloudInitType

-- | The output of an 'ArtifactAssembly' is either a set of generated files,
--  or it might be a directory that contains the artifacts sources.
data AssemblyOutput
  = AssemblyGeneratesOutputFiles [FilePath]
  | AssemblyCopiesSourcesToDirectory FilePath
  deriving (ReadPrec [AssemblyOutput]
ReadPrec AssemblyOutput
Int -> ReadS AssemblyOutput
ReadS [AssemblyOutput]
(Int -> ReadS AssemblyOutput)
-> ReadS [AssemblyOutput]
-> ReadPrec AssemblyOutput
-> ReadPrec [AssemblyOutput]
-> Read AssemblyOutput
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssemblyOutput]
$creadListPrec :: ReadPrec [AssemblyOutput]
readPrec :: ReadPrec AssemblyOutput
$creadPrec :: ReadPrec AssemblyOutput
readList :: ReadS [AssemblyOutput]
$creadList :: ReadS [AssemblyOutput]
readsPrec :: Int -> ReadS AssemblyOutput
$creadsPrec :: Int -> ReadS AssemblyOutput
Read, Int -> AssemblyOutput -> ShowS
[AssemblyOutput] -> ShowS
AssemblyOutput -> String
(Int -> AssemblyOutput -> ShowS)
-> (AssemblyOutput -> String)
-> ([AssemblyOutput] -> ShowS)
-> Show AssemblyOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssemblyOutput] -> ShowS
$cshowList :: [AssemblyOutput] -> ShowS
show :: AssemblyOutput -> String
$cshow :: AssemblyOutput -> String
showsPrec :: Int -> AssemblyOutput -> ShowS
$cshowsPrec :: Int -> AssemblyOutput -> ShowS
Show, Typeable, Typeable AssemblyOutput
DataType
Constr
Typeable AssemblyOutput
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> AssemblyOutput -> c AssemblyOutput)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AssemblyOutput)
-> (AssemblyOutput -> Constr)
-> (AssemblyOutput -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AssemblyOutput))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AssemblyOutput))
-> ((forall b. Data b => b -> b)
    -> AssemblyOutput -> AssemblyOutput)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AssemblyOutput -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AssemblyOutput -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> AssemblyOutput -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AssemblyOutput -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> AssemblyOutput -> m AssemblyOutput)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AssemblyOutput -> m AssemblyOutput)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AssemblyOutput -> m AssemblyOutput)
-> Data AssemblyOutput
AssemblyOutput -> DataType
AssemblyOutput -> Constr
(forall b. Data b => b -> b) -> AssemblyOutput -> AssemblyOutput
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AssemblyOutput -> c AssemblyOutput
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssemblyOutput
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) -> AssemblyOutput -> u
forall u. (forall d. Data d => d -> u) -> AssemblyOutput -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssemblyOutput -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssemblyOutput -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssemblyOutput -> m AssemblyOutput
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssemblyOutput -> m AssemblyOutput
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssemblyOutput
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AssemblyOutput -> c AssemblyOutput
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssemblyOutput)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssemblyOutput)
$cAssemblyCopiesSourcesToDirectory :: Constr
$cAssemblyGeneratesOutputFiles :: Constr
$tAssemblyOutput :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> AssemblyOutput -> m AssemblyOutput
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssemblyOutput -> m AssemblyOutput
gmapMp :: (forall d. Data d => d -> m d)
-> AssemblyOutput -> m AssemblyOutput
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssemblyOutput -> m AssemblyOutput
gmapM :: (forall d. Data d => d -> m d)
-> AssemblyOutput -> m AssemblyOutput
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssemblyOutput -> m AssemblyOutput
gmapQi :: Int -> (forall d. Data d => d -> u) -> AssemblyOutput -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AssemblyOutput -> u
gmapQ :: (forall d. Data d => d -> u) -> AssemblyOutput -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AssemblyOutput -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssemblyOutput -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssemblyOutput -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssemblyOutput -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssemblyOutput -> r
gmapT :: (forall b. Data b => b -> b) -> AssemblyOutput -> AssemblyOutput
$cgmapT :: (forall b. Data b => b -> b) -> AssemblyOutput -> AssemblyOutput
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssemblyOutput)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AssemblyOutput)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c AssemblyOutput)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AssemblyOutput)
dataTypeOf :: AssemblyOutput -> DataType
$cdataTypeOf :: AssemblyOutput -> DataType
toConstr :: AssemblyOutput -> Constr
$ctoConstr :: AssemblyOutput -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssemblyOutput
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AssemblyOutput
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AssemblyOutput -> c AssemblyOutput
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AssemblyOutput -> c AssemblyOutput
$cp1Data :: Typeable AssemblyOutput
Data, AssemblyOutput -> AssemblyOutput -> Bool
(AssemblyOutput -> AssemblyOutput -> Bool)
-> (AssemblyOutput -> AssemblyOutput -> Bool) -> Eq AssemblyOutput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssemblyOutput -> AssemblyOutput -> Bool
$c/= :: AssemblyOutput -> AssemblyOutput -> Bool
== :: AssemblyOutput -> AssemblyOutput -> Bool
$c== :: AssemblyOutput -> AssemblyOutput -> Bool
Eq, (forall x. AssemblyOutput -> Rep AssemblyOutput x)
-> (forall x. Rep AssemblyOutput x -> AssemblyOutput)
-> Generic AssemblyOutput
forall x. Rep AssemblyOutput x -> AssemblyOutput
forall x. AssemblyOutput -> Rep AssemblyOutput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AssemblyOutput x -> AssemblyOutput
$cfrom :: forall x. AssemblyOutput -> Rep AssemblyOutput x
Generic)

-- | Return the files that the artifact assembly consist of.
getAssemblyOutput :: ArtifactAssembly -> [AssemblyOutput]
getAssemblyOutput :: ArtifactAssembly -> [AssemblyOutput]
getAssemblyOutput (VmImages [ImageTarget]
ts VmScript
_) =
  [String] -> AssemblyOutput
AssemblyGeneratesOutputFiles ([String] -> AssemblyOutput)
-> (ImageTarget -> [String]) -> ImageTarget -> AssemblyOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImageTarget -> [String]
getImageDestinationOutputFiles (ImageTarget -> AssemblyOutput)
-> [ImageTarget] -> [AssemblyOutput]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ImageTarget]
ts
getAssemblyOutput (CloudInit [CloudInitType]
ts String
o) = String -> CloudInitType -> AssemblyOutput
getCloudInitOutputFiles String
o (CloudInitType -> AssemblyOutput)
-> [CloudInitType] -> [AssemblyOutput]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CloudInitType]
ts
  where
    getCloudInitOutputFiles :: String -> CloudInitType -> AssemblyOutput
getCloudInitOutputFiles String
baseName CloudInitType
t = case CloudInitType
t of
      CloudInitType
CI_ISO -> [String] -> AssemblyOutput
AssemblyGeneratesOutputFiles [String
baseName String -> ShowS
<.> String
"iso"]
      CloudInitType
CI_VFAT -> [String] -> AssemblyOutput
AssemblyGeneratesOutputFiles [String
baseName String -> ShowS
<.> String
"vfat"]
      CloudInitType
CI_DIR -> String -> AssemblyOutput
AssemblyCopiesSourcesToDirectory String
baseName

-- * QuickCheck instances

instance Arbitrary ArtifactGenerator where
  arbitrary :: Gen ArtifactGenerator
arbitrary =
    [Gen ArtifactGenerator] -> Gen ArtifactGenerator
forall a. [Gen a] -> Gen a
oneof
      [ [ArtifactSource] -> [ArtifactGenerator] -> ArtifactGenerator
Sources ([ArtifactSource] -> [ArtifactGenerator] -> ArtifactGenerator)
-> Gen [ArtifactSource]
-> Gen ([ArtifactGenerator] -> ArtifactGenerator)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [ArtifactSource] -> Gen [ArtifactSource]
forall a. Gen a -> Gen a
halfSize Gen [ArtifactSource]
forall a. Arbitrary a => Gen a
arbitrary Gen ([ArtifactGenerator] -> ArtifactGenerator)
-> Gen [ArtifactGenerator] -> Gen ArtifactGenerator
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [ArtifactGenerator] -> Gen [ArtifactGenerator]
forall a. Gen a -> Gen a
halfSize Gen [ArtifactGenerator]
forall a. Arbitrary a => Gen a
arbitrary,
        [(String, String)] -> [ArtifactGenerator] -> ArtifactGenerator
Let ([(String, String)] -> [ArtifactGenerator] -> ArtifactGenerator)
-> Gen [(String, String)]
-> Gen ([ArtifactGenerator] -> ArtifactGenerator)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [(String, String)] -> Gen [(String, String)]
forall a. Gen a -> Gen a
halfSize Gen [(String, String)]
forall a. Arbitrary a => Gen [(String, a)]
arbitraryEnv Gen ([ArtifactGenerator] -> ArtifactGenerator)
-> Gen [ArtifactGenerator] -> Gen ArtifactGenerator
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [ArtifactGenerator] -> Gen [ArtifactGenerator]
forall a. Gen a -> Gen a
halfSize Gen [ArtifactGenerator]
forall a. Arbitrary a => Gen a
arbitrary,
        Gen ([ArtifactGenerator] -> ArtifactGenerator)
-> Gen ([ArtifactGenerator] -> ArtifactGenerator)
forall a. Gen a -> Gen a
halfSize Gen ([ArtifactGenerator] -> ArtifactGenerator)
arbitraryEachT Gen ([ArtifactGenerator] -> ArtifactGenerator)
-> Gen [ArtifactGenerator] -> Gen ArtifactGenerator
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [ArtifactGenerator] -> Gen [ArtifactGenerator]
forall a. Gen a -> Gen a
halfSize Gen [ArtifactGenerator]
forall a. Arbitrary a => Gen a
arbitrary,
        Gen ([ArtifactGenerator] -> ArtifactGenerator)
-> Gen ([ArtifactGenerator] -> ArtifactGenerator)
forall a. Gen a -> Gen a
halfSize Gen ([ArtifactGenerator] -> ArtifactGenerator)
arbitraryEach Gen ([ArtifactGenerator] -> ArtifactGenerator)
-> Gen [ArtifactGenerator] -> Gen ArtifactGenerator
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [ArtifactGenerator] -> Gen [ArtifactGenerator]
forall a. Gen a -> Gen a
halfSize Gen [ArtifactGenerator]
forall a. Arbitrary a => Gen a
arbitrary,
        InstanceId -> ArtifactAssembly -> ArtifactGenerator
Artifact (InstanceId -> ArtifactAssembly -> ArtifactGenerator)
-> Gen InstanceId -> Gen (ArtifactAssembly -> ArtifactGenerator)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen InstanceId -> Gen InstanceId
forall a. Gen a -> Gen a
smaller Gen InstanceId
forall a. Arbitrary a => Gen a
arbitrary Gen (ArtifactAssembly -> ArtifactGenerator)
-> Gen ArtifactAssembly -> Gen ArtifactGenerator
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ArtifactAssembly -> Gen ArtifactAssembly
forall a. Gen a -> Gen a
smaller Gen ArtifactAssembly
forall a. Arbitrary a => Gen a
arbitrary,
        ArtifactGenerator -> Gen ArtifactGenerator
forall (f :: * -> *) a. Applicative f => a -> f a
pure ArtifactGenerator
EmptyArtifact
      ]

arbitraryEachT :: Gen ([ArtifactGenerator] -> ArtifactGenerator)
arbitraryEachT :: Gen ([ArtifactGenerator] -> ArtifactGenerator)
arbitraryEachT = (Int -> Gen ([ArtifactGenerator] -> ArtifactGenerator))
-> Gen ([ArtifactGenerator] -> ArtifactGenerator)
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen ([ArtifactGenerator] -> ArtifactGenerator))
 -> Gen ([ArtifactGenerator] -> ArtifactGenerator))
-> (Int -> Gen ([ArtifactGenerator] -> ArtifactGenerator))
-> Gen ([ArtifactGenerator] -> ArtifactGenerator)
forall a b. (a -> b) -> a -> b
$ \Int
n ->
  [String] -> [[String]] -> [ArtifactGenerator] -> ArtifactGenerator
EachT ([String]
 -> [[String]] -> [ArtifactGenerator] -> ArtifactGenerator)
-> Gen [String]
-> Gen ([[String]] -> [ArtifactGenerator] -> ArtifactGenerator)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen String -> Gen [String]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n (Gen String -> Gen String
forall a. Gen a -> Gen a
halfSize (Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf1 ((Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Char
'a', Char
'z'))))
    Gen ([[String]] -> [ArtifactGenerator] -> ArtifactGenerator)
-> Gen [[String]] -> Gen ([ArtifactGenerator] -> ArtifactGenerator)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Gen [[String]]] -> Gen [[String]]
forall a. [Gen a] -> Gen a
oneof
      [ Gen [String] -> Gen [[String]]
forall a. Gen a -> Gen [a]
listOf (Int -> Gen String -> Gen [String]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n (Gen String -> Gen String
forall a. Gen a -> Gen a
halfSize Gen String
forall a. Arbitrary a => Gen a
arbitrary)),
        Gen [String] -> Gen [[String]]
forall a. Gen a -> Gen [a]
listOf1 (Gen String -> Gen [String]
forall a. Gen a -> Gen [a]
listOf (Gen String -> Gen String
forall a. Gen a -> Gen a
halfSize Gen String
forall a. Arbitrary a => Gen a
arbitrary))
      ]

arbitraryEach :: Gen ([ArtifactGenerator] -> ArtifactGenerator)
arbitraryEach :: Gen ([ArtifactGenerator] -> ArtifactGenerator)
arbitraryEach = (Int -> Gen ([ArtifactGenerator] -> ArtifactGenerator))
-> Gen ([ArtifactGenerator] -> ArtifactGenerator)
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen ([ArtifactGenerator] -> ArtifactGenerator))
 -> Gen ([ArtifactGenerator] -> ArtifactGenerator))
-> (Int -> Gen ([ArtifactGenerator] -> ArtifactGenerator))
-> Gen ([ArtifactGenerator] -> ArtifactGenerator)
forall a b. (a -> b) -> a -> b
$ \Int
n ->
  [(String, [String])] -> [ArtifactGenerator] -> ArtifactGenerator
Each
    ([(String, [String])] -> [ArtifactGenerator] -> ArtifactGenerator)
-> Gen [(String, [String])]
-> Gen ([ArtifactGenerator] -> ArtifactGenerator)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (String, [String]) -> Gen [(String, [String])]
forall a. Gen a -> Gen [a]
listOf
      ( (,) (String -> [String] -> (String, [String]))
-> Gen String -> Gen ([String] -> (String, [String]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf1 ((Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Char
'a', Char
'z'))
          Gen ([String] -> (String, [String]))
-> Gen [String] -> Gen (String, [String])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Gen String -> Gen [String]
forall a. Int -> Gen a -> Gen [a]
vectorOf
            Int
n
            (Gen String -> Gen String
forall a. Gen a -> Gen a
halfSize (Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf1 ((Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Char
'a', Char
'z'))))
      )

instance Arbitrary InstanceId where
  arbitrary :: Gen InstanceId
arbitrary = String -> InstanceId
IID (String -> InstanceId) -> Gen String -> Gen InstanceId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
arbitraryFilePath

instance Arbitrary ArtifactAssembly where
  arbitrary :: Gen ArtifactAssembly
arbitrary =
    [Gen ArtifactAssembly] -> Gen ArtifactAssembly
forall a. [Gen a] -> Gen a
oneof
      [ [CloudInitType] -> String -> ArtifactAssembly
CloudInit ([CloudInitType] -> String -> ArtifactAssembly)
-> Gen [CloudInitType] -> Gen (String -> ArtifactAssembly)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [CloudInitType]
forall a. Arbitrary a => Gen a
arbitrary Gen (String -> ArtifactAssembly)
-> Gen String -> Gen ArtifactAssembly
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen String
arbitraryFilePath,
        [ImageTarget] -> VmScript -> ArtifactAssembly
VmImages ([ImageTarget] -> VmScript -> ArtifactAssembly)
-> Gen [ImageTarget] -> Gen (VmScript -> ArtifactAssembly)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [ImageTarget] -> Gen [ImageTarget]
forall a. Gen a -> Gen a
smaller Gen [ImageTarget]
forall a. Arbitrary a => Gen a
arbitrary Gen (VmScript -> ArtifactAssembly)
-> Gen VmScript -> Gen ArtifactAssembly
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> VmScript -> Gen VmScript
forall (f :: * -> *) a. Applicative f => a -> f a
pure VmScript
NoVmScript
      ]

instance Arbitrary CloudInitType where
  arbitrary :: Gen CloudInitType
arbitrary = [CloudInitType] -> Gen CloudInitType
forall a. [a] -> Gen a
elements [CloudInitType
CI_ISO, CloudInitType
CI_VFAT, CloudInitType
CI_DIR]