{-# LANGUAGE CPP #-}
--
-- Copyright (c) 2005-2022   Stefan Wehr - http://www.stefanwehr.de
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this library; if not, write to the Free Software
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
--

{- |

A /black box test/ in the terminology of the HTF consists of a
driver program that is run in various input files. For each input
file, the HTF checks that the driver program exits with the
correct exit code and that it produces the expected output.
The samples directory of the HTF source tree shows an example
for a black box test, see <https://github.com/skogsbaer/HTF/tree/master/sample>.

/NOTE:/ If you use black box tests, you have to compile your program
with the @-threaded@ option. Otherwise, your program just blocks
indefinitely!

-}
module Test.Framework.BlackBoxTest (

  BBTArgs(..), defaultBBTArgs,

  blackBoxTests,

  Diff, defaultDiff

) where

#if !MIN_VERSION_base(4,6,0)
import Prelude hiding ( catch )
#endif

import System.Exit
import System.Directory
import qualified Data.Map as Map

import Test.Framework.Process
import Test.Framework.TestInterface
import Test.Framework.TestManager
import Test.Framework.Utils

{- |
The type of a function comparing the content of a file
against a string, similar to the unix tool @diff@.
The first parameter is the name of the file containing the
expected output. If this parameter is 'Nothing', then output
should not be checked. The second parameter is the actual output produced.
If the result is 'Nothing' then no difference was found.
Otherwise, a 'Just' value contains a string explaining the
difference.
-}
type Diff = Maybe FilePath -> String -> IO (Maybe String)

data BlackBoxTestCfg = BlackBoxTestCfg
                       { BlackBoxTestCfg -> Bool
bbtCfg_shouldFail  :: Bool
                       , BlackBoxTestCfg -> String
bbtCfg_cmd         :: String
                       , BlackBoxTestCfg -> Maybe String
bbtCfg_stdinFile   :: Maybe FilePath
                       , BlackBoxTestCfg -> Maybe String
bbtCfg_stdoutFile  :: Maybe FilePath -- ^ path to file holding expected output on stdout
                       , BlackBoxTestCfg -> Maybe String
bbtCfg_stderrFile  :: Maybe FilePath -- ^ path to file holding expected output on stderr
                       , BlackBoxTestCfg -> Bool
bbtCfg_verbose     :: Bool
                       -- functions for comparing output on stdout and stderr.
                       , BlackBoxTestCfg -> Diff
bbtCfg_stdoutCmp   :: Diff
                       , BlackBoxTestCfg -> Diff
bbtCfg_stderrCmp   :: Diff
                       }

runBlackBoxTest :: BlackBoxTestCfg -> Assertion
runBlackBoxTest :: BlackBoxTestCfg -> Assertion
runBlackBoxTest BlackBoxTestCfg
bbt =
    do Maybe String
inp <- case BlackBoxTestCfg -> Maybe String
bbtCfg_stdinFile BlackBoxTestCfg
bbt of
                Maybe String
Nothing -> Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
                Just String
f -> do String
s <- String -> IO String
readFile String
f
                             Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
s
       (String
out,String
err,ExitCode
exit) <- String -> Maybe String -> IO (String, String, ExitCode)
popenShell (BlackBoxTestCfg -> String
bbtCfg_cmd BlackBoxTestCfg
bbt) Maybe String
inp
       case ExitCode
exit of
         ExitCode
ExitSuccess | BlackBoxTestCfg -> Bool
bbtCfg_shouldFail BlackBoxTestCfg
bbt
           -> String -> Assertion
blackBoxTestFail (String
"test is supposed to fail but succeeded")
         ExitFailure Int
i | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ BlackBoxTestCfg -> Bool
bbtCfg_shouldFail BlackBoxTestCfg
bbt
           -> do let details :: String
details =
                         if (BlackBoxTestCfg -> Bool
bbtCfg_verbose BlackBoxTestCfg
bbt)
                            then (String
"stderr for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show (BlackBoxTestCfg -> String
bbtCfg_cmd BlackBoxTestCfg
bbt) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                  String
err String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
endOfOutput String
"stderr" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                  String
"stdout for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show (BlackBoxTestCfg -> String
bbtCfg_cmd BlackBoxTestCfg
bbt) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                  String
out String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
endOfOutput String
"stdout") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
                            else String
""
                 String -> Assertion
blackBoxTestFail (String
details String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                   String
"test is supposed to succeed but failed " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                   String
"with exit code " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i)
         ExitCode
