cardano-timeseries-io, cardano-tracer: fix bugs and style issues from code review

- Elab.hs: fix copy-paste error in binary arithmetic op elab (rhs hole was
  unified against lhsTy instead of rhsTy); rename evalBinaryArithmethicOpElabProblem
  to evalBinaryArithmeticOpElabProblem (typo)
- Elab.hs: elaborate `metrics` as List Text (was Text); add Str elab case
- Elab/Typing.hs, Resolve.hs, Unify.hs: add List Ty to support metrics type
- Interp.hs: guard avg/min/max against empty instant vector; fix rate to
  error on single-point timeseries instead of dividing by zero
- Interp/Value.hs: use showFFloat in Show instance for Scalar to avoid
  scientific notation in JSON output
- TimeseriesServer.hs: fix minimumRetentionMillis units (seconds → ms);
  remove unused RecordWildCards pragma; align sleep delay with Monitoring.hs
- Acceptors/Utils.hs: align new imports with surrounding import block

Author: Russoul

bench/cardano-timeseries-io/src/Cardano/Timeseries/Elab.hs

@@ -125,8 +125,8 @@ prettyBinaryArithmeticOpElabProblem (BinaryArithmeticOpElabProblem gam loc _ lhs
     <> "\n  @ "
     <> asText loc
 
-evalBinaryArithmethicOpElabProblem :: Defs -> BinaryArithmeticOpElabProblem -> BinaryArithmeticOpElabProblem
-evalBinaryArithmethicOpElabProblem defs (BinaryArithmeticOpElabProblem gam loc lhs lhsTy op rhs rhsTy hole holeTy) =
+evalBinaryArithmeticOpElabProblem :: Defs -> BinaryArithmeticOpElabProblem -> BinaryArithmeticOpElabProblem
+evalBinaryArithmeticOpElabProblem defs (BinaryArithmeticOpElabProblem gam loc lhs lhsTy op rhs rhsTy hole holeTy) =
   BinaryArithmeticOpElabProblem
     (resolveContext defs gam)
     loc
@@ -178,7 +178,7 @@ instance AsText ElabProblem where
 evalElabProblem :: Defs -> ElabProblem -> ElabProblem
 evalElabProblem defs (General p) = General (evalGeneralElabProblem defs p)
 evalElabProblem defs (BinaryRelation p) = BinaryRelation (evalBinaryRelationElabProblem defs p)
-evalElabProblem defs (BinaryArithmeticOp p) = BinaryArithmeticOp (evalBinaryArithmethicOpElabProblem defs p)
+evalElabProblem defs (BinaryArithmeticOp p) = BinaryArithmeticOp (evalBinaryArithmeticOpElabProblem defs p)
 evalElabProblem defs (ToScalar p) = ToScalar (evalToScalarElabProblem defs p)
 
 
@@ -490,8 +490,8 @@ solveNoncanonicalBinaryArithmeticOpElabProblem gam loc lhs lhsTy BinaryArithmeti
     , [BinaryArithmeticOp $
         BinaryArithmeticOpElabProblem gam loc lhs Timestamp BinaryArithmeticOp.Sub rhs Duration hole Timestamp]
     )
