module Proteome.Data.AddOptions where

import Ribosome (MsgpackDecode, MsgpackEncode)

import Proteome.Data.ProjectName (ProjectName)
import Proteome.Data.ProjectType (ProjectType)

data AddOptions =
  AddOptions {
    AddOptions -> ProjectName
name :: ProjectName,
    AddOptions -> ProjectType
tpe :: ProjectType,
    AddOptions -> Maybe Bool
activate :: Maybe Bool
  }
  deriving stock (AddOptions -> AddOptions -> Bool
(AddOptions -> AddOptions -> Bool)
-> (AddOptions -> AddOptions -> Bool) -> Eq AddOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddOptions -> AddOptions -> Bool
$c/= :: AddOptions -> AddOptions -> Bool
== :: AddOptions -> AddOptions -> Bool
$c== :: AddOptions -> AddOptions -> Bool
Eq, Int -> AddOptions -> ShowS
[AddOptions] -> ShowS
AddOptions -> String
(Int -> AddOptions -> ShowS)
-> (AddOptions -> String)
-> ([AddOptions] -> ShowS)
-> Show AddOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddOptions] -> ShowS
$cshowList :: [AddOptions] -> ShowS
show :: AddOptions -> String
$cshow :: AddOptions -> String
showsPrec :: Int -> AddOptions -> ShowS
$cshowsPrec :: Int -> AddOptions -> ShowS
Show, (forall x. AddOptions -> Rep AddOptions x)
-> (forall x. Rep AddOptions x -> AddOptions) -> Generic AddOptions
forall x. Rep AddOptions x -> AddOptions
forall x. AddOptions -> Rep AddOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddOptions x -> AddOptions
$cfrom :: forall x. AddOptions -> Rep AddOptions x
Generic)
  deriving anyclass (Object -> Either DecodeError AddOptions
(Object -> Either DecodeError AddOptions)
-> MsgpackDecode AddOptions
forall a. (Object -> Either DecodeError a) -> MsgpackDecode a
fromMsgpack :: Object -> Either DecodeError AddOptions
$cfromMsgpack :: Object -> Either DecodeError AddOptions
MsgpackDecode, AddOptions -> Object
(AddOptions -> Object) -> MsgpackEncode AddOptions
forall a. (a -> Object) -> MsgpackEncode a
toMsgpack :: AddOptions -> Object
$ctoMsgpack :: AddOptions -> Object
MsgpackEncode)