_ -> do Maybe String
cmpOut <- Maybe String -> Diff -> String -> String -> IO (Maybe String)
forall (m :: * -> *) t t a.
Monad m =>
t -> (t -> t -> m (Maybe [a])) -> t -> [a] -> m (Maybe [a])
cmp (BlackBoxTestCfg -> Maybe String
bbtCfg_stdoutFile BlackBoxTestCfg
bbt) (BlackBoxTestCfg -> Diff
bbtCfg_stdoutCmp BlackBoxTestCfg
bbt)
                             String
out String
"Mismatch on stdout:\n"
                 Maybe String
cmpErr <- Maybe String -> Diff -> String -> String -> IO (Maybe String)
forall (m :: * -> *) t t a.
Monad m =>
t -> (t -> t -> m (Maybe [a])) -> t -> [a] -> m (Maybe [a])
cmp (BlackBoxTestCfg -> Maybe String
bbtCfg_stderrFile BlackBoxTestCfg
bbt) (BlackBoxTestCfg -> Diff
bbtCfg_stderrCmp BlackBoxTestCfg
bbt)
                             String
err String
"Mismatch on stderr:\n"
                 case (Maybe String
cmpOut, Maybe String
cmpErr) of
                  (Maybe String
Nothing, Maybe String
Nothing) -> () -> Assertion
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  (Maybe String
x1, Maybe String
x2) ->
                      do let details :: String
details = String -> String
ensureNewline (Maybe String
x1 Maybe String -> Maybe String -> String
`concatMaybes` Maybe String
x2)
                         String -> Assertion
blackBoxTestFail String
details
    where cmp :: t -> (t -> t -> m (Maybe [a])) -> t -> [a] -> m (Maybe [a])
cmp t
expectFile t -> t -> m (Maybe [a])
cmpAction t
real [a]
label =
              do Maybe [a]
res <- t -> t -> m (Maybe [a])
cmpAction t
expectFile t
real
                 case Maybe [a]
res of
                   Maybe [a]
Nothing -> Maybe [a] -> m (Maybe [a])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [a]
forall a. Maybe a
Nothing
                   Just [a]
