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

refactor LineByLine

Browse Source
This commit is contained in:
Filip Gralinski 2018-05-26 14:40:26 +02:00
parent c71c7a019d
commit cb655cd2ae
1 changed files with 25 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
src/GEval/LineByLine.hs
View File

@ -9,7 +9,9 @@
module GEval.LineByLine module GEval.LineByLine
(runLineByLine, (runLineByLine,
runDiff runLineByLineGeneralized,
runDiff,
runDiffGeneralized
) where ) where
import GEval.Core import GEval.Core
@ -31,11 +33,8 @@ data LineRecord = LineRecord Text Text Text Word32 MetricValue
deriving (Eq, Show) deriving (Eq, Show)
runLineByLine :: GEvalSpecification -> IO () runLineByLine :: GEvalSpecification -> IO ()
runLineByLine spec = do runLineByLine spec = runLineByLineGeneralized spec consum
(inputFilePath, expectedFilePath, outFilePath) <- checkAndGetFiles spec where consum :: ConduitT LineRecord Void (ResourceT IO) ()
gevalLineByLineCore metric inputFilePath expectedFilePath outFilePath consum
where metric = gesMetric spec
consum :: ConduitT LineRecord Void (ResourceT IO) ()
consum = (CL.map (encodeUtf8 . formatOutput) .| CC.unlinesAscii .| CC.stdout) consum = (CL.map (encodeUtf8 . formatOutput) .| CC.unlinesAscii .| CC.stdout)
formatOutput (LineRecord inp exp out _ score) = Data.Text.intercalate "\t" [ formatOutput (LineRecord inp exp out _ score) = Data.Text.intercalate "\t" [
formatScore score, formatScore score,
@ -45,18 +44,15 @@ runLineByLine spec = do
formatScore :: MetricValue -> Text formatScore :: MetricValue -> Text
formatScore = Data.Text.pack . printf "%f" formatScore = Data.Text.pack . printf "%f"
runDiff :: FilePath -> GEvalSpecification -> IO () runLineByLineGeneralized :: GEvalSpecification -> ConduitT LineRecord Void (ResourceT IO) a -> IO a
runDiff otherOut spec = do runLineByLineGeneralized spec consum = do
let otherOutFilePath = getOutFile spec otherOut
(inputFilePath, expectedFilePath, outFilePath) <- checkAndGetFiles spec (inputFilePath, expectedFilePath, outFilePath) <- checkAndGetFiles spec
let sourceA = gevalLineByLineSource metric inputFilePath expectedFilePath outFilePath gevalLineByLineCore metric inputFilePath expectedFilePath outFilePath consum
let sourceB = gevalLineByLineSource metric inputFilePath expectedFilePath otherOutFilePath
runResourceT $ runConduit $
((getZipSource $ (,)
<$> ZipSource sourceA
<*> ZipSource sourceB) .| consum)
where metric = gesMetric spec where metric = gesMetric spec
consum :: ConduitT (LineRecord, LineRecord) Void (ResourceT IO) ()
runDiff :: FilePath -> GEvalSpecification -> IO ()
runDiff otherOut spec = runDiffGeneralized otherOut spec consum
where consum :: ConduitT (LineRecord, LineRecord) Void (ResourceT IO) ()
consum = (CL.filter shouldBeShown .| CL.map (encodeUtf8 . formatOutput) .| CC.unlinesAscii .| CC.stdout) consum = (CL.filter shouldBeShown .| CL.map (encodeUtf8 . formatOutput) .| CC.unlinesAscii .| CC.stdout)
shouldBeShown (LineRecord _ _ outA _ scoreA, LineRecord _ _ outB _ scoreB) = shouldBeShown (LineRecord _ _ outA _ scoreA, LineRecord _ _ outB _ scoreB) =
outA /= outB && scoreA /= scoreB outA /= outB && scoreA /= scoreB
@ -69,10 +65,22 @@ runDiff otherOut spec = do
formatScoreDiff :: Double -> Text formatScoreDiff :: Double -> Text
formatScoreDiff = Data.Text.pack . printf "%f" formatScoreDiff = Data.Text.pack . printf "%f"
runDiffGeneralized :: FilePath -> GEvalSpecification -> ConduitT (LineRecord, LineRecord) Void (ResourceT IO) a -> IO a
runDiffGeneralized otherOut spec consum = do
let otherOutFilePath = getOutFile spec otherOut
(inputFilePath, expectedFilePath, outFilePath) <- checkAndGetFiles spec
let sourceA = gevalLineByLineSource metric inputFilePath expectedFilePath outFilePath
let sourceB = gevalLineByLineSource metric inputFilePath expectedFilePath otherOutFilePath
runResourceT $ runConduit $
((getZipSource $ (,)
<$> ZipSource sourceA
<*> ZipSource sourceB) .| consum)
where metric = gesMetric spec
escapeTabs :: Text -> Text escapeTabs :: Text -> Text
escapeTabs = Data.Text.replace "\t" "<tab>" escapeTabs = Data.Text.replace "\t" "<tab>"
gevalLineByLineCore :: Metric -> FilePath -> FilePath -> FilePath -> ConduitT LineRecord Void (ResourceT IO) () -> IO () gevalLineByLineCore :: Metric -> FilePath -> FilePath -> FilePath -> ConduitT LineRecord Void (ResourceT IO) a -> IO a
gevalLineByLineCore metric inputFilePath expectedFilePath outFilePath consum = gevalLineByLineCore metric inputFilePath expectedFilePath outFilePath consum =
runResourceT $ runConduit $ runResourceT $ runConduit $
((gevalLineByLineSource metric inputFilePath expectedFilePath outFilePath) .| consum) ((gevalLineByLineSource metric inputFilePath expectedFilePath outFilePath) .| consum)