Reducers now use filters (WIP, intermediate step)

bench/stdout-tools/app/tq.hs

@@ -163,7 +163,7 @@ run cliOpts@(CliOpts _ parallel ((MkReducer r):_)) = do
     ------------------------------------
     mapM_
       (\(logName,fp) -> do
-        ans <- lineFoldl'
+        ans <- Log.lineFoldl'
           (Reducer.reducerOf r)
           (Reducer.initialOf r)
           fp
@@ -179,7 +179,7 @@ run cliOpts@(CliOpts _ parallel ((MkReducer r):_)) = do
     ---------------------------------------------------------
     ansParallel <- Async.mapConcurrently
       (\(logName,fp) -> do
-        ans <- lineFoldl'
+        ans <- Log.lineFoldl'
           (Reducer.reducerOf r)
           (Reducer.initialOf r)
           fp
@@ -212,15 +212,16 @@ run cliOpts@(CliOpts _ parallel ((MkReducer r):_)) = do
   -- End
   return ()
 
--- Allow to `fold'` through the log file but in JSON format.
-lineFoldl' :: (a -> Either Text.Text Trace.Trace -> a) -> a -> FilePath -> IO a
-lineFoldl' f initialAcc filePath = do
+-- Like `lineFoldl'` but with a filter for which raw lines to apply a function.
+_filterLineFoldl' :: (a -> Text.Text -> (Maybe a)) -> a -> FilePath -> IO a
+_filterLineFoldl' f initialAcc filePath = do
   Log.lineFoldl'
     (\acc textLine ->
-      -- CRITICAL: Has to be "STRICT" to keep `Log.lineFoldl'`'s behaviour.
-      --           I repeat, the accumulator function has to be strict!
-      let !nextAcc = f acc (Trace.fromJson textLine)
-      in nextAcc
+      case f acc textLine of
+        Nothing -> acc
+        -- CRITICAL: Has to be "STRICT" to keep `Log.lineFoldl'`'s behaviour.
+        --           I repeat, the accumulator function has to be strict!
+        Just !nextAcc -> nextAcc
     )
     initialAcc
     filePath

bench/stdout-tools/src/Cardano/Tracer/Filter.hs

@@ -0,0 +1,143 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE TypeFamilies #-}
+
+--------------------------------------------------------------------------------
+
+module Cardano.Tracer.Filter
+  (
+    Filter (..)
+
+  , Id (..)
+
+  -- Trace message validation.
+  , ParseTrace (..)
+  , RightTrace (..)
+  , RightAt (..)
+
+  , Namespace (..)
+  -- TODO: Ideas!
+--  , RemoveFirstNonTraces (..)
+--  , AscendingAt
+
+  -- Get a single data point with a timestamp.
+  , Resource (..)
+  , UtxoSize (..)
+
+  ) where
+
+--------------------------------------------------------------------------------
+
+-- base.
+import           Data.Kind (Type)
+-- package: time.
+import           Data.Time.Clock (UTCTime)
+-- package: text.
+import qualified Data.Text as Text
+-- package: aeson.
+import qualified Data.Aeson as Aeson
+-- library.
+import qualified Cardano.Tracer.Trace as Trace
+
+--------------------------------------------------------------------------------
+
+-- TODO: Show should not be here
+class Show f => Filter f where
+  type family FilterInput f :: Type
+  type family FilterOutput f :: Type
+  filterOf :: f -> FilterInput f -> Maybe (FilterOutput f)
+
+--------------------------------------------------------------------------------
+
+data Id = Id
+  deriving Show
+
+-- From a `Text` line to an `Either` `Trace`.
+data ParseTrace = ParseTrace
+  deriving Show
+
+-- From an `Either` `Trace` to a `Trace`.
+data RightTrace = RightTrace
+  deriving Show
+
+-- From `Trace` with an `Either` `UTCTime` to a `(UTCTime, Text)`.
+data RightAt = RightAt
+  deriving Show
+
+-- Filter valid `Trace`s by namespace (`ns`).
+data Namespace = Namespace Text.Text
+  deriving Show
+
+-- Get a `Resource` property (they are all `Integer`) from a `Trace`.
+data Resource = Resource (Trace.DataResources -> Integer)
+
+instance Show Resource where
+  show _ = "Resource"
+
+-- Get a `remainder`'s "utxoSize" property from a `Trace`.
+data UtxoSize = UtxoSize
+  deriving Show
+
+--------------------------------------------------------------------------------
+
+instance Filter Id where
+  type instance FilterInput  Id = Text.Text
+  type instance FilterOutput Id = Text.Text
+  filterOf _ = Just
+
+instance Filter ParseTrace where
+  type instance FilterInput  ParseTrace = Text.Text
+  type instance FilterOutput ParseTrace = Either Text.Text Trace.Trace
+  filterOf _ text = Just $ Trace.fromJson text
+
+-- To use after `ParseTrace`.
+instance Filter RightTrace where
+  type instance FilterInput  RightTrace = Either Text.Text Trace.Trace
+  type instance FilterOutput RightTrace = Trace.Trace
+  filterOf _ (Left _) = Nothing
+  filterOf _ (Right trace) = Just trace
+
+-- To use after `RightTrace`.
+instance Filter RightAt where
+  type instance FilterInput  RightAt = Trace.Trace
+  type instance FilterOutput RightAt = (UTCTime, Text.Text) -- at and remainder
+  filterOf RightAt (Trace.Trace eitherAt _ remainder) =
+    case eitherAt of
+      (Left _) -> Nothing
+      (Right at) -> Just (at, remainder)
+
+-- To use after `RightTrace`.
+-- The most performant filter, to always use first when possible.
+instance Filter Namespace where
+  type instance FilterInput  Namespace = Trace.Trace
+  type instance FilterOutput Namespace = Trace.Trace
+  filterOf (Namespace ns) trace =
+    if Trace.ns trace == ns
+    then Just trace
+    else Nothing
+
+-- To use after `RightTrace`.
+-- For performance, first the `Namespace` and second the `RightAt` filter.
+instance Filter Resource where
+  type instance FilterInput  Resource = (UTCTime, Text.Text)
+  type instance FilterOutput Resource = (UTCTime, Integer)
+  filterOf (Resource f) (at, remainder) =
+    case Aeson.eitherDecodeStrictText remainder of
+      (Right !aeson) ->
+        -- TODO: Use `unsnoc` when available
+        let resource = f $ Trace.remainderData aeson
+        in Just (at, resource)
+      (Left _) -> Nothing
+
+-- To use after `RightTrace`.
+-- For performance, first the `Namespace` and second the `RightAt` filter.
+instance Filter UtxoSize where
+  type instance FilterInput  UtxoSize = (UTCTime, Text.Text)
+  type instance FilterOutput UtxoSize = (UTCTime, Integer)
+  filterOf UtxoSize (at, remainder) =
+    case Aeson.eitherDecodeStrictText remainder of
+      (Right !aeson) ->
+        -- TODO: Use `unsnoc` when available
+        let utxoSize = Trace.utxoSize $ Trace.remainderData aeson
+        in Just (at, utxoSize)
+      (Left _) -> Nothing