From b4e5dcbd9dff4e2bf01c3b1b4007eeeee8cb3f4f Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
Date: Sun, 20 Dec 2015 16:49:17 +0100
Subject: [PATCH] add getOptions for extracting options without running the
 evaluation

---
 geval.cabal                |  2 +-
 src/GEval/Core.hs          |  2 +-
 src/GEval/OptionsParser.hs | 27 ++++++++++++++++++---------
 stack.yaml                 |  5 +++--
 test/Spec.hs               | 10 ++++++++++
 5 files changed, 33 insertions(+), 13 deletions(-)

diff --git a/geval.cabal b/geval.cabal
index efdc72c..65d993f 100644
--- a/geval.cabal
+++ b/geval.cabal
@@ -1,5 +1,5 @@
 name:                geval
-version:             0.2.2.0
+version:             0.2.3.0
 synopsis:            Machine learning evaluation tools
 description:         Please see README.md
 homepage:            http://github.com/name/project
diff --git a/src/GEval/Core.hs b/src/GEval/Core.hs
index a2bf24b..ed7cba2 100644
--- a/src/GEval/Core.hs
+++ b/src/GEval/Core.hs
@@ -40,7 +40,7 @@ import GEval.BLEU
 type MetricValue = Double
 
 data Metric = RMSE | MSE | BLEU | Accuracy
-              deriving (Show, Read)
+              deriving (Show, Read, Eq)
 
 data MetricOrdering = TheLowerTheBetter | TheHigherTheBetter
 
diff --git a/src/GEval/OptionsParser.hs b/src/GEval/OptionsParser.hs
index cca4605..f446e70 100644
--- a/src/GEval/OptionsParser.hs
+++ b/src/GEval/OptionsParser.hs
@@ -3,7 +3,8 @@
 module GEval.OptionsParser
        (fullOptionsParser,
         runGEval,
-        runGEvalGetOptions) where
+        runGEvalGetOptions,
+        getOptions) where
 
 import Options.Applicative
 import qualified System.Directory as D
@@ -83,29 +84,37 @@ runGEval args = do
     Right (_, mmv) -> return $ Right mmv
 
 runGEvalGetOptions :: [String] -> IO (Either (ParserResult GEvalOptions) (GEvalOptions, Maybe MetricValue))
-runGEvalGetOptions = runGEval' True
+runGEvalGetOptions args = do
+  optionExtractionResult <- getOptions args
+  case optionExtractionResult of
+    Left parserResult -> return $ Left parserResult
+    Right opts -> do
+      mmv <- runGEval'' opts
+      return $ Right (opts, mmv)
+
+getOptions :: [String] -> IO (Either (ParserResult GEvalOptions) GEvalOptions)
+getOptions = getOptions' True
 
 -- the first argument: whether to try to read from the config file
-runGEval' :: Bool -> [String] -> IO (Either (ParserResult GEvalOptions) (GEvalOptions, Maybe MetricValue))
-runGEval' readOptsFromConfigFile args =
+getOptions' :: Bool -> [String] -> IO (Either (ParserResult GEvalOptions) GEvalOptions)
+getOptions' readOptsFromConfigFile args =
   case parserResult of
     Success opts -> if readOptsFromConfigFile then
                       attemptToReadOptsFromConfigFile args opts else
                         do
-                          mmv <- runGEval'' opts
-                          return $ Right $ (opts, mmv)
+                          return $ Right opts
     otherwise -> return $ Left parserResult
   where parserResult = execParserPure (prefs idm) fullOptionsParser args
 
-attemptToReadOptsFromConfigFile :: [String] -> GEvalOptions -> IO (Either (ParserResult GEvalOptions) (GEvalOptions, Maybe MetricValue))
+attemptToReadOptsFromConfigFile :: [String] -> GEvalOptions -> IO (Either (ParserResult GEvalOptions) GEvalOptions)
 attemptToReadOptsFromConfigFile args opts = do
   configExists <- D.doesFileExist configFilePath
   if configExists then do
       configH <- openFile configFilePath ReadMode
       contents <- hGetContents configH
-      runGEval' False ((words contents) ++ args)
+      getOptions' False ((words contents) ++ args)
     else
-      runGEval' False args
+      getOptions' False args
   where configFilePath = (getExpectedDirectory $ geoSpec opts) </> configFileName
 
 
diff --git a/stack.yaml b/stack.yaml
index bc96dc8..65a479b 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,5 +1,6 @@
 flags: {}
 packages:
 - '.'
-extra-deps: []
-resolver: lts-3.13
+extra-deps: [cond-0.4.1.1]
+compiler-check: newer-minor
+resolver: nightly-2015-12-19
diff --git a/test/Spec.hs b/test/Spec.hs
index dc9d7f9..b549a05 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -33,6 +33,9 @@ main = hspec $ do
       precisionCount [["bar", "bar", "bar", "bar", "foo", "xyz", "foo"]] ["foo", "bar", "foo", "baz", "bar", "foo"] `shouldBe` 4
     it "multiple refs" $ do
       precisionCount [["foo", "baz"], ["bar"], ["baz", "xyz"]]  ["foo", "bar", "foo"] `shouldBe` 2
+  describe "reading options" $ do
+    it "can get the metric" $ do
+      extractMetric "bleu-complex" `shouldReturn` (Just BLEU)
   describe "error handling" $ do
     it "too few lines are handled" $ do
       runGEvalTest "error-too-few-lines" `shouldThrow` (== TooFewLines)
@@ -55,6 +58,13 @@ runGEvalTest testName = (runGEval [
   "--out-directory",
   "test/" ++ testName ++ "/" ++ testName ++ "-solution"]) >>= extractVal
 
+extractMetric :: String -> IO (Maybe Metric)
+extractMetric testName = do
+  result <- getOptions ["--expected-directory", "test/" ++ testName ++ "/" ++ testName]
+  return $ case result of
+   Left _ -> Nothing
+   Right opts -> Just $ gesMetric $ geoSpec opts
+
 class AEq a where
     (=~) :: a -> a -> Bool