{-# LANGUAGE DeriveAnyClass #-}

module Hercules.Agent.WorkerProtocol.Command.Build where

import Data.Binary
import Protolude

data Build = Build
  { Build -> Text
drvPath :: Text,
    Build -> [ByteString]
inputDerivationOutputPaths :: [ByteString],
    Build -> Bool
materializeDerivation :: Bool,
    Build -> [ByteString]
materializePlatforms :: [ByteString]
  }
  deriving ((forall x. Build -> Rep Build x)
-> (forall x. Rep Build x -> Build) -> Generic Build
forall x. Rep Build x -> Build
forall x. Build -> Rep Build x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Build -> Rep Build x
from :: forall x. Build -> Rep Build x
$cto :: forall x. Rep Build x -> Build
to :: forall x. Rep Build x -> Build
Generic, Get Build
[Build] -> Put
Build -> Put
(Build -> Put) -> Get Build -> ([Build] -> Put) -> Binary Build
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: Build -> Put
put :: Build -> Put
$cget :: Get Build
get :: Get Build
$cputList :: [Build] -> Put
putList :: [Build] -> Put
Binary, Int -> Build -> ShowS
[Build] -> ShowS
Build -> String
(Int -> Build -> ShowS)
-> (Build -> String) -> ([Build] -> ShowS) -> Show Build
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Build -> ShowS
showsPrec :: Int -> Build -> ShowS
$cshow :: Build -> String
show :: Build -> String
$cshowList :: [Build] -> ShowS
showList :: [Build] -> ShowS
Show, Build -> Build -> Bool
(Build -> Build -> Bool) -> (Build -> Build -> Bool) -> Eq Build
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Build -> Build -> Bool
== :: Build -> Build -> Bool
$c/= :: Build -> Build -> Bool
/= :: Build -> Build -> Bool
Eq)