{-# language StrictData #-}

-- | Definitions & defaults for the CLI options
module Nix.Options where

import           Nix.Prelude
import           Data.Time

--  2021-07-15: NOTE: What these are? They need to be documented.
-- Also need better names. Foe example, Maybes & lists names need to show their type in the name.
data Options =
  Options
    { Options -> Verbosity
getVerbosity   :: Verbosity
    , Options -> Bool
isTrace        :: Bool
    , Options -> Bool
isThunks       :: Bool
    , Options -> Bool
isValues       :: Bool
    , Options -> Bool
isShowScopes   :: Bool
    , Options -> Maybe Path
getReduce      :: Maybe Path
    , Options -> Bool
isReduceSets   :: Bool
    , Options -> Bool
isReduceLists  :: Bool
    , Options -> Bool
isParse        :: Bool
    , Options -> Bool
isParseOnly    :: Bool
    , Options -> Bool
isFinder       :: Bool
    , Options -> Maybe Path
getFindFile    :: Maybe Path
    , Options -> Bool
isStrict       :: Bool
    , Options -> Bool
isEvaluate     :: Bool
    , Options -> Bool
isJson         :: Bool
    , Options -> Bool
isXml          :: Bool
    , Options -> Maybe Text
getAttr        :: Maybe Text
    , Options -> [Path]
getInclude     :: [Path]
    , Options -> Bool
isCheck        :: Bool
    , Options -> Maybe Path
getReadFrom    :: Maybe Path
    , Options -> Bool
isCache        :: Bool
    , Options -> Bool
isRepl         :: Bool
    , Options -> Bool
isIgnoreErrors :: Bool
    , Options -> Maybe Text
getExpression  :: Maybe Text
    , Options -> [(Text, Text)]
getArg         :: [(Text, Text)]
    , Options -> [(Text, Text)]
getArgstr      :: [(Text, Text)]
    , Options -> Maybe Path
getFromFile    :: Maybe Path
    , Options -> UTCTime
getTime        :: UTCTime
    -- ^ The time can be set to reproduce time-dependent states.
    , Options -> [Path]
getFilePaths   :: [Path]
    }
    deriving Int -> Options -> ShowS
[Options] -> ShowS
Options -> String
(Int -> Options -> ShowS)
-> (Options -> String) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> String
$cshow :: Options -> String
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> Options -> ShowS
Show

defaultOptions :: UTCTime -> Options
defaultOptions :: UTCTime -> Options
defaultOptions UTCTime
currentTime =
  Options :: Verbosity
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe Path
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe Path
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe Text
-> [Path]
-> Bool
-> Maybe Path
-> Bool
-> Bool
-> Bool
-> Maybe Text
-> [(Text, Text)]
-> [(Text, Text)]
-> Maybe Path
-> UTCTime
-> [Path]
-> Options
Options
    { getVerbosity :: Verbosity
getVerbosity   = Verbosity
ErrorsOnly
    , isTrace :: Bool
isTrace        = Bool
False
    , isThunks :: Bool
isThunks       = Bool
False
    , isValues :: Bool
isValues       = Bool
False
    , isShowScopes :: Bool
isShowScopes   = Bool
False
    , getReduce :: Maybe Path
getReduce      = Maybe Path
forall a. Monoid a => a
mempty
    , isReduceSets :: Bool
isReduceSets   = Bool
False
    , isReduceLists :: Bool
isReduceLists  = Bool
False
    , isParse :: Bool
isParse        = Bool
False
    , isParseOnly :: Bool
isParseOnly    = Bool
False
    , isFinder :: Bool
isFinder       = Bool
False
    , getFindFile :: Maybe Path
getFindFile    = Maybe Path
forall a. Monoid a => a
mempty
    , isStrict :: Bool
isStrict       = Bool
False
    , isEvaluate :: Bool
isEvaluate     = Bool
False
    , isJson :: Bool
isJson         = Bool
False
    , isXml :: Bool
isXml          = Bool
False
    , getAttr :: Maybe Text
getAttr        = Maybe Text
forall a. Monoid a => a
mempty
    , getInclude :: [Path]
getInclude     = [Path]
forall a. Monoid a => a
mempty
    , isCheck :: Bool
isCheck        = Bool
False
    , getReadFrom :: Maybe Path
getReadFrom    = Maybe Path
forall a. Monoid a => a
mempty
    , isCache :: Bool
isCache        = Bool
False
    , isRepl :: Bool
isRepl         = Bool
False
    , isIgnoreErrors :: Bool
isIgnoreErrors = Bool
False
    , getExpression :: Maybe Text
getExpression  = Maybe Text
forall a. Monoid a => a
mempty
    , getArg :: [(Text, Text)]
getArg         = [(Text, Text)]
forall a. Monoid a => a
mempty
    , getArgstr :: [(Text, Text)]
getArgstr      = [(Text, Text)]
forall a. Monoid a => a
mempty
    , getFromFile :: Maybe Path
getFromFile    = Maybe Path
forall a. Monoid a => a
mempty
    , getTime :: UTCTime
getTime        = UTCTime
currentTime
    , getFilePaths :: [Path]
getFilePaths   = [Path]
forall a. Monoid a => a
mempty
    }

data Verbosity
    = ErrorsOnly
    | Informational
    | Talkative
    | Chatty
    | DebugInfo
    | Vomit
    deriving (Verbosity -> Verbosity -> Bool
(Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool) -> Eq Verbosity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Verbosity -> Verbosity -> Bool
$c/= :: Verbosity -> Verbosity -> Bool
== :: Verbosity -> Verbosity -> Bool
$c== :: Verbosity -> Verbosity -> Bool
Eq, Eq Verbosity
Eq Verbosity
-> (Verbosity -> Verbosity -> Ordering)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Verbosity)
-> (Verbosity -> Verbosity -> Verbosity)
-> Ord Verbosity
Verbosity -> Verbosity -> Bool
Verbosity -> Verbosity -> Ordering
Verbosity -> Verbosity -> Verbosity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Verbosity -> Verbosity -> Verbosity
$cmin :: Verbosity -> Verbosity -> Verbosity
max :: Verbosity -> Verbosity -> Verbosity
$cmax :: Verbosity -> Verbosity -> Verbosity
>= :: Verbosity -> Verbosity -> Bool
$c>= :: Verbosity -> Verbosity -> Bool
> :: Verbosity -> Verbosity -> Bool
$c> :: Verbosity -> Verbosity -> Bool
<= :: Verbosity -> Verbosity -> Bool
$c<= :: Verbosity -> Verbosity -> Bool
< :: Verbosity -> Verbosity -> Bool
$c< :: Verbosity -> Verbosity -> Bool
compare :: Verbosity -> Verbosity -> Ordering
$ccompare :: Verbosity -> Verbosity -> Ordering
$cp1Ord :: Eq Verbosity
Ord, Int -> Verbosity
Verbosity -> Int
Verbosity -> [Verbosity]
Verbosity -> Verbosity
Verbosity -> Verbosity -> [Verbosity]
Verbosity -> Verbosity -> Verbosity -> [Verbosity]
(Verbosity -> Verbosity)
-> (Verbosity -> Verbosity)
-> (Int -> Verbosity)
-> (Verbosity -> Int)
-> (Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> Verbosity -> [Verbosity])
-> Enum Verbosity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
$cenumFromThenTo :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
enumFromTo :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromTo :: Verbosity -> Verbosity -> [Verbosity]
enumFromThen :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromThen :: Verbosity -> Verbosity -> [Verbosity]
enumFrom :: Verbosity -> [Verbosity]
$cenumFrom :: Verbosity -> [Verbosity]
fromEnum :: Verbosity -> Int
$cfromEnum :: Verbosity -> Int
toEnum :: Int -> Verbosity
$ctoEnum :: Int -> Verbosity
pred :: Verbosity -> Verbosity
$cpred :: Verbosity -> Verbosity
succ :: Verbosity -> Verbosity
$csucc :: Verbosity -> Verbosity
Enum, Verbosity
Verbosity -> Verbosity -> Bounded Verbosity
forall a. a -> a -> Bounded a
maxBound :: Verbosity
$cmaxBound :: Verbosity
minBound :: Verbosity
$cminBound :: Verbosity
Bounded, Int -> Verbosity -> ShowS
[Verbosity] -> ShowS
Verbosity -> String
(Int -> Verbosity -> ShowS)
-> (Verbosity -> String)
-> ([Verbosity] -> ShowS)
-> Show Verbosity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Verbosity] -> ShowS
$cshowList :: [Verbosity] -> ShowS
show :: Verbosity -> String
$cshow :: Verbosity -> String
showsPrec :: Int -> Verbosity -> ShowS
$cshowsPrec :: Int -> Verbosity -> ShowS
Show)

askOptions :: forall e m . (MonadReader e m, Has e Options) => m Options
askOptions :: m Options
askOptions = m Options
forall t (m :: * -> *) a. (MonadReader t m, Has t a) => m a
askLocal