Improve detecting wrong metrics during validation

src/GEval/Common.hs

@@ -136,6 +136,7 @@ data GEvalException = NoExpectedFile FilePath
                       | OtherException String
                       | NoHeaderFile FilePath
                       | UnknownMetric String
+                      | UnknownFlags String
                       deriving (Eq)
 
 instance Exception GEvalException
@@ -159,6 +160,7 @@ instance Show GEvalException where
   show (OtherException message) = message
   show (NoHeaderFile filePath) = somethingWrongWithFilesMessage "No file with header specification" filePath
   show (UnknownMetric t) = "Unknown or broken metric definition: " ++ t
+  show (UnknownFlags t) = "Unknown or broken metric flags: " ++ t
 
 somethingWrongWithFilesMessage :: String -> FilePath -> String
 somethingWrongWithFilesMessage msg filePath = Prelude.concat

src/GEval/EvaluationScheme.hs

@@ -9,15 +9,16 @@ module GEval.EvaluationScheme
   where
 
 import GEval.Metric
+import GEval.Common
 
-import Debug.Trace
+import Control.Exception
 
 import Text.Regex.PCRE.Heavy
 import Text.Regex.PCRE.Light.Base (Regex(..))
 import Text.Regex.PCRE.Light (compile)
-import Data.Text (Text(..), concat, toCaseFold, toLower, toUpper, pack, unpack, words, unwords)
+import Data.Text (Text, concat, toCaseFold, toLower, toUpper, pack, unpack, words, unwords)
 import Data.List (intercalate, break, sort)
-import Data.Either
+import Data.Char (isLetter)
 import Data.Maybe (fromMaybe, catMaybes)
 import qualified Data.ByteString.UTF8 as BSU
 
@@ -66,13 +67,17 @@ readOps ('N':theRest) = handleParametrizedOp (SetName . pack) theRest
 readOps ('P':theRest) = handleParametrizedOp (SetPriority . read) theRest
 readOps ('s':theRest) = handleParametrizedBinaryOp (\a b -> RegexpSubstition (compile (BSU.fromString a) []) (pack b)) theRest
 readOps ('f':theRest) = handleParametrizedOp (FeatureFilter . pack) theRest
-readOps s = ([], s)
+-- this is not the right way to do this, but try catch at least unknown flags
+readOps t@(c:_) = if isLetter c
+                  then throw $ UnknownFlags t
+                  else ([], t)
+readOps "" = ([], "")
 
 getRegexpMatch :: EvaluationScheme -> Maybe Regex
 getRegexpMatch (EvaluationScheme _ ops) = getRegexpMatch' ops
   where getRegexpMatch' [] = Nothing
         getRegexpMatch' ((RegexpMatch regex):_) = Just regex
-        getRegexpMatch' (_:ops) = getRegexpMatch' ops
+        getRegexpMatch' (_:ops') = getRegexpMatch' ops'
 
 handleParametrizedOp :: (String -> PreprocessingOperation) -> String -> ([PreprocessingOperation], String)
 handleParametrizedOp constructor theRest =