-solveNoncanonicalBinaryArithmeticOpElabProblem gam loc lhs lhsTy op rhs _ hole Scalar = do
-  pure $ Just ([UnificationProblem loc lhsTy Scalar, UnificationProblem loc lhsTy Scalar],
+solveNoncanonicalBinaryArithmeticOpElabProblem gam loc lhs lhsTy op rhs rhsTy hole Scalar = do
+  pure $ Just ([UnificationProblem loc lhsTy Scalar, UnificationProblem loc rhsTy Scalar],
         [BinaryArithmeticOp $ BinaryArithmeticOpElabProblem gam loc lhs Scalar op rhs Scalar hole Scalar])
 solveNoncanonicalBinaryArithmeticOpElabProblem gam loc lhs Scalar op rhs Scalar hole holeTy = do
   pure $ Just ([UnificationProblem loc holeTy Scalar],
@@ -576,7 +576,7 @@ solveGeneralElabProblem gam (mbBinaryRelation -> Just (l, a, r, b)) x typ = do
           typ
   pure ([], [e1, e2, e3])
 solveGeneralElabProblem _ (Surface.Metrics l) x typ = do
-  let u = UnificationProblem l typ Types.Text
+  let u = UnificationProblem l typ (Types.List Types.Text)
   modify (updateDefs $ instantiateExpr x Semantic.Metrics)
   pure ([u], [])
 solveGeneralElabProblem _ (Surface.Number l f) x typ = do
@@ -921,6 +921,10 @@ solveGeneralElabProblem gam (Surface.ToScalar l t) h hty = do
         ,
          ToScalar $ ToScalarElabProblem gam l (Semantic.Hole th) (Hole tTy) h
         ])
+solveGeneralElabProblem _ (Surface.Str l s) x typ = do
+  let u = UnificationProblem l typ Types.Text
+  modify (updateDefs $ instantiateExpr x (Semantic.Str (Text.unpack s)))
+  pure ([u], [])
 solveGeneralElabProblem _ s _ _ = throwError $
   "Do not know how to elaborate: " <> showT s
 

bench/cardano-timeseries-io/src/Cardano/Timeseries/Elab/Resolve.hs

@@ -24,6 +24,7 @@ resolveTy _ Timestamp = Timestamp
 resolveTy _ Duration = Duration
 resolveTy _ Bool = Bool
 resolveTy _ Text = Text
+resolveTy defs (List typ) = List (resolveTy defs typ)
 
 -- | Computes the head-normal form of `Binding` w.r.t. hole resolution
 --   (i.e. unfolds holes recursively up to the head expression in type of the binding).

bench/cardano-timeseries-io/src/Cardano/Timeseries/Elab/Typing.hs

@@ -31,6 +31,7 @@ data Ty = InstantVector Ty
         | RangeVector Ty
         | Scalar
         | Text
+        | List Ty
         | Bool
         | Pair Ty Ty
         | Unit
@@ -60,6 +61,8 @@ prettyTy _ Bool = "Bool"
 prettyTy _ Timestamp = "Timestamp"
 prettyTy _ Duration = "Duration"
 prettyTy _ Text = "Text"
+prettyTy prec (List typ) = conditionalParens (prec == Tight) $
+  "List " <> prettyTy Tight typ
 prettyTy _ (Hole idx) = "?" <> showT idx
 
 -- | A context entry of a typing context.

bench/cardano-timeseries-io/src/Cardano/Timeseries/Elab/Unify.hs

@@ -80,6 +80,7 @@ occursNu _ Bool               = pure False
 occursNu _ Timestamp          = pure False
 occursNu _ Duration           = pure False
 occursNu _ Text               = pure False
+occursNu x (List ty)          = occursNu x ty
 occursNu x (Hole x')          = pure (x == x')
 
 unify :: Loc -> Ty -> Ty -> UnifyM [UnificationProblem]

bench/cardano-timeseries-io/src/Cardano/Timeseries/Interp.hs

@@ -44,6 +44,7 @@ import           Data.Maybe (fromMaybe)
 import           Data.Set (Set, isSubsetOf, member)
 import qualified Data.Set as Set
 import           Data.Text (Text)
+import qualified Data.Text as Text
 import           Data.Word (Word64)
 
 import           Statistics.Function (minMax)
@@ -98,14 +99,17 @@ interpMap f = traverse (traverse f)
 
 interpRate :: TimeseriesVector Double -> InterpM (InstantVector Double)
 interpRate v = do
