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

Refactor filtering

Browse Source
This commit is contained in:
Filip Gralinski 2021-10-26 08:45:08 +02:00
parent 2783a5bed8
commit e41115ddcd
1 changed files with 10 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
src/GEval/Core.hs
View File

@ -1,3 +1,4 @@
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
@ -1095,8 +1096,7 @@ instance (MonadUnliftIO m, MonadIO m, MonadThrow m) => EvaluationContext (Withou
<*> ZipSource (getZipSource $ (,) <*> ZipSource (getZipSource $ (,)
<$> ZipSource (sourceItems expectedLineSource) <$> ZipSource (sourceItems expectedLineSource)
<*> ZipSource (sourceItems outLineSource))) <*> ZipSource (sourceItems outLineSource)))
.| CC.filter (applyFilter $ generalizedFilterFilter theFilter) .| filterConduit theFilter
.| topperConduit (generalizedFilterTopper theFilter)
.| CC.map (\(TargetRecord _ y z) -> WrappedParsedRecordWithoutInput (applyParser expParser y) (applyParser outParser z)) .| CC.map (\(TargetRecord _ y z) -> WrappedParsedRecordWithoutInput (applyParser expParser y) (applyParser outParser z))
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)
@ -1133,8 +1133,7 @@ instance (MonadUnliftIO m, MonadIO m, MonadThrow m) => EvaluationContext (WithIn
<*> ZipSource (getZipSource $ (,) <*> ZipSource (getZipSource $ (,)
<$> ZipSource (sourceItems expectedLineSource) <$> ZipSource (sourceItems expectedLineSource)
<*> ZipSource (sourceItems outLineSource))) <*> ZipSource (sourceItems outLineSource)))
.| CC.filter (applyFilter $ generalizedFilterFilter theFilter) .| filterConduit theFilter
.| topperConduit (generalizedFilterTopper theFilter)
.| CC.map (\(TargetRecord x y z) -> WrappedParsedRecordWithInput (applyParser inpParser x) (applyParser expParser y) (applyParser outParser z)) .| CC.map (\(TargetRecord x y z) -> WrappedParsedRecordWithInput (applyParser inpParser x) (applyParser expParser y) (applyParser outParser z))
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 _ _ (lineNo, WrappedParsedRecordWithInput _ _ (Wrong m)) = throw $ UnexpectedData lineNo m checkStep _ _ (lineNo, WrappedParsedRecordWithInput _ _ (Wrong m)) = throw $ UnexpectedData lineNo m
@ -1164,14 +1163,13 @@ threeLineSource (WithInput theFilter inputLineSource expectedLineSource outLineS
<$> ZipSource (linesAsItems expectedLineSource) <$> ZipSource (linesAsItems expectedLineSource)
<*> ZipSource (linesAsItems outLineSource))) <*> ZipSource (linesAsItems outLineSource)))
.| (CC.map (\(x, (y,z)) -> TargetRecord (fmap RawItemTarget x) (fmap RawItemTarget y) (fmap RawItemTarget z))) .| (CC.map (\(x, (y,z)) -> TargetRecord (fmap RawItemTarget x) (fmap RawItemTarget y) (fmap RawItemTarget z)))
.| (CC.filter (applyFilter $ generalizedFilterFilter theFilter)) .| filterConduit theFilter
.| topperConduit (generalizedFilterTopper theFilter)
.| (CC.map (\(TargetRecord x y z) -> WrappedParsedRecordWithInput (unwrap x) (unwrap y) (unwrap z))) .| (CC.map (\(TargetRecord x y z) -> WrappedParsedRecordWithInput (unwrap x) (unwrap y) (unwrap z)))
where unwrap = fmap (\(RawItemTarget x) -> x) where unwrap = fmap (\(RawItemTarget x) -> x)
averageC :: MonadResource m => ConduitT Double Void m Double averageC :: MonadResource m => ConduitT Double Void m Double
averageC = getZipSink averageC = getZipSink
$ (\total count -> total / fromIntegral count) $ (\total c -> total / fromIntegral c)
<$> ZipSink CC.sum <$> ZipSink CC.sum
<*> ZipSink CC.length <*> ZipSink CC.length
@ -1204,13 +1202,12 @@ linesAsItems :: MonadResource m => LineSource m -> ConduitT () (SourceItem Text)
linesAsItems (LineSource lineSource _ _ _ _) = linesAsItems (LineSource lineSource _ _ _ _) =
(lineSource .| CL.map Got) >> yield Done (lineSource .| CL.map Got) >> yield Done
applyFilterToSourceItems :: Filter -> (SourceItem Text, (SourceItem Text, SourceItem Text)) -> Bool filterConduit :: Monad m => GeneralizedFilter -> ConduitM TargetRecord TargetRecord m ()
applyFilterToSourceItems filter (Got x, (Got y, Got z)) = applyFilter filter targetRecord filterConduit theFilter =
where targetRecord = TargetRecord (Got (RawItemTarget x)) (CC.filter (applyFilter $ generalizedFilterFilter theFilter))
(Got (RawItemTarget y)) .| topperConduit (generalizedFilterTopper theFilter)
(Got (RawItemTarget z))
applyFilterToSourceItems _ special = True
topperConduit :: Monad m => Topper -> ConduitT TargetRecord TargetRecord m ()
topperConduit NoTopper = doNothing topperConduit NoTopper = doNothing
topperConduit (Topper percentage scorer) = gobbleAndDo (findTop percentage scorer) topperConduit (Topper percentage scorer) = gobbleAndDo (findTop percentage scorer)