module System.Console.HsOptionsTestHelpers where import Test.HUnit import Control.Monad import Control.Exception import qualified System.Console.HsOptions as HSO f2d :: HSO.Flag a -> HSO.FlagData f2d = HSO.flagToData data TestProcessResult = TestProcessError [HSO.FlagError] | TestProcessSuccess HSO.ProcessResults errorsToString :: [HSO.FlagError] -> String errorsToString [] = "" errorsToString (er:errs) = aux er ++ errorsToString errs where aux (HSO.FlagNonFatalError erMessage) = " * '" ++ erMessage ++ "'\n" aux (HSO.FlagFatalError erMessage) = " * '" ++erMessage ++ "'\n" assertError :: TestProcessResult -> String -> Assertion assertError (TestProcessSuccess _) errorMessage = assertFailure $ "assertError failed. expected '" ++ errorMessage ++ "' but zero errors occurred" assertError (TestProcessError errs) errorMessage = let nfErrs = [er | (HSO.FlagNonFatalError er) <- errs] ++ [er | (HSO.FlagFatalError er) <- errs]in when ( errorMessage `notElem` nfErrs) (assertFailure $ "assertError failed. expected '" ++ errorMessage ++ "' but error not found.\n" ++ "** other errors that where found:\n" ++ errorsToString errs) assertSingleError :: TestProcessResult -> Assertion assertSingleError (TestProcessSuccess _) = assertFailure "assertSingleError failed. expected single error but zero errors occurred" assertSingleError (TestProcessError errs) = let count = length errs in when (count /= 1) (assertFailure $ "assertSingleError failed. expected single error but "++ show count ++ " errors occurred") assertFlagValueEquals :: (Eq a, Show a) => TestProcessResult -> HSO.Flag a -> a -> Assertion assertFlagValueEquals (TestProcessError errs) _flag _value = assertFailure ("assertFlagValueEquals failed. expected no errors when getting flag value" ++ " but errors found:\n" ++ "** errors that where found:\n" ++ errorsToString errs) assertFlagValueEquals (TestProcessSuccess (results, _args)) flag expected = assertEqual "" expected value where value = HSO.get results flag assertArgsEquals :: TestProcessResult -> [String] -> Assertion assertArgsEquals (TestProcessError errs) _args = assertFailure ("assertFlagValueEquals failed. expected no errors when getting args value" ++ " but errors found:\n" ++ "** errors that where found:\n" ++ errorsToString errs) assertArgsEquals (TestProcessSuccess (_results, args)) expected = assertEqual "" expected args assertException :: a -> String -> Assertion assertException expr msg = do result <- evaluate' expr case result of Left err -> assertEqual "" msg (show err) Right _ -> fail "Expected exception but no exception occurred" evaluate' :: a -> IO (Either SomeException a) evaluate' flag = try (evaluate flag) process :: HSO.FlagData -> String -> IO TestProcessResult process fd input = do result <- HSO.process fd (words input) case result of Left errs -> return (TestProcessError errs) Right r -> return (TestProcessSuccess r) makeFlagData :: [HSO.FlagData] -> HSO.FlagData makeFlagData = HSO.combine makeConfFile :: [String] -> String makeConfFile = unlines