add exceptions
This commit is contained in:
parent
759c258ecb
commit
d75c1b646b
@ -17,9 +17,11 @@ library
|
|||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
exposed-modules: GEval
|
exposed-modules: GEval
|
||||||
build-depends: base >= 4.7 && < 5
|
build-depends: base >= 4.7 && < 5
|
||||||
|
, cond
|
||||||
, conduit
|
, conduit
|
||||||
, conduit-combinators
|
, conduit-combinators
|
||||||
, conduit-extra
|
, conduit-extra
|
||||||
|
, directory
|
||||||
, filepath
|
, filepath
|
||||||
, resourcet
|
, resourcet
|
||||||
, text
|
, text
|
||||||
|
40
src/GEval.hs
40
src/GEval.hs
@ -21,6 +21,9 @@ import qualified Data.Conduit.List as CL
|
|||||||
import Data.Text
|
import Data.Text
|
||||||
import Data.Text.Read as TR
|
import Data.Text.Read as TR
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
|
import Control.Exception
|
||||||
|
import Control.Conditional (unlessM)
|
||||||
|
import qualified System.Directory as D
|
||||||
|
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
@ -50,6 +53,28 @@ data GEvalOptions = GEvalOptions
|
|||||||
geoSpec :: GEvalSpecification }
|
geoSpec :: GEvalSpecification }
|
||||||
|
|
||||||
|
|
||||||
|
data GEvalException = NoExpectedFile FilePath
|
||||||
|
| NoOutFile FilePath
|
||||||
|
| NoExpectedDirectory FilePath
|
||||||
|
| NoOutDirectory FilePath
|
||||||
|
| NoExpectedTestDirectory FilePath
|
||||||
|
| NoOutTestDirectory FilePath
|
||||||
|
|
||||||
|
instance Exception GEvalException
|
||||||
|
|
||||||
|
instance Show GEvalException where
|
||||||
|
show (NoExpectedFile filePath) = somethingWrongWithFilesMessage "No file with the expected results" filePath
|
||||||
|
show (NoOutFile filePath) = somethingWrongWithFilesMessage "No file with the test results" filePath
|
||||||
|
show (NoExpectedDirectory filePath) = somethingWrongWithFilesMessage "No directory with the expected results" filePath
|
||||||
|
show (NoOutDirectory filePath) = somethingWrongWithFilesMessage "No directory with the test results" filePath
|
||||||
|
show (NoExpectedTestDirectory filePath) = somethingWrongWithFilesMessage "No test subdirectory with the expected results" filePath
|
||||||
|
show (NoOutTestDirectory filePath) = somethingWrongWithFilesMessage "No test subdirectory with the results obtained" filePath
|
||||||
|
|
||||||
|
|
||||||
|
somethingWrongWithFilesMessage :: String -> FilePath -> String
|
||||||
|
somethingWrongWithFilesMessage msg filePath = Prelude.concat
|
||||||
|
[ msg, ": `", filePath, "`" ]
|
||||||
|
|
||||||
defaultGEvalSpecification = GEvalSpecification {
|
defaultGEvalSpecification = GEvalSpecification {
|
||||||
gesOutDirectory = defaultOutDirectory,
|
gesOutDirectory = defaultOutDirectory,
|
||||||
gesExpectedDirectory = Nothing,
|
gesExpectedDirectory = Nothing,
|
||||||
@ -60,9 +85,16 @@ defaultGEvalSpecification = GEvalSpecification {
|
|||||||
|
|
||||||
|
|
||||||
geval :: GEvalSpecification -> IO (Double)
|
geval :: GEvalSpecification -> IO (Double)
|
||||||
geval gevalSpec = gevalCore metric expectedFilePath outFilePath
|
geval gevalSpec = do
|
||||||
where expectedFilePath = expectedDirectory </> testName </> (gesExpectedFile gevalSpec)
|
unlessM (D.doesDirectoryExist outDirectory) $ throwM $ NoOutDirectory outDirectory
|
||||||
outFilePath = outDirectory </> testName </> (gesOutFile gevalSpec)
|
unlessM (D.doesDirectoryExist expectedDirectory) $ throwM $ NoExpectedDirectory expectedDirectory
|
||||||
|
unlessM (D.doesDirectoryExist outTestDirectory) $ throwM $ NoOutTestDirectory outTestDirectory
|
||||||
|
unlessM (D.doesDirectoryExist expectedTestDirectory) $ throwM $ NoExpectedTestDirectory expectedTestDirectory
|
||||||
|
gevalCore metric expectedFilePath outFilePath
|
||||||
|
where expectedFilePath = expectedTestDirectory </> (gesExpectedFile gevalSpec)
|
||||||
|
outFilePath = outTestDirectory </> (gesOutFile gevalSpec)
|
||||||
|
expectedTestDirectory = expectedDirectory </> testName
|
||||||
|
outTestDirectory = outDirectory </> testName
|
||||||
expectedDirectory = fromMaybe outDirectory $ gesExpectedDirectory gevalSpec
|
expectedDirectory = fromMaybe outDirectory $ gesExpectedDirectory gevalSpec
|
||||||
outDirectory = gesOutDirectory gevalSpec
|
outDirectory = gesOutDirectory gevalSpec
|
||||||
testName = gesTestName gevalSpec
|
testName = gesTestName gevalSpec
|
||||||
@ -70,6 +102,8 @@ geval gevalSpec = gevalCore metric expectedFilePath outFilePath
|
|||||||
|
|
||||||
gevalCore :: Metric -> String -> String -> IO (Double)
|
gevalCore :: Metric -> String -> String -> IO (Double)
|
||||||
gevalCore MSE expectedFilePath outFilePath = do
|
gevalCore MSE expectedFilePath outFilePath = do
|
||||||
|
unlessM (D.doesFileExist expectedFilePath) $ throwM $ NoExpectedFile expectedFilePath
|
||||||
|
unlessM (D.doesFileExist outFilePath) $ throwM $ NoOutFile outFilePath
|
||||||
mse <- runResourceT $
|
mse <- runResourceT $
|
||||||
(getZipSource $ (,)
|
(getZipSource $ (,)
|
||||||
<$> ZipSource (items expectedFilePath)
|
<$> ZipSource (items expectedFilePath)
|
||||||
|
Loading…
Reference in New Issue
Block a user