{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# Language DeriveGeneric, MultiWayIf, OverloadedStrings #-}
-- | This module deals with loading configurations.
module Crux.Config.Load where


import Control.Lens (set)
import Control.Monad(foldM, (<=<))
import Control.Exception(Exception(..),catch,catches,throwIO, Handler(..))
import Data.Generics.Product.Fields (field, setField)
import Data.Text (Text)
import GHC.Generics (Generic)

import System.Environment

import SimpleGetOpt
import Config
import Config.Schema
import Config.Schema.Load.Error(ErrorAnnotation(..))

import Crux.Config

-- | The result of loading a configuration.
data Options opts =
    ShowHelp {- XXX: Add help strings -} -- ^ Show help and exit
  | ShowVersion -- ^ Show version and exit
  | Options opts [FilePath]   -- ^ We loaded some options


data ColorOptions = ColorOptions
  { ColorOptions -> Bool
noColorsErr :: Bool
  , ColorOptions -> Bool
noColorsOut :: Bool
  }
  deriving ((forall x. ColorOptions -> Rep ColorOptions x)
-> (forall x. Rep ColorOptions x -> ColorOptions)
-> Generic ColorOptions
forall x. Rep ColorOptions x -> ColorOptions
forall x. ColorOptions -> Rep ColorOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ColorOptions -> Rep ColorOptions x
from :: forall x. ColorOptions -> Rep ColorOptions x
$cto :: forall x. Rep ColorOptions x -> ColorOptions
to :: forall x. Rep ColorOptions x -> ColorOptions
Generic)

defaultColorOptions :: ColorOptions
defaultColorOptions :: ColorOptions
defaultColorOptions = ColorOptions
allColors

allColors :: ColorOptions
allColors :: ColorOptions
allColors = ColorOptions
  { noColorsErr :: Bool
noColorsErr = Bool
False
  , noColorsOut :: Bool
noColorsOut = Bool
False
  }

noColors :: ColorOptions
noColors :: ColorOptions
noColors = ColorOptions
  { noColorsErr :: Bool
noColorsErr = Bool
True
  , noColorsOut :: Bool
noColorsOut = Bool
True
  }


-- | Command line options processed before loading the configuration file.
data EarlyConfig opts = EarlyConfig
  { forall opts. EarlyConfig opts -> Bool
showHelp      :: Bool -- ^ Describe options & quit
  , forall opts. EarlyConfig opts -> Bool
showVersion   :: Bool -- ^ Show tool version & quit
  , forall opts. EarlyConfig opts -> Maybe [Char]
configFile    :: Maybe FilePath
    -- ^ Load configuratoin from here.
    -- Other command line options override the settings in the file.
  , forall opts. EarlyConfig opts -> ColorOptions
colorOptions  :: ColorOptions
  , forall opts. EarlyConfig opts -> OptSetter opts
options       :: OptSetter opts
  , forall opts. EarlyConfig opts -> [[Char]]
files         :: [FilePath]
  }
  deriving ((forall x. EarlyConfig opts -> Rep (EarlyConfig opts) x)
-> (forall x. Rep (EarlyConfig opts) x -> EarlyConfig opts)
-> Generic (EarlyConfig opts)
forall x. Rep (EarlyConfig opts) x -> EarlyConfig opts
forall x. EarlyConfig opts -> Rep (EarlyConfig opts) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall opts x. Rep (EarlyConfig opts) x -> EarlyConfig opts
forall opts x. EarlyConfig opts -> Rep (EarlyConfig opts) x
$cfrom :: forall opts x. EarlyConfig opts -> Rep (EarlyConfig opts) x
from :: forall x. EarlyConfig opts -> Rep (EarlyConfig opts) x
$cto :: forall opts x. Rep (EarlyConfig opts) x -> EarlyConfig opts
to :: forall x. Rep (EarlyConfig opts) x -> EarlyConfig opts
Generic)


commandLineOptions :: Config opts -> OptSpec (EarlyConfig opts)
commandLineOptions :: forall opts. Config opts -> OptSpec (EarlyConfig opts)
commandLineOptions Config opts
cfg = OptSpec
  { progDefaults :: EarlyConfig opts
progDefaults = EarlyConfig
                     { showHelp :: Bool
showHelp     = Bool
False
                     , showVersion :: Bool
showVersion  = Bool
False
                     , configFile :: Maybe [Char]
configFile   = Maybe [Char]
forall a. Maybe a
Nothing
                     , colorOptions :: ColorOptions
colorOptions = ColorOptions
defaultColorOptions
                     , options :: OptSetter opts
options      = OptSetter opts
forall a b. b -> Either a b
Right
                     , files :: [[Char]]
files        = []
                     }

  , progOptions :: [OptDescr (EarlyConfig opts)]
progOptions =
      [ [Char]
-> [[Char]]
-> [Char]
-> ArgDescr (EarlyConfig opts)
-> OptDescr (EarlyConfig opts)
forall a. [Char] -> [[Char]] -> [Char] -> ArgDescr a -> OptDescr a
Option [Char]
"h?" [[Char]
"help"]
        [Char]
"Print this help message"
        (ArgDescr (EarlyConfig opts) -> OptDescr (EarlyConfig opts))
-> ArgDescr (EarlyConfig opts) -> OptDescr (EarlyConfig opts)
forall a b. (a -> b) -> a -> b
$ OptSetter (EarlyConfig opts) -> ArgDescr (EarlyConfig opts)
forall a. OptSetter a -> ArgDescr a
NoArg (OptSetter (EarlyConfig opts) -> ArgDescr (EarlyConfig opts))
-> OptSetter (EarlyConfig opts) -> ArgDescr (EarlyConfig opts)
forall a b. (a -> b) -> a -> b
$ \EarlyConfig opts
opts -> OptSetter (EarlyConfig opts)
forall a b. b -> Either a b
Right EarlyConfig opts
opts { showHelp = True }

      , [Char]
-> [[Char]]
-> [Char]
-> ArgDescr (EarlyConfig opts)
-> OptDescr (EarlyConfig opts)
forall a. [Char] -> [[Char]] -> [Char] -> ArgDescr a -> OptDescr a
Option [Char]
"V" [[Char]
"version"]
        [Char]
"Show the version of the tool"
        (ArgDescr (EarlyConfig opts) -> OptDescr (EarlyConfig opts))
-> ArgDescr (EarlyConfig opts) -> OptDescr (EarlyConfig opts)
forall a b. (a -> b) -> a -> b
$ OptSetter (EarlyConfig opts) -> ArgDescr (EarlyConfig opts)
forall a. OptSetter a -> ArgDescr a
NoArg (OptSetter (EarlyConfig opts) -> ArgDescr (EarlyConfig opts))
-> OptSetter (EarlyConfig opts) -> ArgDescr (EarlyConfig opts)
forall a b. (a -> b) -> a -> b
$ \EarlyConfig opts
opts -> OptSetter (EarlyConfig opts)
forall a b. b -> Either a b
Right EarlyConfig opts
opts { showVersion = True }

      , [Char]
-> [[Char]]
-> [Char]
-> ArgDescr (EarlyConfig opts)
-> OptDescr (EarlyConfig opts)
forall a. [Char] -> [[Char]] -> [Char] -> ArgDescr a -> OptDescr a
Option [Char]
"" [[Char]
"config"]
        [Char]
"Load configuration from this file."
        (ArgDescr (EarlyConfig opts) -> OptDescr (EarlyConfig opts))
-> ArgDescr (EarlyConfig opts) -> OptDescr (EarlyConfig opts)
forall a b. (a -> b) -> a -> b
$ [Char]
-> ([Char] -> OptSetter (EarlyConfig opts))
-> ArgDescr (EarlyConfig opts)
forall a. [Char] -> ([Char] -> OptSetter a) -> ArgDescr a
ReqArg [Char]
"FILE" (([Char] -> OptSetter (EarlyConfig opts))
 -> ArgDescr (EarlyConfig opts))
-> ([Char] -> OptSetter (EarlyConfig opts))
-> ArgDescr (EarlyConfig opts)
forall a b. (a -> b) -> a -> b
$ \[Char]
f EarlyConfig opts
opts -> OptSetter (EarlyConfig opts)
forall a b. b -> Either a b
Right EarlyConfig opts
opts { configFile = Just f }

      , [Char]
-> [[Char]]
-> [Char]
-> ArgDescr (EarlyConfig opts)
-> OptDescr (EarlyConfig opts)
forall a. [Char] -> [[Char]] -> [Char] -> ArgDescr a -> OptDescr a
Option [] [[Char]
"no-colors-err"]
        [Char]
"Suppress color codes in the errors"
        (ArgDescr (EarlyConfig opts) -> OptDescr (EarlyConfig opts))
-> ArgDescr (EarlyConfig opts) -> OptDescr (EarlyConfig opts)
forall a b. (a -> b) -> a -> b
$ OptSetter (EarlyConfig opts) -> ArgDescr (EarlyConfig opts)
forall a. OptSetter a -> ArgDescr a
NoArg (OptSetter (EarlyConfig opts) -> ArgDescr (EarlyConfig opts))
-> OptSetter (EarlyConfig opts) -> ArgDescr (EarlyConfig opts)
forall a b. (a -> b) -> a -> b
$ OptSetter (EarlyConfig opts)
forall a b. b -> Either a b
Right OptSetter (EarlyConfig opts)
-> (EarlyConfig opts -> EarlyConfig opts)
-> OptSetter (EarlyConfig opts)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter (EarlyConfig opts) (EarlyConfig opts) Bool Bool
-> Bool -> EarlyConfig opts -> EarlyConfig opts
forall s t a b. ASetter s t a b -> b -> s -> t
set (forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"colorOptions" ((ColorOptions -> Identity ColorOptions)
 -> EarlyConfig opts -> Identity (EarlyConfig opts))
-> ((Bool -> Identity Bool)
    -> ColorOptions -> Identity ColorOptions)
-> ASetter (EarlyConfig opts) (EarlyConfig opts) Bool Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"noColorsErr") Bool
True

      , [Char]
-> [[Char]]
-> [Char]
-> ArgDescr (EarlyConfig opts)
-> OptDescr (EarlyConfig opts)
forall a. [Char] -> [[Char]] -> [Char] -> ArgDescr a -> OptDescr a
Option [] [[Char]
"no-colors-out"]
        [Char]
"Suppress color codes in the output"
        (ArgDescr (EarlyConfig opts) -> OptDescr (EarlyConfig opts))
-> ArgDescr (EarlyConfig opts) -> OptDescr (EarlyConfig opts)
forall a b. (a -> b) -> a -> b
$ OptSetter (EarlyConfig opts) -> ArgDescr (EarlyConfig opts)
forall a. OptSetter a -> ArgDescr a
NoArg (OptSetter (EarlyConfig opts) -> ArgDescr (EarlyConfig opts))
-> OptSetter (EarlyConfig opts) -> ArgDescr (EarlyConfig opts)
forall a b. (a -> b) -> a -> b
$ OptSetter (EarlyConfig opts)
forall a b. b -> Either a b
Right OptSetter (EarlyConfig opts)
-> (EarlyConfig opts -> EarlyConfig opts)
-> OptSetter (EarlyConfig opts)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter (EarlyConfig opts) (EarlyConfig opts) Bool Bool
-> Bool -> EarlyConfig opts -> EarlyConfig opts
forall s t a b. ASetter s t a b -> b -> s -> t
set (forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"colorOptions" ((ColorOptions -> Identity ColorOptions)
 -> EarlyConfig opts -> Identity (EarlyConfig opts))
-> ((Bool -> Identity Bool)
    -> ColorOptions -> Identity ColorOptions)
-> ASetter (EarlyConfig opts) (EarlyConfig opts) Bool Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"noColorsOut") Bool
True

      , [Char]
-> [[Char]]
-> [Char]
-> ArgDescr (EarlyConfig opts)
-> OptDescr (EarlyConfig opts)
forall a. [Char] -> [[Char]] -> [Char] -> ArgDescr a -> OptDescr a
Option [] [[Char]
"no-colors"]
        [Char]
"Suppress color codes in both the output and the errors"
        (ArgDescr (EarlyConfig opts) -> OptDescr (EarlyConfig opts))
-> ArgDescr (EarlyConfig opts) -> OptDescr (EarlyConfig opts)
forall a b. (a -> b) -> a -> b
$ OptSetter (EarlyConfig opts) -> ArgDescr (EarlyConfig opts)
forall a. OptSetter a -> ArgDescr a
NoArg (OptSetter (EarlyConfig opts) -> ArgDescr (EarlyConfig opts))
-> OptSetter (EarlyConfig opts) -> ArgDescr (EarlyConfig opts)
forall a b. (a -> b) -> a -> b
$ OptSetter (EarlyConfig opts)
forall a b. b -> Either a b
Right OptSetter (EarlyConfig opts)
-> (EarlyConfig opts -> EarlyConfig opts)
-> OptSetter (EarlyConfig opts)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"colorOptions" ColorOptions
noColors

      ] [OptDescr (EarlyConfig opts)]
-> [OptDescr (EarlyConfig opts)] -> [OptDescr (EarlyConfig opts)]
forall a. [a] -> [a] -> [a]
++ (OptDescr opts -> OptDescr (EarlyConfig opts))
-> [OptDescr opts] -> [OptDescr (EarlyConfig opts)]
forall a b. (a -> b) -> [a] -> [b]
map ((OptSetter opts -> OptSetter (EarlyConfig opts))
-> OptDescr opts -> OptDescr (EarlyConfig opts)
forall a b.
(OptSetter a -> OptSetter b) -> OptDescr a -> OptDescr b
mapOptDescr OptSetter opts -> OptSetter (EarlyConfig opts)
forall opts. OptSetter opts -> OptSetter (EarlyConfig opts)
delayOpt) (Config opts -> [OptDescr opts]
forall opts. Config opts -> [OptDescr opts]
cfgCmdLineFlag Config opts
cfg)

  , progParamDocs :: [([Char], [Char])]
progParamDocs = [([Char]
"FILES", [Char]
"Input files to process.")]
  , progParams :: [Char] -> OptSetter (EarlyConfig opts)
progParams = \[Char]
f EarlyConfig opts
opts -> OptSetter (EarlyConfig opts)
forall a b. b -> Either a b
Right EarlyConfig opts
opts { files = f : files opts }
  }


delayOpt :: OptSetter opts -> OptSetter (EarlyConfig opts)
delayOpt :: forall opts. OptSetter opts -> OptSetter (EarlyConfig opts)
delayOpt OptSetter opts
f EarlyConfig opts
opts = EarlyConfig opts -> Either [Char] (EarlyConfig opts)
forall a b. b -> Either a b
Right EarlyConfig opts
opts { options = f <=< options opts }



data ConfigFileLoc =
    NoConfgFile
  | AtPosition Position
    deriving Int -> ConfigFileLoc -> ShowS
[ConfigFileLoc] -> ShowS
ConfigFileLoc -> [Char]
(Int -> ConfigFileLoc -> ShowS)
-> (ConfigFileLoc -> [Char])
-> ([ConfigFileLoc] -> ShowS)
-> Show ConfigFileLoc
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfigFileLoc -> ShowS
showsPrec :: Int -> ConfigFileLoc -> ShowS
$cshow :: ConfigFileLoc -> [Char]
show :: ConfigFileLoc -> [Char]
$cshowList :: [ConfigFileLoc] -> ShowS
showList :: [ConfigFileLoc] -> ShowS
Show

instance ErrorAnnotation ConfigFileLoc where
  displayAnnotation :: ConfigFileLoc -> Doc
displayAnnotation ConfigFileLoc
a =
    case ConfigFileLoc
a of
      ConfigFileLoc
NoConfgFile -> Doc
"(no configuration file)"
      AtPosition Position
p -> Position -> Doc
forall a. ErrorAnnotation a => a -> Doc
displayAnnotation Position
p

data ConfigError =
    FailedToReadFile IOError
  | FailedToParseFile ParseError
  | FailedToProcessFile (ValueSpecMismatch ConfigFileLoc)
  | InvalidEnvVar String String String -- ^ variable, value, error message
  | InvalidCommandLine [String]
    deriving Int -> ConfigError -> ShowS
[ConfigError] -> ShowS
ConfigError -> [Char]
(Int -> ConfigError -> ShowS)
-> (ConfigError -> [Char])
-> ([ConfigError] -> ShowS)
-> Show ConfigError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfigError -> ShowS
showsPrec :: Int -> ConfigError -> ShowS
$cshow :: ConfigError -> [Char]
show :: ConfigError -> [Char]
$cshowList :: [ConfigError] -> ShowS
showList :: [ConfigError] -> ShowS
Show

instance Exception ConfigError where
  displayException :: ConfigError -> [Char]
displayException = ConfigError -> [Char]
ppConfigError

ppConfigError :: ConfigError -> String
ppConfigError :: ConfigError -> [Char]
ppConfigError (FailedToReadFile IOError
ioe) =
  [Char]
"Failed to read config file: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ IOError -> [Char]
forall e. Exception e => e -> [Char]
displayException IOError
ioe
ppConfigError (FailedToParseFile ParseError
pe) =
  [Char]
"Failed to parse config file: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ParseError -> [Char]
forall e. Exception e => e -> [Char]
displayException ParseError
pe
ppConfigError (FailedToProcessFile ValueSpecMismatch ConfigFileLoc
vsm) =
  [Char]
"Failed to check config file: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ValueSpecMismatch ConfigFileLoc -> [Char]
forall e. Exception e => e -> [Char]
displayException ValueSpecMismatch ConfigFileLoc
vsm
ppConfigError (InvalidEnvVar [Char]
var [Char]
val [Char]
msg) =
  [[Char]] -> [Char]
unwords [[Char]
"Environment variable", [Char]
var, [Char]
"has invalid value", [Char]
val [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
":",  [Char]
msg]
ppConfigError (InvalidCommandLine [[Char]]
msg) =
  [[Char]] -> [Char]
unlines ([Char]
"Invalid command line option:" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
msg)

-- | Merges command-line options, environment variable options, and
-- configuration file options (in that order) to get the overall
-- Options configuration for running Crux. Throws 'ConfigError' on
-- failure.
loadConfig :: Text -> Config opts -> IO (ColorOptions, Options opts)
loadConfig :: forall opts. Text -> Config opts -> IO (ColorOptions, Options opts)
loadConfig Text
nm Config opts
cfg =
  do EarlyConfig opts
earlyOpts <- OptSpec (EarlyConfig opts) -> IO (EarlyConfig opts)
forall a. OptSpec a -> IO a
getOptsX (Config opts -> OptSpec (EarlyConfig opts)
forall opts. Config opts -> OptSpec (EarlyConfig opts)
commandLineOptions Config opts
cfg) IO (EarlyConfig opts)
-> (GetOptException -> IO (EarlyConfig opts))
-> IO (EarlyConfig opts)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch`
                  \(GetOptException [[Char]]
errs) -> ConfigError -> IO (EarlyConfig opts)
forall e a. Exception e => e -> IO a
throwIO ([[Char]] -> ConfigError
InvalidCommandLine [[Char]]
errs)
     let copts :: ColorOptions
copts = EarlyConfig opts -> ColorOptions
forall opts. EarlyConfig opts -> ColorOptions
colorOptions EarlyConfig opts
earlyOpts
     if | EarlyConfig opts -> Bool
forall opts. EarlyConfig opts -> Bool
showHelp EarlyConfig opts
earlyOpts -> (ColorOptions, Options opts) -> IO (ColorOptions, Options opts)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ColorOptions
copts, Options opts
forall opts. Options opts
ShowHelp)
        | EarlyConfig opts -> Bool
forall opts. EarlyConfig opts -> Bool
showVersion EarlyConfig opts
earlyOpts -> (ColorOptions, Options opts) -> IO (ColorOptions, Options opts)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ColorOptions
copts, Options opts
forall opts. Options opts
ShowVersion)
        | Bool
otherwise ->
          do opts
opts  <- Text -> Config opts -> Maybe [Char] -> IO opts
forall opts. Text -> Config opts -> Maybe [Char] -> IO opts
fromFile Text
nm Config opts
cfg (EarlyConfig opts -> Maybe [Char]
forall opts. EarlyConfig opts -> Maybe [Char]
configFile EarlyConfig opts
earlyOpts)
             opts
opts1 <- (opts -> EnvDescr opts -> IO opts)
-> opts -> [EnvDescr opts] -> IO opts
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM opts -> EnvDescr opts -> IO opts
forall opts. opts -> EnvDescr opts -> IO opts
fromEnv opts
opts (Config opts -> [EnvDescr opts]
forall opts. Config opts -> [EnvDescr opts]
cfgEnv Config opts
cfg)
             case EarlyConfig opts -> OptSetter opts
forall opts. EarlyConfig opts -> OptSetter opts
options EarlyConfig opts
earlyOpts opts
opts1 of
               Left [Char]
err    -> ConfigError -> IO (ColorOptions, Options opts)
forall e a. Exception e => e -> IO a
throwIO ([[Char]] -> ConfigError
InvalidCommandLine [[Char]
err])
               Right opts
opts2 -> (ColorOptions, Options opts) -> IO (ColorOptions, Options opts)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ColorOptions
copts, opts -> [[Char]] -> Options opts
forall opts. opts -> [[Char]] -> Options opts
Options opts
opts2 ([[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse (EarlyConfig opts -> [[Char]]
forall opts. EarlyConfig opts -> [[Char]]
files EarlyConfig opts
earlyOpts)))


-- | Load settings from a file, or from an empty configuration value.
fromFile :: Text -> Config opts -> Maybe FilePath -> IO opts
fromFile :: forall opts. Text -> Config opts -> Maybe [Char] -> IO opts
fromFile Text
nm Config opts
cfg Maybe [Char]
mbFile =
  do let spec :: ValueSpec opts
spec = Text -> SectionsSpec opts -> ValueSpec opts
forall a. Text -> SectionsSpec a -> ValueSpec a
sectionsSpec Text
nm (Config opts -> SectionsSpec opts
forall opts. Config opts -> SectionsSpec opts
cfgFile Config opts
cfg)
     case Maybe [Char]
mbFile of

       Maybe [Char]
Nothing -> -- no file, use an empty value
         case ValueSpec opts
-> Value ConfigFileLoc
-> Either (ValueSpecMismatch ConfigFileLoc) opts
forall a p.
ValueSpec a -> Value p -> Either (ValueSpecMismatch p) a
loadValue ValueSpec opts
spec (ConfigFileLoc -> [Section ConfigFileLoc] -> Value ConfigFileLoc
forall a. a -> [Section a] -> Value a
Sections ConfigFileLoc
NoConfgFile []) of
           Left ValueSpecMismatch ConfigFileLoc
err -> ConfigError -> IO opts
forall e a. Exception e => e -> IO a
throwIO (ValueSpecMismatch ConfigFileLoc -> ConfigError
FailedToProcessFile ValueSpecMismatch ConfigFileLoc
err)
           Right opts
opts -> opts -> IO opts
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure opts
opts

       Just [Char]
file ->
        ValueSpec opts -> [Char] -> IO opts
forall a. ValueSpec a -> [Char] -> IO a
loadValueFromFile ValueSpec opts
spec [Char]
file
           IO opts -> [Handler opts] -> IO opts
forall a. IO a -> [Handler a] -> IO a
`catches` [ (IOError -> IO opts) -> Handler opts
forall a e. Exception e => (e -> IO a) -> Handler a
Handler (ConfigError -> IO opts
forall e a. Exception e => e -> IO a
throwIO (ConfigError -> IO opts)
-> (IOError -> ConfigError) -> IOError -> IO opts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> ConfigError
FailedToReadFile)
                     , (ParseError -> IO opts) -> Handler opts
forall a e. Exception e => (e -> IO a) -> Handler a
Handler (ConfigError -> IO opts
forall e a. Exception e => e -> IO a
throwIO (ConfigError -> IO opts)
-> (ParseError -> ConfigError) -> ParseError -> IO opts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> ConfigError
FailedToParseFile)
                     , (ValueSpecMismatch ConfigFileLoc -> IO opts) -> Handler opts
forall a e. Exception e => (e -> IO a) -> Handler a
Handler (ConfigError -> IO opts
forall e a. Exception e => e -> IO a
throwIO (ConfigError -> IO opts)
-> (ValueSpecMismatch ConfigFileLoc -> ConfigError)
-> ValueSpecMismatch ConfigFileLoc
-> IO opts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueSpecMismatch ConfigFileLoc -> ConfigError
FailedToProcessFile)
                     ]


-- | Modify the options using an environment variable.
fromEnv :: opts -> EnvDescr opts -> IO opts
fromEnv :: forall opts. opts -> EnvDescr opts -> IO opts
fromEnv opts
opts EnvDescr opts
v =
  do Maybe [Char]
mb <- [Char] -> IO (Maybe [Char])
lookupEnv (EnvDescr opts -> [Char]
forall opts. EnvDescr opts -> [Char]
evName EnvDescr opts
v)
     case Maybe [Char]
mb of
       Just [Char]
s -> case EnvDescr opts -> [Char] -> OptSetter opts
forall opts. EnvDescr opts -> [Char] -> OptSetter opts
evValue EnvDescr opts
v [Char]
s opts
opts of
                   Right opts
opts1 -> opts -> IO opts
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure opts
opts1
                   Left [Char]
err    -> ConfigError -> IO opts
forall e a. Exception e => e -> IO a
throwIO ([Char] -> [Char] -> [Char] -> ConfigError
InvalidEnvVar (EnvDescr opts -> [Char]
forall opts. EnvDescr opts -> [Char]
evName EnvDescr opts
v) [Char]
s [Char]
err)
       Maybe [Char]
Nothing -> opts -> IO opts
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure opts
opts