filipg/geval
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

show line number when something wrong

Browse Source
This commit is contained in:
Filip Gralinski 2018-01-13 15:06:09 +01:00 committed by Filip Gralinski
parent b323e6148c
commit 5c00ab6d26
2 changed files with 23 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
src/GEval/Core.hs
View File

@ -174,7 +174,7 @@ data GEvalException = NoExpectedFile FilePath
| TooFewLinesInInput | TooFewLinesInInput
| TooManyLinesInInput | TooManyLinesInInput
| EmptyOutput | EmptyOutput
| UnexpectedData String | UnexpectedData Word32 String
deriving (Eq) deriving (Eq)
instance Exception GEvalException instance Exception GEvalException
@ -193,7 +193,7 @@ instance Show GEvalException where
show TooFewLinesInInput = "Too few lines in the input file" show TooFewLinesInInput = "Too few lines in the input file"
show TooManyLinesInInput = "Too many lines in the input file" show TooManyLinesInInput = "Too many lines in the input file"
show EmptyOutput = "The output file is empty" show EmptyOutput = "The output file is empty"
show (UnexpectedData message) = "Unexpected data [" ++ message ++ "]" show (UnexpectedData lineNo message) = "Line " ++ (show lineNo) ++ ": Unexpected data [" ++ message ++ "]"
somethingWrongWithFilesMessage :: String -> FilePath -> String somethingWrongWithFilesMessage :: String -> FilePath -> String
somethingWrongWithFilesMessage msg filePath = Prelude.concat somethingWrongWithFilesMessage msg filePath = Prelude.concat
@ -340,7 +340,14 @@ gevalCore' MAP _ = gevalCoreWithoutInput (Right . DLS.splitOn "\t" . unpack)
gevalCore' (LogLossHashed nbOfBits) _ = helper nbOfBits gevalCore' (LogLossHashed nbOfBits) _ = helper nbOfBits
-- for LogLossHashed we "salt" each hash with the line number -- for LogLossHashed we "salt" each hash with the line number
where helper nbOfBits expectedLineSource outLineSource = where helper nbOfBits expectedLineSource outLineSource =
gevalCore''' (ParserSpecWithoutInput (Right . id) (Right . id)) (\(lineNo, (t,d)) -> calculateLogLoss nbOfBits lineNo t (parseDistributionWrapper nbOfBits lineNo d)) averageC negate (WithoutInput expectedLineSource outLineSource) gevalCore''' (ParserSpecWithoutInput (Right . id) tentativeParser) (\(lineNo, (t,d)) -> calculateLogLoss nbOfBits lineNo t (parseDistributionWrapper nbOfBits lineNo d)) averageC negate (WithoutInput expectedLineSource outLineSource)
-- Unfortunately, we're parsing the distribution twice. We need to
-- tentatively parse the distribution when the line number is unknown
-- (so we just set it to 1)
-- @TODO Fix this.
tentativeParser t = case parseDistribution nbOfBits 1 t of
Right _ -> Right t
Left m -> Left m
gevalCore' CharMatch inputLineSource = helper inputLineSource gevalCore' CharMatch inputLineSource = helper inputLineSource
where where
@ -352,7 +359,7 @@ gevalCore' CharMatch inputLineSource = helper inputLineSource
parseDistributionWrapper :: Word32 -> Word32 -> Text -> HashedDistribution parseDistributionWrapper :: Word32 -> Word32 -> Text -> HashedDistribution
parseDistributionWrapper nbOfBits seed distroSpec = case parseDistribution nbOfBits seed distroSpec of parseDistributionWrapper nbOfBits seed distroSpec = case parseDistribution nbOfBits seed distroSpec of
Right distro -> distro Right distro -> distro
Left m -> throw $ UnexpectedData m Left s -> throw $ UnexpectedData 0 s -- shouldn't be here anyway
data SourceItem a = Got a | Wrong String | Done data SourceItem a = Got a | Wrong String | Done
@ -407,15 +414,15 @@ instance (MonadBaseControl IO m, MonadIO m, MonadThrow m) => EvaluationContext (
<$> ZipSource (items expectedLineSource expParser) <$> ZipSource (items expectedLineSource expParser)
<*> ZipSource (items outLineSource outParser) <*> ZipSource (items outLineSource outParser)
checkStep _ step (lineNo, WrappedParsedRecordWithoutInput (Got expectedItem) (Got outItem)) = Just $ step (lineNo, ParsedRecordWithoutInput expectedItem outItem) checkStep _ step (lineNo, WrappedParsedRecordWithoutInput (Got expectedItem) (Got outItem)) = Just $ step (lineNo, ParsedRecordWithoutInput expectedItem outItem)
checkStep _ _ (_, WrappedParsedRecordWithoutInput _ (Wrong m)) = throw $ UnexpectedData m checkStep _ _ (lineNo, WrappedParsedRecordWithoutInput _ (Wrong m)) = throw $ UnexpectedData lineNo m
checkStep _ _ (_, WrappedParsedRecordWithoutInput (Wrong m) _) = throw $ UnexpectedData m checkStep _ _ (lineNo, WrappedParsedRecordWithoutInput (Wrong m) _) = throw $ UnexpectedData lineNo m
checkStep _ _ (_, WrappedParsedRecordWithoutInput (Got _) Done) = throw TooFewLines checkStep _ _ (_, WrappedParsedRecordWithoutInput (Got _) Done) = throw TooFewLines
checkStep _ _ (_, WrappedParsedRecordWithoutInput Done (Got _)) = throw TooManyLines checkStep _ _ (_, WrappedParsedRecordWithoutInput Done (Got _)) = throw TooManyLines
checkStep _ _ (_, WrappedParsedRecordWithoutInput Done Done) = Nothing checkStep _ _ (_, WrappedParsedRecordWithoutInput Done Done) = Nothing
checkStepM step (lineNo, WrappedParsedRecordWithoutInput (Got expectedItem) (Got outItem)) = Just <$> step (lineNo, ParsedRecordWithoutInput expectedItem outItem) checkStepM step (lineNo, WrappedParsedRecordWithoutInput (Got expectedItem) (Got outItem)) = Just <$> step (lineNo, ParsedRecordWithoutInput expectedItem outItem)
checkStepM _ (_, WrappedParsedRecordWithoutInput _ (Wrong m)) = throw $ UnexpectedData m checkStepM _ (lineNo, WrappedParsedRecordWithoutInput _ (Wrong m)) = throw $ UnexpectedData lineNo m
checkStepM _ (_, WrappedParsedRecordWithoutInput (Wrong m) _) = throw $ UnexpectedData m checkStepM _ (lineNo, WrappedParsedRecordWithoutInput (Wrong m) _) = throw $ UnexpectedData lineNo m
checkStepM _ (_, WrappedParsedRecordWithoutInput (Got _) Done) = throwM TooFewLines checkStepM _ (_, WrappedParsedRecordWithoutInput (Got _) Done) = throwM TooFewLines
checkStepM _ (_, WrappedParsedRecordWithoutInput Done (Got _)) = throwM TooManyLines checkStepM _ (_, WrappedParsedRecordWithoutInput Done (Got _)) = throwM TooManyLines
checkStepM _ (_, WrappedParsedRecordWithoutInput Done Done) = return Nothing checkStepM _ (_, WrappedParsedRecordWithoutInput Done Done) = return Nothing
@ -436,9 +443,9 @@ instance (MonadBaseControl IO m, MonadIO m, MonadThrow m) => EvaluationContext (
<$> ZipSource (items expectedLineSource expParser) <$> ZipSource (items expectedLineSource expParser)
<*> ZipSource (items outLineSource outParser)) <*> ZipSource (items outLineSource outParser))
checkStep _ step (lineNo, WrappedParsedRecordWithInput (Got inputItem) (Got expectedItem) (Got outItem)) = Just $ step (lineNo, ParsedRecordWithInput inputItem expectedItem outItem) checkStep _ step (lineNo, WrappedParsedRecordWithInput (Got inputItem) (Got expectedItem) (Got outItem)) = Just $ step (lineNo, ParsedRecordWithInput inputItem expectedItem outItem)
checkStep _ _ (_, WrappedParsedRecordWithInput _ _ (Wrong m)) = throw $ UnexpectedData m checkStep _ _ (lineNo, WrappedParsedRecordWithInput _ _ (Wrong m)) = throw $ UnexpectedData lineNo m
checkStep _ _ (_, WrappedParsedRecordWithInput _ (Wrong m) _) = throw $ UnexpectedData m checkStep _ _ (lineNo, WrappedParsedRecordWithInput _ (Wrong m) _) = throw $ UnexpectedData lineNo m
checkStep _ _ (_, WrappedParsedRecordWithInput (Wrong m) _ _) = throw $ UnexpectedData m checkStep _ _ (lineNo, WrappedParsedRecordWithInput (Wrong m) _ _) = throw $ UnexpectedData lineNo m
checkStep _ _ (_, WrappedParsedRecordWithInput _ (Got _) Done) = throw TooFewLines checkStep _ _ (_, WrappedParsedRecordWithInput _ (Got _) Done) = throw TooFewLines
checkStep _ _ (_, WrappedParsedRecordWithInput _ Done (Got _)) = throw TooManyLines checkStep _ _ (_, WrappedParsedRecordWithInput _ Done (Got _)) = throw TooManyLines
checkStep _ _ (_, WrappedParsedRecordWithInput Done (Got _) (Got _)) = throw TooFewLinesInInput checkStep _ _ (_, WrappedParsedRecordWithInput Done (Got _) (Got _)) = throw TooFewLinesInInput
@ -446,9 +453,9 @@ instance (MonadBaseControl IO m, MonadIO m, MonadThrow m) => EvaluationContext (
checkStep _ _ (_, WrappedParsedRecordWithInput Done Done Done) = Nothing checkStep _ _ (_, WrappedParsedRecordWithInput Done Done Done) = Nothing
checkStepM step (lineNo, WrappedParsedRecordWithInput (Got inputItem) (Got expectedItem) (Got outItem)) = Just <$> step (lineNo, ParsedRecordWithInput inputItem expectedItem outItem) checkStepM step (lineNo, WrappedParsedRecordWithInput (Got inputItem) (Got expectedItem) (Got outItem)) = Just <$> step (lineNo, ParsedRecordWithInput inputItem expectedItem outItem)
checkStepM _ (_, WrappedParsedRecordWithInput _ _ (Wrong m)) = throw $ UnexpectedData m checkStepM _ (lineNo, WrappedParsedRecordWithInput _ _ (Wrong m)) = throw $ UnexpectedData lineNo m
checkStepM _ (_, WrappedParsedRecordWithInput _ (Wrong m) _) = throw $ UnexpectedData m checkStepM _ (lineNo, WrappedParsedRecordWithInput _ (Wrong m) _) = throw $ UnexpectedData lineNo m
checkStepM _ (_, WrappedParsedRecordWithInput (Wrong m) _ _) = throw $ UnexpectedData m checkStepM _ (lineNo, WrappedParsedRecordWithInput (Wrong m) _ _) = throw $ UnexpectedData lineNo m
checkStepM _ (_, WrappedParsedRecordWithInput _ (Got _) Done) = throw TooFewLines checkStepM _ (_, WrappedParsedRecordWithInput _ (Got _) Done) = throw TooFewLines
checkStepM _ (_, WrappedParsedRecordWithInput _ Done (Got _)) = throw TooManyLines checkStepM _ (_, WrappedParsedRecordWithInput _ Done (Got _)) = throw TooManyLines
checkStepM _ (_, WrappedParsedRecordWithInput Done (Got _) (Got _)) = throw TooFewLinesInInput checkStepM _ (_, WrappedParsedRecordWithInput Done (Got _) (Got _)) = throw TooFewLinesInInput

4
test/Spec.hs
View File

@ -104,9 +104,9 @@ main = hspec $ do
it "empty output is handled" $ do it "empty output is handled" $ do
runGEvalTest "empty-output" `shouldThrow` (== EmptyOutput) runGEvalTest "empty-output" `shouldThrow` (== EmptyOutput)
it "unexpected data is handled" $ it "unexpected data is handled" $
runGEvalTest "unexpected-data" `shouldThrow` (== UnexpectedData "input does not start with a digit") runGEvalTest "unexpected-data" `shouldThrow` (== UnexpectedData 3 "input does not start with a digit")
it "unwanted data is handled" $ it "unwanted data is handled" $
runGEvalTest "unwanted-data" `shouldThrow` (== UnexpectedData "number expected") runGEvalTest "unwanted-data" `shouldThrow` (== UnexpectedData 2 "number expected")
describe "precision and recall" $ do describe "precision and recall" $ do
it "null test" $ do it "null test" $ do
precision neverMatch ['a', 'b', 'c'] [0, 1, 2, 3, 4, 5] `shouldBeAlmost` 0.0 precision neverMatch ['a', 'b', 'c'] [0, 1, 2, 3, 4, 5] `shouldBeAlmost` 0.0