{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DuplicateRecordFields #-}

module App.Commands.Options.Types where

import Antiope.Env                      (Region)
import GHC.Generics
import HaskellWorks.CabalCache.Location

import qualified Antiope.Env as AWS

data SyncToArchiveOptions = SyncToArchiveOptions
  { SyncToArchiveOptions -> Region
region        :: Region
  , SyncToArchiveOptions -> Location
archiveUri    :: Location
  , SyncToArchiveOptions -> FilePath
buildPath     :: FilePath
  , SyncToArchiveOptions -> FilePath
storePath     :: FilePath
  , SyncToArchiveOptions -> Maybe FilePath
storePathHash :: Maybe String
  , SyncToArchiveOptions -> Int
threads       :: Int
  , SyncToArchiveOptions -> Maybe LogLevel
awsLogLevel   :: Maybe AWS.LogLevel
  } deriving (SyncToArchiveOptions -> SyncToArchiveOptions -> Bool
(SyncToArchiveOptions -> SyncToArchiveOptions -> Bool)
-> (SyncToArchiveOptions -> SyncToArchiveOptions -> Bool)
-> Eq SyncToArchiveOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SyncToArchiveOptions -> SyncToArchiveOptions -> Bool
$c/= :: SyncToArchiveOptions -> SyncToArchiveOptions -> Bool
== :: SyncToArchiveOptions -> SyncToArchiveOptions -> Bool
$c== :: SyncToArchiveOptions -> SyncToArchiveOptions -> Bool
Eq, Int -> SyncToArchiveOptions -> ShowS
[SyncToArchiveOptions] -> ShowS
SyncToArchiveOptions -> FilePath
(Int -> SyncToArchiveOptions -> ShowS)
-> (SyncToArchiveOptions -> FilePath)
-> ([SyncToArchiveOptions] -> ShowS)
-> Show SyncToArchiveOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SyncToArchiveOptions] -> ShowS
$cshowList :: [SyncToArchiveOptions] -> ShowS
show :: SyncToArchiveOptions -> FilePath
$cshow :: SyncToArchiveOptions -> FilePath
showsPrec :: Int -> SyncToArchiveOptions -> ShowS
$cshowsPrec :: Int -> SyncToArchiveOptions -> ShowS
Show, (forall x. SyncToArchiveOptions -> Rep SyncToArchiveOptions x)
-> (forall x. Rep SyncToArchiveOptions x -> SyncToArchiveOptions)
-> Generic SyncToArchiveOptions
forall x. Rep SyncToArchiveOptions x -> SyncToArchiveOptions
forall x. SyncToArchiveOptions -> Rep SyncToArchiveOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SyncToArchiveOptions x -> SyncToArchiveOptions
$cfrom :: forall x. SyncToArchiveOptions -> Rep SyncToArchiveOptions x
Generic)

data PlanOptions = PlanOptions
  { PlanOptions -> FilePath
buildPath     :: FilePath
  , PlanOptions -> FilePath
storePath     :: FilePath
  , PlanOptions -> Maybe FilePath
storePathHash :: Maybe String
  , PlanOptions -> FilePath
outputFile    :: FilePath
  } deriving (PlanOptions -> PlanOptions -> Bool
(PlanOptions -> PlanOptions -> Bool)
-> (PlanOptions -> PlanOptions -> Bool) -> Eq PlanOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlanOptions -> PlanOptions -> Bool
$c/= :: PlanOptions -> PlanOptions -> Bool
== :: PlanOptions -> PlanOptions -> Bool
$c== :: PlanOptions -> PlanOptions -> Bool
Eq, Int -> PlanOptions -> ShowS
[PlanOptions] -> ShowS
PlanOptions -> FilePath
(Int -> PlanOptions -> ShowS)
-> (PlanOptions -> FilePath)
-> ([PlanOptions] -> ShowS)
-> Show PlanOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PlanOptions] -> ShowS
$cshowList :: [PlanOptions] -> ShowS
show :: PlanOptions -> FilePath
$cshow :: PlanOptions -> FilePath
showsPrec :: Int -> PlanOptions -> ShowS
$cshowsPrec :: Int -> PlanOptions -> ShowS
Show, (forall x. PlanOptions -> Rep PlanOptions x)
-> (forall x. Rep PlanOptions x -> PlanOptions)
-> Generic PlanOptions
forall x. Rep PlanOptions x -> PlanOptions
forall x. PlanOptions -> Rep PlanOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PlanOptions x -> PlanOptions
$cfrom :: forall x. PlanOptions -> Rep PlanOptions x
Generic)

