-- | Definition of 'VmScript' an artifact encapsulating several virtual machines
--    disk images that can be mounted in an execution environment like
--    "B9.LibVirtLXC". A 'VmScript' is embedded by in an
--    'B9.Artifact.Generator.ArtifactGenerator'.
module B9.Vm
  ( VmScript (..),
    substVmScript,
  )
where

import B9.Artifact.Content.StringTemplate
import B9.B9Error
import B9.DiskImages
import B9.Environment
import B9.ExecEnv
import B9.ShellScript
import Control.Eff
import Control.Parallel.Strategies
import Data.Binary
import Data.Data
import Data.Generics.Aliases hiding (Generic)
import Data.Generics.Schemes
import Data.Hashable
import GHC.Generics (Generic)

-- | Describe a virtual machine, i.e. a set up disk images to create and a shell
-- script to put things together.
data VmScript
  = VmScript
      CPUArch
      [SharedDirectory]
      Script
  | NoVmScript
  deriving (ReadPrec [VmScript]
ReadPrec VmScript
Int -> ReadS VmScript
ReadS [VmScript]
(Int -> ReadS VmScript)
-> ReadS [VmScript]
-> ReadPrec VmScript
-> ReadPrec [VmScript]
-> Read VmScript
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VmScript]
$creadListPrec :: ReadPrec [VmScript]
readPrec :: ReadPrec VmScript
$creadPrec :: ReadPrec VmScript
readList :: ReadS [VmScript]
$creadList :: ReadS [VmScript]
readsPrec :: Int -> ReadS VmScript
$creadsPrec :: Int -> ReadS VmScript
Read, Int -> VmScript -> ShowS
[VmScript] -> ShowS
VmScript -> String
(Int -> VmScript -> ShowS)
-> (VmScript -> String) -> ([VmScript] -> ShowS) -> Show VmScript
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VmScript] -> ShowS
$cshowList :: [VmScript] -> ShowS
show :: VmScript -> String
$cshow :: VmScript -> String
showsPrec :: Int -> VmScript -> ShowS
$cshowsPrec :: Int -> VmScript -> ShowS
Show, Typeable, Typeable VmScript
DataType
Constr
Typeable VmScript
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> VmScript -> c VmScript)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c VmScript)
-> (VmScript -> Constr)
-> (VmScript -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c VmScript))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VmScript))
-> ((forall b. Data b => b -> b) -> VmScript -> VmScript)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> VmScript -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> VmScript -> r)
-> (forall u. (forall d. Data d => d -> u) -> VmScript -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> VmScript -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> VmScript -> m VmScript)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> VmScript -> m VmScript)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> VmScript -> m VmScript)
-> Data VmScript
VmScript -> DataType
VmScript -> Constr
(forall b. Data b => b -> b) -> VmScript -> VmScript
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VmScript -> c VmScript
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VmScript
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) -> VmScript -> u
forall u. (forall d. Data d => d -> u) -> VmScript -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VmScript -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VmScript -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> VmScript -> m VmScript
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VmScript -> m VmScript
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VmScript
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VmScript -> c VmScript
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VmScript)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VmScript)
$cNoVmScript :: Constr
$cVmScript :: Constr
$tVmScript :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> VmScript -> m VmScript
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VmScript -> m VmScript
gmapMp :: (forall d. Data d => d -> m d) -> VmScript -> m VmScript
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VmScript -> m VmScript
gmapM :: (forall d. Data d => d -> m d) -> VmScript -> m VmScript
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> VmScript -> m VmScript
gmapQi :: Int -> (forall d. Data d => d -> u) -> VmScript -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> VmScript -> u
gmapQ :: (forall d. Data d => d -> u) -> VmScript -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> VmScript -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VmScript -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VmScript -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VmScript -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VmScript -> r
gmapT :: (forall b. Data b => b -> b) -> VmScript -> VmScript
$cgmapT :: (forall b. Data b => b -> b) -> VmScript -> VmScript
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VmScript)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VmScript)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c VmScript)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VmScript)
dataTypeOf :: VmScript -> DataType
$cdataTypeOf :: VmScript -> DataType
toConstr :: VmScript -> Constr
$ctoConstr :: VmScript -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VmScript
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VmScript
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VmScript -> c VmScript
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VmScript -> c VmScript
$cp1Data :: Typeable VmScript
Data, VmScript -> VmScript -> Bool
(VmScript -> VmScript -> Bool)
-> (VmScript -> VmScript -> Bool) -> Eq VmScript
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VmScript -> VmScript -> Bool
$c/= :: VmScript -> VmScript -> Bool
== :: VmScript -> VmScript -> Bool
$c== :: VmScript -> VmScript -> Bool
Eq, (forall x. VmScript -> Rep VmScript x)
-> (forall x. Rep VmScript x -> VmScript) -> Generic VmScript
forall x. Rep VmScript x -> VmScript
forall x. VmScript -> Rep VmScript x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VmScript x -> VmScript
$cfrom :: forall x. VmScript -> Rep VmScript x
Generic)

instance Hashable VmScript

instance Binary VmScript

instance NFData VmScript

substVmScript ::
  forall e.
  (Member EnvironmentReader e, Member ExcB9 e) =>
  VmScript ->
  Eff e VmScript
