From fd8a30cbd62d1e3ad2bbbe1410eb2652e46265e2 Mon Sep 17 00:00:00 2001 From: Danila Danko Date: Wed, 13 Mar 2024 00:21:43 +0300 Subject: [PATCH 01/19] fix(metrics): count dataless formations --- .../src/Language/EO/Phi/Metrics/Collect.hs | 186 +++++++++++++----- 1 file changed, 137 insertions(+), 49 deletions(-) diff --git a/eo-phi-normalizer/src/Language/EO/Phi/Metrics/Collect.hs b/eo-phi-normalizer/src/Language/EO/Phi/Metrics/Collect.hs index 68365d006..e91cf336b 100644 --- a/eo-phi-normalizer/src/Language/EO/Phi/Metrics/Collect.hs +++ b/eo-phi-normalizer/src/Language/EO/Phi/Metrics/Collect.hs @@ -1,8 +1,14 @@ +{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE RecordWildCards #-} {- FOURMOLU_DISABLE -} @@ -15,15 +21,19 @@ module Language.EO.Phi.Metrics.Collect where import Control.Lens ((+=)) import Control.Monad (forM_) -import Control.Monad.State (State, execState) +import Control.Monad.State (State, runState) import Data.Aeson (FromJSON) import Data.Aeson.Types (ToJSON) +import Data.Foldable (fold) +import Data.Function ((&)) import Data.Generics.Labels () +import Data.Maybe (catMaybes) +import Data.Traversable (forM) import GHC.Generics (Generic) import Language.EO.Phi.Rules.Common () import Language.EO.Phi.Syntax.Abs -data Metrics = Metrics +data ObjectMetrics = ObjectMetrics { dataless :: Int , applications :: Int , formations :: Int @@ -31,75 +41,153 @@ data Metrics = Metrics } deriving (Generic, Show, FromJSON, ToJSON, Eq) -defaultMetrics :: Metrics -defaultMetrics = - Metrics +defaultObjectMetrics :: ObjectMetrics +defaultObjectMetrics = + ObjectMetrics { dataless = 0 , applications = 0 , formations = 0 , dispatches = 0 } -collectMetrics :: (Inspectable a) => a -> Metrics -collectMetrics a = execState (inspect a) defaultMetrics +instance Semigroup ObjectMetrics where + (<>) :: ObjectMetrics -> ObjectMetrics -> ObjectMetrics + ObjectMetrics + { dataless = dataless1 + , applications = applications1 + , formations = formations1 + , dispatches = dispatches1 + } + <> ObjectMetrics + { dataless = dataless2 + , applications = applications2 + , formations = formations2 + , dispatches = dispatches2 + } = + ObjectMetrics + { dataless = dataless1 + dataless2 + , applications = applications1 + applications2 + , formations = formations1 + formations2 + , dispatches = dispatches1 + dispatches2 + } + +instance Monoid ObjectMetrics where + mempty :: ObjectMetrics + mempty = defaultObjectMetrics + +data BindingMetrics = BindingMetrics + { name :: String + , metrics :: ObjectMetrics + } + deriving (Show, Generic, FromJSON, ToJSON, Eq) class Inspectable a where - inspect :: a -> State Metrics () + inspect :: a -> State ObjectMetrics (Maybe Int) count :: (a -> Bool) -> [a] -> Int count x = length . filter x --- | Count dataless formations in a list of bindings --- --- >>> countDataless' :: Object -> Int; countDataless' x = let Formation bindings = x in countDataless bindings --- --- >>> countDataless' "⟦ α0 ↦ ξ, α0 ↦ Φ.org.eolang.bytes( Δ ⤍ 00-00-00-00-00-00-00-2A ) ⟧" --- 1 --- --- >>> countDataless' "⟦ α0 ↦ ξ, Δ ⤍ 00-00-00-00-00-00-00-2A ⟧" --- 0 --- --- --- >>> countDataless' "⟦ α0 ↦ ξ, α1 ↦ ⟦ Δ ⤍ 00-00-00-00-00-00-00-2A ⟧ ⟧" --- 0 --- --- --- >>> countDataless' "⟦ α0 ↦ ξ, α1 ↦ ⟦ α2 ↦ ⟦ Δ ⤍ 00-00-00-00-00-00-00-2A ⟧ ⟧ ⟧" --- 1 -countDataless :: (Num a) => [Binding] -> a -countDataless bindings = - let countDeltas = count (\case DeltaBinding _ -> True; DeltaEmptyBinding -> True; _ -> False) - nestedBindings = concatMap (\case AlphaBinding _ (Formation bindings') -> bindings'; _ -> []) bindings - deltas = countDeltas (bindings <> nestedBindings) - in if deltas == 0 then 1 else 0 - -instance Inspectable Program where - inspect (Program bindings) = inspect (Formation bindings) +getHeight :: (Ord b, Num b) => [Binding] -> [Maybe b] -> b +getHeight bindings heights = + let + heightAttributes = heights & catMaybes & (\case [] -> 0; x -> minimum x + 1) + hasDeltaAttribute = not $ null [x | x@(DeltaBinding _, _) <- zip bindings heights] + in + if hasDeltaAttribute + then 1 + else heightAttributes + +countDataless :: Int -> Int +countDataless x + | x == 0 || x > 2 = 1 + | otherwise = 0 instance Inspectable Binding where + inspect :: Binding -> State ObjectMetrics (Maybe Int) inspect = \case - AlphaBinding attr obj -> do - inspect attr + AlphaBinding _ obj -> do inspect obj - EmptyBinding attr -> do - inspect attr - _ -> pure () - -instance Inspectable Attribute where - inspect _ = pure () + _ -> pure Nothing instance Inspectable Object where + inspect :: Object -> State ObjectMetrics (Maybe Int) inspect = \case Formation bindings -> do - #dataless += countDataless bindings #formations += 1 - forM_ bindings inspect + heights <- forM bindings inspect + let height = getHeight bindings heights + #dataless += countDataless height + pure (Just height) Application obj bindings -> do #applications += 1 - inspect obj + _ <- inspect obj forM_ bindings inspect - ObjectDispatch obj attr -> do + pure Nothing + ObjectDispatch obj _ -> do #dispatches += 1 - inspect obj - inspect attr - _ -> pure () + _ <- inspect obj + pure Nothing + _ -> pure Nothing + +data ProgramMetrics = ProgramMetrics + { attributes :: [BindingMetrics] + , program :: ObjectMetrics + } + deriving (Show, Generic, FromJSON, ToJSON, Eq) + +defaultMetrics :: ProgramMetrics +defaultMetrics = + ProgramMetrics + { attributes = [] + , program = defaultObjectMetrics + } + +-- | Count dataless formations in a list of bindings +-- +-- >>> collectMetrics "{⟦ α0 ↦ ξ, α0 ↦ Φ.org.eolang.bytes( Δ ⤍ 00- ) ⟧}" +-- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}},BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 1, formations = 0, dispatches = 3}}], program = ObjectMetrics {dataless = 1, applications = 1, formations = 1, dispatches = 3}} +-- +-- >>> collectMetrics "{⟦ α0 ↦ ξ, Δ ⤍ 00- ⟧}" +-- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}}], program = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}} +-- +-- +-- >>> collectMetrics "{⟦ α0 ↦ ξ, α1 ↦ ⟦ Δ ⤍ 00- ⟧ ⟧}" +-- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}},BindingMetrics {name = "\945\&1", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}}], program = ObjectMetrics {dataless = 0, applications = 0, formations = 2, dispatches = 0}} +-- +-- +-- >>> collectMetrics "{⟦ α0 ↦ ξ, α1 ↦ ⟦ α2 ↦ ⟦ Δ ⤍ 00- ⟧ ⟧ ⟧}" +-- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}},BindingMetrics {name = "\945\&1", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 2, dispatches = 0}}], program = ObjectMetrics {dataless = 1, applications = 0, formations = 3, dispatches = 0}} +-- +-- >>> collectMetrics "{⟦ Δ ⤍ 00- ⟧}" +-- ProgramMetrics {attributes = [], program = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}} +-- +-- >>> collectMetrics "{⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧}" +-- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 1, applications = 0, formations = 1, dispatches = 0}}], program = ObjectMetrics {dataless = 1, applications = 0, formations = 2, dispatches = 0}} +-- +-- >>> collectMetrics "{⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧ ⟧}" +-- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 1, applications = 0, formations = 2, dispatches = 0}}], program = ObjectMetrics {dataless = 1, applications = 0, formations = 3, dispatches = 0}} +-- +-- >>> collectMetrics "{⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧ ⟧ ⟧}" +-- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 1, applications = 0, formations = 3, dispatches = 0}}], program = ObjectMetrics {dataless = 2, applications = 0, formations = 4, dispatches = 0}} +-- +-- >>> collectMetrics "{ ⟦ org ↦ ⟦ ⟧ ⟧ }" +-- ProgramMetrics {attributes = [BindingMetrics {name = "org", metrics = ObjectMetrics {dataless = 1, applications = 0, formations = 1, dispatches = 0}}], program = ObjectMetrics {dataless = 1, applications = 0, formations = 2, dispatches = 0}} +collectMetrics :: Program -> ProgramMetrics +collectMetrics (Program bindings) = + let attributes' = flip runState mempty . inspect <$> bindings + (heights, objectMetrics) = unzip attributes' + attributes = do + x <- zip bindings objectMetrics + case x of + (AlphaBinding (Alpha (AlphaIndex name)) _, metrics) -> [BindingMetrics{..}] + (AlphaBinding (Label (LabelId name)) _, metrics) -> [BindingMetrics{..}] + _ -> [] + height = getHeight bindings heights + program = + fold objectMetrics + & \x -> + x + { dataless = x.dataless + countDataless height + , formations = x.formations + 1 + } + in ProgramMetrics{..} From be79d169b81f56509b20fae4b970d645b0f89868 Mon Sep 17 00:00:00 2001 From: Danila Danko Date: Wed, 13 Mar 2024 00:22:15 +0300 Subject: [PATCH 02/19] fix(metrics): test types --- eo-phi-normalizer/test/Test/Metrics/Phi.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/eo-phi-normalizer/test/Test/Metrics/Phi.hs b/eo-phi-normalizer/test/Test/Metrics/Phi.hs index 96daa8865..08a455af6 100644 --- a/eo-phi-normalizer/test/Test/Metrics/Phi.hs +++ b/eo-phi-normalizer/test/Test/Metrics/Phi.hs @@ -6,7 +6,7 @@ module Test.Metrics.Phi where import Data.Yaml (FromJSON) import GHC.Generics (Generic) -import Language.EO.Phi.Metrics.Collect (Metrics) +import Language.EO.Phi.Metrics.Collect (ProgramMetrics) data MetricsTestSet = MetricsTestSet { title :: String @@ -17,6 +17,6 @@ data MetricsTestSet = MetricsTestSet data MetricsTest = MetricsTest { title :: String , phi :: String - , metrics :: Metrics + , metrics :: ProgramMetrics } deriving (Generic, FromJSON) From e83af0cad8438ce4186472fdf10fd05ad16a8edd Mon Sep 17 00:00:00 2001 From: Danila Danko Date: Wed, 13 Mar 2024 00:22:34 +0300 Subject: [PATCH 03/19] fix(metrics): test metrics --- eo-phi-normalizer/test/eo/phi/metrics.yaml | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/eo-phi-normalizer/test/eo/phi/metrics.yaml b/eo-phi-normalizer/test/eo/phi/metrics.yaml index 20f8cdb38..d7c9c8c52 100644 --- a/eo-phi-normalizer/test/eo/phi/metrics.yaml +++ b/eo-phi-normalizer/test/eo/phi/metrics.yaml @@ -37,7 +37,15 @@ tests: ⟧ } metrics: - dataless: 5 - applications: 8 - formations: 5 - dispatches: 24 + program: + dataless: 3 + applications: 8 + formations: 5 + dispatches: 24 + attributes: + - name: org + metrics: + dataless: 2 + applications: 8 + formations: 4 + dispatches: 24 From 963265c9419d5b62781560ef507f399e253b35b2 Mon Sep 17 00:00:00 2001 From: Danila Danko Date: Wed, 13 Mar 2024 00:29:31 +0300 Subject: [PATCH 04/19] refactor(metrics): update hlint config --- .hlint.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.hlint.yaml b/.hlint.yaml index 36220a45c..57925e73f 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -65,7 +65,7 @@ # - ignore: {name: Use const, within: SpecialModule} # Only within certain modules - ignore: name: Unused LANGUAGE pragma - within: Language.EO.Phi.Metrics.Collect + within: Language.EO.Phi.Metrics # Define some custom infix operators # - fixity: infixr 3 ~^#^~ From 1e89f30e5901815480d41676279ce071672a388c Mon Sep 17 00:00:00 2001 From: Danila Danko Date: Wed, 13 Mar 2024 00:33:41 +0300 Subject: [PATCH 05/19] refactor(metrics): move metrics module --- eo-phi-normalizer/app/Main.hs | 2 +- eo-phi-normalizer/eo-phi-normalizer.cabal | 2 +- .../src/Language/EO/Phi/{Metrics/Collect.hs => Metrics.hs} | 4 +--- eo-phi-normalizer/test/Language/EO/PhiSpec.hs | 2 +- eo-phi-normalizer/test/Test/Metrics/Phi.hs | 2 +- 5 files changed, 5 insertions(+), 7 deletions(-) rename eo-phi-normalizer/src/Language/EO/Phi/{Metrics/Collect.hs => Metrics.hs} (98%) diff --git a/eo-phi-normalizer/app/Main.hs b/eo-phi-normalizer/app/Main.hs index 9e1e4b663..1f6042ffa 100644 --- a/eo-phi-normalizer/app/Main.hs +++ b/eo-phi-normalizer/app/Main.hs @@ -27,7 +27,7 @@ import Data.Text.Internal.Builder (toLazyText) import Data.Text.Lazy.Lens import GHC.Generics (Generic) import Language.EO.Phi (Attribute (Sigma), Object (Formation), Program (Program), parseProgram, printTree) -import Language.EO.Phi.Metrics.Collect (collectMetrics) +import Language.EO.Phi.Metrics (collectMetrics) import Language.EO.Phi.Rules.Common (ApplicationLimits (ApplicationLimits), Context (..), applyRulesChainWith, applyRulesWith, objectSize) import Language.EO.Phi.Rules.Yaml (RuleSet (rules, title), convertRule, parseRuleSetFromFile) import Options.Applicative diff --git a/eo-phi-normalizer/eo-phi-normalizer.cabal b/eo-phi-normalizer/eo-phi-normalizer.cabal index 6f747e1fc..430b05727 100644 --- a/eo-phi-normalizer/eo-phi-normalizer.cabal +++ b/eo-phi-normalizer/eo-phi-normalizer.cabal @@ -34,7 +34,7 @@ custom-setup library exposed-modules: Language.EO.Phi - Language.EO.Phi.Metrics.Collect + Language.EO.Phi.Metrics Language.EO.Phi.Normalize Language.EO.Phi.Rules.Common Language.EO.Phi.Rules.PhiPaper diff --git a/eo-phi-normalizer/src/Language/EO/Phi/Metrics/Collect.hs b/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs similarity index 98% rename from eo-phi-normalizer/src/Language/EO/Phi/Metrics/Collect.hs rename to eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs index e91cf336b..7ff345443 100644 --- a/eo-phi-normalizer/src/Language/EO/Phi/Metrics/Collect.hs +++ b/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs @@ -4,8 +4,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE RecordWildCards #-} @@ -17,7 +15,7 @@ {- FOURMOLU_ENABLE -} -module Language.EO.Phi.Metrics.Collect where +module Language.EO.Phi.Metrics where import Control.Lens ((+=)) import Control.Monad (forM_) diff --git a/eo-phi-normalizer/test/Language/EO/PhiSpec.hs b/eo-phi-normalizer/test/Language/EO/PhiSpec.hs index d0e15143a..0f2b8508c 100644 --- a/eo-phi-normalizer/test/Language/EO/PhiSpec.hs +++ b/eo-phi-normalizer/test/Language/EO/PhiSpec.hs @@ -16,7 +16,7 @@ import Data.String (IsString (..)) import Data.String.Interpolate (i) import Data.Yaml (decodeFileThrow) import Language.EO.Phi -import Language.EO.Phi.Metrics.Collect (collectMetrics) +import Language.EO.Phi.Metrics (collectMetrics) import Language.EO.Phi.Rules.Common (Context (..), Rule, equalProgram) import Language.EO.Phi.Rules.PhiPaper (rule1, rule6) import Test.EO.Phi diff --git a/eo-phi-normalizer/test/Test/Metrics/Phi.hs b/eo-phi-normalizer/test/Test/Metrics/Phi.hs index 08a455af6..2ae2fb6db 100644 --- a/eo-phi-normalizer/test/Test/Metrics/Phi.hs +++ b/eo-phi-normalizer/test/Test/Metrics/Phi.hs @@ -6,7 +6,7 @@ module Test.Metrics.Phi where import Data.Yaml (FromJSON) import GHC.Generics (Generic) -import Language.EO.Phi.Metrics.Collect (ProgramMetrics) +import Language.EO.Phi.Metrics (ProgramMetrics) data MetricsTestSet = MetricsTestSet { title :: String From 63f1829e2ccf0e52fc1c8a7b23d809c049bb04a1 Mon Sep 17 00:00:00 2001 From: Danila Danko Date: Wed, 13 Mar 2024 13:10:23 +0300 Subject: [PATCH 06/19] refactor(metrics): follow the reviewer comments --- .../src/Language/EO/Phi/Metrics.hs | 45 +++++++------------ 1 file changed, 16 insertions(+), 29 deletions(-) diff --git a/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs b/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs index 7ff345443..073c1f235 100644 --- a/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs +++ b/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs @@ -50,24 +50,13 @@ defaultObjectMetrics = instance Semigroup ObjectMetrics where (<>) :: ObjectMetrics -> ObjectMetrics -> ObjectMetrics - ObjectMetrics - { dataless = dataless1 - , applications = applications1 - , formations = formations1 - , dispatches = dispatches1 - } - <> ObjectMetrics - { dataless = dataless2 - , applications = applications2 - , formations = formations2 - , dispatches = dispatches2 - } = - ObjectMetrics - { dataless = dataless1 + dataless2 - , applications = applications1 + applications2 - , formations = formations1 + formations2 - , dispatches = dispatches1 + dispatches2 - } + x <> y = + ObjectMetrics + { dataless = x.dataless + y.dataless + , applications = x.applications + y.applications + , formations = x.formations + y.formations + , dispatches = x.dispatches + y.dispatches + } instance Monoid ObjectMetrics where mempty :: ObjectMetrics @@ -79,27 +68,25 @@ data BindingMetrics = BindingMetrics } deriving (Show, Generic, FromJSON, ToJSON, Eq) -class Inspectable a where - inspect :: a -> State ObjectMetrics (Maybe Int) - count :: (a -> Bool) -> [a] -> Int count x = length . filter x getHeight :: (Ord b, Num b) => [Binding] -> [Maybe b] -> b -getHeight bindings heights = - let - heightAttributes = heights & catMaybes & (\case [] -> 0; x -> minimum x + 1) - hasDeltaAttribute = not $ null [x | x@(DeltaBinding _, _) <- zip bindings heights] - in - if hasDeltaAttribute - then 1 - else heightAttributes +getHeight bindings heights + | hasDeltaAttribute = 1 + | otherwise = heightAttributes + where + heightAttributes = heights & catMaybes & (\case [] -> 0; x -> minimum x + 1) + hasDeltaAttribute = not $ null [x | x@(DeltaBinding _, _) <- zip bindings heights] countDataless :: Int -> Int countDataless x | x == 0 || x > 2 = 1 | otherwise = 0 +class Inspectable a where + inspect :: a -> State ObjectMetrics (Maybe Int) + instance Inspectable Binding where inspect :: Binding -> State ObjectMetrics (Maybe Int) inspect = \case From 8d064095623d6dbde4079506b383aa853171ab30 Mon Sep 17 00:00:00 2001 From: Danila Danko Date: Fri, 15 Mar 2024 01:27:23 +0300 Subject: [PATCH 07/19] fix(metrics): counting dataless formations --- .../src/Language/EO/Phi/Metrics.hs | 36 ++++++++++--------- 1 file changed, 19 insertions(+), 17 deletions(-) diff --git a/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs b/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs index 073c1f235..baba5a4c0 100644 --- a/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs +++ b/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs @@ -25,7 +25,6 @@ import Data.Aeson.Types (ToJSON) import Data.Foldable (fold) import Data.Function ((&)) import Data.Generics.Labels () -import Data.Maybe (catMaybes) import Data.Traversable (forM) import GHC.Generics (Generic) import Language.EO.Phi.Rules.Common () @@ -71,13 +70,16 @@ data BindingMetrics = BindingMetrics count :: (a -> Bool) -> [a] -> Int count x = length . filter x -getHeight :: (Ord b, Num b) => [Binding] -> [Maybe b] -> b +getHeight :: [Binding] -> [Int] -> Int getHeight bindings heights - | hasDeltaAttribute = 1 + | hasDeltaBinding = 1 | otherwise = heightAttributes where - heightAttributes = heights & catMaybes & (\case [] -> 0; x -> minimum x + 1) - hasDeltaAttribute = not $ null [x | x@(DeltaBinding _, _) <- zip bindings heights] + heightAttributes = + case heights of + [] -> 0 + _ -> minimum heights + 1 + hasDeltaBinding = not $ null [undefined | DeltaBinding _ <- bindings] countDataless :: Int -> Int countDataless x @@ -85,34 +87,34 @@ countDataless x | otherwise = 0 class Inspectable a where - inspect :: a -> State ObjectMetrics (Maybe Int) + inspect :: a -> State ObjectMetrics Int instance Inspectable Binding where - inspect :: Binding -> State ObjectMetrics (Maybe Int) + inspect :: Binding -> State ObjectMetrics Int inspect = \case AlphaBinding _ obj -> do inspect obj - _ -> pure Nothing + _ -> pure 0 instance Inspectable Object where - inspect :: Object -> State ObjectMetrics (Maybe Int) + inspect :: Object -> State ObjectMetrics Int inspect = \case Formation bindings -> do #formations += 1 heights <- forM bindings inspect let height = getHeight bindings heights #dataless += countDataless height - pure (Just height) + pure height Application obj bindings -> do #applications += 1 _ <- inspect obj forM_ bindings inspect - pure Nothing + pure 0 ObjectDispatch obj _ -> do #dispatches += 1 _ <- inspect obj - pure Nothing - _ -> pure Nothing + pure 0 + _ -> pure 0 data ProgramMetrics = ProgramMetrics { attributes :: [BindingMetrics] @@ -130,7 +132,7 @@ defaultMetrics = -- | Count dataless formations in a list of bindings -- -- >>> collectMetrics "{⟦ α0 ↦ ξ, α0 ↦ Φ.org.eolang.bytes( Δ ⤍ 00- ) ⟧}" --- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}},BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 1, formations = 0, dispatches = 3}}], program = ObjectMetrics {dataless = 1, applications = 1, formations = 1, dispatches = 3}} +-- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}},BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 1, formations = 0, dispatches = 3}}], program = ObjectMetrics {dataless = 0, applications = 1, formations = 1, dispatches = 3}} -- -- >>> collectMetrics "{⟦ α0 ↦ ξ, Δ ⤍ 00- ⟧}" -- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}}], program = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}} @@ -141,16 +143,16 @@ defaultMetrics = -- -- -- >>> collectMetrics "{⟦ α0 ↦ ξ, α1 ↦ ⟦ α2 ↦ ⟦ Δ ⤍ 00- ⟧ ⟧ ⟧}" --- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}},BindingMetrics {name = "\945\&1", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 2, dispatches = 0}}], program = ObjectMetrics {dataless = 1, applications = 0, formations = 3, dispatches = 0}} +-- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}},BindingMetrics {name = "\945\&1", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 2, dispatches = 0}}], program = ObjectMetrics {dataless = 0, applications = 0, formations = 3, dispatches = 0}} -- -- >>> collectMetrics "{⟦ Δ ⤍ 00- ⟧}" -- ProgramMetrics {attributes = [], program = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}} -- -- >>> collectMetrics "{⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧}" --- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 1, applications = 0, formations = 1, dispatches = 0}}], program = ObjectMetrics {dataless = 1, applications = 0, formations = 2, dispatches = 0}} +-- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}}], program = ObjectMetrics {dataless = 0, applications = 0, formations = 2, dispatches = 0}} -- -- >>> collectMetrics "{⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧ ⟧}" --- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 1, applications = 0, formations = 2, dispatches = 0}}], program = ObjectMetrics {dataless = 1, applications = 0, formations = 3, dispatches = 0}} +-- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 2, dispatches = 0}}], program = ObjectMetrics {dataless = 1, applications = 0, formations = 3, dispatches = 0}} -- -- >>> collectMetrics "{⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧ ⟧ ⟧}" -- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 1, applications = 0, formations = 3, dispatches = 0}}], program = ObjectMetrics {dataless = 2, applications = 0, formations = 4, dispatches = 0}} From cd78a8f0ba3b25415a1644a45f63ca1329f1bf0a Mon Sep 17 00:00:00 2001 From: Danila Danko Date: Fri, 15 Mar 2024 00:08:01 +0300 Subject: [PATCH 08/19] feat(metrics): support metrics for bindings by path --- eo-phi-normalizer/app/Main.hs | 31 +++++- .../src/Language/EO/Phi/Metrics.hs | 95 +++++++++++-------- 2 files changed, 83 insertions(+), 43 deletions(-) diff --git a/eo-phi-normalizer/app/Main.hs b/eo-phi-normalizer/app/Main.hs index 1f6042ffa..76b6a37c3 100644 --- a/eo-phi-normalizer/app/Main.hs +++ b/eo-phi-normalizer/app/Main.hs @@ -22,12 +22,14 @@ import Data.Foldable (forM_) import Control.Lens ((^.)) import Data.Aeson (ToJSON) import Data.Aeson.Encode.Pretty (Config (..), Indent (..), defConfig, encodePrettyToTextBuilder') +import Data.Maybe (fromMaybe) import Data.String.Interpolate (i) +import Data.Text qualified as T import Data.Text.Internal.Builder (toLazyText) import Data.Text.Lazy.Lens import GHC.Generics (Generic) import Language.EO.Phi (Attribute (Sigma), Object (Formation), Program (Program), parseProgram, printTree) -import Language.EO.Phi.Metrics (collectMetrics) +import Language.EO.Phi.Metrics (collectBindingsMetrics, programBindingsByPath) import Language.EO.Phi.Rules.Common (ApplicationLimits (ApplicationLimits), Context (..), applyRulesChainWith, applyRulesWith, objectSize) import Language.EO.Phi.Rules.Yaml (RuleSet (rules, title), convertRule, parseRuleSetFromFile) import Options.Applicative @@ -49,6 +51,7 @@ data CLI'TransformPhi = CLI'TransformPhi data CLI'MetricsPhi = CLI'MetricsPhi { inputFile :: Maybe FilePath , outputFile :: Maybe FilePath + , programPath :: Maybe String } deriving (Show) @@ -84,10 +87,21 @@ cliTransformPhiParser = do inputFile <- inputFileArg pure CLI'TransformPhi{..} +programPathOption :: Parser (Maybe String) +programPathOption = + optional $ + strOption + ( long "program-path" + <> short 'p' + <> metavar "PATH" + <> help [i|Report metrics for attributes accessible in a program via PATH. Defaults to an empty path. Example: "org.eolang"|] + ) + cliMetricsPhiParser :: Parser CLI'MetricsPhi cliMetricsPhiParser = do inputFile <- inputFileArg outputFile <- outputFileOption + programPath <- programPathOption pure CLI'MetricsPhi{..} metricsParserInfo :: ParserInfo CLI @@ -136,7 +150,7 @@ getProgram :: Optparse.Context -> Maybe FilePath -> IO Program getProgram parserContext inputFile = do src <- maybe getContents' readFile inputFile case parseProgram src of - Left err -> die parserContext [i|"An error occurred when parsing the input program: #{err}|] + Left err -> die parserContext [i|An error occurred when parsing the input program: #{err}|] Right program -> pure program getLoggers :: Maybe FilePath -> IO (String -> IO (), String -> IO ()) @@ -147,15 +161,24 @@ getLoggers outputFile = do , \x -> hPutStr handle x >> hFlush handle ) +-- >>> splitStringOn "." "abra.cada.bra" +-- ["abra","cada","bra"] +-- +-- >>> splitStringOn "." "" +-- [] +splitStringOn :: String -> String -> [String] +splitStringOn sep s = filter (not . null) $ T.unpack <$> T.splitOn (T.pack sep) (T.pack s) + main :: IO () main = do opts <- customExecParser pprefs cliOpts case opts of CLI'MetricsPhi' CLI'MetricsPhi{..} -> do let parserContext = Optparse.Context metricsCommandName metricsParserInfo - program' <- getProgram parserContext inputFile + program <- getProgram parserContext inputFile (logStrLn, _) <- getLoggers outputFile - let metrics = collectMetrics program' + let path = splitStringOn "." (fromMaybe "" programPath) + metrics = collectBindingsMetrics (programBindingsByPath path program) logStrLn $ encodeToJSONString metrics CLI'TransformPhi' CLI'TransformPhi{..} -> do let parserContext = Optparse.Context transformCommandName transformParserInfo diff --git a/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs b/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs index baba5a4c0..da15daee1 100644 --- a/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs +++ b/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs @@ -6,15 +6,9 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -{- FOURMOLU_DISABLE -} - --- $setup --- >>> :set -XOverloadedStrings - -{- FOURMOLU_ENABLE -} - module Language.EO.Phi.Metrics where import Control.Lens ((+=)) @@ -129,38 +123,8 @@ defaultMetrics = , program = defaultObjectMetrics } --- | Count dataless formations in a list of bindings --- --- >>> collectMetrics "{⟦ α0 ↦ ξ, α0 ↦ Φ.org.eolang.bytes( Δ ⤍ 00- ) ⟧}" --- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}},BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 1, formations = 0, dispatches = 3}}], program = ObjectMetrics {dataless = 0, applications = 1, formations = 1, dispatches = 3}} --- --- >>> collectMetrics "{⟦ α0 ↦ ξ, Δ ⤍ 00- ⟧}" --- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}}], program = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}} --- --- --- >>> collectMetrics "{⟦ α0 ↦ ξ, α1 ↦ ⟦ Δ ⤍ 00- ⟧ ⟧}" --- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}},BindingMetrics {name = "\945\&1", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}}], program = ObjectMetrics {dataless = 0, applications = 0, formations = 2, dispatches = 0}} --- --- --- >>> collectMetrics "{⟦ α0 ↦ ξ, α1 ↦ ⟦ α2 ↦ ⟦ Δ ⤍ 00- ⟧ ⟧ ⟧}" --- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}},BindingMetrics {name = "\945\&1", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 2, dispatches = 0}}], program = ObjectMetrics {dataless = 0, applications = 0, formations = 3, dispatches = 0}} --- --- >>> collectMetrics "{⟦ Δ ⤍ 00- ⟧}" --- ProgramMetrics {attributes = [], program = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}} --- --- >>> collectMetrics "{⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧}" --- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}}], program = ObjectMetrics {dataless = 0, applications = 0, formations = 2, dispatches = 0}} --- --- >>> collectMetrics "{⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧ ⟧}" --- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 2, dispatches = 0}}], program = ObjectMetrics {dataless = 1, applications = 0, formations = 3, dispatches = 0}} --- --- >>> collectMetrics "{⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧ ⟧ ⟧}" --- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 1, applications = 0, formations = 3, dispatches = 0}}], program = ObjectMetrics {dataless = 2, applications = 0, formations = 4, dispatches = 0}} --- --- >>> collectMetrics "{ ⟦ org ↦ ⟦ ⟧ ⟧ }" --- ProgramMetrics {attributes = [BindingMetrics {name = "org", metrics = ObjectMetrics {dataless = 1, applications = 0, formations = 1, dispatches = 0}}], program = ObjectMetrics {dataless = 1, applications = 0, formations = 2, dispatches = 0}} -collectMetrics :: Program -> ProgramMetrics -collectMetrics (Program bindings) = +collectBindingsMetrics :: [Binding] -> ProgramMetrics +collectBindingsMetrics bindings = let attributes' = flip runState mempty . inspect <$> bindings (heights, objectMetrics) = unzip attributes' attributes = do @@ -178,3 +142,56 @@ collectMetrics (Program bindings) = , formations = x.formations + 1 } in ProgramMetrics{..} + +bindingsByPath :: [String] -> [Binding] -> [Binding] +bindingsByPath path bindings = + case path of + [] -> bindings + (p : ps) -> + case bindings of + [] -> [] + _ -> do + x <- bindings + bindingsByPath ps $ + case x of + AlphaBinding (Alpha (AlphaIndex name)) (Formation bindings') | name == p -> bindings' + AlphaBinding (Label (LabelId name)) (Formation bindings') | name == p -> bindings' + _ -> [] + +-- >>> programBindingsByPath ["org", "eolang"] "{⟦ org ↦ ⟦ eolang ↦ ⟦ x ↦ ⟦ φ ↦ Φ.org.eolang.bool ( α0 ↦ Φ.org.eolang.bytes (Δ ⤍ 01-) ) ⟧, z ↦ ⟦ y ↦ ⟦ x ↦ ∅, φ ↦ ξ.x ⟧, φ ↦ Φ.org.eolang.bool ( α0 ↦ Φ.org.eolang.bytes (Δ ⤍ 01-) ) ⟧, λ ⤍ Package ⟧, λ ⤍ Package ⟧⟧ }" & \x -> [y | AlphaBinding (Label (LabelId y)) _ <- x] <> [y | AlphaBinding (Alpha (AlphaIndex y)) _ <- x] +-- ["x","z"] +programBindingsByPath :: [String] -> Program -> [Binding] +programBindingsByPath path (Program bindings) = bindingsByPath path bindings + +-- | Count dataless formations in a list of bindings +-- +-- >>> collectProgramMetrics "{⟦ α0 ↦ ξ, α0 ↦ Φ.org.eolang.bytes( Δ ⤍ 00- ) ⟧}" +-- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}},BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 1, formations = 0, dispatches = 3}}], program = ObjectMetrics {dataless = 1, applications = 1, formations = 1, dispatches = 3}} +-- +-- >>> collectProgramMetrics "{⟦ α0 ↦ ξ, Δ ⤍ 00- ⟧}" +-- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}}], program = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}} +-- +-- +-- >>> collectProgramMetrics "{⟦ α0 ↦ ξ, α1 ↦ ⟦ Δ ⤍ 00- ⟧ ⟧}" +-- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}},BindingMetrics {name = "\945\&1", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}}], program = ObjectMetrics {dataless = 0, applications = 0, formations = 2, dispatches = 0}} +-- +-- +-- >>> collectProgramMetrics "{⟦ α0 ↦ ξ, α1 ↦ ⟦ α2 ↦ ⟦ Δ ⤍ 00- ⟧ ⟧ ⟧}" +-- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}},BindingMetrics {name = "\945\&1", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 2, dispatches = 0}}], program = ObjectMetrics {dataless = 1, applications = 0, formations = 3, dispatches = 0}} +-- +-- >>> collectProgramMetrics "{⟦ Δ ⤍ 00- ⟧}" +-- ProgramMetrics {attributes = [], program = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}} +-- +-- >>> collectProgramMetrics "{⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧}" +-- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 1, applications = 0, formations = 1, dispatches = 0}}], program = ObjectMetrics {dataless = 1, applications = 0, formations = 2, dispatches = 0}} +-- +-- >>> collectProgramMetrics "{⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧ ⟧}" +-- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 1, applications = 0, formations = 2, dispatches = 0}}], program = ObjectMetrics {dataless = 1, applications = 0, formations = 3, dispatches = 0}} +-- +-- >>> collectProgramMetrics "{⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧ ⟧ ⟧}" +-- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 1, applications = 0, formations = 3, dispatches = 0}}], program = ObjectMetrics {dataless = 2, applications = 0, formations = 4, dispatches = 0}} +-- +-- >>> collectProgramMetrics "{ ⟦ org ↦ ⟦ ⟧ ⟧ }" +-- ProgramMetrics {attributes = [BindingMetrics {name = "org", metrics = ObjectMetrics {dataless = 1, applications = 0, formations = 1, dispatches = 0}}], program = ObjectMetrics {dataless = 1, applications = 0, formations = 2, dispatches = 0}} +collectProgramMetrics :: Program -> ProgramMetrics +collectProgramMetrics (Program bindings) = collectBindingsMetrics bindings From 5a663cb26cf69990c7bb70f2aa2e21accf1b70ae Mon Sep 17 00:00:00 2001 From: Danila Danko Date: Fri, 15 Mar 2024 01:35:42 +0300 Subject: [PATCH 09/19] fix(metrics): collect metrics for an object --- eo-phi-normalizer/app/Main.hs | 10 +- .../src/Language/EO/Phi/Metrics.hs | 150 ++++++++++-------- 2 files changed, 90 insertions(+), 70 deletions(-) diff --git a/eo-phi-normalizer/app/Main.hs b/eo-phi-normalizer/app/Main.hs index 76b6a37c3..4cbc7d258 100644 --- a/eo-phi-normalizer/app/Main.hs +++ b/eo-phi-normalizer/app/Main.hs @@ -29,7 +29,7 @@ import Data.Text.Internal.Builder (toLazyText) import Data.Text.Lazy.Lens import GHC.Generics (Generic) import Language.EO.Phi (Attribute (Sigma), Object (Formation), Program (Program), parseProgram, printTree) -import Language.EO.Phi.Metrics (collectBindingsMetrics, programBindingsByPath) +import Language.EO.Phi.Metrics (collectCompleteMetrics, programObjectByPath) import Language.EO.Phi.Rules.Common (ApplicationLimits (ApplicationLimits), Context (..), applyRulesChainWith, applyRulesWith, objectSize) import Language.EO.Phi.Rules.Yaml (RuleSet (rules, title), convertRule, parseRuleSetFromFile) import Options.Applicative @@ -178,8 +178,12 @@ main = do program <- getProgram parserContext inputFile (logStrLn, _) <- getLoggers outputFile let path = splitStringOn "." (fromMaybe "" programPath) - metrics = collectBindingsMetrics (programBindingsByPath path program) - logStrLn $ encodeToJSONString metrics + obj = programObjectByPath path program + case obj of + Left path' -> die parserContext [i|Could not access an object at path #{path'}.|] + Right obj' -> do + let metrics = collectCompleteMetrics obj' + logStrLn $ encodeToJSONString metrics CLI'TransformPhi' CLI'TransformPhi{..} -> do let parserContext = Optparse.Context transformCommandName transformParserInfo program' <- getProgram parserContext inputFile diff --git a/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs b/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs index da15daee1..4216e5afb 100644 --- a/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs +++ b/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs @@ -13,7 +13,7 @@ module Language.EO.Phi.Metrics where import Control.Lens ((+=)) import Control.Monad (forM_) -import Control.Monad.State (State, runState) +import Control.Monad.State (State, execState, runState) import Data.Aeson (FromJSON) import Data.Aeson.Types (ToJSON) import Data.Foldable (fold) @@ -110,88 +110,104 @@ instance Inspectable Object where pure 0 _ -> pure 0 -data ProgramMetrics = ProgramMetrics +data CompleteMetrics = CompleteMetrics { attributes :: [BindingMetrics] - , program :: ObjectMetrics + , this :: ObjectMetrics } deriving (Show, Generic, FromJSON, ToJSON, Eq) -defaultMetrics :: ProgramMetrics +defaultMetrics :: CompleteMetrics defaultMetrics = - ProgramMetrics + CompleteMetrics { attributes = [] - , program = defaultObjectMetrics + , this = defaultObjectMetrics } -collectBindingsMetrics :: [Binding] -> ProgramMetrics -collectBindingsMetrics bindings = - let attributes' = flip runState mempty . inspect <$> bindings - (heights, objectMetrics) = unzip attributes' - attributes = do - x <- zip bindings objectMetrics - case x of - (AlphaBinding (Alpha (AlphaIndex name)) _, metrics) -> [BindingMetrics{..}] - (AlphaBinding (Label (LabelId name)) _, metrics) -> [BindingMetrics{..}] - _ -> [] - height = getHeight bindings heights - program = - fold objectMetrics - & \x -> - x - { dataless = x.dataless + countDataless height - , formations = x.formations + 1 - } - in ProgramMetrics{..} - -bindingsByPath :: [String] -> [Binding] -> [Binding] -bindingsByPath path bindings = - case path of - [] -> bindings - (p : ps) -> - case bindings of - [] -> [] - _ -> do - x <- bindings - bindingsByPath ps $ - case x of - AlphaBinding (Alpha (AlphaIndex name)) (Formation bindings') | name == p -> bindings' - AlphaBinding (Label (LabelId name)) (Formation bindings') | name == p -> bindings' - _ -> [] - --- >>> programBindingsByPath ["org", "eolang"] "{⟦ org ↦ ⟦ eolang ↦ ⟦ x ↦ ⟦ φ ↦ Φ.org.eolang.bool ( α0 ↦ Φ.org.eolang.bytes (Δ ⤍ 01-) ) ⟧, z ↦ ⟦ y ↦ ⟦ x ↦ ∅, φ ↦ ξ.x ⟧, φ ↦ Φ.org.eolang.bool ( α0 ↦ Φ.org.eolang.bytes (Δ ⤍ 01-) ) ⟧, λ ⤍ Package ⟧, λ ⤍ Package ⟧⟧ }" & \x -> [y | AlphaBinding (Label (LabelId y)) _ <- x] <> [y | AlphaBinding (Alpha (AlphaIndex y)) _ <- x] --- ["x","z"] -programBindingsByPath :: [String] -> Program -> [Binding] -programBindingsByPath path (Program bindings) = bindingsByPath path bindings - --- | Count dataless formations in a list of bindings +-- | Collect metrics for an object -- --- >>> collectProgramMetrics "{⟦ α0 ↦ ξ, α0 ↦ Φ.org.eolang.bytes( Δ ⤍ 00- ) ⟧}" --- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}},BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 1, formations = 0, dispatches = 3}}], program = ObjectMetrics {dataless = 1, applications = 1, formations = 1, dispatches = 3}} +-- When an object is a formation, provide metrics for its attributes and metrics for the object. -- --- >>> collectProgramMetrics "{⟦ α0 ↦ ξ, Δ ⤍ 00- ⟧}" --- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}}], program = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}} +-- >>> collectCompleteMetrics "⟦ α0 ↦ ξ, α0 ↦ Φ.org.eolang.bytes( Δ ⤍ 00- ) ⟧" +-- CompleteMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}},BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 1, formations = 0, dispatches = 3}}], this = ObjectMetrics {dataless = 0, applications = 1, formations = 1, dispatches = 3}} -- +-- >>> collectCompleteMetrics "⟦ α0 ↦ ξ, Δ ⤍ 00- ⟧" +-- CompleteMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}}], this = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}} -- --- >>> collectProgramMetrics "{⟦ α0 ↦ ξ, α1 ↦ ⟦ Δ ⤍ 00- ⟧ ⟧}" --- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}},BindingMetrics {name = "\945\&1", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}}], program = ObjectMetrics {dataless = 0, applications = 0, formations = 2, dispatches = 0}} +-- >>> collectCompleteMetrics "⟦ α0 ↦ ξ, α1 ↦ ⟦ Δ ⤍ 00- ⟧ ⟧" +-- CompleteMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}},BindingMetrics {name = "\945\&1", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}}], this = ObjectMetrics {dataless = 0, applications = 0, formations = 2, dispatches = 0}} -- +-- >>> collectCompleteMetrics "⟦ α0 ↦ ξ, α1 ↦ ⟦ α2 ↦ ⟦ Δ ⤍ 00- ⟧ ⟧ ⟧" +-- CompleteMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}},BindingMetrics {name = "\945\&1", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 2, dispatches = 0}}], this = ObjectMetrics {dataless = 0, applications = 0, formations = 3, dispatches = 0}} -- --- >>> collectProgramMetrics "{⟦ α0 ↦ ξ, α1 ↦ ⟦ α2 ↦ ⟦ Δ ⤍ 00- ⟧ ⟧ ⟧}" --- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}},BindingMetrics {name = "\945\&1", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 2, dispatches = 0}}], program = ObjectMetrics {dataless = 1, applications = 0, formations = 3, dispatches = 0}} +-- >>> collectCompleteMetrics "⟦ Δ ⤍ 00- ⟧" +-- CompleteMetrics {attributes = [], this = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}} -- --- >>> collectProgramMetrics "{⟦ Δ ⤍ 00- ⟧}" --- ProgramMetrics {attributes = [], program = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}} +-- >>> collectCompleteMetrics "⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧" +-- CompleteMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}}], this = ObjectMetrics {dataless = 0, applications = 0, formations = 2, dispatches = 0}} -- --- >>> collectProgramMetrics "{⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧}" --- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 1, applications = 0, formations = 1, dispatches = 0}}], program = ObjectMetrics {dataless = 1, applications = 0, formations = 2, dispatches = 0}} +-- >>> collectCompleteMetrics "⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧ ⟧" +-- CompleteMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 2, dispatches = 0}}], this = ObjectMetrics {dataless = 1, applications = 0, formations = 3, dispatches = 0}} -- --- >>> collectProgramMetrics "{⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧ ⟧}" --- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 1, applications = 0, formations = 2, dispatches = 0}}], program = ObjectMetrics {dataless = 1, applications = 0, formations = 3, dispatches = 0}} +-- >>> collectCompleteMetrics "⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧ ⟧ ⟧" +-- CompleteMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 1, applications = 0, formations = 3, dispatches = 0}}], this = ObjectMetrics {dataless = 2, applications = 0, formations = 4, dispatches = 0}} -- --- >>> collectProgramMetrics "{⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧ ⟧ ⟧}" --- ProgramMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 1, applications = 0, formations = 3, dispatches = 0}}], program = ObjectMetrics {dataless = 2, applications = 0, formations = 4, dispatches = 0}} +-- >>> collectCompleteMetrics "⟦ org ↦ ⟦ ⟧ ⟧" +-- CompleteMetrics {attributes = [BindingMetrics {name = "org", metrics = ObjectMetrics {dataless = 1, applications = 0, formations = 1, dispatches = 0}}], this = ObjectMetrics {dataless = 1, applications = 0, formations = 2, dispatches = 0}} +-- +-- >>> collectCompleteMetrics "⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b(c ↦ ⟦⟧).d ⟧.e ⟧" +-- CompleteMetrics {attributes = [BindingMetrics {name = "a", metrics = ObjectMetrics {dataless = 1, applications = 1, formations = 4, dispatches = 5}}], this = ObjectMetrics {dataless = 1, applications = 1, formations = 5, dispatches = 5}} +collectCompleteMetrics :: Object -> CompleteMetrics +collectCompleteMetrics = \case + Formation bindings -> + let attributes' = flip runState mempty . inspect <$> bindings + (heights, objectMetrics) = unzip attributes' + attributes = do + x <- zip bindings objectMetrics + case x of + (AlphaBinding (Alpha (AlphaIndex name)) _, metrics) -> [BindingMetrics{..}] + (AlphaBinding (Label (LabelId name)) _, metrics) -> [BindingMetrics{..}] + _ -> [] + height = getHeight bindings heights + this = + fold objectMetrics + & \x -> + x + { dataless = x.dataless + countDataless height + , formations = x.formations + 1 + } + in CompleteMetrics{..} + obj -> + CompleteMetrics + { attributes = [] + , this = execState (inspect obj) mempty + } + +objectByPath :: [String] -> Object -> Either [String] Object +objectByPath path object = + case path of + [] -> Right object + (p : ps) -> + case object of + Formation bindings -> + case objectByPath' of + [] -> Left path + (x : _) -> Right x + where + objectByPath' = + do + x <- bindings + Right obj <- + case x of + AlphaBinding (Alpha (AlphaIndex name)) obj | name == p -> [objectByPath ps obj] + AlphaBinding (Label (LabelId name)) obj | name == p -> [objectByPath ps obj] + _ -> [Left path] + pure obj + _ -> Left path + +-- >>> programObjectByPath ["org", "eolang"] "{⟦ org ↦ ⟦ eolang ↦ ⟦ x ↦ ⟦ φ ↦ Φ.org.eolang.bool ( α0 ↦ Φ.org.eolang.bytes (Δ ⤍ 01-) ) ⟧, z ↦ ⟦ y ↦ ⟦ x ↦ ∅, φ ↦ ξ.x ⟧, φ ↦ Φ.org.eolang.bool ( α0 ↦ Φ.org.eolang.bytes (Δ ⤍ 01-) ) ⟧, λ ⤍ Package ⟧, λ ⤍ Package ⟧⟧ }" +-- Right (Formation [AlphaBinding (Label (LabelId "x")) (Formation [AlphaBinding Phi (Application (ObjectDispatch (ObjectDispatch (ObjectDispatch GlobalObject (Label (LabelId "org"))) (Label (LabelId "eolang"))) (Label (LabelId "bool"))) [AlphaBinding (Alpha (AlphaIndex "\945\&0")) (Application (ObjectDispatch (ObjectDispatch (ObjectDispatch GlobalObject (Label (LabelId "org"))) (Label (LabelId "eolang"))) (Label (LabelId "bytes"))) [DeltaBinding (Bytes "01-")])])]),AlphaBinding (Label (LabelId "z")) (Formation [AlphaBinding (Label (LabelId "y")) (Formation [EmptyBinding (Label (LabelId "x")),AlphaBinding Phi (ObjectDispatch ThisObject (Label (LabelId "x")))]),AlphaBinding Phi (Application (ObjectDispatch (ObjectDispatch (ObjectDispatch GlobalObject (Label (LabelId "org"))) (Label (LabelId "eolang"))) (Label (LabelId "bool"))) [AlphaBinding (Alpha (AlphaIndex "\945\&0")) (Application (ObjectDispatch (ObjectDispatch (ObjectDispatch GlobalObject (Label (LabelId "org"))) (Label (LabelId "eolang"))) (Label (LabelId "bytes"))) [DeltaBinding (Bytes "01-")])])]),LambdaBinding (Function "Package")]) -- --- >>> collectProgramMetrics "{ ⟦ org ↦ ⟦ ⟧ ⟧ }" --- ProgramMetrics {attributes = [BindingMetrics {name = "org", metrics = ObjectMetrics {dataless = 1, applications = 0, formations = 1, dispatches = 0}}], program = ObjectMetrics {dataless = 1, applications = 0, formations = 2, dispatches = 0}} -collectProgramMetrics :: Program -> ProgramMetrics -collectProgramMetrics (Program bindings) = collectBindingsMetrics bindings +-- >>> programObjectByPath ["a"] "{⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b(c ↦ ⟦⟧).d ⟧.e ⟧}" +-- Right (ObjectDispatch (Formation [AlphaBinding (Label (LabelId "b")) (Formation [EmptyBinding (Label (LabelId "c")),AlphaBinding (Label (LabelId "d")) (Formation [AlphaBinding Phi (ObjectDispatch (ObjectDispatch ThisObject Rho) (Label (LabelId "c")))])]),AlphaBinding (Label (LabelId "e")) (ObjectDispatch (Application (ObjectDispatch ThisObject (Label (LabelId "b"))) [AlphaBinding (Label (LabelId "c")) (Formation [])]) (Label (LabelId "d")))]) (Label (LabelId "e"))) +programObjectByPath :: [String] -> Program -> Either [String] Object +programObjectByPath path (Program bindings) = objectByPath path (Formation bindings) From 75a89544a7085a0539d548b8cea5a546e3e933ec Mon Sep 17 00:00:00 2001 From: Danila Danko Date: Fri, 15 Mar 2024 13:16:01 +0300 Subject: [PATCH 10/19] fix(metrics): collect object and program metrics --- eo-phi-normalizer/app/Main.hs | 33 ++- .../src/Language/EO/Phi/Metrics.hs | 222 +++++++++++------- 2 files changed, 153 insertions(+), 102 deletions(-) diff --git a/eo-phi-normalizer/app/Main.hs b/eo-phi-normalizer/app/Main.hs index 4cbc7d258..f8296ac99 100644 --- a/eo-phi-normalizer/app/Main.hs +++ b/eo-phi-normalizer/app/Main.hs @@ -22,14 +22,15 @@ import Data.Foldable (forM_) import Control.Lens ((^.)) import Data.Aeson (ToJSON) import Data.Aeson.Encode.Pretty (Config (..), Indent (..), defConfig, encodePrettyToTextBuilder') +import Data.List (intercalate) import Data.Maybe (fromMaybe) -import Data.String.Interpolate (i) +import Data.String.Interpolate (i, iii) import Data.Text qualified as T import Data.Text.Internal.Builder (toLazyText) import Data.Text.Lazy.Lens import GHC.Generics (Generic) import Language.EO.Phi (Attribute (Sigma), Object (Formation), Program (Program), parseProgram, printTree) -import Language.EO.Phi.Metrics (collectCompleteMetrics, programObjectByPath) +import Language.EO.Phi.Metrics (getProgramMetrics) import Language.EO.Phi.Rules.Common (ApplicationLimits (ApplicationLimits), Context (..), applyRulesChainWith, applyRulesWith, objectSize) import Language.EO.Phi.Rules.Yaml (RuleSet (rules, title), convertRule, parseRuleSetFromFile) import Options.Applicative @@ -91,10 +92,15 @@ programPathOption :: Parser (Maybe String) programPathOption = optional $ strOption - ( long "program-path" - <> short 'p' + ( long "bindings-by-path" + <> short 'b' <> metavar "PATH" - <> help [i|Report metrics for attributes accessible in a program via PATH. Defaults to an empty path. Example: "org.eolang"|] + <> help + [iii| + Report metrics for bindings of a formation accessible in a program by a PATH. + The default PATH is empty. + Example of a PATH: 'org.eolang'. + |] ) cliMetricsPhiParser :: Parser CLI'MetricsPhi @@ -178,12 +184,17 @@ main = do program <- getProgram parserContext inputFile (logStrLn, _) <- getLoggers outputFile let path = splitStringOn "." (fromMaybe "" programPath) - obj = programObjectByPath path program - case obj of - Left path' -> die parserContext [i|Could not access an object at path #{path'}.|] - Right obj' -> do - let metrics = collectCompleteMetrics obj' - logStrLn $ encodeToJSONString metrics + metrics = getProgramMetrics path program + case metrics of + Left path' -> + die + parserContext + [iii| + Could not find bindings at path '#{intercalate "." path}' + because an object at '#{intercalate "." path'}' is not a formation. + |] + Right metrics' -> do + logStrLn $ encodeToJSONString metrics' CLI'TransformPhi' CLI'TransformPhi{..} -> do let parserContext = Optparse.Context transformCommandName transformParserInfo program' <- getProgram parserContext inputFile diff --git a/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs b/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs index 4216e5afb..48006bbbe 100644 --- a/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs +++ b/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs @@ -1,13 +1,18 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} module Language.EO.Phi.Metrics where @@ -16,15 +21,13 @@ import Control.Monad (forM_) import Control.Monad.State (State, execState, runState) import Data.Aeson (FromJSON) import Data.Aeson.Types (ToJSON) -import Data.Foldable (fold) -import Data.Function ((&)) import Data.Generics.Labels () import Data.Traversable (forM) import GHC.Generics (Generic) import Language.EO.Phi.Rules.Common () import Language.EO.Phi.Syntax.Abs -data ObjectMetrics = ObjectMetrics +data Metrics = Metrics { dataless :: Int , applications :: Int , formations :: Int @@ -32,32 +35,32 @@ data ObjectMetrics = ObjectMetrics } deriving (Generic, Show, FromJSON, ToJSON, Eq) -defaultObjectMetrics :: ObjectMetrics -defaultObjectMetrics = - ObjectMetrics +defaultMetrics :: Metrics +defaultMetrics = + Metrics { dataless = 0 , applications = 0 , formations = 0 , dispatches = 0 } -instance Semigroup ObjectMetrics where - (<>) :: ObjectMetrics -> ObjectMetrics -> ObjectMetrics +instance Semigroup Metrics where + (<>) :: Metrics -> Metrics -> Metrics x <> y = - ObjectMetrics + Metrics { dataless = x.dataless + y.dataless , applications = x.applications + y.applications , formations = x.formations + y.formations , dispatches = x.dispatches + y.dispatches } -instance Monoid ObjectMetrics where - mempty :: ObjectMetrics - mempty = defaultObjectMetrics +instance Monoid Metrics where + mempty :: Metrics + mempty = defaultMetrics data BindingMetrics = BindingMetrics { name :: String - , metrics :: ObjectMetrics + , metrics :: Metrics } deriving (Show, Generic, FromJSON, ToJSON, Eq) @@ -81,17 +84,17 @@ countDataless x | otherwise = 0 class Inspectable a where - inspect :: a -> State ObjectMetrics Int + inspect :: a -> State Metrics Int instance Inspectable Binding where - inspect :: Binding -> State ObjectMetrics Int + inspect :: Binding -> State Metrics Int inspect = \case AlphaBinding _ obj -> do inspect obj _ -> pure 0 instance Inspectable Object where - inspect :: Object -> State ObjectMetrics Int + inspect :: Object -> State Metrics Int inspect = \case Formation bindings -> do #formations += 1 @@ -110,80 +113,64 @@ instance Inspectable Object where pure 0 _ -> pure 0 -data CompleteMetrics = CompleteMetrics - { attributes :: [BindingMetrics] - , this :: ObjectMetrics +type Path = [String] + +data BindingsByPathMetrics = BindingsByPathMetrics + { path :: Path + , bindingsMetrics :: [BindingMetrics] } deriving (Show, Generic, FromJSON, ToJSON, Eq) -defaultMetrics :: CompleteMetrics -defaultMetrics = - CompleteMetrics - { attributes = [] - , this = defaultObjectMetrics - } +data ObjectMetrics = ObjectMetrics + { bindingsByPathMetrics :: BindingsByPathMetrics + , thisObjectMetrics :: Metrics + } + deriving (Show, Generic, FromJSON, ToJSON, Eq) --- | Collect metrics for an object --- --- When an object is a formation, provide metrics for its attributes and metrics for the object. --- --- >>> collectCompleteMetrics "⟦ α0 ↦ ξ, α0 ↦ Φ.org.eolang.bytes( Δ ⤍ 00- ) ⟧" --- CompleteMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}},BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 1, formations = 0, dispatches = 3}}], this = ObjectMetrics {dataless = 0, applications = 1, formations = 1, dispatches = 3}} --- --- >>> collectCompleteMetrics "⟦ α0 ↦ ξ, Δ ⤍ 00- ⟧" --- CompleteMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}}], this = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}} --- --- >>> collectCompleteMetrics "⟦ α0 ↦ ξ, α1 ↦ ⟦ Δ ⤍ 00- ⟧ ⟧" --- CompleteMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}},BindingMetrics {name = "\945\&1", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}}], this = ObjectMetrics {dataless = 0, applications = 0, formations = 2, dispatches = 0}} --- --- >>> collectCompleteMetrics "⟦ α0 ↦ ξ, α1 ↦ ⟦ α2 ↦ ⟦ Δ ⤍ 00- ⟧ ⟧ ⟧" --- CompleteMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 0, dispatches = 0}},BindingMetrics {name = "\945\&1", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 2, dispatches = 0}}], this = ObjectMetrics {dataless = 0, applications = 0, formations = 3, dispatches = 0}} --- --- >>> collectCompleteMetrics "⟦ Δ ⤍ 00- ⟧" --- CompleteMetrics {attributes = [], this = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}} --- --- >>> collectCompleteMetrics "⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧" --- CompleteMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 1, dispatches = 0}}], this = ObjectMetrics {dataless = 0, applications = 0, formations = 2, dispatches = 0}} --- --- >>> collectCompleteMetrics "⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧ ⟧" --- CompleteMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 0, applications = 0, formations = 2, dispatches = 0}}], this = ObjectMetrics {dataless = 1, applications = 0, formations = 3, dispatches = 0}} --- --- >>> collectCompleteMetrics "⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧ ⟧ ⟧" --- CompleteMetrics {attributes = [BindingMetrics {name = "\945\&0", metrics = ObjectMetrics {dataless = 1, applications = 0, formations = 3, dispatches = 0}}], this = ObjectMetrics {dataless = 2, applications = 0, formations = 4, dispatches = 0}} --- --- >>> collectCompleteMetrics "⟦ org ↦ ⟦ ⟧ ⟧" --- CompleteMetrics {attributes = [BindingMetrics {name = "org", metrics = ObjectMetrics {dataless = 1, applications = 0, formations = 1, dispatches = 0}}], this = ObjectMetrics {dataless = 1, applications = 0, formations = 2, dispatches = 0}} --- --- >>> collectCompleteMetrics "⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b(c ↦ ⟦⟧).d ⟧.e ⟧" --- CompleteMetrics {attributes = [BindingMetrics {name = "a", metrics = ObjectMetrics {dataless = 1, applications = 1, formations = 4, dispatches = 5}}], this = ObjectMetrics {dataless = 1, applications = 1, formations = 5, dispatches = 5}} -collectCompleteMetrics :: Object -> CompleteMetrics -collectCompleteMetrics = \case - Formation bindings -> - let attributes' = flip runState mempty . inspect <$> bindings - (heights, objectMetrics) = unzip attributes' - attributes = do - x <- zip bindings objectMetrics - case x of - (AlphaBinding (Alpha (AlphaIndex name)) _, metrics) -> [BindingMetrics{..}] - (AlphaBinding (Label (LabelId name)) _, metrics) -> [BindingMetrics{..}] - _ -> [] - height = getHeight bindings heights - this = - fold objectMetrics - & \x -> - x - { dataless = x.dataless + countDataless height - , formations = x.formations + 1 - } - in CompleteMetrics{..} - obj -> - CompleteMetrics - { attributes = [] - , this = execState (inspect obj) mempty - } +-- | Get metrics for an object +-- +-- >>> getThisObjectMetrics "⟦ α0 ↦ ξ, α0 ↦ Φ.org.eolang.bytes( Δ ⤍ 00- ) ⟧" +-- Metrics {dataless = 0, applications = 1, formations = 1, dispatches = 3} +-- +-- >>> getThisObjectMetrics "⟦ α0 ↦ ξ, Δ ⤍ 00- ⟧" +-- Metrics {dataless = 0, applications = 0, formations = 1, dispatches = 0} +-- +-- >>> getThisObjectMetrics "⟦ α0 ↦ ξ, α1 ↦ ⟦ Δ ⤍ 00- ⟧ ⟧" +-- Metrics {dataless = 0, applications = 0, formations = 2, dispatches = 0} +-- +-- >>> getThisObjectMetrics "⟦ α0 ↦ ξ, α1 ↦ ⟦ α2 ↦ ⟦ Δ ⤍ 00- ⟧ ⟧ ⟧" +-- Metrics {dataless = 0, applications = 0, formations = 3, dispatches = 0} +-- +-- >>> getThisObjectMetrics "⟦ Δ ⤍ 00- ⟧" +-- Metrics {dataless = 0, applications = 0, formations = 1, dispatches = 0} +-- +-- >>> getThisObjectMetrics "⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧" +-- Metrics {dataless = 0, applications = 0, formations = 2, dispatches = 0} +-- +-- >>> getThisObjectMetrics "⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧ ⟧" +-- Metrics {dataless = 1, applications = 0, formations = 3, dispatches = 0} +-- +-- >>> getThisObjectMetrics "⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ⟦ α0 ↦ ∅ ⟧ ⟧ ⟧ ⟧" +-- Metrics {dataless = 2, applications = 0, formations = 4, dispatches = 0} +-- +-- >>> getThisObjectMetrics "⟦ org ↦ ⟦ ⟧ ⟧" +-- Metrics {dataless = 1, applications = 0, formations = 2, dispatches = 0} +-- +-- >>> getThisObjectMetrics "⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b(c ↦ ⟦⟧).d ⟧.e ⟧" +-- Metrics {dataless = 1, applications = 1, formations = 5, dispatches = 5} +getThisObjectMetrics :: Object -> Metrics +getThisObjectMetrics obj = execState (inspect obj) mempty -objectByPath :: [String] -> Object -> Either [String] Object -objectByPath path object = +-- | Get an object by a path within a given object. +-- +-- If no object is accessible by the path, return a prefix of the path that led to a non-formation when the remaining path wasn't empty. +-- >>> getObjectByPath ["org", "eolang"] "⟦ org ↦ ⟦ eolang ↦ ⟦ x ↦ ⟦ φ ↦ Φ.org.eolang.bool ( α0 ↦ Φ.org.eolang.bytes (Δ ⤍ 01-) ) ⟧, z ↦ ⟦ y ↦ ⟦ x ↦ ∅, φ ↦ ξ.x ⟧, φ ↦ Φ.org.eolang.bool ( α0 ↦ Φ.org.eolang.bytes (Δ ⤍ 01-) ) ⟧, λ ⤍ Package ⟧, λ ⤍ Package ⟧⟧" +-- Right (Formation [AlphaBinding (Label (LabelId "x")) (Formation [AlphaBinding Phi (Application (ObjectDispatch (ObjectDispatch (ObjectDispatch GlobalObject (Label (LabelId "org"))) (Label (LabelId "eolang"))) (Label (LabelId "bool"))) [AlphaBinding (Alpha (AlphaIndex "\945\&0")) (Application (ObjectDispatch (ObjectDispatch (ObjectDispatch GlobalObject (Label (LabelId "org"))) (Label (LabelId "eolang"))) (Label (LabelId "bytes"))) [DeltaBinding (Bytes "01-")])])]),AlphaBinding (Label (LabelId "z")) (Formation [AlphaBinding (Label (LabelId "y")) (Formation [EmptyBinding (Label (LabelId "x")),AlphaBinding Phi (ObjectDispatch ThisObject (Label (LabelId "x")))]),AlphaBinding Phi (Application (ObjectDispatch (ObjectDispatch (ObjectDispatch GlobalObject (Label (LabelId "org"))) (Label (LabelId "eolang"))) (Label (LabelId "bool"))) [AlphaBinding (Alpha (AlphaIndex "\945\&0")) (Application (ObjectDispatch (ObjectDispatch (ObjectDispatch GlobalObject (Label (LabelId "org"))) (Label (LabelId "eolang"))) (Label (LabelId "bytes"))) [DeltaBinding (Bytes "01-")])])]),LambdaBinding (Function "Package")]) +-- +-- >>> getObjectByPath ["a"] "⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b(c ↦ ⟦⟧).d ⟧.e ⟧" +-- Right (ObjectDispatch (Formation [AlphaBinding (Label (LabelId "b")) (Formation [EmptyBinding (Label (LabelId "c")),AlphaBinding (Label (LabelId "d")) (Formation [AlphaBinding Phi (ObjectDispatch (ObjectDispatch ThisObject Rho) (Label (LabelId "c")))])]),AlphaBinding (Label (LabelId "e")) (ObjectDispatch (Application (ObjectDispatch ThisObject (Label (LabelId "b"))) [AlphaBinding (Label (LabelId "c")) (Formation [])]) (Label (LabelId "d")))]) (Label (LabelId "e"))) +getObjectByPath :: Path -> Object -> Either Path Object +getObjectByPath path object = case path of [] -> Right object (p : ps) -> @@ -198,16 +185,69 @@ objectByPath path object = x <- bindings Right obj <- case x of - AlphaBinding (Alpha (AlphaIndex name)) obj | name == p -> [objectByPath ps obj] - AlphaBinding (Label (LabelId name)) obj | name == p -> [objectByPath ps obj] + AlphaBinding (Alpha (AlphaIndex name)) obj | name == p -> [getObjectByPath ps obj] + AlphaBinding (Label (LabelId name)) obj | name == p -> [getObjectByPath ps obj] _ -> [Left path] pure obj _ -> Left path --- >>> programObjectByPath ["org", "eolang"] "{⟦ org ↦ ⟦ eolang ↦ ⟦ x ↦ ⟦ φ ↦ Φ.org.eolang.bool ( α0 ↦ Φ.org.eolang.bytes (Δ ⤍ 01-) ) ⟧, z ↦ ⟦ y ↦ ⟦ x ↦ ∅, φ ↦ ξ.x ⟧, φ ↦ Φ.org.eolang.bool ( α0 ↦ Φ.org.eolang.bytes (Δ ⤍ 01-) ) ⟧, λ ⤍ Package ⟧, λ ⤍ Package ⟧⟧ }" +-- | Get metrics for bindings of a formation that is accessible by a path within a given object. +-- +-- If no formation is accessible by the path, return a prefix of the path that led to a non-formation when the remaining path wasn't empty. +-- >>> getBindingsByPathMetrics ["a"] "⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b(c ↦ ⟦⟧).d ⟧.e ⟧" +-- Left ["a"] +-- +-- >>> getBindingsByPathMetrics ["a"] "⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b(c ↦ ⟦⟧).d ⟧ ⟧" +-- Right (BindingsByPathMetrics {path = ["a"], bindingsMetrics = [BindingMetrics {name = "b", metrics = Metrics {dataless = 0, applications = 0, formations = 2, dispatches = 2}},BindingMetrics {name = "e", metrics = Metrics {dataless = 1, applications = 1, formations = 1, dispatches = 2}}]}) +getBindingsByPathMetrics :: Path -> Object -> Either Path BindingsByPathMetrics +getBindingsByPathMetrics path obj = + case getObjectByPath path obj of + Right (Formation bindings) -> + let attributes' = flip runState mempty . inspect <$> bindings + (_, objectMetrics) = unzip attributes' + bindingsMetrics = do + x <- zip bindings objectMetrics + case x of + (AlphaBinding (Alpha (AlphaIndex name)) _, metrics) -> [BindingMetrics{..}] + (AlphaBinding (Label (LabelId name)) _, metrics) -> [BindingMetrics{..}] + _ -> [] + in Right $ BindingsByPathMetrics{..} + Right _ -> Left path + Left path' -> Left path' + +-- | Get metrics for an object and for bindings of a formation accessible by a given path. +-- +-- Combine metrics produced by 'getThisObjectMetrics' and 'getBindingsByPathMetrics'. +-- +-- If no formation is accessible by the path, return a prefix of the path that led to a non-formation when the remaining path wasn't empty. +-- >>> getObjectMetrics ["a"] "⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b(c ↦ ⟦⟧).d ⟧.e ⟧" +-- Left ["a"] +-- +-- >>> getObjectMetrics ["a"] "⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b(c ↦ ⟦⟧).d ⟧ ⟧" +-- Right (ObjectMetrics {bindingsByPathMetrics = BindingsByPathMetrics {path = ["a"], bindingsMetrics = [BindingMetrics {name = "b", metrics = Metrics {dataless = 0, applications = 0, formations = 2, dispatches = 2}},BindingMetrics {name = "e", metrics = Metrics {dataless = 1, applications = 1, formations = 1, dispatches = 2}}]}, thisObjectMetrics = Metrics {dataless = 1, applications = 1, formations = 5, dispatches = 4}}) +getObjectMetrics :: Path -> Object -> Either Path ObjectMetrics +getObjectMetrics path obj = do + let thisObjectMetrics = getThisObjectMetrics obj + bindingsByPathMetrics <- getBindingsByPathMetrics path obj + pure ObjectMetrics{..} + +data ProgramMetrics = ProgramMetrics + { bindingsByPathMetrics :: BindingsByPathMetrics + , programMetrics :: Metrics + } + deriving (Show, Generic, FromJSON, ToJSON, Eq) + +-- | Get metrics for a program and for bindings of a formation accessible by a given path. +-- +-- Combine metrics produced by 'getThisObjectMetrics' and 'getBindingsByPathMetrics'. +-- +-- If no formation is accessible by the path, return a prefix of the path that led to a non-formation when the remaining path wasn't empty. +-- >>> getProgramMetrics ["org", "eolang"] "{⟦ org ↦ ⟦ eolang ↦ ⟦ x ↦ ⟦ φ ↦ Φ.org.eolang.bool ( α0 ↦ Φ.org.eolang.bytes (Δ ⤍ 01-) ) ⟧, z ↦ ⟦ y ↦ ⟦ x ↦ ∅, φ ↦ ξ.x ⟧, φ ↦ Φ.org.eolang.bool ( α0 ↦ Φ.org.eolang.bytes (Δ ⤍ 01-) ) ⟧, λ ⤍ Package ⟧, λ ⤍ Package ⟧⟧ }" -- Right (Formation [AlphaBinding (Label (LabelId "x")) (Formation [AlphaBinding Phi (Application (ObjectDispatch (ObjectDispatch (ObjectDispatch GlobalObject (Label (LabelId "org"))) (Label (LabelId "eolang"))) (Label (LabelId "bool"))) [AlphaBinding (Alpha (AlphaIndex "\945\&0")) (Application (ObjectDispatch (ObjectDispatch (ObjectDispatch GlobalObject (Label (LabelId "org"))) (Label (LabelId "eolang"))) (Label (LabelId "bytes"))) [DeltaBinding (Bytes "01-")])])]),AlphaBinding (Label (LabelId "z")) (Formation [AlphaBinding (Label (LabelId "y")) (Formation [EmptyBinding (Label (LabelId "x")),AlphaBinding Phi (ObjectDispatch ThisObject (Label (LabelId "x")))]),AlphaBinding Phi (Application (ObjectDispatch (ObjectDispatch (ObjectDispatch GlobalObject (Label (LabelId "org"))) (Label (LabelId "eolang"))) (Label (LabelId "bool"))) [AlphaBinding (Alpha (AlphaIndex "\945\&0")) (Application (ObjectDispatch (ObjectDispatch (ObjectDispatch GlobalObject (Label (LabelId "org"))) (Label (LabelId "eolang"))) (Label (LabelId "bytes"))) [DeltaBinding (Bytes "01-")])])]),LambdaBinding (Function "Package")]) -- --- >>> programObjectByPath ["a"] "{⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b(c ↦ ⟦⟧).d ⟧.e ⟧}" +-- >>> getProgramMetrics ["a"] "{⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b(c ↦ ⟦⟧).d ⟧.e ⟧}" -- Right (ObjectDispatch (Formation [AlphaBinding (Label (LabelId "b")) (Formation [EmptyBinding (Label (LabelId "c")),AlphaBinding (Label (LabelId "d")) (Formation [AlphaBinding Phi (ObjectDispatch (ObjectDispatch ThisObject Rho) (Label (LabelId "c")))])]),AlphaBinding (Label (LabelId "e")) (ObjectDispatch (Application (ObjectDispatch ThisObject (Label (LabelId "b"))) [AlphaBinding (Label (LabelId "c")) (Formation [])]) (Label (LabelId "d")))]) (Label (LabelId "e"))) -programObjectByPath :: [String] -> Program -> Either [String] Object -programObjectByPath path (Program bindings) = objectByPath path (Formation bindings) +getProgramMetrics :: Path -> Program -> Either Path ProgramMetrics +getProgramMetrics path (Program bindings) = do + ObjectMetrics{..} <- getObjectMetrics path (Formation bindings) + pure ProgramMetrics{programMetrics = thisObjectMetrics, ..} From cdec22e4c0bfd8ec923f1ca447d5d447f9d7f4a6 Mon Sep 17 00:00:00 2001 From: Danila Danko Date: Tue, 19 Mar 2024 14:52:45 +0300 Subject: [PATCH 11/19] fix(phiSpec): update metrics functions --- eo-phi-normalizer/test/Language/EO/PhiSpec.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/eo-phi-normalizer/test/Language/EO/PhiSpec.hs b/eo-phi-normalizer/test/Language/EO/PhiSpec.hs index 0f2b8508c..ea4793aed 100644 --- a/eo-phi-normalizer/test/Language/EO/PhiSpec.hs +++ b/eo-phi-normalizer/test/Language/EO/PhiSpec.hs @@ -16,7 +16,7 @@ import Data.String (IsString (..)) import Data.String.Interpolate (i) import Data.Yaml (decodeFileThrow) import Language.EO.Phi -import Language.EO.Phi.Metrics (collectMetrics) +import Language.EO.Phi.Metrics (BindingsByPathMetrics (..), ProgramMetrics (..), getProgramMetrics) import Language.EO.Phi.Rules.Common (Context (..), Rule, equalProgram) import Language.EO.Phi.Rules.PhiPaper (rule1, rule6) import Test.EO.Phi @@ -57,7 +57,7 @@ spec = do metricsTests <- runIO $ decodeFileThrow @_ @MetricsTestSet "test/eo/phi/metrics.yaml" forM_ metricsTests.tests $ \test -> do it test.title $ - collectMetrics (fromString @Program test.phi) `shouldBe` test.metrics + getProgramMetrics ["org", "eolang"] (fromString @Program test.phi) `shouldBe` Right test.metrics trim :: String -> String trim = dropWhileEnd isSpace From 68fd00143d61b1fa7363b607b072414f592842f9 Mon Sep 17 00:00:00 2001 From: Danila Danko Date: Tue, 19 Mar 2024 14:53:02 +0300 Subject: [PATCH 12/19] fix(metrics test): update test format --- eo-phi-normalizer/test/eo/phi/metrics.yaml | 26 ++++++++++++++-------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/eo-phi-normalizer/test/eo/phi/metrics.yaml b/eo-phi-normalizer/test/eo/phi/metrics.yaml index d7c9c8c52..a416fcf1a 100644 --- a/eo-phi-normalizer/test/eo/phi/metrics.yaml +++ b/eo-phi-normalizer/test/eo/phi/metrics.yaml @@ -37,15 +37,23 @@ tests: ⟧ } metrics: - program: - dataless: 3 + programMetrics: + dataless: 0 applications: 8 formations: 5 dispatches: 24 - attributes: - - name: org - metrics: - dataless: 2 - applications: 8 - formations: 4 - dispatches: 24 + bindingsByPathMetrics: + path: ['org', 'eolang'] + bindingsMetrics: + - name: prints-itself + metrics: + dataless: 0 + applications: 4 + formations: 1 + dispatches: 11 + - name: prints-itself-to-console + metrics: + dataless: 0 + applications: 4 + formations: 1 + dispatches: 13 From b70ed954abfa86047ebb661f3530aef446c47fe0 Mon Sep 17 00:00:00 2001 From: Danila Danko Date: Tue, 19 Mar 2024 15:00:13 +0300 Subject: [PATCH 13/19] fix(site): in the sample program, make the top-level attribute attached to a formation --- site/docs/src/common/sample-program.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/site/docs/src/common/sample-program.md b/site/docs/src/common/sample-program.md index 1b35d6a58..921f17d29 100644 --- a/site/docs/src/common/sample-program.md +++ b/site/docs/src/common/sample-program.md @@ -13,7 +13,7 @@ cat > program.phi < Date: Tue, 19 Mar 2024 15:03:07 +0300 Subject: [PATCH 14/19] feat(docs): document bindings-by-path --- site/docs/src/commands/normalizer-metrics.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/site/docs/src/commands/normalizer-metrics.md b/site/docs/src/commands/normalizer-metrics.md index 08b57de5d..a75953eaf 100644 --- a/site/docs/src/commands/normalizer-metrics.md +++ b/site/docs/src/commands/normalizer-metrics.md @@ -88,3 +88,9 @@ cat program.phi | normalizer metrics "formations": 5 } ``` + +### `--bindings-by-path` + +```$ as console +normalizer metrics --bindings-by-path "a" program.phi +``` From 0a367aaf757b5f7527d94af30eef3a5e78504409 Mon Sep 17 00:00:00 2001 From: Danila Danko Date: Tue, 19 Mar 2024 15:04:40 +0300 Subject: [PATCH 15/19] chore(site): run mdsh --- site/docs/src/commands/normalizer-metrics.md | 89 +++++++++++++++++-- .../docs/src/commands/normalizer-transform.md | 22 ++--- 2 files changed, 90 insertions(+), 21 deletions(-) diff --git a/site/docs/src/commands/normalizer-metrics.md b/site/docs/src/commands/normalizer-metrics.md index a75953eaf..cd0898f2e 100644 --- a/site/docs/src/commands/normalizer-metrics.md +++ b/site/docs/src/commands/normalizer-metrics.md @@ -48,6 +48,7 @@ normalizer metrics --help ```console Usage: normalizer metrics [FILE] [-o|--output-file FILE] + [-b|--bindings-by-path PATH] Collect metrics for a PHI program. @@ -56,6 +57,10 @@ Available options: read from stdin. -o,--output-file FILE Output to FILE. When this option is not specified, output to stdout. + -b,--bindings-by-path PATH + Report metrics for bindings of a formation accessible + in a program by a PATH. The default PATH is empty. + Example of a PATH: 'org.eolang'. -h,--help Show this help text ``` @@ -67,10 +72,26 @@ normalizer metrics program.phi ```json { - "applications": 1, - "dataless": 5, - "dispatches": 5, - "formations": 5 + "bindingsByPathMetrics": { + "bindingsMetrics": [ + { + "metrics": { + "applications": 1, + "dataless": 1, + "dispatches": 4, + "formations": 4 + }, + "name": "a" + } + ], + "path": [] + }, + "programMetrics": { + "applications": 1, + "dataless": 1, + "dispatches": 4, + "formations": 5 + } } ``` @@ -82,10 +103,26 @@ cat program.phi | normalizer metrics ```json { - "applications": 1, - "dataless": 5, - "dispatches": 5, - "formations": 5 + "bindingsByPathMetrics": { + "bindingsMetrics": [ + { + "metrics": { + "applications": 1, + "dataless": 1, + "dispatches": 4, + "formations": 4 + }, + "name": "a" + } + ], + "path": [] + }, + "programMetrics": { + "applications": 1, + "dataless": 1, + "dispatches": 4, + "formations": 5 + } } ``` @@ -94,3 +131,39 @@ cat program.phi | normalizer metrics ```$ as console normalizer metrics --bindings-by-path "a" program.phi ``` + +```console +{ + "bindingsByPathMetrics": { + "bindingsMetrics": [ + { + "metrics": { + "applications": 0, + "dataless": 0, + "dispatches": 2, + "formations": 2 + }, + "name": "b" + }, + { + "metrics": { + "applications": 1, + "dataless": 1, + "dispatches": 2, + "formations": 1 + }, + "name": "e" + } + ], + "path": [ + "a" + ] + }, + "programMetrics": { + "applications": 1, + "dataless": 1, + "dispatches": 4, + "formations": 5 + } +} +``` diff --git a/site/docs/src/commands/normalizer-transform.md b/site/docs/src/commands/normalizer-transform.md index 68cdc1eaf..14d3b669e 100644 --- a/site/docs/src/commands/normalizer-transform.md +++ b/site/docs/src/commands/normalizer-transform.md @@ -104,10 +104,10 @@ normalizer transform --rules ./eo-phi-normalizer/test/eo/phi/rules/yegor.yaml pr ```console Rule set based on Yegor's draft Input: -{ ⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b (c ↦ ⟦ ⟧).d ⟧.e ⟧ } +{ ⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b (c ↦ ⟦ ⟧).d ⟧ ⟧ } ==================================================== Result 1 out of 1: -{ ⟦ a ↦ ξ.b (c ↦ ⟦ ⟧).d (ρ ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧ ⟧) ⟧ } +{ ⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b (c ↦ ⟦ ⟧).d ⟧ ⟧ } ---------------------------------------------------- ``` @@ -122,11 +122,10 @@ normalizer transform --chain --rules ./eo-phi-normalizer/test/eo/phi/rules/yegor ```console Rule set based on Yegor's draft Input: -{ ⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b (c ↦ ⟦ ⟧).d ⟧.e ⟧ } +{ ⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b (c ↦ ⟦ ⟧).d ⟧ ⟧ } ==================================================== Result 1 out of 1: -[ 1 / 2 ]{ ⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b (c ↦ ⟦ ⟧).d ⟧.e ⟧ } -[ 2 / 2 ]{ ⟦ a ↦ ξ.b (c ↦ ⟦ ⟧).d (ρ ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧ ⟧) ⟧ } +[ 1 / 1 ]{ ⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b (c ↦ ⟦ ⟧).d ⟧ ⟧ } ---------------------------------------------------- ``` @@ -138,12 +137,9 @@ normalizer transform --json --chain --rules ./eo-phi-normalizer/test/eo/phi/rule ```json { - "input": "{ ⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b (c ↦ ⟦ ⟧).d ⟧.e ⟧ }", + "input": "{ ⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b (c ↦ ⟦ ⟧).d ⟧ ⟧ }", "output": [ - [ - "{ ⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b (c ↦ ⟦ ⟧).d ⟧.e ⟧ }", - "{ ⟦ a ↦ ξ.b (c ↦ ⟦ ⟧).d (ρ ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧ ⟧) ⟧ }" - ] + ["{ ⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b (c ↦ ⟦ ⟧).d ⟧ ⟧ }"] ] } ``` @@ -155,7 +151,7 @@ normalizer transform --single --rules ./eo-phi-normalizer/test/eo/phi/rules/yego ``` ```console -{ ⟦ a ↦ ξ.b (c ↦ ⟦ ⟧).d (ρ ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧ ⟧) ⟧ } +{ ⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b (c ↦ ⟦ ⟧).d ⟧ ⟧ } ``` ### `--single` `--json` @@ -165,7 +161,7 @@ normalizer transform --single --json --rules ./eo-phi-normalizer/test/eo/phi/rul ``` ```console -"{ ⟦ a ↦ ξ.b (c ↦ ⟦ ⟧).d (ρ ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧ ⟧) ⟧ }" +"{ ⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b (c ↦ ⟦ ⟧).d ⟧ ⟧ }" ``` ### `FILE` not specified (read from stdin) @@ -175,5 +171,5 @@ cat program.phi | normalizer transform --single --json --rules ./eo-phi-normaliz ``` ```console -"{ ⟦ a ↦ ξ.b (c ↦ ⟦ ⟧).d (ρ ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧ ⟧) ⟧ }" +"{ ⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b (c ↦ ⟦ ⟧).d ⟧ ⟧ }" ``` From efa6035bf21f88d75685e2dc3cda1dce9933c0d8 Mon Sep 17 00:00:00 2001 From: Danila Danko Date: Tue, 19 Mar 2024 15:09:20 +0300 Subject: [PATCH 16/19] refactor(tests): remove redundant import --- eo-phi-normalizer/test/Language/EO/PhiSpec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/eo-phi-normalizer/test/Language/EO/PhiSpec.hs b/eo-phi-normalizer/test/Language/EO/PhiSpec.hs index 5f0e58382..a51d235f2 100644 --- a/eo-phi-normalizer/test/Language/EO/PhiSpec.hs +++ b/eo-phi-normalizer/test/Language/EO/PhiSpec.hs @@ -16,7 +16,7 @@ import Data.String (IsString (..)) import Data.String.Interpolate (i) import Data.Yaml (decodeFileThrow) import Language.EO.Phi -import Language.EO.Phi.Metrics (BindingsByPathMetrics (..), ProgramMetrics (..), getProgramMetrics) +import Language.EO.Phi.Metrics (getProgramMetrics) import Language.EO.Phi.Rules.Common (Rule, defaultContext, equalProgram) import Language.EO.Phi.Rules.PhiPaper (rule1, rule6) import Test.EO.Phi From 217c8de072b10dbf9ae3626c48f7ca33246e92e5 Mon Sep 17 00:00:00 2001 From: Danila Danko Date: Tue, 19 Mar 2024 15:20:07 +0300 Subject: [PATCH 17/19] chore(site): run mdsh --- site/docs/src/commands/normalizer.md | 1 + 1 file changed, 1 insertion(+) diff --git a/site/docs/src/commands/normalizer.md b/site/docs/src/commands/normalizer.md index 045acedbb..a31e4083a 100644 --- a/site/docs/src/commands/normalizer.md +++ b/site/docs/src/commands/normalizer.md @@ -17,4 +17,5 @@ Available options: Available commands: transform Transform a PHI program. metrics Collect metrics for a PHI program. + dataize Dataize a PHI program. ``` From 94bdd653a2e21a13ce29f101c03c02134f408221 Mon Sep 17 00:00:00 2001 From: Danila Danko Date: Tue, 19 Mar 2024 15:24:05 +0300 Subject: [PATCH 18/19] fix(metrics): update doctests --- eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs b/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs index 48006bbbe..96954f043 100644 --- a/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs +++ b/eo-phi-normalizer/src/Language/EO/Phi/Metrics.hs @@ -241,12 +241,13 @@ data ProgramMetrics = ProgramMetrics -- -- Combine metrics produced by 'getThisObjectMetrics' and 'getBindingsByPathMetrics'. -- --- If no formation is accessible by the path, return a prefix of the path that led to a non-formation when the remaining path wasn't empty. -- >>> getProgramMetrics ["org", "eolang"] "{⟦ org ↦ ⟦ eolang ↦ ⟦ x ↦ ⟦ φ ↦ Φ.org.eolang.bool ( α0 ↦ Φ.org.eolang.bytes (Δ ⤍ 01-) ) ⟧, z ↦ ⟦ y ↦ ⟦ x ↦ ∅, φ ↦ ξ.x ⟧, φ ↦ Φ.org.eolang.bool ( α0 ↦ Φ.org.eolang.bytes (Δ ⤍ 01-) ) ⟧, λ ⤍ Package ⟧, λ ⤍ Package ⟧⟧ }" --- Right (Formation [AlphaBinding (Label (LabelId "x")) (Formation [AlphaBinding Phi (Application (ObjectDispatch (ObjectDispatch (ObjectDispatch GlobalObject (Label (LabelId "org"))) (Label (LabelId "eolang"))) (Label (LabelId "bool"))) [AlphaBinding (Alpha (AlphaIndex "\945\&0")) (Application (ObjectDispatch (ObjectDispatch (ObjectDispatch GlobalObject (Label (LabelId "org"))) (Label (LabelId "eolang"))) (Label (LabelId "bytes"))) [DeltaBinding (Bytes "01-")])])]),AlphaBinding (Label (LabelId "z")) (Formation [AlphaBinding (Label (LabelId "y")) (Formation [EmptyBinding (Label (LabelId "x")),AlphaBinding Phi (ObjectDispatch ThisObject (Label (LabelId "x")))]),AlphaBinding Phi (Application (ObjectDispatch (ObjectDispatch (ObjectDispatch GlobalObject (Label (LabelId "org"))) (Label (LabelId "eolang"))) (Label (LabelId "bool"))) [AlphaBinding (Alpha (AlphaIndex "\945\&0")) (Application (ObjectDispatch (ObjectDispatch (ObjectDispatch GlobalObject (Label (LabelId "org"))) (Label (LabelId "eolang"))) (Label (LabelId "bytes"))) [DeltaBinding (Bytes "01-")])])]),LambdaBinding (Function "Package")]) +-- Right (ProgramMetrics {bindingsByPathMetrics = BindingsByPathMetrics {path = ["org","eolang"], bindingsMetrics = [BindingMetrics {name = "x", metrics = Metrics {dataless = 0, applications = 2, formations = 1, dispatches = 6}},BindingMetrics {name = "z", metrics = Metrics {dataless = 0, applications = 2, formations = 2, dispatches = 7}}]}, programMetrics = Metrics {dataless = 0, applications = 4, formations = 6, dispatches = 13}}) +-- +-- If no formation is accessible by the path, return a prefix of the path that led to a non-formation when the remaining path wasn't empty. -- -- >>> getProgramMetrics ["a"] "{⟦ a ↦ ⟦ b ↦ ⟦ c ↦ ∅, d ↦ ⟦ φ ↦ ξ.ρ.c ⟧ ⟧, e ↦ ξ.b(c ↦ ⟦⟧).d ⟧.e ⟧}" --- Right (ObjectDispatch (Formation [AlphaBinding (Label (LabelId "b")) (Formation [EmptyBinding (Label (LabelId "c")),AlphaBinding (Label (LabelId "d")) (Formation [AlphaBinding Phi (ObjectDispatch (ObjectDispatch ThisObject Rho) (Label (LabelId "c")))])]),AlphaBinding (Label (LabelId "e")) (ObjectDispatch (Application (ObjectDispatch ThisObject (Label (LabelId "b"))) [AlphaBinding (Label (LabelId "c")) (Formation [])]) (Label (LabelId "d")))]) (Label (LabelId "e"))) +-- Left ["a"] getProgramMetrics :: Path -> Program -> Either Path ProgramMetrics getProgramMetrics path (Program bindings) = do ObjectMetrics{..} <- getObjectMetrics path (Formation bindings) From b37cdc1d03eb4b6f7b273271e19016ab084c048d Mon Sep 17 00:00:00 2001 From: Danila Danko Date: Tue, 19 Mar 2024 15:30:17 +0300 Subject: [PATCH 19/19] refactor(any): apply hlint suggestions --- eo-phi-normalizer/src/Language/EO/Phi/Rules/Yaml.hs | 4 ++-- eo-phi-normalizer/test/Language/EO/Rules/PhiPaperSpec.hs | 3 +-- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/eo-phi-normalizer/src/Language/EO/Phi/Rules/Yaml.hs b/eo-phi-normalizer/src/Language/EO/Phi/Rules/Yaml.hs index 050cd5892..88513cf2a 100644 --- a/eo-phi-normalizer/src/Language/EO/Phi/Rules/Yaml.hs +++ b/eo-phi-normalizer/src/Language/EO/Phi/Rules/Yaml.hs @@ -301,9 +301,9 @@ newtype MetaState = MetaState evaluateMetaFuncs' :: Object -> State MetaState Object evaluateMetaFuncs' (MetaFunction (MetaFunctionName "@T") _) = do - res <- gets (Common.intToBytesObject . nuCount) + nuCount' <- gets (Common.intToBytesObject . nuCount) #nuCount += 1 - pure res + pure nuCount' evaluateMetaFuncs' (Formation bindings) = Formation <$> mapM evaluateMetaFuncsBinding bindings evaluateMetaFuncs' (Application obj bindings) = Application <$> evaluateMetaFuncs' obj <*> mapM evaluateMetaFuncsBinding bindings evaluateMetaFuncs' (ObjectDispatch obj a) = ObjectDispatch <$> evaluateMetaFuncs' obj <*> pure a diff --git a/eo-phi-normalizer/test/Language/EO/Rules/PhiPaperSpec.hs b/eo-phi-normalizer/test/Language/EO/Rules/PhiPaperSpec.hs index ff23aef57..2df746ccc 100644 --- a/eo-phi-normalizer/test/Language/EO/Rules/PhiPaperSpec.hs +++ b/eo-phi-normalizer/test/Language/EO/Rules/PhiPaperSpec.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} @@ -231,7 +230,7 @@ defaultSearchLimits :: Int -> SearchLimits defaultSearchLimits = defaultApplicationLimits confluent :: [Rule] -> Property -confluent rulesFromYaml = withMaxSuccess 1000 $ +confluent rulesFromYaml = withMaxSuccess 1_000 $ forAllShrink (resize 40 $ genCriticalPair rulesFromYaml) (shrinkCriticalPair rulesFromYaml) $ \pair@CriticalPair{..} -> within 100_000 $ -- 0.1 second timeout per test