data SyncFromArchiveOptions = SyncFromArchiveOptions
  { SyncFromArchiveOptions -> Region
region        :: Region
  , SyncFromArchiveOptions -> [Location]
archiveUris   :: [Location]
  , SyncFromArchiveOptions -> FilePath
buildPath     :: FilePath
  , SyncFromArchiveOptions -> FilePath
storePath     :: FilePath
  , SyncFromArchiveOptions -> Maybe FilePath
storePathHash :: Maybe String
  , SyncFromArchiveOptions -> Int
threads       :: Int
  , SyncFromArchiveOptions -> Maybe LogLevel
awsLogLevel   :: Maybe AWS.LogLevel
  } deriving (SyncFromArchiveOptions -> SyncFromArchiveOptions -> Bool
(SyncFromArchiveOptions -> SyncFromArchiveOptions -> Bool)
-> (SyncFromArchiveOptions -> SyncFromArchiveOptions -> Bool)
-> Eq SyncFromArchiveOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SyncFromArchiveOptions -> SyncFromArchiveOptions -> Bool
$c/= :: SyncFromArchiveOptions -> SyncFromArchiveOptions -> Bool
== :: SyncFromArchiveOptions -> SyncFromArchiveOptions -> Bool
$c== :: SyncFromArchiveOptions -> SyncFromArchiveOptions -> Bool
Eq, Int -> SyncFromArchiveOptions -> ShowS
[SyncFromArchiveOptions] -> ShowS
SyncFromArchiveOptions -> FilePath
(Int -> SyncFromArchiveOptions -> ShowS)
-> (SyncFromArchiveOptions -> FilePath)
-> ([SyncFromArchiveOptions] -> ShowS)
-> Show SyncFromArchiveOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SyncFromArchiveOptions] -> ShowS
$cshowList :: [SyncFromArchiveOptions] -> ShowS
show :: SyncFromArchiveOptions -> FilePath
$cshow :: SyncFromArchiveOptions -> FilePath
showsPrec :: Int -> SyncFromArchiveOptions -> ShowS
$cshowsPrec :: Int -> SyncFromArchiveOptions -> ShowS
Show, (forall x. SyncFromArchiveOptions -> Rep SyncFromArchiveOptions x)
-> (forall x.
    Rep SyncFromArchiveOptions x -> SyncFromArchiveOptions)
-> Generic SyncFromArchiveOptions
forall x. Rep SyncFromArchiveOptions x -> SyncFromArchiveOptions
forall x. SyncFromArchiveOptions -> Rep SyncFromArchiveOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SyncFromArchiveOptions x -> SyncFromArchiveOptions
$cfrom :: forall x. SyncFromArchiveOptions -> Rep SyncFromArchiveOptions x
Generic)

data VersionOptions = VersionOptions deriving (VersionOptions -> VersionOptions -> Bool
(VersionOptions -> VersionOptions -> Bool)
-> (VersionOptions -> VersionOptions -> Bool) -> Eq VersionOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionOptions -> VersionOptions -> Bool
$c/= :: VersionOptions -> VersionOptions -> Bool
== :: VersionOptions -> VersionOptions -> Bool
$c== :: VersionOptions -> VersionOptions -> Bool
Eq, Int -> VersionOptions -> ShowS
[VersionOptions] -> ShowS
VersionOptions -> FilePath
(Int -> VersionOptions -> ShowS)
-> (VersionOptions -> FilePath)
-> ([VersionOptions] -> ShowS)
-> Show VersionOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [VersionOptions] -> ShowS
$cshowList :: [VersionOptions] -> ShowS
show :: VersionOptions -> FilePath
$cshow :: VersionOptions -> FilePath
showsPrec :: Int -> VersionOptions -> ShowS
$cshowsPrec :: Int -> VersionOptions -> ShowS
Show, (forall x. VersionOptions -> Rep VersionOptions x)
-> (forall x. Rep VersionOptions x -> VersionOptions)
-> Generic VersionOptions
forall x. Rep VersionOptions x -> VersionOptions
forall x. VersionOptions -> Rep VersionOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VersionOptions x -> VersionOptions
$cfrom :: forall x. VersionOptions -> Rep VersionOptions x
Generic)