substVmScript :: VmScript -> Eff e VmScript
substVmScript = GenericM (Eff e) -> GenericM (Eff e)
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
everywhereM GenericM (Eff e)
gsubst
  where
    gsubst :: GenericM (Eff e)
    gsubst :: a -> Eff e a
gsubst = (MountPoint -> Eff e MountPoint) -> a -> Eff e a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
mkM MountPoint -> Eff e MountPoint
forall (e :: [* -> *]).
(FindElem (Exc SomeException) e,
 FindElem (Reader Environment) e) =>
MountPoint -> Eff e MountPoint
substMountPoint (a -> Eff e a)
-> (SharedDirectory -> Eff e SharedDirectory) -> a -> Eff e a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m a) -> (b -> m b) -> a -> m a
`extM` SharedDirectory -> Eff e SharedDirectory
forall (e :: [* -> *]).
(FindElem (Exc SomeException) e,
 FindElem (Reader Environment) e) =>
SharedDirectory -> Eff e SharedDirectory
substSharedDir (a -> Eff e a) -> (Script -> Eff e Script) -> a -> Eff e a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m a) -> (b -> m b) -> a -> m a
`extM` Script -> Eff e Script
forall (e :: [* -> *]).
(FindElem (Exc SomeException) e,
 FindElem (Reader Environment) e) =>
Script -> Eff e Script
substScript
    substMountPoint :: MountPoint -> Eff e MountPoint
substMountPoint MountPoint
NotMounted = MountPoint -> Eff e MountPoint
forall (f :: * -> *) a. Applicative f => a -> f a
pure MountPoint
NotMounted
    substMountPoint (MountPoint String
x) = String -> MountPoint
MountPoint (String -> MountPoint) -> Eff e String -> Eff e MountPoint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Eff e String
forall (e :: [* -> *]).
(Member (Exc SomeException) e, Member (Reader Environment) e) =>
String -> Eff e String
substStr String
x
    substSharedDir :: SharedDirectory -> Eff e SharedDirectory
substSharedDir (SharedDirectory String
fp MountPoint
mp) =
      String -> MountPoint -> SharedDirectory
SharedDirectory (String -> MountPoint -> SharedDirectory)
-> Eff e String -> Eff e (MountPoint -> SharedDirectory)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Eff e String
forall (e :: [* -> *]).
(Member (Exc SomeException) e, Member (Reader Environment) e) =>
String -> Eff e String
substStr String
fp Eff e (MountPoint -> SharedDirectory)
-> Eff e MountPoint -> Eff e SharedDirectory
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MountPoint -> Eff e MountPoint
forall (f :: * -> *) a. Applicative f => a -> f a
pure MountPoint
mp
    substSharedDir (SharedDirectoryRO String
fp MountPoint
mp) =
      String -> MountPoint -> SharedDirectory
SharedDirectoryRO (String -> MountPoint -> SharedDirectory)
-> Eff e String -> Eff e (MountPoint -> SharedDirectory)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Eff e String
forall (e :: [* -> *]).
(Member (Exc SomeException) e, Member (Reader Environment) e) =>
String -> Eff e String
substStr String
fp Eff e (MountPoint -> SharedDirectory)
-> Eff e MountPoint -> Eff e SharedDirectory
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MountPoint -> Eff e MountPoint
forall (f :: * -> *) a. Applicative f => a -> f a
pure MountPoint
mp
    substSharedDir SharedDirectory
s = SharedDirectory -> Eff e SharedDirectory
forall (f :: * -> *) a. Applicative f => a -> f a
pure SharedDirectory
s
    substScript :: Script -> Eff e Script
substScript (In String
fp [Script]
s) = String -> [Script] -> Script
In (String -> [Script] -> Script)
-> Eff e String -> Eff e ([Script] -> Script)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Eff e String
forall (e :: [* -> *]).
(Member (Exc SomeException) e, Member (Reader Environment) e) =>
String -> Eff e String
substStr String
fp Eff e ([Script] -> Script) -> Eff e [Script] -> Eff e Script
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Script] -> Eff e [Script]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Script]
s
    substScript (Run String
fp [String]
args) = String -> [String] -> Script
Run (String -> [String] -> Script)
-> Eff e String -> Eff e ([String] -> Script)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Eff e String
forall (e :: [* -> *]).
(Member (Exc SomeException) e, Member (Reader Environment) e) =>
String -> Eff e String
substStr String
fp Eff e ([String] -> Script) -> Eff e [String] -> Eff e Script
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Eff e String) -> [String] -> Eff e [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> Eff e String
forall (e :: [* -> *]).
(Member (Exc SomeException) e, Member (Reader Environment) e) =>
String -> Eff e String
substStr [String]
args
    substScript (As String
fp [Script]
s) = String -> [Script] -> Script
As (String -> [Script] -> Script)
-> Eff e String -> Eff e ([Script] -> Script)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Eff e String
forall (e :: [* -> *]).
(Member (Exc SomeException) e, Member (Reader Environment) e) =>
String -> Eff e String
substStr String
fp Eff e ([Script] -> Script) -> Eff e [Script] -> Eff e Script
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Script] -> Eff e [Script]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Script]
s
    substScript Script
s = Script -> Eff e Script
forall (f :: * -> *) a. Applicative f => a -> f a
pure Script
s