Skip to content

Commit 9ec2c88

Browse files
deepfiredeepfire
committed
locli: report templating
1 parent fdf87fd commit 9ec2c88

File tree

13 files changed

+439
-5
lines changed

13 files changed

+439
-5
lines changed

‎bench/locli/locli.cabal

+3
Original file line numberDiff line numberDiff line change
@@ -56,6 +56,7 @@ library
5656
Data.DataDomain
5757

5858
Cardano.Command
59+
Cardano.Report
5960
Cardano.TopHandler
6061
Cardano.Util
6162

@@ -91,6 +92,7 @@ library
9192
, containers
9293
, deepseq
9394
, directory
95+
, ede
9496
, extra
9597
, filepath
9698
, file-embed
@@ -114,6 +116,7 @@ library
114116
, trace-resources
115117
, transformers
116118
, transformers-except
119+
, unix
117120
, unordered-containers
118121
, utf8-string
119122
, vector

‎bench/locli/src/Cardano/Analysis/API.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,7 @@ import Cardano.Util
3737
-- | Results of block propagation analysis.
3838
data BlockProp f
3939
= BlockProp
40-
{ bpVersion :: !Version
40+
{ bpVersion :: !Cardano.Analysis.Version.Version
4141
, bpDomainSlots :: !(DataDomain SlotNo)
4242
, bpDomainBlocks :: !(DataDomain BlockNo)
4343
, bpForgerChecks :: !(CDF f NominalDiffTime)
@@ -148,7 +148,7 @@ data BPErrorKind
148148
-- | The top-level representation of the machine timeline analysis results.
149149
data MachPerf f
150150
= MachPerf
151-
{ sVersion :: !Version
151+
{ sVersion :: !Cardano.Analysis.Version.Version
152152
, sDomainSlots :: !(DataDomain SlotNo)
153153
-- distributions
154154
, sMissCDF :: !(CDF f Double)

‎bench/locli/src/Cardano/Analysis/Context.hs

+67-1
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,12 @@
11
{-# LANGUAGE DeriveAnyClass #-}
2+
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
23
{-# LANGUAGE StrictData #-}
34
module Cardano.Analysis.Context (module Cardano.Analysis.Context) where
45

56
import Cardano.Prelude
67

7-
import Data.Aeson (FromJSON, ToJSON)
8+
import Data.Aeson (FromJSON (..), ToJSON (..), withObject, object, (.:), (.:?), (.=))
9+
import Data.Text qualified as T
810
import Data.Time.Clock (UTCTime, NominalDiffTime)
911

1012

@@ -52,10 +54,74 @@ data GeneratorProfile
5254
}
5355
deriving (Generic, Show, FromJSON, ToJSON)
5456

57+
newtype Commit = Commit { unCommit :: Text } deriving newtype (Show, FromJSON, ToJSON)
58+
newtype Branch = Branch { unBranch :: Text } deriving newtype (Show, FromJSON, ToJSON)
59+
newtype Version = Version { unVersion :: Text } deriving newtype (Show, FromJSON, ToJSON)
60+
61+
unsafeShortenCommit :: Int -> Commit -> Commit
62+
unsafeShortenCommit n (Commit c) = Commit (T.take n c)
63+
64+
data Manifest
65+
= Manifest
66+
{ mNode :: !Commit
67+
, mNodeApproxVer :: !Version
68+
, mNodeBranch :: !Branch
69+
, mNodeStatus :: !Text
70+
, mNetwork :: !Commit
71+
, mLedger :: !Commit
72+
, mPlutus :: !Commit
73+
, mCrypto :: !Commit
74+
, mBase :: !Commit
75+
, mPrelude :: !Commit
76+
}
77+
deriving (Generic, Show)
78+
79+
unsafeShortenManifest :: Int -> Manifest -> Manifest
80+
unsafeShortenManifest n m@Manifest{..} =
81+
m { mNode = unsafeShortenCommit n mNode
82+
, mNetwork = unsafeShortenCommit n mNetwork
83+
, mLedger = unsafeShortenCommit n mLedger
84+
, mPlutus = unsafeShortenCommit n mPlutus
85+
, mCrypto = unsafeShortenCommit n mCrypto
86+
, mBase = unsafeShortenCommit n mBase
87+
, mPrelude = unsafeShortenCommit n mPrelude
88+
}
89+
90+
instance FromJSON Manifest where
91+
parseJSON = withObject "Manifest" $ \v -> do
92+
mNode <- v .: "cardano-node"
93+
mNodeBranch <- v .:? "cardano-node-branch" <&> fromMaybe (Branch "unknown")
94+
mNodeApproxVer <- v .:? "cardano-node-version" <&> fromMaybe (Version "unknown")
95+
mNodeStatus <- v .: "cardano-node-status"
96+
mNetwork <- v .: "ouroboros-network"
97+
mLedger <- v .: "cardano-ledger"
98+
mPlutus <- v .: "plutus"
99+
mCrypto <- v .: "cardano-crypto"
100+
mBase <- v .: "cardano-base"
101+
mPrelude <- v .: "cardano-prelude"
102+
pure Manifest{..}
103+
104+
instance ToJSON Manifest where
105+
toJSON Manifest{..} =
106+
object
107+
[ "cardano-node" .= mNode
108+
, "cardano-node-branch" .= mNodeBranch
109+
, "cardano-node-version" .= mNodeApproxVer
110+
, "cardano-node-status" .= mNodeStatus
111+
, "ouroboros-network" .= mNetwork
112+
, "cardano-ledger" .= mLedger
113+
, "plutus" .= mPlutus
114+
, "cardano-crypto" .= mCrypto
115+
, "cardano-base" .= mBase
116+
, "cardano-prelude" .= mPrelude
117+
]
118+
55119
data Metadata
56120
= Metadata
57121
{ tag :: Text
122+
, batch :: Text
58123
, profile :: Text
59124
, era :: Text
125+
, manifest :: Manifest
60126
}
61127
deriving (Generic, Show, FromJSON, ToJSON)

‎bench/locli/src/Cardano/Analysis/Ground.hs

+25
Original file line numberDiff line numberDiff line change
@@ -82,6 +82,11 @@ data HostDeduction
8282
---
8383
--- Files
8484
---
85+
newtype InputDir
86+
= InputDir { unInputDir :: FilePath }
87+
deriving (Show, Eq)
88+
deriving newtype (NFData)
89+
8590
newtype JsonLogfile
8691
= JsonLogfile { unJsonLogfile :: FilePath }
8792
deriving (Show, Eq)
@@ -103,6 +108,10 @@ newtype OrgOutputFile
103108
= OrgOutputFile { unOrgOutputFile :: FilePath }
104109
deriving (Show, Eq)
105110

111+
newtype TextInputFile
112+
= TextInputFile { unTextInputFile :: FilePath }
113+
deriving (Show, Eq)
114+
106115
newtype TextOutputFile
107116
= TextOutputFile { unTextOutputFile :: FilePath }
108117
deriving (Show, Eq)
@@ -118,6 +127,14 @@ newtype OutputFile
118127
---
119128
--- Parsers
120129
---
130+
optInputDir :: String -> String -> Parser InputDir
131+
optInputDir optname desc =
132+
fmap InputDir $
133+
Opt.option Opt.str
134+
$ long optname
135+
<> metavar "DIR"
136+
<> help desc
137+
121138
optJsonLogfile :: String -> String -> Parser JsonLogfile
122139
optJsonLogfile optname desc =
123140
fmap JsonLogfile $
@@ -155,6 +172,14 @@ optGnuplotOutputFile optname desc =
155172
<> metavar "CDF-OUTFILE"
156173
<> help desc
157174

175+
optTextInputFile :: String -> String -> Parser TextInputFile
176+
optTextInputFile optname desc =
177+
fmap TextInputFile $
178+
Opt.option Opt.str
179+
$ long optname
180+
<> metavar "TEXT-INFILE"
181+
<> help desc
182+
158183
optTextOutputFile :: String -> String -> Parser TextOutputFile
159184
optTextOutputFile optname desc =
160185
fmap TextOutputFile $

‎bench/locli/src/Cardano/Analysis/Run.hs

+3-1
Original file line numberDiff line numberDiff line change
@@ -30,7 +30,7 @@ data Anchor
3030
, aFilters :: [FilterName]
3131
, aSlots :: Maybe (DataDomain SlotNo)
3232
, aBlocks :: Maybe (DataDomain BlockNo)
33-
, aVersion :: Version
33+
, aVersion :: Cardano.Analysis.Version.Version
3434
, aWhen :: UTCTime
3535
}
3636

@@ -113,6 +113,8 @@ instance FromJSON RunPartial where
113113
--
114114
tag <- meta .: "tag"
115115
profile <- meta .: "profile"
116+
batch <- meta .: "batch"
117+
manifest <- meta .: "manifest"
116118

117119
eraGtor <- generator .:? "era"
118120
eraTop <- profile_content .:? "era"

‎bench/locli/src/Cardano/Command.hs

+34
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@ module Cardano.Command (module Cardano.Command) where
44
import Cardano.Prelude hiding (State, head)
55

66
import Data.Aeson qualified as Aeson
7+
import Data.ByteString qualified as BS
78
import Data.ByteString.Lazy.Char8 qualified as LBS
89
import Data.Text (pack)
910
import Data.Text qualified as T
@@ -13,6 +14,7 @@ import Options.Applicative
1314
import Options.Applicative qualified as Opt
1415

1516
import System.FilePath
17+
import System.Posix.Files qualified as IO
1618

1719
import Cardano.Analysis.API
1820
import Cardano.Analysis.BlockProp
@@ -23,6 +25,7 @@ import Cardano.Analysis.MachPerf
2325
import Cardano.Analysis.Run
2426
import Cardano.Unlog.LogObject hiding (Text)
2527
import Cardano.Unlog.Render
28+
import Cardano.Report
2629
import Data.CDF
2730

2831
data CommandError
@@ -161,6 +164,18 @@ parseChainCommand =
161164
, op "render-multi-clusterperf" "Write multi-run cluster performance results"
162165
(writerOpts RenderMultiClusterPerf "Render"
163166
<*> parsePerfSubset)
167+
168+
, op "compare" "Generate a report comparing multiple runs"
169+
(Compare
170+
<$> optInputDir "ede" "Directory with EDE templates."
171+
<*> optional
172+
(optTextInputFile "template" "Template to use as base.")
173+
<*> optTextOutputFile "report" "Report .org file to create."
174+
<*> some
175+
((,)
176+
<$> optJsonInputFile "run-metafile" "The meta.json file of a benchmark run"
177+
<*> optJsonInputFile "shelley-genesis" "Genesis file of the run"
178+
))
164179
])
165180
where
166181
op :: String -> String -> Parser a -> Mod CommandFields a
@@ -249,6 +264,9 @@ data ChainCommand
249264
| ComputeMultiClusterPerf
250265
| RenderMultiClusterPerf RenderMode TextOutputFile PerfSubset
251266

267+
| Compare InputDir (Maybe TextInputFile) TextOutputFile
268+
[(JsonInputFile RunPartial, JsonInputFile Genesis)]
269+
252270
deriving Show
253271

254272
data State
@@ -557,6 +575,22 @@ runChainCommand s@State{sMultiClusterPerf=Just (MultiClusterPerf perf)}
557575
runChainCommand _ c@RenderMultiClusterPerf{} = missingCommandData c
558576
["multi-run cluster preformance stats"]
559577

578+
runChainCommand s c@(Compare ede mTmpl outf@(TextOutputFile outfp) runs) = do
579+
xs :: [Run] <- forM runs $
580+
\(mf,gf)-> readRun gf mf & firstExceptT (fromAnalysisError c)
581+
(tmpl, orgReport) <- case xs of
582+
baseline:deltas@(_:_) -> liftIO $
583+
Cardano.Report.generate ede mTmpl baseline deltas
584+
_ -> throwE $ CommandError c $ mconcat
585+
[ "At least two runs required for comparison." ]
586+
dumpText "report" [orgReport] outf
587+
& firstExceptT (CommandError c)
588+
589+
let tmplPath = Cardano.Analysis.API.replaceExtension outfp "ede"
590+
liftIO . unlessM (IO.fileExist tmplPath) $
591+
BS.writeFile tmplPath tmpl
592+
593+
pure s
560594

561595
missingCommandData :: ChainCommand -> [String] -> ExceptT CommandError IO a
562596
missingCommandData c xs =

‎bench/locli/src/Cardano/Report.hs

+120
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,120 @@
1+
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
module Cardano.Report
4+
( module Cardano.Report
5+
)
6+
where
7+
8+
import Cardano.Prelude
9+
10+
import Data.Aeson (FromJSON (..), ToJSON (..), object)
11+
import Data.ByteString qualified as BS
12+
import Data.HashMap.Lazy qualified as HM
13+
import Data.List (last)
14+
import Data.Text qualified as T
15+
import Data.Text.Lazy qualified as LT
16+
import Data.Time.Clock
17+
import System.Posix.User
18+
19+
import Text.EDE
20+
21+
import Cardano.Analysis.API
22+
import Cardano.Analysis.Context
23+
import Cardano.Analysis.Ground
24+
import Cardano.Analysis.Run hiding (Version)
25+
import Cardano.Analysis.Run qualified as Run
26+
27+
28+
newtype Author = Author { unAuthor :: Text } deriving newtype (FromJSON, ToJSON)
29+
newtype Revision = Revision { unRevision :: Int } deriving newtype (FromJSON, ToJSON)
30+
newtype ShortId = ShortId { unShortId :: Text } deriving newtype (FromJSON, ToJSON)
31+
32+
data Report
33+
= Report
34+
{ rAuthor :: !Author
35+
, rDate :: !UTCTime
36+
, rRevision :: !Revision
37+
, rLocliVersion :: !Run.Version
38+
, rTarget :: !Version
39+
}
40+
instance ToJSON Report where
41+
toJSON Report{..} =
42+
object
43+
[ "author" .= rAuthor
44+
, "date" .= rDate
45+
, "revision" .= rRevision
46+
, "locli" .= rLocliVersion
47+
, "target" .= rTarget
48+
]
49+
50+
getReport :: Version -> Maybe Revision -> IO Report
51+
getReport rTarget mrev = do
52+
rAuthor <- (getUserEntryForName =<< getLoginName) <&> Author . T.pack . userGecos
53+
rDate <- getCurrentTime
54+
let rRevision = fromMaybe (Revision 1) mrev
55+
rLocliVersion = Run.getVersion
56+
pure Report{..}
57+
58+
data Workload
59+
= WValue
60+
| WPlutus
61+
62+
instance ToJSON Workload where
63+
toJSON = \case
64+
WValue -> "Value"
65+
WPlutus -> "Plutus"
66+
67+
data RunSpec
68+
= RunSpec
69+
{ rsMeta :: !Metadata
70+
, rsShortId :: !ShortId
71+
, rsWorkload :: !Workload
72+
, rsManifest :: !Manifest
73+
}
74+
75+
instance ToJSON RunSpec where
76+
toJSON RunSpec{rsManifest=Manifest{..},..} =
77+
object
78+
[ "meta" .= rsMeta
79+
, "id" .= rsShortId
80+
, "workload" .= rsWorkload
81+
, "branch" .= mNodeBranch
82+
, "ver" .= mNodeApproxVer
83+
, "rev" .=
84+
object
85+
[ "node" .= mNode
86+
, "network" .= mNetwork
87+
, "ledger" .= mLedger
88+
, "plutus" .= mPlutus
89+
, "crypto" .= mCrypto
90+
, "base" .= mBase
91+
, "prelude" .= mPrelude
92+
]
93+
]
94+
95+
liftRunSpec :: Run -> RunSpec
96+
liftRunSpec Run{..} =
97+
RunSpec
98+
{ rsMeta = metadata
99+
, rsShortId = ShortId "rc4"
100+
, rsWorkload = WValue
101+
, rsManifest = manifest metadata & unsafeShortenManifest 5
102+
}
103+
104+
generate :: InputDir -> Maybe TextInputFile -> Run -> [Run] -> IO (ByteString, Text)
105+
generate (InputDir ede) mReport (liftRunSpec -> base) (fmap liftRunSpec -> runs) = do
106+
ctx <- getReport (last runs & rsManifest & mNodeApproxVer) Nothing
107+
tmplRaw <- BS.readFile (maybe defaultReportPath unTextInputFile mReport)
108+
tmpl <- parseWith defaultSyntax (includeFile ede) "report" tmplRaw
109+
result (error . show) (pure . (tmplRaw,) . LT.toStrict) $ tmpl >>=
110+
\x ->
111+
renderWith fenv x (env ctx base runs)
112+
where
113+
defaultReportPath = ede <> "/report.ede"
114+
fenv = HM.fromList
115+
[]
116+
env rc b rs = fromPairs
117+
[ "report" .= rc
118+
, "base" .= b
119+
, "runs" .= rs
120+
]

0 commit comments

Comments
 (0)