module Hix.Data.GlobalOptions where

import Path (Abs, Dir, Path)

import Hix.Data.OutputFormat (OutputFormat (OutputNone))
import Hix.Data.OutputTarget (OutputTarget (OutputDefault))

data GlobalOptions =
  GlobalOptions {
    GlobalOptions -> Bool
verbose :: Bool,
    GlobalOptions -> Bool
debug :: Bool,
    GlobalOptions -> Bool
quiet :: Bool,
    GlobalOptions -> Path Abs Dir
cwd :: Path Abs Dir,
    GlobalOptions -> OutputFormat
output :: OutputFormat,
    GlobalOptions -> OutputTarget
target :: OutputTarget
  }
  deriving stock (GlobalOptions -> GlobalOptions -> Bool
(GlobalOptions -> GlobalOptions -> Bool)
-> (GlobalOptions -> GlobalOptions -> Bool) -> Eq GlobalOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GlobalOptions -> GlobalOptions -> Bool
== :: GlobalOptions -> GlobalOptions -> Bool
$c/= :: GlobalOptions -> GlobalOptions -> Bool
/= :: GlobalOptions -> GlobalOptions -> Bool
Eq, Int -> GlobalOptions -> ShowS
[GlobalOptions] -> ShowS
GlobalOptions -> String
(Int -> GlobalOptions -> ShowS)
-> (GlobalOptions -> String)
-> ([GlobalOptions] -> ShowS)
-> Show GlobalOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GlobalOptions -> ShowS
showsPrec :: Int -> GlobalOptions -> ShowS
$cshow :: GlobalOptions -> String
show :: GlobalOptions -> String
$cshowList :: [GlobalOptions] -> ShowS
showList :: [GlobalOptions] -> ShowS
Show, (forall x. GlobalOptions -> Rep GlobalOptions x)
-> (forall x. Rep GlobalOptions x -> GlobalOptions)
-> Generic GlobalOptions
forall x. Rep GlobalOptions x -> GlobalOptions
forall x. GlobalOptions -> Rep GlobalOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GlobalOptions -> Rep GlobalOptions x
from :: forall x. GlobalOptions -> Rep GlobalOptions x
$cto :: forall x. Rep GlobalOptions x -> GlobalOptions
to :: forall x. Rep GlobalOptions x -> GlobalOptions
Generic)

defaultGlobalOptions :: Path Abs Dir -> GlobalOptions
defaultGlobalOptions :: Path Abs Dir -> GlobalOptions
defaultGlobalOptions Path Abs Dir
cwd =
  GlobalOptions {
    verbose :: Bool
verbose = Bool
False,
    debug :: Bool
debug = Bool
False,
    quiet :: Bool
quiet = Bool
False,
    Path Abs Dir
cwd :: Path Abs Dir
cwd :: Path Abs Dir
cwd,
    output :: OutputFormat
output = OutputFormat
OutputNone,
    target :: OutputTarget
target = OutputTarget
OutputDefault
  }