Skip to content

Commit

Permalink
CAD-2907 locli: switch MachTimeline to generalised distribution renderer
Browse files Browse the repository at this point in the history
  • Loading branch information
@deepfire
deepfire committed Jun 10, 2021
1 parent 2f6a978 commit a9102ce
Show file tree
Hide file tree
Showing 3 changed files with 56 additions and 109 deletions.
13 changes: 4 additions & 9 deletions nix/workbench/locli/src/Cardano/Analysis/Driver.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -188,13 +188,14 @@ runMachineTimeline chainInfo logfiles MachineTimelineOutputFiles{..} = do
withFile (unTextOutputFile o) WriteMode $ \hnd -> do
hPutStrLn hnd . T.pack $
printf "--- input: %s" (intercalate " " $ unJsonLogfile <$> srcs)
renderMachTimelineCDF statsHeadP statsFormatP statsFormatPF s hnd
mapM_ (T.hPutStrLn hnd) (renderDistributions s)
-- renderMachTimelineCDF statsHeadP statsFormatP statsFormatPF s hnd
renderSlotTimeline slotHeadP slotFormatP False xs hnd
renderExportStats :: RunScalars -> MachTimeline -> CsvOutputFile -> IO ()
renderExportStats rs s (CsvOutputFile o) =
renderExportStats rs _s (CsvOutputFile o) =
withFile o WriteMode $
\h -> do
renderMachTimelineCDF statsHeadE statsFormatE statsFormatEF s h
-- renderMachTimelineCDF statsHeadE statsFormatE statsFormatEF s h
mapM_ (hPutStrLn h) $
renderChainInfoExport chainInfo
<>
Expand All @@ -204,12 +205,6 @@ runMachineTimeline chainInfo logfiles MachineTimelineOutputFiles{..} = do
withFile o WriteMode $
renderSlotTimeline slotHeadE slotFormatE True xs

renderMachTimelineCDF :: Text -> Text -> Text -> MachTimeline -> Handle -> IO ()
renderMachTimelineCDF statHead statFmt propFmt timeline hnd = do
hPutStrLn hnd statHead
forM_ (toDistribLines statFmt propFmt timeline) $
hPutStrLn hnd

renderDerivedSlots :: [DerivedSlot] -> CsvOutputFile -> IO ()
renderDerivedSlots slots (CsvOutputFile o) = do
withFile o WriteMode $ \hnd -> do
Expand Down
115 changes: 26 additions & 89 deletions nix/workbench/locli/src/Cardano/Analysis/MachTimeline.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,18 +7,16 @@
{-# OPTIONS_GHC -Wno-incomplete-patterns -Wno-name-shadowing #-}
module Cardano.Analysis.MachTimeline (module Cardano.Analysis.MachTimeline) where

import Prelude (String, error)
import Prelude (String, (!!), error)
import Cardano.Prelude

import Control.Arrow ((&&&), (***))
import qualified Data.Aeson as AE
import Data.Aeson
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Text as T
import Data.Vector (Vector)
import qualified Data.Vector as Vec
import qualified Data.Map.Strict as Map
import Text.Printf (printf)

import Data.Time.Clock (NominalDiffTime, UTCTime)
import qualified Data.Time.Clock as Time
Expand All @@ -30,6 +28,7 @@ import Data.Distribution

import Cardano.Profile
import Cardano.Unlog.LogObject hiding (Text)
import Cardano.Unlog.Render
import Cardano.Unlog.Resources
import Cardano.Unlog.SlotStats

Expand Down Expand Up @@ -57,6 +56,30 @@ data MachTimeline
}
deriving Show

instance RenderDistributions MachTimeline where
rdFields =
-- Width LeftPad
[ Field 4 0 "Miss" "ratio" $ DFloat sMissDistrib
, Field 6 0 "" "ChkΔt" $ DDeltaT sSpanCheckDistrib
, Field 6 0 "" "LeadΔt" $ DDeltaT sSpanLeadDistrib
, Field 4 0 "Block" "gap" $ DWord64 sBlocklessDistrib
, Field 5 0 "Dens" "ity" $ DFloat sDensityDistrib
, Field 3 0 "CPU" "%" $ DWord64 (rCentiCpu . sResourceDistribs)
, Field 3 0 "GC" "%" $ DWord64 (rCentiGC . sResourceDistribs)
, Field 3 0 "MUT" "%" $ DWord64 (rCentiMut . sResourceDistribs)
, Field 3 0 "GC " "Maj" $ DWord64 (rGcsMajor . sResourceDistribs)
, Field 3 0 "flt " "Min" $ DWord64 (rGcsMinor . sResourceDistribs)
, Field 5 0 (m!!0) "RSS" $ DWord64 (rRSS . sResourceDistribs)
, Field 5 0 (m!!1) "Heap" $ DWord64 (rHeap . sResourceDistribs)
, Field 5 0 (m!!2) "Live" $ DWord64 (rLive . sResourceDistribs)
, Field 5 0 "Alloc" "MB/s" $ DWord64 (rAlloc . sResourceDistribs)
, Field 5 0 (c!!0) "All" $ DInt sSpanLensCPU85Distrib
, Field 5 0 (c!!1) "EBnd" $ DInt sSpanLensCPU85EBndDistrib
]
where
m = nChunksEachOf 3 6 "Memory usage, MB"
c = nChunksEachOf 2 6 "CPU85% spans"

