diff --git a/eo-phi-normalizer/app/Main.hs b/eo-phi-normalizer/app/Main.hs index d55e8511f..0342253e0 100644 --- 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 index bad3afece..a0e56ad87 100644 --- 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 index db7cdc9f1..78ff19b1a 100644 --- 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'