-  min <- liftEither $ maybeToEither (InterpError "Can't compute rate") (eachOldest v)
-  max <- liftEither $ maybeToEither (InterpError "Can't compute rate") (eachNewest v)
-  pure $ zipWith compute min max where
+  mins <- liftEither $ maybeToEither (InterpError "Can't compute rate") (eachOldest v)
+  maxs <- liftEither $ maybeToEither (InterpError "Can't compute rate") (eachNewest v)
+  traverse (uncurry compute) (zip mins maxs) where
 
-  compute :: Instant Double -> Instant Double -> Instant Double
-  compute min max =
-    let x = (max.value - min.value) / fromIntegral (max.timestamp - min.timestamp) in
-    Instant min.labels max.timestamp x
+  compute :: Instant Double -> Instant Double -> InterpM (Instant Double)
+  compute minI maxI
+    | minI.timestamp == maxI.timestamp =
+        throwInterpError "rate: single-point timeseries has undefined rate (zero time span)"
+    | otherwise =
+        let x = (maxI.value - minI.value) / fromIntegral (maxI.timestamp - minI.timestamp)
+        in pure $ Instant minI.labels maxI.timestamp x
 
 interpIncrease :: TimeseriesVector Double -> InterpM (InstantVector Double)
 interpIncrease v = liftEither $ do