instance ToJSON MachTimeline where
toJSON MachTimeline{..} = AE.Array $ Vec.fromList
[ AE.Object $ HashMap.fromList
Expand Down Expand Up @@ -176,92 +199,6 @@ slotStatsMachTimeline CInfo{} slots =
missRatio :: Word64 -> Float
missRatio = (/ fromIntegral maxChecks) . fromIntegral

mapMachTimeline ::
Text
-> MachTimeline
-> Text
-> (forall a. Num a => Distribution Float a -> Float)
-> Text
mapMachTimeline statsF MachTimeline{..} desc f =
distribPropertyLine desc
(f sMissDistrib)
(f sSpanCheckDistrib)
(f sSpanLeadDistrib)
(f sBlocklessDistrib)
(f sDensityDistrib)
(f (rCentiCpu sResourceDistribs))
(f (rCentiGC sResourceDistribs))
(f (rCentiMut sResourceDistribs))
(f (rGcsMajor sResourceDistribs))
(f (rGcsMinor sResourceDistribs))
(f (rRSS sResourceDistribs))
(f (rHeap sResourceDistribs))
(f (rLive sResourceDistribs))
(f (rAlloc sResourceDistribs))
(f sSpanLensCPU85Distrib)
(f sSpanLensCPU85EBndDistrib)
(f sSpanLensCPU85RwdDistrib)
where
distribPropertyLine ::
Text
-> Float -> Float -> Float -> Float
-> Float -> Float -> Float
-> Float -> Float
-> Float -> Float -> Float -> Float
-> Float -> Float -> Float
-> Float
-> Text
distribPropertyLine descr miss chkdt leaddt blkl dens cpu gc mut majg ming rss hea liv alc cpu85Sp cpu85SpEBnd cpu85SpRwd = T.pack $
printf (T.unpack statsF)
descr miss chkdt leaddt blkl dens cpu gc mut majg ming rss hea liv alc cpu85Sp cpu85SpEBnd cpu85SpRwd

toDistribLines :: Text -> Text -> MachTimeline -> [Text]
toDistribLines statsF distPropsF s@MachTimeline{..} =
distribLine
<$> ZipList (pctSpec <$> dPercentiles sMissDistrib)
<*> ZipList (max 1 . ceiling . (* fromIntegral (dSize sMissDistrib))
. (1.0 -) . pctFrac
<$> dPercentiles sMissDistrib)
<*> ZipList (pctSample <$> dPercentiles sMissDistrib)
<*> ZipList (pctSample <$> dPercentiles sSpanCheckDistrib)
<*> ZipList (pctSample <$> dPercentiles sSpanLeadDistrib)
<*> ZipList (pctSample <$> dPercentiles sBlocklessDistrib)
<*> ZipList (pctSample <$> dPercentiles sDensityDistrib)
<*> ZipList (pctSample <$> dPercentiles (rCentiCpu sResourceDistribs))
<*> ZipList (min 999 . -- workaround for ghc-8.10.x
pctSample <$> dPercentiles (rCentiGC sResourceDistribs))
<*> ZipList (min 999 . -- workaround for ghc-8.10.x
pctSample <$> dPercentiles (rCentiMut sResourceDistribs))
<*> ZipList (pctSample <$> dPercentiles (rGcsMajor sResourceDistribs))
<*> ZipList (pctSample <$> dPercentiles (rGcsMinor sResourceDistribs))
-- <*> ZipList (pctSample <$> dPercentiles ( sResourceDistribs))
<*> ZipList (pctSample <$> dPercentiles (rRSS sResourceDistribs))
<*> ZipList (pctSample <$> dPercentiles (rHeap sResourceDistribs))
<*> ZipList (pctSample <$> dPercentiles (rLive sResourceDistribs))
<*> ZipList (pctSample <$> dPercentiles (rAlloc sResourceDistribs))
<*> ZipList (pctSample <$> dPercentiles sSpanLensCPU85Distrib)
<*> ZipList (pctSample <$> dPercentiles sSpanLensCPU85EBndDistrib)
<*> ZipList (pctSample <$> dPercentiles sSpanLensCPU85RwdDistrib)
& getZipList
& (<> [ mapMachTimeline distPropsF s "size" (fromIntegral . dSize)
, mapMachTimeline distPropsF s "avg" dAverage
])
where
distribLine ::
PercSpec Float -> Int
-> Float -> NominalDiffTime -> NominalDiffTime -> Word64 -> Float
-> Word64 -> Word64 -> Word64
-> Word64 -> Word64
-> Word64 -> Word64 -> Word64 -> Word64
-> Int -> Int -> Int
-> Text
distribLine ps count miss chkdt' leaddt' blkl dens cpu gc mut
majg ming rss hea liv alc cpu85Sp cpu85SpEBnd cpu85SpRwd = T.pack $
printf (T.unpack statsF)
(renderPercSpec 6 ps) count miss chkdt leaddt blkl dens cpu gc mut majg ming rss hea liv alc cpu85Sp cpu85SpEBnd cpu85SpRwd
where chkdt = T.init $ show chkdt' :: Text
leaddt = T.init $ show leaddt' :: Text

-- The "fold" state that accumulates as we process 'LogObject's into a stream
-- of 'SlotStats'.
data TimelineAccum
Expand Down
37 changes: 26 additions & 11 deletions nix/workbench/locli/src/Cardano/Unlog/Render.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,9 +5,10 @@
{-# LANGUAGE ViewPatterns #-}
module Cardano.Unlog.Render (module Cardano.Unlog.Render) where

import Prelude (head, show)
import Prelude (head, tail, show)
import Cardano.Prelude hiding (head, show)

import Control.Arrow ((&&&))
import Data.List (dropWhileEnd)
import qualified Data.Text as T
import Data.Time.Clock (NominalDiffTime)
Expand Down Expand Up @@ -46,7 +47,7 @@ mapSomeFieldDistribution f a = \case
DDeltaT s -> f (s a)

renderDistributions :: forall a. RenderDistributions a => a -> [Text]
renderDistributions x = (catMaybes [head1, head2]) <> pLines
renderDistributions x = (catMaybes [head1, head2]) <> pLines <> sizeAvg
where
pLines :: [Text]
pLines = fLine <$> [0..(nPercs - 1)]
Expand All @@ -60,26 +61,40 @@ renderDistributions x = (catMaybes [head1, head2]) <> pLines
in T.pack $ case fSelect of
DInt (($x)->d) -> printf ('%':(w++"d")) (getCapPerc d)
DWord64 (($x)->d) -> printf ('%':(w++"d")) (getCapPerc d)
DFloat (($x)->d) -> printf ('%':(w++"f")) (getCapPerc d)
DDeltaT (($x)->d) -> printf ('%':(w++"s"))
(take fWidth . dropWhileEnd (== 's')
. show $ getCapPerc d)
DFloat (($x)->d) -> take fWidth $
printf ('%':'.':((show $ fWidth - 2)++"F")) $
getCapPerc d
DDeltaT (($x)->d) -> take fWidth . dropWhileEnd (== 's') . show $
getCapPerc d

head1, head2 :: Maybe Text
head1 = if all ((== 0) . T.length . fHead1) fields then Nothing
else Just (renderLineHead1 fHead1)
else Just (renderLineHead1 (uncurry T.take . ((+1) . fWidth &&& fHead1)))
head2 = if all ((== 0) . T.length . fHead2) fields then Nothing
else Just (renderLineHead2 fHead2)
else Just (renderLineHead2 (uncurry T.take . ((+1) . fWidth &&& fHead2)))

sizeAvg :: [Text]
sizeAvg = fmap (T.intercalate " ")
[ (T.center (fWidth (head fields)) ' ' "avg" :) $
(\f -> flip (renderField fLeftPad fWidth) f $ const $
mapSomeFieldDistribution
(T.take (fWidth f) .T.pack . printf "%F" . dAverage) x (fSelect f))
<$> tail fields
, (T.center (fWidth (head fields)) ' ' "size" :) $
(\f -> flip (renderField fLeftPad fWidth) f $ const $
mapSomeFieldDistribution
(T.take (fWidth f) . T.pack . show . dSize) x (fSelect f))
<$> tail fields
]

renderLineHead1 = mconcat . renderLine' (const 0) ((+ 1) . fWidth)
renderLineHead2 = mconcat . renderLine' fLeftPad ((+ 1) . fWidth)
renderLineDist = T.intercalate " " . renderLine' fLeftPad fWidth

renderLine' ::
(Field a -> Int) -> (Field a -> Int) -> (Field a -> Text) -> [Text]
renderLine' lpfn wfn rfn = flip fmap fields $
\f ->
(T.replicate (lpfn f) " ") <> T.center (wfn f) ' ' (rfn f)
renderLine' lpfn wfn rfn = renderField lpfn wfn rfn <$> fields
renderField lpfn wfn rfn f = (T.replicate (lpfn f) " ") <> T.center (wfn f) ' ' (rfn f)

fields :: [Field a]
fields = percField : rdFields
Expand Down

0 comments on commit a9102ce

Please sign in to comment.