s -> Maybe [a] -> m (Maybe [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [a] -> m (Maybe [a])) -> Maybe [a] -> m (Maybe [a])
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe [a]
forall a. a -> Maybe a
Just ([a]
label [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
s)
          concatMaybes :: Maybe String -> Maybe String -> String
concatMaybes Maybe String
Nothing Maybe String
Nothing = String
""
          concatMaybes (Just String
s) Maybe String
Nothing = String
s
          concatMaybes (Maybe String
Nothing) (Just String
s) = String
s
          concatMaybes (Just String
s1) (Just String
s2) = String
s1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s2

endOfOutput :: String -> String
endOfOutput :: String -> String
endOfOutput String
s = String
"[end of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"

blackBoxTestFail :: String -> Assertion
blackBoxTestFail :: String -> Assertion
blackBoxTestFail String
s = FullTestResult -> Assertion
forall (m :: * -> *) a.
MonadBaseControl IO m =>
FullTestResult -> m a
failHTF (FullTestResult -> Assertion) -> FullTestResult -> Assertion
forall a b. (a -> b) -> a -> b
$ TestResult -> Maybe String -> FullTestResult
mkFullTestResult TestResult
Fail (String -> Maybe String
forall a. a -> Maybe a
Just String
s)

{- |
Use a value of this datatype to customize various aspects
of your black box tests.
-}
data BBTArgs = BBTArgs { BBTArgs -> String
bbtArgs_stdinSuffix    :: String -- ^ File extension for the file used as stdin.
                       , BBTArgs -> String
bbtArgs_stdoutSuffix   :: String -- ^ File extension for the file specifying expected output on stdout.
                       , BBTArgs -> String
bbtArgs_stderrSuffix   :: String -- ^ File extension for the file specifying expected output on stderr.
                       , BBTArgs -> String
bbtArgs_dynArgsName    :: String -- ^ Name of a file defining various arguments for executing the tests contained in a subdirectory of the test hierarchy. If a directory contains a such-named file, the arguments apply to all testfiles directly contained in this directory. See the documentation of 'blackBoxTests' for a specification of the argument file format. Default: BBTArgs
                       , BBTArgs -> Bool
bbtArgs_verbose        :: Bool   -- ^ Be verbose or not.
                       , BBTArgs -> Diff
bbtArgs_stdoutDiff     :: Diff   -- ^ Diff program for comparing output on stdout with the expected value.
                       , BBTArgs -> Diff
bbtArgs_stderrDiff     :: Diff   -- ^ Diff program for comparing output on stderr with the expected value.
                       }

{- |
Sensible default values for 'BBTArgs':

@
defaultBBTArgs = BBTArgs { bbtArgs_stdinSuffix    = \".in\"
                         , bbtArgs_stdoutSuffix   = \".out\"
                         , bbtArgs_stderrSuffix   = \".err\"
                         , bbtArgs_dynArgsName    = \"BBTArgs\"
                         , bbtArgs_stdoutDiff     = defaultDiff
                         , bbtArgs_stderrDiff     = defaultDiff
                         , bbtArgs_verbose        = False }
@
-}
defaultBBTArgs :: BBTArgs
defaultBBTArgs :: BBTArgs
defaultBBTArgs = BBTArgs :: String
-> String -> String -> String -> Bool -> Diff -> Diff -> BBTArgs
BBTArgs { bbtArgs_stdinSuffix :: String
bbtArgs_stdinSuffix    = String
".in"
                         , bbtArgs_stdoutSuffix :: String
bbtArgs_stdoutSuffix   = String
".out"
                         , bbtArgs_stderrSuffix :: String
bbtArgs_stderrSuffix   = String
".err"
                         , bbtArgs_dynArgsName :: String
bbtArgs_dynArgsName    = String
"BBTArgs"
                         , bbtArgs_stdoutDiff :: Diff
bbtArgs_stdoutDiff     = Diff
defaultDiff
                         , bbtArgs_stderrDiff :: Diff
bbtArgs_stderrDiff     = Diff
defaultDiff
                         , bbtArgs_verbose :: Bool
bbtArgs_verbose        = Bool
False }

{- |
A default value for the 'Diff' datatype that simple resorts to the
@diff@ commandline utility.
-}
defaultDiff :: Diff
defaultDiff :: Diff
defaultDiff Maybe String
expectFile String
real =
    case Maybe String
expectFile of
      Maybe String
Nothing -> Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
      Just String
expect ->
          do Maybe String
mexe <- String -> IO (Maybe String)
findExecutable String
"diff"
             let exe :: String
exe = case Maybe String
mexe of
                         Just String
p -> String
p
                         Maybe String
Nothing -> String -> String
forall a. HasCallStack => String -> a
error (String
"diff command not in path")
             (String
out, String
err, ExitCode
exitCode) <- String -> [String] -> Maybe String -> IO (String, String, ExitCode)
popen String
exe [String
"-u", String
expect, String
"-"]
                                        (String -> Maybe String
forall a. a -> Maybe a
Just String
real)
             case ExitCode
exitCode of
               ExitCode
ExitSuccess -> Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing       -- no difference
               ExitFailure Int
1 ->                    -- files differ
                   Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just (String
out String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
endOfOutput String
"diff output"))
               ExitFailure Int
i -> String -> IO (Maybe String)
forall a. HasCallStack => String -> a
error (String
"diff command failed with exit " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                       String
"code " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)

{- |
Collects all black box tests with the given file extension stored in a specific directory.
For example, the invocation

> blackBoxTests "bbt-dir" "dist/build/sample/sample" ".num" defaultBBTArgs

returns a list of 'Test' values, one 'Test' for each @.num@ file found in
@bbt-dir@ and its subdirectories. (The samples directory of the HTF source tree
contains the example shown here,
see <https://github.com/skogsbaer/HTF/tree/master/sample>.)

Suppose that one of the @.num@ files
is @bbt-dir\/should-pass\/x.num@. Running the corresponding 'Test' invokes
@dist\/build\/sample\/sample@ (the program under test)
with @bbt-dir\/should-pass\/x.num@ as the last commandline argument.
The other commandline arguments are taken from the flags specification given in the
file whose name is stored in the 'bbtArgs_dynArgsName' field of the 'BBTArgs' record
(see below, default is BBTArgs).

If @bbt-dir\/should-pass\/x.in@ existed, its content
would be used as stdin. The tests succeeds
if the exit code of the program is zero and
the output on stdout and stderr matches the contents of
@bbt-dir\/should-pass\/x.out@ and @bbt-dir\/should-pass\/x.err@, respectively.
If @bbt-dir\/should-pass\/x.out@ and @bbt-dir\/should-pass\/x.err@ do
not exist, then output is not checked.

The 'bbtArgs_dynArgsName' field of the 'BBTArgs' record specifies a filename
that contains some more configuration flags for the tests. The following
flags (separated by newlines) are supported:

 [@Skip@] Skips all tests in the same directory as the argument file.

 [@Fail@] Specify that the test should succeed if it exits with a non-zero exit code.

 [@Flags: flags@] Passes the given @flags@ to the program under test.

-}
blackBoxTests :: FilePath  -- ^ root directory of the test hierarchy
              -> String    -- ^ name of program under test
              -> String    -- ^ filename suffix for input file
              -> BBTArgs   -- ^ configuration
              -> IO [Test]
blackBoxTests :: String -> String -> String -> BBTArgs -> IO [Test]
blackBoxTests String
root String
exe String
suf BBTArgs
cfg =
    do let prune :: String -> p -> IO Bool
prune String
root p
_ = do DynamicConfig
dynCfg <- DynamicConfigMap -> String -> IO DynamicConfig
readDynCfg DynamicConfigMap
forall k a. Map k a
Map.empty
                                                  (String
root String -> String -> String
</>
                                                   BBTArgs -> String
bbtArgs_dynArgsName BBTArgs
cfg)
                             Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ DynamicConfig -> Bool
dyn_skip DynamicConfig
dynCfg
       [String]
inputFiles <- String -> String -> (String -> [String] -> IO Bool) -> IO [String]
collectFiles String
root String
suf String -> [String] -> IO Bool
forall p. String -> p -> IO Bool
prune
       (DynamicConfigMap
_, [Test]
tests) <- (DynamicConfigMap -> String -> IO (DynamicConfigMap, Test))
-> DynamicConfigMap -> [String] -> IO (DynamicConfigMap, [Test])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM DynamicConfigMap -> String -> IO (DynamicConfigMap, Test)
genTest DynamicConfigMap
forall k a. Map k a
Map.empty [String]
inputFiles
       [Test] -> IO [Test]
forall (m :: * -> *) a. Monad m => a -> m a
return [Test]
tests
    where genTest :: DynamicConfigMap -> FilePath -> IO (DynamicConfigMap,
                                                         Test)
          genTest :: DynamicConfigMap -> String -> IO (DynamicConfigMap, Test)
genTest DynamicConfigMap
map String
fname =
            do Maybe String
stdinf <- String -> IO (Maybe String)
maybeFile (String -> IO (Maybe String)) -> String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> String -> String
replaceSuffix String
fname
                                       (BBTArgs -> String
bbtArgs_stdinSuffix BBTArgs
cfg)
               Maybe String
stdoutf <- String -> IO (Maybe String)
maybeFile (String -> IO (Maybe String)) -> String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$  String -> String -> String
replaceSuffix String
fname
                                         (BBTArgs -> String
bbtArgs_stdoutSuffix BBTArgs
cfg)
               Maybe String
stderrf <- String -> IO (Maybe String)
maybeFile (String -> IO (Maybe String)) -> String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> String -> String
replaceSuffix String
fname
                                        (BBTArgs -> String
bbtArgs_stderrSuffix BBTArgs
cfg)
               let configFile :: String
configFile = String -> String
dirname String
fname String -> String -> String
</> BBTArgs -> String
bbtArgs_dynArgsName BBTArgs
cfg
               DynamicConfig
dynCfg <- DynamicConfigMap -> String -> IO DynamicConfig
readDynCfg DynamicConfigMap
map String
configFile
               let cmd :: String
cmd = String
exe String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
dropSpace (DynamicConfig -> String
dyn_flags DynamicConfig
dynCfg) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                         String
fname
                   shouldFail :: Bool
shouldFail = DynamicConfig -> Bool
dyn_shouldFail DynamicConfig
dynCfg
                   verbose :: Bool
verbose = BBTArgs -> Bool
bbtArgs_verbose BBTArgs
cfg Bool -> Bool -> Bool
|| DynamicConfig -> Bool
dyn_verbose DynamicConfig
dynCfg
               let bbt :: BlackBoxTestCfg
bbt = BlackBoxTestCfg :: Bool
-> String
-> Maybe String
-> Maybe String
-> Maybe String
-> Bool
-> Diff
-> Diff
-> BlackBoxTestCfg
BlackBoxTestCfg
                         { bbtCfg_shouldFail :: Bool
bbtCfg_shouldFail  = Bool
shouldFail
                         , bbtCfg_cmd :: String
bbtCfg_cmd         = String
cmd
                         , bbtCfg_stdinFile :: Maybe String
bbtCfg_stdinFile   = Maybe String
stdinf
                         , bbtCfg_stdoutFile :: Maybe String
bbtCfg_stdoutFile  = Maybe String
stdoutf
                         , bbtCfg_stderrFile :: Maybe String
bbtCfg_stderrFile  = Maybe String
stderrf
                         , bbtCfg_verbose :: Bool
bbtCfg_verbose     = Bool
verbose
                         , bbtCfg_stdoutCmp :: Diff
bbtCfg_stdoutCmp   = BBTArgs -> Diff
bbtArgs_stdoutDiff BBTArgs
cfg
                         , bbtCfg_stderrCmp :: Diff
bbtCfg_stderrCmp   = BBTArgs -> Diff
bbtArgs_stderrDiff BBTArgs
cfg
                         }
               (DynamicConfigMap, Test) -> IO (DynamicConfigMap, Test)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> DynamicConfig -> DynamicConfigMap -> DynamicConfigMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
configFile DynamicConfig
dynCfg DynamicConfigMap
map,
                       String -> Assertion -> Test
makeBlackBoxTest String
fname (BlackBoxTestCfg -> Assertion
runBlackBoxTest BlackBoxTestCfg
bbt))

data DynamicConfig = DynamicConfig { DynamicConfig -> Bool
dyn_skip        :: Bool
                                   , DynamicConfig -> String
dyn_flags       :: String
                                   , DynamicConfig -> Bool
dyn_shouldFail  :: Bool
                                   , DynamicConfig -> Bool
dyn_verbose     :: Bool }

type DynamicConfigMap = Map.Map FilePath DynamicConfig

defaultDynCfg :: DynamicConfig
defaultDynCfg = DynamicConfig :: Bool -> String -> Bool -> Bool -> DynamicConfig
DynamicConfig { dyn_skip :: Bool
dyn_skip       = Bool
False
                              , dyn_flags :: String
dyn_flags      = String
""
                              , dyn_shouldFail :: Bool
dyn_shouldFail = Bool
False
                              , dyn_verbose :: Bool
dyn_verbose    = Bool
False }

readDynCfg :: DynamicConfigMap -> FilePath -> IO DynamicConfig
readDynCfg :: DynamicConfigMap -> String -> IO DynamicConfig
readDynCfg DynamicConfigMap
m String
f =
    do case String -> DynamicConfigMap -> Maybe DynamicConfig
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
f DynamicConfigMap
m of
         Just DynamicConfig
dynCfg -> DynamicConfig -> IO DynamicConfig
forall (m :: * -> *) a. Monad m => a -> m a
return DynamicConfig
dynCfg
         Maybe DynamicConfig
Nothing ->
             do Bool
b <- String -> IO Bool
doesFileExist String
f
                if Bool -> Bool
not Bool
b then DynamicConfig -> IO DynamicConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (DynamicConfig -> IO DynamicConfig)
-> DynamicConfig -> IO DynamicConfig
forall a b. (a -> b) -> a -> b
$ DynamicConfig
defaultDynCfg
                   else do String
s <- String -> IO String
readFile String
f
                           DynamicConfig -> IO DynamicConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (DynamicConfig -> IO DynamicConfig)
-> DynamicConfig -> IO DynamicConfig
forall a b. (a -> b) -> a -> b
$ (DynamicConfig -> String -> DynamicConfig)
-> DynamicConfig -> [String] -> DynamicConfig
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (String -> DynamicConfig -> String -> DynamicConfig
parse String
f) DynamicConfig
defaultDynCfg ([String] -> DynamicConfig) -> [String] -> DynamicConfig
forall a b. (a -> b) -> a -> b
$
                                 (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isUseless) ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
dropSpace
                                                               (String -> [String]
lines String
s))
    where isUseless :: String -> Bool
          isUseless :: String -> Bool
isUseless []      = Bool
True
          isUseless (Char
'#':String
_) = Bool
True
          isUseless String
_       = Bool
False
          parse :: FilePath -> DynamicConfig -> String -> DynamicConfig
          parse :: String -> DynamicConfig -> String -> DynamicConfig
parse String
_ DynamicConfig
cfg String
"Skip" = DynamicConfig
cfg { dyn_skip :: Bool
dyn_skip = Bool
True }
          parse String
_ DynamicConfig
cfg String
"Fail" = DynamicConfig
cfg { dyn_shouldFail :: Bool
dyn_shouldFail = Bool
True }
          parse String
_ DynamicConfig
cfg String
"Verbose" = DynamicConfig
cfg { dyn_verbose :: Bool
dyn_verbose = Bool
True }
          parse String
_ DynamicConfig
cfg (Char
'F':Char
'l':Char
'a':Char
'g':Char
's':Char
':':String
flags) = DynamicConfig
cfg { dyn_flags :: String
dyn_flags = String
flags }
          parse String
f DynamicConfig
_ String
l = String -> DynamicConfig
forall a. HasCallStack => String -> a
error (String
"invalid line in dynamic configuration file `" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                               String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"': " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
l)