Attempt to fix plots

bittide-experiments/src/Bittide/Hitl.hs

@@ -1,8 +1,11 @@
 -- SPDX-FileCopyrightText: 2024 Google LLC
 --
 -- SPDX-License-Identifier: Apache-2.0
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
 
 {- | Tooling to define hardware-in-the-loop (HITL) tests. HITL tests in the
 Bittide project involve FPGA designs that incorporate a
@@ -43,6 +46,7 @@ module Bittide.Hitl (
   -- * Test definition
   HitlTest (..),
   HitlTestIter (..),
+  MayHavePostProcData (..),
   Done,
   Success,
   hitlVio,
@@ -65,6 +69,7 @@ import Clash.Cores.Xilinx.VIO (vioProbe)
 import Data.Containers.ListUtils (nubOrd)
 import Data.Map.Strict (Map)
 import Data.Maybe (isJust)
+import Data.Typeable (Typeable)
 import Language.Haskell.TH.Syntax (Name)
 import Numeric.Natural (Natural)
 
@@ -163,6 +168,7 @@ This must be accompanied by a @hitlVio \@NumberOfStages@ in the design.
 -}
 data HitlTest where
   HitlTest ::
+    (Typeable a, Typeable b) =>
     { topEntity :: ClashTargetName
     , extraXdcFiles :: [String]
     , testIters :: [HitlTestIter HwTargetRef a b]
@@ -176,7 +182,7 @@ associated with it.
 -}
 data HitlTestIter h a b where
   HitlTestIter ::
-    (Show h, Show a, BitPack a, Show b) =>
+    (Show h, Show a, BitPack a, Show b, Typeable h) =>
     { iterName :: String
     , hwTParamMap :: Map h a
     , postProcData :: b
@@ -185,6 +191,23 @@ data HitlTestIter h a b where
 
 deriving instance Show (HitlTestIter h a b)
 
+-- | A class for extracting optional post processing data from a test.
+class MayHavePostProcData b where
+  -- | Returns the test names with some post processing data of type @c@,
+  -- if that data exists.
+  mGetPPD ::
+    forall h a.
+    [HitlTestIter h a b] ->
+    Map String (Maybe b)
+
+instance MayHavePostProcData a where
+  mGetPPD iters =
+    Map.fromList
+      [(iterName, Just postProcData) | HitlTestIter{..} <- iters]
+
+instance MayHavePostProcData () where
+  mGetPPD = Map.fromList . map ((,Nothing) . iterName)
+
 -- | Obtain a list of the hardware targets that are relevant for a given HITL test.
 hwTRefsFromTest :: HitlTest -> [HwTargetRef]
 hwTRefsFromTest HitlTest{testIters} =
@@ -213,7 +236,7 @@ to it and receives that constructur as test parameter.
 -}
 testItersFromEnum ::
   forall a b.
-  (Show a, Bounded a, Enum a, BitPack a, Show b) =>
+  (Show a, Bounded a, Enum a, BitPack a, Show b, Typeable a, Typeable b) =>
   [HwTargetRef] ->
   b ->
   [HitlTestIter HwTargetRef a b]

bittide-tools/clockcontrol/plot/Main.hs

@@ -61,7 +61,6 @@ import Control.Exception (Exception (..), catch, throw)
 import Control.Monad (filterM, forM, forM_, unless, when)
 import Control.Monad.Extra (unlessM)
 import Data.Bifunctor (bimap)
-import Data.Bool
 import Data.ByteString qualified as BS
 import Data.ByteString.Char8 qualified as BSC
 import Data.ByteString.Lazy qualified as BSL
@@ -82,13 +81,14 @@ import Data.Csv.Conduit (
  )
 import Data.Functor ((<&>))
 import Data.HashMap.Strict qualified as HashMap
-import Data.List (find, isPrefixOf, isSuffixOf, uncons, unzip4)
+import Data.List (isPrefixOf, isSuffixOf, uncons, unzip4)
 import Data.Map qualified as Map
 import Data.Maybe (catMaybes, fromJust, fromMaybe, mapMaybe)
 import Data.Proxy (Proxy (..))
 import Data.Set qualified as Set
 import Data.String (fromString)
 import Data.Text qualified as Text
+import Data.Typeable (cast)
 import Data.Vector qualified as Vector
 import GHC.IO.Exception (IOErrorType (..), IOException (..))
 import GHC.Stack (HasCallStack)
@@ -100,7 +100,6 @@ import System.Directory (
 import System.Environment (getArgs, getProgName)
 import System.Exit (die)
 import System.FilePath (
-  isExtensionOf,
   takeBaseName,
   takeExtensions,
   takeFileName,
@@ -127,13 +126,13 @@ import Bittide.Hitl
 import Bittide.Instances.Domains
 import Bittide.Instances.Hitl.IlaPlot
 import Bittide.Instances.Hitl.Setup
-import Bittide.Instances.Hitl.Tests
 import Bittide.Plot
 import Bittide.Report.ClockControl
 import Bittide.Simulate.Config (CcConf, saveCcConfig, simTopologyFileName)
 import Bittide.Topology
 
 import Bittide.Simulate.Config qualified as CcConf
+import Bittide.Instances.Hitl.Tests (hitlTests)
 
 -- A newtype wrapper for working with hex encoded types.
 newtype Hex a = Hex {fromHex :: a}
@@ -482,18 +481,21 @@ fromCsvDump t i links (csvHandle, csvFile) =
 {- | The HITL tests, whose post proc data offers a simulation config
 for plotting.
 -}
-knownTestsWithCcConf :: (HasCallStack) => [(String, [(String, CcConf)])]
-knownTestsWithCcConf = hasCcConf <$> hitlTests
+knownTestsWithCcConf :: (HasCallStack) => [(ClashTargetName, [(String, CcConf)])]
+knownTestsWithCcConf = mapMaybe go hitlTests
  where
-  hasCcConf = \case
-    LoadConfig name _ -> (name, [])
-    KnownType name test ->
-      let !simConfMap = Map.mapMaybeWithKey justOrDie (mGetPPD @_ @CcConf test)
-       in (name, first Text.unpack <$> Map.toList simConfMap)
-
   justOrDie _ (Just x) = Just x
   justOrDie k Nothing = error $ "No CcConf for " <> show k
 
+  go HitlTest{topEntity, testIters = iters :: [HitlTestIter HwTargetRef q r]} =
+    case cast @[HitlTestIter HwTargetRef q r] @[HitlTestIter HwTargetRef q CcConf] iters of
+      Just q ->
+        Just
+          ( topEntity
+          , Map.toList (Map.mapMaybeWithKey justOrDie (mGetPPD @CcConf @HwTargetRef q))
+          )
+      Nothing -> Nothing
+
 {- | Calculate an offset such that the clocks start at their set offsets. That is
 to say, we consider the reference clock to be at 0 fs by definition. The offsets
 of the other clocks are then measured relative to this reference clock. We don't
@@ -739,47 +741,46 @@ main =
         unless (null zr) wrongNumberOfArguments
         return (plotDataDir, outDir, mA)
 
-      tests <- do
-        dirs <- listDirectory plotDataDir
-        let hitlDir = plotDataDir </> "hitl"
-        files <-
-          bool
-            (die $ "No 'hitl' folder in " <> fromMaybe plotDataDir mArtifactName)
-            (listDirectory hitlDir)
-            ("hitl" `elem` dirs)
-        case filter (".yml" `isExtensionOf`) files of
-          [] -> die $ "No YAML files in " <> hitlDir
-          [x] -> return $ getTestsWithCcConf $ takeBaseName x
-          _ -> die $ "Too many YAML files in " <> hitlDir
-
-      (testDirs, testsDir) <- do
+      let tests =
+            [ (show topEntity <> ":" <> iterName, mCcConf)
+            | (topEntity, iters) <- knownTestsWithCcConf
+            , (iterName, mCcConf) <- iters
+            ]
+      -- tests <- do
+      --   dirs <- listDirectory plotDataDir
+      --   let hitlDir = plotDataDir </> "hitl"
+      --   files <- bool
+      --     (die $ "No 'hitl' folder in " <> fromMaybe plotDataDir mArtifactName)
+      --     (listDirectory hitlDir)
+      --     ("hitl" `elem` dirs)
+      --   case filter (".yml" `isExtensionOf`) files of
+      --     []  -> die $ "No YAML files in " <> hitlDir
+      --     [x] -> return $ getTestsWithCcConf $ takeBaseName x
+      --     _   -> die $ "Too many YAML files in " <> hitlDir
+
+      (_, testsDir) <- do
         let epsfix = maybe (Left "Bittide.Instances.Hitl.") Right mArtifactName
         dir <- diveDownInto epsfix plotDataDir
         listDirectory dir
           >>= filterM (doesDirectoryExist . (dir </>))
           <&> (,dir)
 
-      let sDirs = Set.fromList testDirs
-          sNames = Set.fromList $ fst <$> tests
-      when (sDirs /= sNames) $
-        die $
-          if sDirs `Set.isProperSubsetOf` sNames
-            then
-              "Missing tests "
-                <> show (Set.toList (sNames `Set.difference` sDirs))
-                <> " in "
-                <> testsDir
-            else
-              "Unknown tests "
-                <> show (Set.toList (sDirs `Set.difference` sNames))
-                <> " in "
-                <> testsDir
+      -- let sDirs  = Set.fromList testDirs
+      --     sNames = Set.fromList $ fst <$> tests
+      -- when (sDirs /= sNames) $ die $
+      --   if sDirs `Set.isProperSubsetOf` sNames
+      --   then "Missing tests "
+      --     <> show (Set.toList (sNames `Set.difference` sDirs))
+      --     <> " in " <> testsDir
+      --   else "Unknown tests "
+      --     <> show (Set.toList (sDirs `Set.difference` sNames))
+      --     <> " in " <> testsDir
 
       forM_ tests $ \(test, cfg) ->
         plotTest (Proxy @Basic125) test cfg (testsDir </> test) outDir
  where
-  getTestsWithCcConf name =
-    maybe [] snd $ find ((== name) . fst) knownTestsWithCcConf
+  -- getTestsWithCcConf name =
+  --   maybe [] snd $ find ((== name) . fst) knownTestsWithCcConf
 
   diveDownInto epsfix dir =
     listDirectory dir