fix(eo-phi-normalizer): update code that uses the pipeline config

objectionary · Dec 28, 2024 · 9ed3051 · 9ed3051
1 parent ec1e150
commit 9ed3051
Show file tree

Hide file tree

Showing 3 changed files with 119 additions and 12 deletions.
diff --git a/eo-phi-normalizer/app/Main.hs b/eo-phi-normalizer/app/Main.hs
@@ -65,7 +65,7 @@ import Data.Text.Internal.Builder (toLazyText)
 import Data.Text.Lazy as TL (unpack)
 import Data.Text.Lazy.Manipulate (toOrdinal)
 import Data.Version (showVersion)
-import Data.Yaml (decodeFileThrow, decodeThrow)
+import Data.Yaml (decodeThrow, encodeFile)
 import GHC.Generics (Generic)
 import Language.EO.Locale (withCorrectLocale)
 import Language.EO.Phi (Binding (..), Bytes (Bytes), Object (..), Program (Program), parseProgram, printTree)
@@ -766,7 +766,8 @@ main = withCorrectLocale do
                in logStrLn (printAsProgramOrAsObject obj'')
             Right (Bytes bytes) -> logStrLn bytes
     CLI'Pipeline' (CLI'Pipeline'Report' CLI'Pipeline'Report{..}) -> do
-      pipelineConfig <- decodeFileThrow @_ @PipelineConfig configFile
+      pipelineConfig <- readPipelineConfig configFile
+      encodeFile "abra.yaml" pipelineConfig
       let testSets = filter (fromMaybe True . (.enable)) pipelineConfig.testSets
       programReports <- forM (zip [1 ..] testSets) $ \(index :: Int, (.phi) -> testSet) -> do
         let progress = [fmt|({index}/{length testSets})|] :: String
@@ -796,10 +797,10 @@ main = withCorrectLocale do
           createDirectoryIfMissing True (takeDirectory path)
           writeFile path reportString
     CLI'Pipeline' (CLI'Pipeline'PrepareTests' CLI'Pipeline'PrepareTests{..}) -> do
-      config <- decodeFileThrow @_ @PipelineConfig configFile
+      config <- readPipelineConfig configFile
       PrepareTests.prepareTests config
     CLI'Pipeline' (CLI'Pipeline'PrintDataizeConfigs' CLI'Pipeline'PrintDataizeConfigs{..}) -> do
-      config <- decodeFileThrow @_ @PipelineConfig configFile
+      config <- readPipelineConfig configFile
       PrintConfigs.printDataizeConfigs config phiPrefixesToStrip singleLine
     CLI'Test' (CLI'Test{..}) ->
       evalSpec defaultConfig (spec rulePaths)

diff --git a/eo-phi-normalizer/src/Language/EO/Phi/Pipeline/Config.hs b/eo-phi-normalizer/src/Language/EO/Phi/Pipeline/Config.hs
@@ -27,17 +27,27 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -Wno-partial-fields #-}
 
 module Language.EO.Phi.Pipeline.Config where
 
+import Control.Monad.IO.Class (MonadIO)
 import Data.Aeson (ToJSON)
 import Data.Aeson.Types (FromJSON)
+import Data.Functor ((<&>))
+import Data.List (intercalate)
+import Data.Yaml (decodeFileThrow)
 import GHC.Generics (Generic)
 import Language.EO.Phi.Metrics.Data
 import Language.EO.Phi.TH (deriveJSON)
+import System.FilePath ((<.>), (</>))
 import Text.Printf (printf)
 
 data TestSetPhi = TestSetPhi
@@ -127,16 +137,65 @@ data AtomsSet = AtomsSet
 
 $(deriveJSON ''AtomsSet)
 
-data TestSet = TestSet
-  { eo :: TestSetEO
-  , phi :: TestSetPhi
-  , atoms :: Maybe AtomsSet
+data PathPrefixEO = PathPrefixEO
+  { original :: FilePath
+  , yaml :: FilePath
+  , filtered :: FilePath
+  }
+  deriving stock (Show, Generic)
+
+$(deriveJSON ''PathPrefixEO)
+
+data PathPrefixPhi = PathPrefixPhi
+  { initial :: FilePath
+  , normalized :: FilePath
+  }
+  deriving stock (Show, Generic)
+
+$(deriveJSON ''PathPrefixPhi)
+
+data PathPrefix = PathPrefix
+  { eo :: PathPrefixEO
+  , phi :: PathPrefixPhi
+  }
+  deriving stock (Show, Generic)
+
+$(deriveJSON ''PathPrefix)
+
+data Common = Common
+  { pathPrefix :: PathPrefix
+  , bindingsPath :: Maybe String
+  }
+  deriving stock (Show, Generic)
+
+$(deriveJSON ''Common)
+
+data Individual = Individual
+  { name :: String
   , enable :: Maybe Bool
-  -- ^
-  -- Whether to enable this test set.
+  , include :: Maybe [String]
+  , exclude :: Maybe [String]
+  , atoms :: Maybe AtomsSet
   }
   deriving stock (Show, Generic)
 
+$(deriveJSON ''Individual)
+
+data TestSet
+  = TestSetExtended
+      { eo :: TestSetEO
+      , phi :: TestSetPhi
+      , atoms :: Maybe AtomsSet
+      , enable :: Maybe Bool
+      -- ^
+      -- Whether to enable this test set.
+      }
+  | TestSetCompact
+      { common :: Common
+      , individual :: [Individual]
+      }
+  deriving stock (Show, Generic)
+
 $(deriveJSON ''TestSet)
 
 data PipelineConfig = PipelineConfig
@@ -152,3 +211,45 @@ data ReportFormat
   | -- | GitHub Flavored Markdown
     ReportFormat'Markdown
   deriving stock (Eq)
+
+split :: forall a. (a -> Bool) -> [a] -> [[a]]
+split cond xs = go xs [] []
+ where
+  go [] _ res = res
+  go (y : ys) curSpan res
+    | cond y = go ys [] (res <> [curSpan])
+    | otherwise = go ys (curSpan <> [y]) res
+
+-- >>> split @Int (== 3) [1,2,3,3,4,3]
+
+toExtended :: PipelineConfig -> PipelineConfig
+toExtended c@(PipelineConfig{testSets}) = c{testSets = concatMap go testSets}
+ where
+  go = \case
+    e@TestSetExtended{} -> [e]
+    TestSetCompact{..} -> go1 common <$> individual
+
+  go1 (Common{..}) (Individual{..}) = TestSetExtended{..}
+   where
+    eo =
+      TestSetEO
+        { original = pathPrefix.eo.original </> name <.> "eo"
+        , yaml = pathPrefix.eo.yaml </> name <.> "yaml"
+        , filtered = pathPrefix.eo.filtered </> name <.> "eo"
+        , include
+        , exclude
+        }
+    phi =
+      TestSetPhi
+        { initial = pathPrefix.phi.initial </> name <.> "phi"
+        , normalized = pathPrefix.phi.normalized </> name <.> "phi"
+        , bindingsPathInitial = bindingsPath <&> mkBindingsPathSuffix
+        , bindingsPathNormalized = bindingsPath <&> mkBindingsPathSuffix
+        }
+     where
+      name' = split (== '/') name
+      mkBindingsPathSuffix x =
+        x <> intercalate "." (if name' /= [] then init name' else [])
+
+readPipelineConfig :: (MonadIO m) => FilePath -> m PipelineConfig
+readPipelineConfig path = toExtended <$> decodeFileThrow @_ @PipelineConfig path
diff --git a/eo-phi-normalizer/src/Language/EO/Phi/TH.hs b/eo-phi-normalizer/src/Language/EO/Phi/TH.hs
@@ -23,13 +23,18 @@
 {- FOURMOLU_ENABLE -}
 module Language.EO.Phi.TH where
 
-import Data.Aeson (Options (..), camelTo2)
+import Data.Aeson (Options (..), SumEncoding (..), camelTo2)
 import Data.Aeson.TH as TH (deriveJSON)
 import Data.Aeson.Types (defaultOptions)
 import Language.Haskell.TH (Dec, Name, Q)
 
 defaultOptions' :: Options
-defaultOptions' = defaultOptions{fieldLabelModifier = camelTo2 '-', rejectUnknownFields = True}
+defaultOptions' =
+  defaultOptions
+    { fieldLabelModifier = camelTo2 '-'
+    , rejectUnknownFields = True
+    , sumEncoding = UntaggedValue
+    }
 
 deriveJSON :: Name -> Q [Dec]
 deriveJSON = TH.deriveJSON defaultOptions'