From 252493a776c6c682cc9b656d1a876badbc26f58b Mon Sep 17 00:00:00 2001 From: Filip Gralinski Date: Wed, 13 May 2020 13:01:35 +0200 Subject: [PATCH] Infrastructure ready --- src/GEval/Common.hs | 2 ++ src/GEval/Core.hs | 45 ++++++++++++++++++++++++++++++++++------- src/GEval/DataSource.hs | 13 ++++++++++-- 3 files changed, 51 insertions(+), 9 deletions(-) diff --git a/src/GEval/Common.hs b/src/GEval/Common.hs index 8f96a80..4a9cc4e 100644 --- a/src/GEval/Common.hs +++ b/src/GEval/Common.hs @@ -9,6 +9,8 @@ import Control.Exception import Data.Attoparsec.Text +data SourceItem a = Got a | Wrong String | Done + type MetricValue = Double data GraphSeries = GraphSeries [(Double, Double)] diff --git a/src/GEval/Core.hs b/src/GEval/Core.hs index c3e696a..d7a84dc 100644 --- a/src/GEval/Core.hs +++ b/src/GEval/Core.hs @@ -749,8 +749,6 @@ parseDistributionWrapper nbOfBits seed distroSpec = case parseDistribution nbOfB Right distro -> distro Left s -> throw $ UnexpectedData 0 s -- shouldn't be here anyway -data SourceItem a = Got a | Wrong String | Done - skipLineNumber :: (x -> c) -> ((Word32, x) -> c) skipLineNumber fun = fun . snd @@ -979,17 +977,30 @@ class EvaluationContext ctxt m where checkStepM :: ((Word32, ParsedRecord ctxt) -> (ResourceT m) c) -> (Word32, WrappedParsedRecord ctxt) -> (ResourceT m) (Maybe c) data WithoutInput m e o = WithoutInput (LineSource (ResourceT m)) (LineSource (ResourceT m)) + | WithoutInputButFiltered Filter (LineSource (ResourceT m)) (LineSource (ResourceT m)) (LineSource (ResourceT m)) instance (MonadUnliftIO m, MonadIO m, MonadThrow m) => EvaluationContext (WithoutInput m e o) m where data ParserSpec (WithoutInput m e o) = ParserSpecWithoutInput (ItemTarget -> Either String e) (ItemTarget -> Either String o) data WrappedParsedRecord (WithoutInput m e o) = WrappedParsedRecordWithoutInput (SourceItem e) (SourceItem o) data ParsedRecord (WithoutInput m e o) = ParsedRecordWithoutInput e o getFirstLineNo _ (WithoutInput _ (LineSource _ _ _ _ lineNo)) = lineNo + getFirstLineNo _ (WithoutInputButFiltered _ _ _ (LineSource _ _ _ _ lineNo)) = lineNo getExpectedSource (WithoutInput (LineSource _ _ _ expectedSource _) _) = expectedSource + getExpectedSource (WithoutInputButFiltered _ _ (LineSource _ _ _ expectedSource _) _) = expectedSource getOutSource (WithoutInput _ (LineSource _ _ _ outSource _)) = outSource + getOutSource (WithoutInputButFiltered _ _ _ (LineSource _ _ _ outSource _)) = outSource recordSource (WithoutInput expectedLineSource outLineSource) (ParserSpecWithoutInput expParser outParser) = getZipSource $ WrappedParsedRecordWithoutInput <$> ZipSource (items expectedLineSource expParser) <*> ZipSource (items outLineSource outParser) + recordSource (WithoutInputButFiltered theFilter inputLineSource expectedLineSource outLineSource) (ParserSpecWithoutInput expParser outParser) = + (getZipSource $ (\x (y,z) -> TargetRecord x y z) + <$> ZipSource (sourceItems inputLineSource) + <*> ZipSource (getZipSource $ (,) + <$> ZipSource (sourceItems expectedLineSource) + <*> ZipSource (sourceItems outLineSource))) + .| CC.filter (applyFilter theFilter) + .| 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 _ _ (lineNo, WrappedParsedRecordWithoutInput _ (Wrong m)) = throw $ UnexpectedData lineNo m checkStep _ _ (lineNo, WrappedParsedRecordWithoutInput (Wrong m) _) = throw $ UnexpectedData lineNo m @@ -1017,10 +1028,14 @@ instance (MonadUnliftIO m, MonadIO m, MonadThrow m) => EvaluationContext (WithIn getFirstLineNo _ (WithInput _ _ _ (LineSource _ _ _ _ lineNo)) = lineNo getExpectedSource (WithInput _ _ (LineSource _ _ _ expectedSource _) _) = expectedSource getOutSource (WithInput _ _ _ (LineSource _ _ _ outSource _)) = outSource - recordSource (WithInput _ inputLineSource expectedLineSource outLineSource) (ParserSpecWithInput inpParser expParser outParser) = getZipSource $ (\x (y,z) -> WrappedParsedRecordWithInput x y z) - <$> ZipSource (items inputLineSource inpParser) <*> (ZipSource $ getZipSource $ (,) - <$> ZipSource (items expectedLineSource expParser) - <*> ZipSource (items outLineSource outParser)) + recordSource (WithInput theFilter inputLineSource expectedLineSource outLineSource) (ParserSpecWithInput inpParser expParser outParser) = + (getZipSource $ (\x (y,z) -> TargetRecord x y z) + <$> ZipSource (sourceItems inputLineSource) + <*> ZipSource (getZipSource $ (,) + <$> ZipSource (sourceItems expectedLineSource) + <*> ZipSource (sourceItems outLineSource))) + .| CC.filter (applyFilter theFilter) + .| 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 _ _ (lineNo, WrappedParsedRecordWithInput _ _ (Wrong m)) = throw $ UnexpectedData lineNo m checkStep _ _ (lineNo, WrappedParsedRecordWithInput _ (Wrong m) _) = throw $ UnexpectedData lineNo m @@ -1067,6 +1082,19 @@ items (LineSource lineSource itemDecoder preprocess _ _) parser = preprocess' (RawItemTarget t) = RawItemTarget $ preprocess t preprocess' (PartiallyParsedItemTarget ts) = PartiallyParsedItemTarget $ Prelude.map preprocess ts +sourceItems :: MonadResource m => LineSource m -> ConduitT () (SourceItem ItemTarget) m () +sourceItems (LineSource lineSource itemDecoder preprocess _ _) = + (lineSource .| CL.map (Got . preprocess' . itemDecoder)) >> yield Done + where preprocess' (RawItemTarget t) = RawItemTarget $ preprocess t + preprocess' (PartiallyParsedItemTarget ts) = PartiallyParsedItemTarget $ Prelude.map preprocess ts + +applyParser :: (ItemTarget -> Either String a) -> SourceItem ItemTarget -> SourceItem a +applyParser parser (Got x) = case parser x of + Right v -> Got v + Left c -> Wrong c +applyParser _ Done = Done +applyParser _ (Wrong c) = Wrong c + -- | Takes a source of lines and returns a conduit of lines represented as -- items (without preprocessing and parsing!) to be used in line-by-line modes. linesAsItems :: MonadResource m => LineSource m -> ConduitT () (SourceItem Text) m () @@ -1074,5 +1102,8 @@ linesAsItems (LineSource lineSource _ _ _ _) = (lineSource .| CL.map Got) >> yield Done applyFilterToSourceItems :: Filter -> (SourceItem Text, (SourceItem Text, SourceItem Text)) -> Bool -applyFilterToSourceItems filter (Got x, (Got y, Got z)) = applyFilter filter (x, (y, z)) +applyFilterToSourceItems filter (Got x, (Got y, Got z)) = applyFilter filter targetRecord + where targetRecord = TargetRecord (Got (RawItemTarget x)) + (Got (RawItemTarget y)) + (Got (RawItemTarget z)) applyFilterToSourceItems _ special = True diff --git a/src/GEval/DataSource.hs b/src/GEval/DataSource.hs index 8fadb03..1c8f8bd 100644 --- a/src/GEval/DataSource.hs +++ b/src/GEval/DataSource.hs @@ -1,25 +1,34 @@ +{-# LANGUAGE OverloadedStrings #-} + module GEval.DataSource (ChallengeDataSource(..), DataSource(..), + TargetRecord(..), Filter, noFilter, applyFilter) where +import GEval.Common (SourceItem(..)) +import GEval.Selector (ItemTarget(..)) + import Data.Text import Data.Conduit.SmartSource import Data.Conduit.Header import GEval.Selector +data TargetRecord = TargetRecord (SourceItem ItemTarget) (SourceItem ItemTarget) (SourceItem ItemTarget) + data Filter = NoFilter | InputFilter (Text -> Bool) noFilter :: Filter noFilter = NoFilter -applyFilter :: Filter -> (Text, (Text, Text)) -> Bool +applyFilter :: Filter -> TargetRecord -> Bool applyFilter NoFilter _ = True -applyFilter (InputFilter fun) (inp, (exp, out)) = fun inp +applyFilter (InputFilter fun) (TargetRecord (Got (RawItemTarget t)) _ _) = fun t +applyFilter (InputFilter fun) (TargetRecord (Got (PartiallyParsedItemTarget ts)) _ _) = fun (intercalate "\t" ts) -- | This type specifies the way the challenge data (input and -- expected data, but not outputs) flow into evaluation.