@@ -299,13 +303,19 @@ interp cfg store env (Increase r_) now = do
   pure (Value.InstantVector (fmap (fmap Value.Scalar) r'))
 interp cfg store env (Avg expr) now = do
   v <- interp cfg store env expr now >>= expectInstantVectorScalar
-  pure $ Value.Scalar $ mean (Instant.toVector v)
+  if null v
+    then throwInterpError "avg: empty instant vector"
+    else pure $ Value.Scalar $ mean (Instant.toVector v)
 interp cfg store env (Max expr) now = do
   v <- interp cfg store env expr now >>= expectInstantVectorScalar
-  pure $ Value.Scalar $ snd $ minMax (Instant.toVector v)
+  if null v
+    then throwInterpError "max: empty instant vector"
+    else pure $ Value.Scalar $ snd $ minMax (Instant.toVector v)
 interp cfg store env (Min expr) now = do
   v <- interp cfg store env expr now >>= expectInstantVectorScalar
-  pure $ Value.Scalar $ fst $ minMax (Instant.toVector v)
+  if null v
+    then throwInterpError "min: empty instant vector"
+    else pure $ Value.Scalar $ fst $ minMax (Instant.toVector v)
 interp cfg store env (AvgOverTime expr) now = do
   v <- interp cfg store env expr now >>= expectRangeVectorScalar
   pure $ Value.InstantVector (fmap Value.Scalar <$> avgOverTime now v)
@@ -393,4 +403,5 @@ interp cfg store env (Expr.AddDuration a_ b_) now = do
   pure (Value.Duration (a + b))
 interp cfg store env (mbBinaryRelationInstantVector -> Just (v, rel, k)) now =
   interpFilterBinaryRelation cfg store env v rel k now
+interp _ _ _ (Expr.Str s) _ = pure (Value.Text (Text.pack s))
 interp _ _ _ expr _ = throwInterpError $ "Can't interpret expression: " <> showT expr

bench/cardano-timeseries-io/src/Cardano/Timeseries/Interp/Value.hs

@@ -12,6 +12,7 @@ import           Control.DeepSeq (NFData)
 import           Data.Text (unpack, Text)
 import           Data.Word (Word64)
 import           GHC.Generics (Generic)
+import           Numeric (showFFloat)
 
 type FunctionValue = Value -> InterpM Value
 
@@ -47,7 +48,7 @@ data Value where
 instance NFData Value
 
 instance Show Value where
-  show (Scalar x)        = show x
+  show (Scalar x)        = showFFloat Nothing x ""
   show (RangeVector x)   = unpack (asText x)
   show (InstantVector x) = unpack (asText x)
   show (Pair x y)        = "(" <> show x <> ", " <> show y <> ")"

bench/cardano-timeseries-io/src/Cardano/Timeseries/JSON.hs

@@ -13,9 +13,8 @@ import qualified Data.Map.Strict    as Map
 import qualified Data.Set           as Set
 import qualified Data.Vector        as V
 
-import           Cardano.Timeseries.AsText (showT)
-
 import           Data.Text          (Text)
+import qualified Data.Text          as Text
 
 import           Cardano.Timeseries.Domain.Types        (SeriesIdentifier)
 import           Cardano.Timeseries.Domain.Instant      (Instant (..))
@@ -31,13 +30,13 @@ labelsJson si = A.toJSON (Map.fromList (Set.toList si))
 instance (A.ToJSON a, Show a) => A.ToJSON (Instant a) where
   toJSON (Instant ls ts val) = A.object
     [ "metric" A..= labelsJson ls
-    , "value"  A..= A.Array (V.fromList [A.toJSON (fromIntegral ts / 1000.0 :: Double), A.String (showT val)])
+    , "value"  A..= A.Array (V.fromList [A.toJSON (fromIntegral ts / 1000.0 :: Double), A.String (Text.pack (show val))])
     ]
 
 instance (A.ToJSON a, Show a) => A.ToJSON (Timeseries a) where
   toJSON (Timeseries ls ps) = A.object
     [ "metric" A..= labelsJson ls
-    , "values" A..= map (\(t, v) -> A.Array (V.fromList [A.toJSON (fromIntegral t / 1000.0 :: Double), A.String (showT v)])) ps
+    , "values" A..= map (\(t, v) -> A.Array (V.fromList [A.toJSON (fromIntegral t / 1000.0 :: Double), A.String (Text.pack (show v))])) ps
     ]
 
 instance A.ToJSON Value where

cardano-tracer/src/Cardano/Tracer/Acceptors/Utils.hs

@@ -43,11 +43,11 @@ import           System.Metrics.ReqResp
 import           System.Metrics.Store.Acceptor (MetricsLocalStore, emptyMetricsLocalStore,
                    storeMetrics)
 
-import           Trace.Forward.Utils.DataPoint (DataPointRequestor, initDataPointRequestor)
-import qualified Data.Text.Read as Text
-import Data.Char (isAsciiLower, isAsciiUpper, isDigit)
-import qualified Data.Text as T
-import Control.Arrow (first)
+import           Control.Arrow                  (first)
+import           Data.Char                      (isAsciiLower, isAsciiUpper, isDigit)
+import qualified Data.Text                      as T
+import qualified Data.Text.Read                 as Text
+import           Trace.Forward.Utils.DataPoint  (DataPointRequestor, initDataPointRequestor)
 
 prepareDataPointRequestor
   :: Show addr

cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/TimeseriesServer.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ViewPatterns #-}
 
 module Cardano.Tracer.Handlers.Metrics.TimeseriesServer(runTimeseriesServer) where
@@ -177,7 +176,7 @@ runTimeseriesServer :: TracerEnv -> Endpoint -> TimeseriesHandle -> IO ()
 runTimeseriesServer tracerEnv endpoint handle = do
 
   -- Pause to prevent collision between "Listening"-notifications from servers.
-  sleep 0.1
+  sleep 0.2
 
   traceWith tracerEnv.teTracer TracerStartedTimeseries
     { ttTimeseriesEndpoint = endpoint
@@ -192,7 +191,7 @@ runTimeseriesServer tracerEnv endpoint handle = do
       tlsSettingsChain certificateFile (fromMaybe [] certificateChain) certificateKeyFile
 
     inputSanCfg = InputSanitationConfig {
-        minimumRetentionMillis = truncate (fromMaybe 1000 tracerEnv.teConfig.ekgRequestFreq)
+        minimumRetentionMillis = round (fromMaybe 1.0 tracerEnv.teConfig.ekgRequestFreq * 1000)
       , minimumPruningPeriodMillis = 1
     }