From 7f5d6e73fd19015de1c8e91947405aa3173635a6 Mon Sep 17 00:00:00 2001 From: Christophe Combelles Date: Fri, 10 Jul 2026 23:43:46 +0200 Subject: [PATCH 1/4] Add declarative method patches for characterization factors Method import strategies (Brightway's term for imperative CF-mutation functions applied at import time) are stateful and non-idempotent: they mutate a persisted store, so re-running an import re-applies the mutation. VoLCA parses methods fresh from source on every load, so the same adjustment can be expressed as data instead: a `[[methods.patches]]` TOML block that rescales or overrides matched characterization factors, applied as a pure transform right after parsing. A patch selector (category, flow name/prefix, CAS, subcompartment substring) is a product type with conjunctive matching; the decoder rejects an empty selector and requires exactly one of `scale` or `set-value`, so invalid patches are unrepresentable rather than silently ambiguous. A patch that matches zero characterization factors logs a warning at load time instead of failing silently. Config.mcPatches defaults to `[]`, so existing configs are unaffected. --- src/API/DatabaseHandlers.hs | 1 + src/CLI/Command.hs | 1 + src/Config.hs | 88 ++++++++++++++++++++- src/Database/Manager.hs | 39 +++++++-- src/Method/ParserSimaPro.hs | 1 + src/Method/Patch.hs | 113 ++++++++++++++++++++++++++ test/ConfigSpec.hs | 67 ++++++++++++++++ test/MethodPatchSpec.hs | 154 ++++++++++++++++++++++++++++++++++++ test/MethodUploadSpec.hs | 2 + volca.cabal | 2 + 10 files changed, 461 insertions(+), 7 deletions(-) create mode 100644 src/Method/Patch.hs create mode 100644 test/MethodPatchSpec.hs diff --git a/src/API/DatabaseHandlers.hs b/src/API/DatabaseHandlers.hs index 772a7b29..68c4e6ef 100644 --- a/src/API/DatabaseHandlers.hs +++ b/src/API/DatabaseHandlers.hs @@ -645,6 +645,7 @@ uploadMethodHandler mName mDesc src = , mcFormat = Just $ formatToText $ urFormat uploadResult , mcScoringSets = [] , mcGlobalMethods = [] + , mcPatches = [] } liftIO $ addMethodCollection dbManager mc diff --git a/src/CLI/Command.hs b/src/CLI/Command.hs index 0846e55a..a8635a02 100644 --- a/src/CLI/Command.hs +++ b/src/CLI/Command.hs @@ -426,6 +426,7 @@ executeMcUpload fmt manager args = do , mcFormat = Nothing , mcScoringSets = [] , mcGlobalMethods = [] + , mcPatches = [] } addMethodCollection manager mc reportProgress Info $ "Method uploaded: " ++ T.unpack slug diff --git a/src/Config.hs b/src/Config.hs index db58f958..c1f84d21 100644 --- a/src/Config.hs +++ b/src/Config.hs @@ -9,6 +9,9 @@ module Config ( DatabaseConfig (..), MethodConfig (..), ScoringSetConfig (..), + MethodPatch (..), + MethodPatchMatch (..), + CFPatchOp (..), RefDataConfig (..), HostingConfig (..), ClassificationPreset (..), @@ -33,7 +36,7 @@ import Control.Monad (forM_, unless, when) import Data.List (isPrefixOf) import Data.Map.Strict (Map) import qualified Data.Map.Strict as M -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, isNothing) import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T @@ -42,7 +45,7 @@ import GHC.Generics (Generic) import System.Directory (doesFileExist) import System.Environment (lookupEnv) import System.FilePath (takeFileName) -import TOML (DecodeTOML (..), Decoder, decodeFile, getArrayOf, getField, getFieldOpt, getFieldOptWith) +import TOML (DecodeTOML (..), Decoder, decodeFile, getArrayOf, getField, getFieldOpt, getFieldOptWith, getFieldWith) import Types (GeographyPolicy (..)) -- | A single classification filter entry (system + value) @@ -135,6 +138,62 @@ data MethodConfig = MethodConfig CFs are *all* region-tagged would be left with none. Empty = keep every method's native regionalization. -} + , mcPatches :: ![MethodPatch] + {- ^ Declarative adjustments applied to this collection's characterization + factors right after parsing, before the collection is registered. The + equivalent of a Brightway import "strategy", but data instead of code: a + pure, idempotent transform of the freshly parsed factors, re-derived from + the untouched source file on every reload rather than mutating a persisted + store. Empty = the collection is used exactly as parsed. + -} + } + deriving (Show, Eq, Generic) + +{- | What a 'MethodPatch' does to a matched CF's value. A sum so a patch is +either a rescale or a hard override, never an ambiguous combination of both. +-} +data CFPatchOp + = -- | Multiply the matched CF's value (TOML: @scale = 0.6@). + ScaleBy !Double + | -- | Replace the matched CF's value outright (TOML: @set-value = 0.0@). + SetValueTo !Double + deriving (Show, Eq, Generic) + +{- | Selector picking which characterization factors a 'MethodPatch' touches. +Every present field must match (conjunction); a selector with no field set +is rejected by the decoder — a patch that would touch every CF in every +method is almost certainly a mistake, not an intent. +-} +data MethodPatchMatch = MethodPatchMatch + { mpmCategory :: !(Maybe Text) + {- ^ Impact category name (TOML: @category@), e.g. \"Resource use, fossils\". + For a SimaPro CSV method export this is the per-category 'Method.methodName' + (each \"Impact category\" section becomes its own 'Method' sharing the + collection's overall methodology name, not this one). + -} + , mpmFlowName :: !(Maybe Text) + -- ^ Exact flow name (TOML: @flow-name@), matched against 'Method.mcfFlowName'. + , mpmFlowNamePrefix :: !(Maybe Text) + -- ^ Flow name prefix (TOML: @flow-name-prefix@), matched with 'Data.Text.isPrefixOf'. + , mpmCAS :: !(Maybe Text) + {- ^ CAS registry number (TOML: @cas@), matched against 'Method.mcfCAS' after + normalizing both sides the same way (leading zeros in each dash-separated + segment are insignificant), so either the raw or the normalized form works. + -} + , mpmSubcompartmentContains :: !(Maybe Text) + {- ^ Case-insensitive substring of the subcompartment (TOML: + @subcompartment-contains@), matched against 'Method.mcfCompartment'. A CF + with no compartment never matches this field. + -} + } + deriving (Show, Eq, Generic) + +-- | One declarative adjustment to a method collection's characterization factors. +data MethodPatch = MethodPatch + { mpDescription :: !(Maybe Text) + -- ^ Free-text note on why this patch exists, surfaced in load logs. + , mpMatch :: !MethodPatchMatch + , mpOp :: !CFPatchOp } deriving (Show, Eq, Generic) @@ -252,8 +311,33 @@ instance DecodeTOML MethodConfig where let mcFormat = Nothing -- Detected later from file content mcScoringSets <- fromMaybe [] <$> getFieldOpt "scoring" mcGlobalMethods <- fromMaybe [] <$> getFieldOpt "global-methods" + mcPatches <- fromMaybe [] <$> getFieldOpt "patches" pure MethodConfig{..} +instance DecodeTOML MethodPatchMatch where + tomlDecoder = do + mpmCategory <- getFieldOpt "category" + mpmFlowName <- getFieldOpt "flow-name" + mpmFlowNamePrefix <- getFieldOpt "flow-name-prefix" + mpmCAS <- getFieldOpt "cas" + mpmSubcompartmentContains <- getFieldOpt "subcompartment-contains" + when (all isNothing [mpmCategory, mpmFlowName, mpmFlowNamePrefix, mpmCAS, mpmSubcompartmentContains]) $ + fail "match: at least one selector field must be set (a patch matching every CF is almost certainly a mistake)" + pure MethodPatchMatch{..} + +instance DecodeTOML MethodPatch where + tomlDecoder = do + mpDescription <- getFieldOpt "description" + mpMatch <- getFieldWith tomlDecoder "match" + mScale <- getFieldOpt "scale" + mSetValue <- getFieldOpt "set-value" + mpOp <- case (mScale, mSetValue) of + (Just s, Nothing) -> pure (ScaleBy s) + (Nothing, Just v) -> pure (SetValueTo v) + (Nothing, Nothing) -> fail "patch: exactly one of 'scale' or 'set-value' is required, neither was set" + (Just _, Just _) -> fail "patch: exactly one of 'scale' or 'set-value' is required, both were set" + pure MethodPatch{..} + instance DecodeTOML ScoringSetConfig where tomlDecoder = do sscName <- getField "name" diff --git a/src/Database/Manager.hs b/src/Database/Manager.hs index 492b1182..d3b6214a 100644 --- a/src/Database/Manager.hs +++ b/src/Database/Manager.hs @@ -235,6 +235,7 @@ import qualified Method.Parser import qualified Method.Parser.OlcaSchema as OlcaSchema import Method.ParserCSV (parseMethodCSVBytes, stripBOM) import Method.ParserSimaPro (isSimaProMethodCSV, parseSimaProMethodCSVBytes) +import qualified Method.Patch import qualified SimaPro.Parser as SimaPro import SynonymDB.Extract (extractFromEcoSpold2, extractFromILCDFlows, synonymPairsToCSV) @@ -1032,8 +1033,7 @@ initDatabaseManager config noCache configPath = do result <- loadMethodCollectionFromConfig mc case result of Right (collection0, flowInfo) -> do - let scoringSets = map configToScoringSet (Config.mcScoringSets mc) - collection = collection0{Method.Types.mcScoringSets = scoringSets} + let (collection, patchStats) = applyMethodConfig mc collection0 atomically $ modifyTVar' loadedMethodsVar (M.insert (mcName mc) collection) reportProgress Info $ " [OK] Loaded method: " @@ -1041,6 +1041,7 @@ initDatabaseManager config noCache configPath = do <> " (" <> show (length (mcMethods collection)) <> " impact categories)" + warnZeroTouchPatches (mcName mc) patchStats -- Surface a 'global-methods' entry that matches no loaded method: -- the de-regionalization is keyed by method name, so a typo or a -- renamed method would otherwise be ignored in silence and the @@ -1214,6 +1215,33 @@ configToScoringSet ssc = , ssDisplayMultiplier = sscDisplayMultiplier ssc } +{- | Fold a 'MethodConfig's post-parse adjustments into a freshly parsed +collection: inject the configured scoring sets, then apply the declarative +CF patches ('Config.mcPatches'). Pure — reapplying the same config to the +same source file always yields the same result, so a reload never +compounds a patch. Also returns, per patch, how many CFs it touched (for +the zero-touch warning at the call site). +-} +applyMethodConfig :: MethodConfig -> MethodCollection -> (MethodCollection, [(Config.MethodPatch, Int)]) +applyMethodConfig mc collection0 = + let scoringSets = map configToScoringSet (Config.mcScoringSets mc) + withScoring = collection0{Method.Types.mcScoringSets = scoringSets} + in Method.Patch.applyMethodPatches (Config.mcPatches mc) withScoring + +{- | Surface a patch that matched no characterization factor: the selector is +almost certainly wrong (a typo'd category or flow name), and staying silent +would leave the collection scoring as if the patch were never declared. +-} +warnZeroTouchPatches :: Text -> [(Config.MethodPatch, Int)] -> IO () +warnZeroTouchPatches collName stats = + forM_ [p | (p, n) <- stats, n == 0] $ \patch -> + reportProgress Warning $ + " [patch] collection " + <> T.unpack collName + <> ": \"" + <> T.unpack (Method.Patch.describePatch patch) + <> "\" touched 0 characterization factors — check the selector." + -- | Convert a DatabaseFormat to display text for methods methodFormatText :: DatabaseFormat -> Text methodFormatText SimaProCSV = "SimaPro CSV" @@ -1237,6 +1265,7 @@ discoverUploadedMethodConfigs = do , mcFormat = Just $ methodFormatText (UploadedDB.umFormat meta) , mcScoringSets = [] , mcGlobalMethods = [] + , mcPatches = [] } -- | Get a database by name @@ -2998,9 +3027,8 @@ loadMethodCollection manager name = do reportProgress Error $ " [FAIL] " <> T.unpack name <> ": " <> T.unpack err return $ Left err Right (collection0, flowInfo) -> do - -- Inject scoring sets from TOML config - let scoringSets = map configToScoringSet (Config.mcScoringSets mc) - collection = collection0{Method.Types.mcScoringSets = scoringSets} + -- Inject scoring sets from TOML config, apply declarative CF patches + let (collection, patchStats) = applyMethodConfig mc collection0 atomically $ modifyTVar' (dmLoadedMethods manager) (M.insert name collection) clearMethodMappingCache manager let methods = mcMethods collection @@ -3013,6 +3041,7 @@ loadMethodCollection manager name = do <> " impact categories, " <> show totalCFs <> " characterization factors)" + warnZeroTouchPatches name patchStats -- Auto-extract synonyms from ILCD flow definitions let pairs = extractFromILCDFlows flowInfo autoCreateFlowSynonyms diff --git a/src/Method/ParserSimaPro.hs b/src/Method/ParserSimaPro.hs index 64ea63a0..5e9bcfeb 100644 --- a/src/Method/ParserSimaPro.hs +++ b/src/Method/ParserSimaPro.hs @@ -12,6 +12,7 @@ module Method.ParserSimaPro ( parseSimaProMethodCSV, parseSimaProMethodCSVBytes, isSimaProMethodCSV, + normalizeCAS, ) where import qualified Data.ByteString as BS diff --git a/src/Method/Patch.hs b/src/Method/Patch.hs new file mode 100644 index 00000000..5bc62530 --- /dev/null +++ b/src/Method/Patch.hs @@ -0,0 +1,113 @@ +{-# LANGUAGE OverloadedStrings #-} + +{- | Declarative, idempotent adjustments to a freshly parsed method +collection's characterization factors — the equivalent of a Brightway +import "strategy", but expressed as data ('Config.MethodPatch') instead +of an imperative function. + +A patch is a pure transform of the just-parsed 'MethodCF' list: applying +the same patches to the same source file always yields the same result, +so reloading a collection never compounds an adjustment (unlike a +Brightway strategy, which mutates a persisted store and re-applies on +every re-import). +-} +module Method.Patch ( + applyMethodPatches, + cfMatches, + applyOp, + describePatch, +) where + +import Config (CFPatchOp (..), MethodPatch (..), MethodPatchMatch (..)) +import qualified Data.Text as T +import Method.ParserSimaPro (normalizeCAS) +import Method.Types (Compartment (..), Method (..), MethodCF (..), MethodCollection (..)) + +{- | Apply every patch, in order, to a method collection. Each patch scans +every CF of every method whose category matches (via 'cfMatches') and +replaces its value with 'applyOp'; a patch with no 'mpmCategory' selector +crosses every method in the collection. + +Returns the patched collection alongside, for each patch, how many CFs it +touched — a patch that touches zero is very likely a selector typo, and +the caller (which has a logging effect) is expected to surface that. +-} +applyMethodPatches :: [MethodPatch] -> MethodCollection -> (MethodCollection, [(MethodPatch, Int)]) +applyMethodPatches patches collection0 = foldl step (collection0, []) patches + where + step (collection, stats) patch = + let (methods', touched) = patchMethods patch (mcMethods collection) + in (collection{mcMethods = methods'}, stats ++ [(patch, touched)]) + +patchMethods :: MethodPatch -> [Method] -> ([Method], Int) +patchMethods patch methods = + let results = map (patchMethod patch) methods + in (map fst results, sum (map snd results)) + +patchMethod :: MethodPatch -> Method -> (Method, Int) +patchMethod patch method = + let category = methodName method + go cf + | cfMatches (mpMatch patch) category cf = (cf{mcfValue = applyOp (mpOp patch) (mcfValue cf)}, 1 :: Int) + | otherwise = (cf, 0) + results = map go (methodFactors method) + in (method{methodFactors = map fst results}, sum (map snd results)) + +{- | Does this CF match the selector? Every field the selector sets must +match (conjunction); an unset field imposes no constraint. 'category' is +compared against the enclosing 'Method.methodName' — for a SimaPro CSV +export each impact-category section is its own 'Method' whose name is +the category (e.g. \"Resource use, fossils\"), not the collection's +overall methodology name. +-} +cfMatches :: MethodPatchMatch -> T.Text -> MethodCF -> Bool +cfMatches sel category cf = + maybe True (== category) (mpmCategory sel) + && maybe True (== mcfFlowName cf) (mpmFlowName sel) + && maybe True (`T.isPrefixOf` mcfFlowName cf) (mpmFlowNamePrefix sel) + && maybe True (casMatches (mcfCAS cf)) (mpmCAS sel) + && maybe True (subcompartmentMatches (mcfCompartment cf)) (mpmSubcompartmentContains sel) + +{- | Compare CAS numbers after normalizing both sides the same way (dropping +insignificant leading zeros), so either the raw or normalized form matches. +An unnormalizable selector (e.g. all zeros/dashes) matches nothing rather +than mis-matching every CAS-less CF. +-} +casMatches :: Maybe T.Text -> T.Text -> Bool +casMatches mcfCas want = case normalizeCAS want of + Nothing -> False + Just normalized -> mcfCas == Just normalized + +subcompartmentMatches :: Maybe Compartment -> T.Text -> Bool +subcompartmentMatches Nothing _ = False +subcompartmentMatches (Just (Compartment _ subcompartment _)) want = + T.toLower want `T.isInfixOf` T.toLower subcompartment + +applyOp :: CFPatchOp -> Double -> Double +applyOp (ScaleBy s) v = v * s +applyOp (SetValueTo v) _ = v + +{- | Human-readable label for a patch, for log lines — its description when +given, else a rendering of the selector and operation. +-} +describePatch :: MethodPatch -> T.Text +describePatch patch = case mpDescription patch of + Just d -> d + Nothing -> describeMatch (mpMatch patch) <> " " <> describeOp (mpOp patch) + +describeMatch :: MethodPatchMatch -> T.Text +describeMatch sel = + T.intercalate ", " $ + concat + [ ["category=" <> c | c <- toList (mpmCategory sel)] + , ["flow-name=" <> f | f <- toList (mpmFlowName sel)] + , ["flow-name-prefix=" <> f | f <- toList (mpmFlowNamePrefix sel)] + , ["cas=" <> c | c <- toList (mpmCAS sel)] + , ["subcompartment-contains=" <> s | s <- toList (mpmSubcompartmentContains sel)] + ] + where + toList = maybe [] (: []) + +describeOp :: CFPatchOp -> T.Text +describeOp (ScaleBy s) = "(scale ×" <> T.pack (show s) <> ")" +describeOp (SetValueTo v) = "(set-value " <> T.pack (show v) <> ")" diff --git a/test/ConfigSpec.hs b/test/ConfigSpec.hs index 470c65b8..ac747e77 100644 --- a/test/ConfigSpec.hs +++ b/test/ConfigSpec.hs @@ -3,8 +3,11 @@ module ConfigSpec (spec) where import Config ( + CFPatchOp (..), Config (..), MethodConfig (..), + MethodPatch (..), + MethodPatchMatch (..), RefDataConfig (..), ScoringSetConfig (..), applyDataDir, @@ -40,6 +43,70 @@ spec = do Right mc -> mcGlobalMethods mc `shouldBe` [] Left e -> expectationFailure (show e) + describe "MethodConfig patches" $ do + let decodeMethod t = TOML.decode t :: Either TOML.TOMLError MethodConfig + + it "defaults patches to empty when the key is absent" $ + case decodeMethod "name = \"EF\"\npath = \"x.zip\"\n" of + Right mc -> mcPatches mc `shouldBe` [] + Left e -> expectationFailure (show e) + + it "parses a scale patch with a category + flow-name-prefix selector" $ + case decodeMethod + "name = \"EF\"\npath = \"x.zip\"\n\n\ + \[[patches]]\n\ + \description = \"uraniumFRU\"\n\ + \match = { category = \"Resource use, fossils\", flow-name-prefix = \"Uranium\" }\n\ + \scale = 0.6\n" of + Right mc -> case mcPatches mc of + [patch] -> do + mpDescription patch `shouldBe` Just "uraniumFRU" + mpmCategory (mpMatch patch) `shouldBe` Just "Resource use, fossils" + mpmFlowNamePrefix (mpMatch patch) `shouldBe` Just "Uranium" + mpOp patch `shouldBe` ScaleBy 0.6 + ps -> expectationFailure ("expected exactly one patch, got " <> show (length ps)) + Left e -> expectationFailure (show e) + + it "parses a set-value patch with a subcompartment-contains selector" $ + case decodeMethod + "name = \"EF\"\npath = \"x.zip\"\n\n\ + \[[patches]]\n\ + \match = { subcompartment-contains = \"long-term\" }\n\ + \set-value = 0.0\n" of + Right mc -> case mcPatches mc of + [patch] -> do + mpmSubcompartmentContains (mpMatch patch) `shouldBe` Just "long-term" + mpOp patch `shouldBe` SetValueTo 0.0 + ps -> expectationFailure ("expected exactly one patch, got " <> show (length ps)) + Left e -> expectationFailure (show e) + + it "rejects a patch with both scale and set-value" $ + case decodeMethod + "name = \"EF\"\npath = \"x.zip\"\n\n\ + \[[patches]]\n\ + \match = { flow-name = \"Uranium\" }\n\ + \scale = 0.6\n\ + \set-value = 0.0\n" of + Left _ -> pure () + Right _ -> expectationFailure "expected a decode error for scale + set-value together" + + it "rejects a patch with neither scale nor set-value" $ + case decodeMethod + "name = \"EF\"\npath = \"x.zip\"\n\n\ + \[[patches]]\n\ + \match = { flow-name = \"Uranium\" }\n" of + Left _ -> pure () + Right _ -> expectationFailure "expected a decode error when neither scale nor set-value is set" + + it "rejects a patch whose selector matches every CF" $ + case decodeMethod + "name = \"EF\"\npath = \"x.zip\"\n\n\ + \[[patches]]\n\ + \match = {}\n\ + \scale = 0.6\n" of + Left _ -> pure () + Right _ -> expectationFailure "expected a decode error for an empty selector" + describe "redirectIntoDataDir" $ do it "leaves paths unchanged when VOLCA_DATA_DIR is unset" $ redirectIntoDataDir Nothing "data/flows.csv" `shouldBe` "data/flows.csv" diff --git a/test/MethodPatchSpec.hs b/test/MethodPatchSpec.hs new file mode 100644 index 00000000..a79f82f9 --- /dev/null +++ b/test/MethodPatchSpec.hs @@ -0,0 +1,154 @@ +{-# LANGUAGE OverloadedStrings #-} + +module MethodPatchSpec (spec) where + +import Config ( + CFPatchOp (..), + MethodPatch (..), + MethodPatchMatch (..), + ) +import Data.Text (Text) +import qualified Data.UUID as UUID +import Method.Patch (applyMethodPatches, cfMatches) +import Method.Types ( + Compartment (..), + FlowDirection (..), + Method (..), + MethodCF (..), + MethodCollection (..), + ) +import Test.Hspec + +-- | A CF with everything defaulted, so each test only sets what it matches on. +mkCF :: Text -> Double -> MethodCF +mkCF name value = + MethodCF + { mcfFlowRef = UUID.nil + , mcfFlowName = name + , mcfDirection = Input + , mcfValue = value + , mcfCompartment = Nothing + , mcfCAS = Nothing + , mcfUnit = "kg" + , mcfConsumerLocation = Nothing + } + +mkMethod :: Text -> [MethodCF] -> Method +mkMethod category cfs = + Method + { methodId = UUID.nil + , methodName = category + , methodDescription = Nothing + , methodUnit = "MJ" + , methodCategory = category + , methodMethodology = Just "Test methodology" + , methodFactors = cfs + } + +emptyMatch :: MethodPatchMatch +emptyMatch = + MethodPatchMatch + { mpmCategory = Nothing + , mpmFlowName = Nothing + , mpmFlowNamePrefix = Nothing + , mpmCAS = Nothing + , mpmSubcompartmentContains = Nothing + } + +spec :: Spec +spec = do + describe "cfMatches" $ do + let cf = mkCF "Uranium" 1000 + + it "matches on category + flow-name-prefix (conjunction)" $ do + let sel = emptyMatch{mpmCategory = Just "Resource use, fossils", mpmFlowNamePrefix = Just "Uranium"} + cfMatches sel "Resource use, fossils" cf `shouldBe` True + + it "fails when only part of the conjunction matches" $ do + let sel = emptyMatch{mpmCategory = Just "Land use", mpmFlowNamePrefix = Just "Uranium"} + cfMatches sel "Resource use, fossils" cf `shouldBe` False + + it "matches flow-name-prefix without requiring an exact flow-name" $ do + let sel = emptyMatch{mpmFlowNamePrefix = Just "Uran"} + cfMatches sel "any" cf `shouldBe` True + + it "matches subcompartment-contains case-insensitively" $ do + let cfWithComp = cf{mcfCompartment = Just (Compartment "water" "Groundwater, long-term" "")} + sel = emptyMatch{mpmSubcompartmentContains = Just "long-term"} + cfMatches sel "any" cfWithComp `shouldBe` True + + it "never matches subcompartment-contains when the CF has no compartment" $ do + let sel = emptyMatch{mpmSubcompartmentContains = Just "long-term"} + cfMatches sel "any" cf `shouldBe` False + + it "matches CAS after normalizing leading zeros on both sides" $ do + let cfWithCas = cf{mcfCAS = Just "7440-61-1"} + sel = emptyMatch{mpmCAS = Just "007440-61-1"} + cfMatches sel "any" cfWithCas `shouldBe` True + + describe "applyMethodPatches" $ do + let uranium = mkCF "Uranium" 560000 + uraniumOre = mkCF "Uranium ore, 1.11 GJ per kg" 1110 + coal = mkCF "Coal" 18 + method = mkMethod "Resource use, fossils" [uranium, uraniumOre, coal] + collection = MethodCollection [method] [] [] [] + + it "leaves the collection unchanged when there are no patches" $ do + let (patched, stats) = applyMethodPatches [] collection + patched `shouldBe` collection + stats `shouldBe` [] + + it "scales only the matched CFs, by patch name" $ do + let patch = + MethodPatch + { mpDescription = Just "uraniumFRU" + , mpMatch = emptyMatch{mpmCategory = Just "Resource use, fossils", mpmFlowNamePrefix = Just "Uranium"} + , mpOp = ScaleBy 0.6 + } + (patched, stats) = applyMethodPatches [patch] collection + [patchedMethod] = mcMethods patched + values = [(mcfFlowName cf, mcfValue cf) | cf <- methodFactors patchedMethod] + values `shouldBe` [("Uranium", 336000), ("Uranium ore, 1.11 GJ per kg", 666), ("Coal", 18)] + stats `shouldBe` [(patch, 2)] + + it "sets matched CFs to a fixed value" $ do + let patch = + MethodPatch + { mpDescription = Nothing + , mpMatch = emptyMatch{mpmFlowName = Just "Coal"} + , mpOp = SetValueTo 0 + } + (patched, stats) = applyMethodPatches [patch] collection + [patchedMethod] = mcMethods patched + values = [(mcfFlowName cf, mcfValue cf) | cf <- methodFactors patchedMethod] + values `shouldBe` [("Uranium", 560000), ("Uranium ore, 1.11 GJ per kg", 1110), ("Coal", 0)] + stats `shouldBe` [(patch, 1)] + + it "reports zero touched CFs for a selector that matches nothing" $ do + let patch = + MethodPatch + { mpDescription = Nothing + , mpMatch = emptyMatch{mpmFlowName = Just "Nonexistent"} + , mpOp = ScaleBy 0.5 + } + (patched, stats) = applyMethodPatches [patch] collection + patched `shouldBe` collection + stats `shouldBe` [(patch, 0)] + + it "applies patches in order, each seeing the previous patch's result" $ do + let halveEverything = + MethodPatch + { mpDescription = Nothing + , mpMatch = emptyMatch{mpmFlowName = Just "Uranium"} + , mpOp = ScaleBy 0.5 + } + halveAgain = + MethodPatch + { mpDescription = Nothing + , mpMatch = emptyMatch{mpmFlowName = Just "Uranium"} + , mpOp = ScaleBy 0.5 + } + (patched, _) = applyMethodPatches [halveEverything, halveAgain] collection + [patchedMethod] = mcMethods patched + Just uraniumCF = lookup "Uranium" [(mcfFlowName cf, cf) | cf <- methodFactors patchedMethod] + mcfValue uraniumCF `shouldBe` 140000 diff --git a/test/MethodUploadSpec.hs b/test/MethodUploadSpec.hs index aa7c731f..9923cab9 100644 --- a/test/MethodUploadSpec.hs +++ b/test/MethodUploadSpec.hs @@ -117,6 +117,7 @@ spec = do , mcFormat = Just "openlca-jsonld" , mcScoringSets = [] , mcGlobalMethods = [] + , mcPatches = [] } loaded <- loadMethodCollectionFromConfig mc case loaded of @@ -178,4 +179,5 @@ spec = do , mcFormat = Nothing , mcScoringSets = [] , mcGlobalMethods = [] + , mcPatches = [] } diff --git a/volca.cabal b/volca.cabal index 5f24f390..5f0d10d9 100644 --- a/volca.cabal +++ b/volca.cabal @@ -62,6 +62,7 @@ library , Method.ParserSimaPro , Method.ParserNW , Method.Mapping + , Method.Patch , Method.ChemSynonyms , Method.FlowResolver , API.Routes @@ -215,6 +216,7 @@ test-suite lca-tests , InventorySpec , MatrixExportSpec , MethodSpec + , MethodPatchSpec , SimaProParserSpec , BrightwayExcelSpec , BrightwayExcelWriterSpec From b7ad63f79d45b082d3eef2e67a33fefeea8b0a77 Mon Sep 17 00:00:00 2001 From: Christophe Combelles Date: Fri, 10 Jul 2026 23:45:47 +0200 Subject: [PATCH 2/4] Support exclude-long-term on the bulk impacts endpoint The per-activity /impacts endpoint already let a caller drop delayed long-term emissions before scoring; the bulk multi-activity endpoint (POST /db/{db}/impacts/{collection}) didn't, forcing scripts that need both a full panel and long-term exclusion onto the much slower per-activity path. Threads the same LongTermMode through batchImpactsH/runBatchImpacts, applied to each solved inventory before characterization. Also exposed on the score_activities MCP tool, which had the same gap relative to score_activity. --- src/API/BatchImpacts.hs | 7 +++++-- src/API/MCP.hs | 3 ++- src/API/Resources.hs | 7 ++++--- src/API/Routes.hs | 13 ++++++++----- test/BatchImpactsSpec.hs | 2 +- 5 files changed, 20 insertions(+), 12 deletions(-) diff --git a/src/API/BatchImpacts.hs b/src/API/BatchImpacts.hs index d0433a6a..c21b3798 100644 --- a/src/API/BatchImpacts.hs +++ b/src/API/BatchImpacts.hs @@ -29,7 +29,7 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as TE import Database.Manager (DatabaseManager (..)) -import Method.Mapping (LongTermMode) +import Method.Mapping (LongTermMode (..)) import Servant (ServerError (..)) import qualified Servant @@ -107,10 +107,12 @@ runBatchImpacts :: Text -> -- | per-(activity, method) top contributors (default 0 — see batchImpactsH) Maybe Int -> + -- | whether to keep or drop delayed long-term emissions + LongTermMode -> -- | process_ids to score [Text] -> IO (Either BatchError BatchImpactsResponse) -runBatchImpacts dbm dbName coll topFlows pids = do +runBatchImpacts dbm dbName coll topFlows ltMode pids = do let env = AppEnv { aeDbManager = dbm @@ -126,6 +128,7 @@ runBatchImpacts dbm dbName coll topFlows pids = do dbName coll topFlows + ltMode (BatchImpactsRequest{birProcessIds = pids}) case res of Right r -> pure (Right r) diff --git a/src/API/MCP.hs b/src/API/MCP.hs index 9f375c70..6ab71c8f 100644 --- a/src/API/MCP.hs +++ b/src/API/MCP.hs @@ -1892,9 +1892,10 @@ callScoreActivities dbManager mBaseUrl rid args = pids <- except (parseArrayArg "process_ids" (Just "'process_ids' required (array of strings)") args :: Either Text [Text]) wantedSets <- except (parseArrayArg "scoring_sets" Nothing args :: Either Text [Text]) let summaryOnly = fromMaybe False (boolArg "summary_only" args) + ltMode = longTermModeFromExclude (fromMaybe False (boolArg "exclude_long_term" args)) configured <- liftIO $ configuredScoringSets dbManager coll chosen <- except (resolveSingleScoringSet wantedSets configured) - res <- liftIO $ BI.runBatchImpacts dbManager dbName coll Nothing pids + res <- liftIO $ BI.runBatchImpacts dbManager dbName coll Nothing ltMode pids case res of Left e -> throwE (batchErrorMsg e) Right bir -> pure (toolSuccessJson rid (toColumnarBatch summaryOnly mBaseUrl dbName coll chosen bir)) diff --git a/src/API/Resources.hs b/src/API/Resources.hs index 10311785..988486b4 100644 --- a/src/API/Resources.hs +++ b/src/API/Resources.hs @@ -491,9 +491,9 @@ pSubstitutions = \When empty or absent, the call behaves as a plain GET." {- | Optional switch to drop delayed long-term emissions before scoring. -Shared by 'get_impacts' and 'score_activity'. Long-term flows are always -emissions (never resources), so excluding them never touches regionalized -water/land categories. +Shared by 'get_impacts', 'score_activity' and 'score_activities'. Long-term +flows are always emissions (never resources), so excluding them never +touches regionalized water/land categories. -} pExcludeLongTerm :: Param pExcludeLongTerm = @@ -730,6 +730,7 @@ params r = case r of , Param "process_ids" "array" Required "Process IDs to score (activityUUID_productUUID). All resolved in one multi-RHS solve." , pScoringSetsFilter , pSummaryOnly + , pExcludeLongTerm ] ListScoringSets -> [ Param "collection" "string" Optional "Method collection name. If omitted, returns scoring sets across all loaded collections, grouped by collection." diff --git a/src/API/Routes.hs b/src/API/Routes.hs index 2cbb464d..248fc4d5 100644 --- a/src/API/Routes.hs +++ b/src/API/Routes.hs @@ -112,7 +112,7 @@ type LCAAPI = :<|> "db" :> Capture "dbName" Text :> "flows" :> QueryParam "q" Text :> QueryParam "lang" Text :> QueryParam "limit" Int :> QueryParam "offset" Int :> QueryParam "sort" Text :> QueryParam "order" Text :> Get '[JSON] (SearchResults FlowSearchResult) :<|> "db" :> Capture "dbName" Text :> "activities" :> QueryParam "name" Text :> QueryParam "geo" Text :> QueryParam "product" Text :> QueryParam "exact" Bool :> QueryParam "preset" Text :> QueryParams "classification" Text :> QueryParams "classification-value" Text :> QueryParams "classification-mode" Text :> QueryParam "limit" Int :> QueryParam "offset" Int :> QueryParam "sort" Text :> QueryParam "order" Text :> Get '[JSON] (SearchResults ActivitySummary) :<|> "db" :> Capture "dbName" Text :> "classifications" :> Get '[JSON] [ClassificationSystem] - :<|> "db" :> Capture "dbName" Text :> "impacts" :> Capture "collection" Text :> QueryParam "top-flows" Int :> ReqBody '[JSON] BatchImpactsRequest :> Post '[JSON] BatchImpactsResponse + :<|> "db" :> Capture "dbName" Text :> "impacts" :> Capture "collection" Text :> QueryParam "top-flows" Int :> QueryParam "exclude-long-term" Bool :> ReqBody '[JSON] BatchImpactsRequest :> Post '[JSON] BatchImpactsResponse -- Database management endpoints :<|> "db" :> Get '[JSON] DatabaseListResponse -- Load/Unload/Delete endpoints @@ -858,9 +858,10 @@ batchImpactsH :: Text -> Text -> Maybe Int -> + LongTermMode -> BatchImpactsRequest -> AppM BatchImpactsResponse -batchImpactsH dbName collectionName topFlowsParam req = do +batchImpactsH dbName collectionName topFlowsParam ltMode req = do dbManager <- asks aeDbManager (db, sharedSolver) <- requireDatabaseByName dbName loadedCollections <- liftIO $ readTVarIO (dmLoadedMethods dbManager) @@ -876,7 +877,8 @@ batchImpactsH dbName collectionName topFlowsParam req = do invalid = [pidText | (pidText, Left (Service.InvalidProcessId _)) <- resolved] validPidNums = [pidNum | (_, pidNum, _) <- valid] t0 <- liftIO getCurrentTime - sols <- solutionsWithDeps dbName db sharedSolver validPidNums + sols0 <- solutionsWithDeps dbName db sharedSolver validPidNums + sols <- liftIO $ mapM (applyLongTermToSolution dbManager ltMode) sols0 t1 <- liftIO getCurrentTime ctxs <- liftIO $ mapConcurrently (prepMethodCtx dbManager dbName collectionName db) (mcMethods collection) let topFlows = max 0 (fromMaybe 0 topFlowsParam) @@ -1911,8 +1913,9 @@ getClassifications dbName = do (db, _) <- requireDatabaseByName dbName return $ Service.getClassifications db -postImpactsBatch :: Text -> Text -> Maybe Int -> BatchImpactsRequest -> AppM BatchImpactsResponse -postImpactsBatch = batchImpactsH +postImpactsBatch :: Text -> Text -> Maybe Int -> Maybe Bool -> BatchImpactsRequest -> AppM BatchImpactsResponse +postImpactsBatch dbName collectionName topFlowsParam mExcludeLT = + batchImpactsH dbName collectionName topFlowsParam (longTermModeFromExclude (fromMaybe False mExcludeLT)) -- --------------------------------------------------------------------------- -- Servant server diff --git a/test/BatchImpactsSpec.hs b/test/BatchImpactsSpec.hs index eda3cdc2..8540c232 100644 --- a/test/BatchImpactsSpec.hs +++ b/test/BatchImpactsSpec.hs @@ -84,7 +84,7 @@ spec = do describe "runBatchImpacts (empty DatabaseManager)" $ do it "returns DatabaseNotLoaded when the requested DB is not loaded" $ do dbm <- initDatabaseManager defaultConfig True Nothing - res <- runBatchImpacts dbm "no-such-db" "no-coll" Nothing ["pidA", "pidB"] + res <- runBatchImpacts dbm "no-such-db" "no-coll" Nothing IncludeLongTerm ["pidA", "pidB"] case res of Left e -> e `shouldBe` DatabaseNotLoaded "no-such-db" Right _ -> expectationFailure "expected DatabaseNotLoaded; got a successful result" From 22e363589adf5f3ef33c85f3164378d58d1b3c0e Mon Sep 17 00:00:00 2001 From: Christophe Combelles Date: Sat, 11 Jul 2026 00:54:22 +0200 Subject: [PATCH 3/4] Tidy the patch fold and its spec mapAccumL instead of a foldl with quadratic list append, maybeToList instead of a local reimplementation, and a total factorValues helper in the spec instead of irrefutable let patterns that would crash rather than fail cleanly. --- src/Method/Patch.hs | 20 ++++++++++---------- test/MethodPatchSpec.hs | 16 +++++++--------- 2 files changed, 17 insertions(+), 19 deletions(-) diff --git a/src/Method/Patch.hs b/src/Method/Patch.hs index 5bc62530..ff522d4c 100644 --- a/src/Method/Patch.hs +++ b/src/Method/Patch.hs @@ -19,6 +19,8 @@ module Method.Patch ( ) where import Config (CFPatchOp (..), MethodPatch (..), MethodPatchMatch (..)) +import Data.List (mapAccumL) +import Data.Maybe (maybeToList) import qualified Data.Text as T import Method.ParserSimaPro (normalizeCAS) import Method.Types (Compartment (..), Method (..), MethodCF (..), MethodCollection (..)) @@ -33,11 +35,11 @@ touched — a patch that touches zero is very likely a selector typo, and the caller (which has a logging effect) is expected to surface that. -} applyMethodPatches :: [MethodPatch] -> MethodCollection -> (MethodCollection, [(MethodPatch, Int)]) -applyMethodPatches patches collection0 = foldl step (collection0, []) patches +applyMethodPatches patches collection0 = mapAccumL step collection0 patches where - step (collection, stats) patch = + step collection patch = let (methods', touched) = patchMethods patch (mcMethods collection) - in (collection{mcMethods = methods'}, stats ++ [(patch, touched)]) + in (collection{mcMethods = methods'}, (patch, touched)) patchMethods :: MethodPatch -> [Method] -> ([Method], Int) patchMethods patch methods = @@ -99,14 +101,12 @@ describeMatch :: MethodPatchMatch -> T.Text describeMatch sel = T.intercalate ", " $ concat - [ ["category=" <> c | c <- toList (mpmCategory sel)] - , ["flow-name=" <> f | f <- toList (mpmFlowName sel)] - , ["flow-name-prefix=" <> f | f <- toList (mpmFlowNamePrefix sel)] - , ["cas=" <> c | c <- toList (mpmCAS sel)] - , ["subcompartment-contains=" <> s | s <- toList (mpmSubcompartmentContains sel)] + [ ["category=" <> c | c <- maybeToList (mpmCategory sel)] + , ["flow-name=" <> f | f <- maybeToList (mpmFlowName sel)] + , ["flow-name-prefix=" <> f | f <- maybeToList (mpmFlowNamePrefix sel)] + , ["cas=" <> c | c <- maybeToList (mpmCAS sel)] + , ["subcompartment-contains=" <> s | s <- maybeToList (mpmSubcompartmentContains sel)] ] - where - toList = maybe [] (: []) describeOp :: CFPatchOp -> T.Text describeOp (ScaleBy s) = "(scale ×" <> T.pack (show s) <> ")" diff --git a/test/MethodPatchSpec.hs b/test/MethodPatchSpec.hs index a79f82f9..6980754f 100644 --- a/test/MethodPatchSpec.hs +++ b/test/MethodPatchSpec.hs @@ -45,6 +45,10 @@ mkMethod category cfs = , methodFactors = cfs } +-- | Every (flow name, value) pair in the collection, in method and factor order. +factorValues :: MethodCollection -> [(Text, Double)] +factorValues c = [(mcfFlowName cf, mcfValue cf) | m <- mcMethods c, cf <- methodFactors m] + emptyMatch :: MethodPatchMatch emptyMatch = MethodPatchMatch @@ -106,9 +110,7 @@ spec = do , mpOp = ScaleBy 0.6 } (patched, stats) = applyMethodPatches [patch] collection - [patchedMethod] = mcMethods patched - values = [(mcfFlowName cf, mcfValue cf) | cf <- methodFactors patchedMethod] - values `shouldBe` [("Uranium", 336000), ("Uranium ore, 1.11 GJ per kg", 666), ("Coal", 18)] + factorValues patched `shouldBe` [("Uranium", 336000), ("Uranium ore, 1.11 GJ per kg", 666), ("Coal", 18)] stats `shouldBe` [(patch, 2)] it "sets matched CFs to a fixed value" $ do @@ -119,9 +121,7 @@ spec = do , mpOp = SetValueTo 0 } (patched, stats) = applyMethodPatches [patch] collection - [patchedMethod] = mcMethods patched - values = [(mcfFlowName cf, mcfValue cf) | cf <- methodFactors patchedMethod] - values `shouldBe` [("Uranium", 560000), ("Uranium ore, 1.11 GJ per kg", 1110), ("Coal", 0)] + factorValues patched `shouldBe` [("Uranium", 560000), ("Uranium ore, 1.11 GJ per kg", 1110), ("Coal", 0)] stats `shouldBe` [(patch, 1)] it "reports zero touched CFs for a selector that matches nothing" $ do @@ -149,6 +149,4 @@ spec = do , mpOp = ScaleBy 0.5 } (patched, _) = applyMethodPatches [halveEverything, halveAgain] collection - [patchedMethod] = mcMethods patched - Just uraniumCF = lookup "Uranium" [(mcfFlowName cf, cf) | cf <- methodFactors patchedMethod] - mcfValue uraniumCF `shouldBe` 140000 + lookup "Uranium" (factorValues patched) `shouldBe` Just 140000 From ceefb46084c28fa48c520adc68feb6f2b77baf40 Mon Sep 17 00:00:00 2001 From: Christophe Combelles Date: Sat, 11 Jul 2026 00:54:22 +0200 Subject: [PATCH 4/4] Document method patches in the changelog and README Also record the bulk exclude-long-term extension in the changelog. --- CHANGELOG.md | 13 +++++++++++++ README.md | 10 ++++++++++ 2 files changed, 23 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 2f6fec29..6dc01c8e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,19 @@ ## [Unreleased] +### Added +- A characterization method declared in the TOML configuration can carry + `[[methods.patches]]` blocks: declarative adjustments that rescale or + replace the matched characterization factors every time the collection + loads. A patch selects factors by impact category, flow name or prefix, + CAS number, or subcompartment, and is re-applied to the freshly parsed + source file on each load — so reloading never compounds it. A patch that + matches no factor is reported at load time instead of being silently + ignored. +- Bulk impact scoring — the `POST /db/{db}/impacts/{collection}` endpoint and + the `score_activities` MCP tool — can now exclude long-term emissions, as + scoring a single activity already could. + ### Changed - Database exports download as raw bytes instead of base64-encoded JSON, matching how uploads already work — a third less data on the wire and far diff --git a/README.md b/README.md index 373b0350..95642dfa 100644 --- a/README.md +++ b/README.md @@ -153,6 +153,16 @@ path = "DBs/EF-v3.1.zip" # ILCD method package (ZIP or directory) # their region-tagged CFs are dropped so the method's global (unlocated) # CF is the single answer — for matching references that flattened # spatial factors. A name matching no method logs a warning. +# +# Optional patches adjust matched characterization factors at load time. +# Selector fields combine with AND; at least one is required. Exactly one +# of `scale` (multiply) or `set-value` (replace) per patch. A patch that +# matches no factor logs a warning at load time. +# [[methods.patches]] +# description = "example: -40% on Uranium in Resource use, fossils" +# match = { category = "Resource use, fossils", flow-name-prefix = "Uranium" } +# # other selectors: flow-name (exact), cas, subcompartment-contains +# scale = 0.6 [[flow-synonyms]] name = "Default flow synonyms"