@@ -92,11 +97,13 @@ handleParametrizedBinaryOp constructor theRest =
                                    in ((constructor paramA paramB):ops, theRest''')
 
 parseParameter :: String -> (Maybe String, String)
-parseParameter (leftParameterBracket:theRest) =
-  case break (== rightParameterBracket) theRest of
-    (s, []) -> (Nothing, s)
-    (param, (_:theRest')) -> (Just param, theRest')
-parseParameter s = (Nothing, s)
+parseParameter [] = (Nothing, [])
+parseParameter t@(fChar:theRest) =
+  if fChar == leftParameterBracket
+  then case break (== rightParameterBracket) theRest of
+         (s, []) -> throw $ UnknownFlags t
+         (param, (_:theRest')) -> (Just param, theRest')
+  else throw $ UnknownFlags t
 
 
 instance Show EvaluationScheme where
@@ -105,9 +112,10 @@ instance Show EvaluationScheme where
                                                                 else ":" ++ (Prelude.concat (map show operations)))
 
 evaluationSchemeName :: EvaluationScheme -> String
-evaluationSchemeName scheme@(EvaluationScheme metric operations) = fromMaybe (show scheme) (findNameSet operations)
+evaluationSchemeName scheme@(EvaluationScheme _ operations) = fromMaybe (show scheme) (findNameSet operations)
 
-evaluationSchemePriority scheme@(EvaluationScheme _ operations) = fromMaybe defaultPriority (findPrioritySet operations)
+evaluationSchemePriority :: EvaluationScheme -> Int
+evaluationSchemePriority (EvaluationScheme _ operations) = fromMaybe defaultPriority (findPrioritySet operations)
   where defaultPriority = 1
 
 findNameSet :: [PreprocessingOperation] -> Maybe String

test/Spec.hs

@@ -700,6 +700,10 @@ main = hspec $ do
                   gesFormatting = FormattingOptions (Just 4) False }
             createChallenge True tempDir spec
             validationChallenge tempDir spec
+  describe "check validation on broken challenges" $ do
+    it "broken metric" $ do
+      (hSilence [stderr] $ runGEval ["--validate", "--expected-directory", "test/_validation/broken-metric"]) `shouldThrow` anyException
+
   describe "test sample outputs" $ do
     (flip mapM_ ) (Prelude.filter isEvaluationSchemeDescribed listOfAvailableEvaluationSchemes) $ \scheme@(EvaluationScheme metric _) -> do
       it (show scheme) $ do

test/_validation/broken-metric/.gitignore

@@ -0,0 +1,8 @@
+
+*~
+*.swp
+*.bak
+*.pyc
+*.o
+.DS_Store
+.token

test/_validation/broken-metric/README.md

@@ -0,0 +1,27 @@
+
+Tag names and their component
+=============================
+
+Tag names and their components (first name/surname) in a text.
+
+Tags:
+* person
+* surname
+* first-name
+
+For each tag a sequence of token IDs separated with commas should be given (after a slash).
+
+Directory structure
+-------------------
+
+* `README.md` — this file
+* `config.txt` — configuration file
+* `train/` — directory with training data
+* `train/in.tsv` — input data for the train set
+* `train/expected.tsv` — expected (reference) data for the train set
+* `dev-0/` — directory with dev (test) data
+* `dev-0/in.tsv` — input data for the dev set
+* `dev-0/expected.tsv` — expected (reference) data for the dev set
+* `test-A` — directory with test data
+* `test-A/in.tsv` — input data for the test set
+* `test-A/expected.tsv` — expected (reference) data for the test set

test/_validation/broken-metric/config.txt

@@ -0,0 +1 @@
+--metric MultiLabel-F1 --metric WER:P-S<3>u --in-header in-header.tsv  --out-header out-header.tsv

test/_validation/broken-metric/dev-0/expected.tsv

@@ -0,0 +1,3 @@
+person/1,2 first-name/1 surname/2
+
+first-name/1

test/_validation/broken-metric/dev-0/in.tsv

@@ -0,0 +1,3 @@
+Jan Kowalski is here
+I see him
+Barbara

test/_validation/broken-metric/in-header.tsv

@@ -0,0 +1 @@
+Text

test/_validation/broken-metric/out-header.tsv

@@ -0,0 +1 @@
+Entities

test/_validation/broken-metric/test-A/expected.tsv

@@ -0,0 +1,3 @@
+person/1,3 first-name/1 surname/3
+
+first-name/3

test/_validation/broken-metric/test-A/in.tsv

@@ -0,0 +1,3 @@
+John bloody Smith
+Nobody is there
+I saw Marketa

test/_validation/broken-metric/train/expected.tsv

@@ -0,0 +1,3 @@
+I know Mr John Smith
+Steven bloody Brown
+James and James

test/_validation/broken-metric/train/in.tsv

@@ -0,0 +1,3 @@
+person/3,4,5 first-name/4 surname/5
+person/1,3 first-name/1 surname/3
+first-name/1 firstname/3