ghc-build-stats (empty) → 0.1.0.0
raw patch · 8 files changed
+318/−0 lines, 8 filesdep +aesondep +basedep +bytestring
Dependencies added: aeson, base, bytestring, containers, ghc-build-stats, optparse-applicative, psqueues, text
Files
- CHANGELOG.md +5/−0
- LICENSE +29/−0
- app/Main.hs +5/−0
- ghc-build-stats.cabal +46/−0
- src/ChromeTracingExport.hs +25/−0
- src/Lib.hs +69/−0
- src/Simulate.hs +125/−0
- src/WeighedNode.hs +14/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for ghc-build-stats++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2026, Teo Camarasu+++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of the copyright holder nor the names of its+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ app/Main.hs view
@@ -0,0 +1,5 @@+module Main where+import qualified Lib++main = Lib.main+
+ ghc-build-stats.cabal view
@@ -0,0 +1,46 @@+cabal-version: 3.0+name: ghc-build-stats+version: 0.1.0.0+synopsis: A tool for analysing the output of ghc-build-stats-plugin+description: A tool for analysing the output of ghc-build-stats-plugin+license: BSD-3-Clause+license-file: LICENSE+author: Teo Camarasu+maintainer: teofilcamarasu@gmail.com+copyright: ghc-build-stats Contributors+category: Development+build-type: Simple+extra-doc-files: CHANGELOG.md+tested-with: + GHC ==9.10+ || ==9.12+ || ==9.14++common warnings+ ghc-options: -Wall++library+ import: warnings+ exposed-modules:+ WeighedNode+ Lib + ChromeTracingExport+ Simulate+ build-depends:+ aeson >= 2.2 && < 2.3+ , base >= 4.20 && < 4.23+ , bytestring >= 0.12 && < 0.13+ , containers >= 0.7 && < 0.9+ , psqueues >= 0.2 && < 0.3+ , text >= 2.1.3 && < 2.2+ , optparse-applicative >=0.18.1 && <0.19.1+ hs-source-dirs: src+ default-language: GHC2024++executable ghc-build-stats+ main-is: Main.hs+ hs-source-dirs: app+ default-language: Haskell2010+ build-depends:+ , base+ , ghc-build-stats
+ src/ChromeTracingExport.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings #-}+module ChromeTracingExport where++import Data.Aeson (Encoding, (.=))+import Data.Text (Text)++import qualified Data.Aeson as JSON++mkCompleteEvent+ :: Text -- ^ name+ -> Text -- ^ category+ -> Double -- ^ timestamp+ -> Double -- ^ duration+ -> Int -- ^ pid+ -> Int -- ^ thread id+ -> Encoding+mkCompleteEvent name cat timestamp duration pid tid =+ JSON.pairs $+ ("name" .= name)+ <> ("cat" .= cat)+ <> ("ts" .= timestamp)+ <> ("dur" .= duration)+ <> ("pid" .= pid)+ <> ("tid" .= (tid + 1))+ <> ("ph" .= ("X" :: Text)) -- indicates Complete Event
+ src/Lib.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedRecordDot #-}+module Lib where+import Prelude hiding (writeFile)+import Control.Arrow (first)+import Data.Aeson (FromJSON(..))+import Data.Aeson.Encoding (encodingToLazyByteString)+import Data.ByteString.Lazy (writeFile)+import Data.Foldable (traverse_, for_)+import Data.Function (on)+import Data.List (sortBy)+import Data.Maybe+import Data.Text (pack)+import GHC.Generics+import Text.Printf+import Options.Applicative+import qualified Data.Aeson.Encoding as Encoding+import qualified Data.Aeson.Decoding as Aeson+import qualified Data.Map as M+import qualified Data.ByteString.Char8 as BS++import WeighedNode+import Simulate (simulate, critPath, ModEvent (..))+import ChromeTracingExport++data JSONNode = JSONNode { name :: ModName, duration :: Double, deps :: [ModName]}+ deriving (Generic, FromJSON)++data Options =+ Options+ { simulatedCores :: Int+ , inputFile :: FilePath+ }++optionsParser :: Parser Options+optionsParser =+ Options+ <$> option auto+ ( long "cores"+ <> help "The amount of simulated cores"+ <> showDefault+ <> value 8+ <> metavar "CORES")+ <*> argument str (metavar "INPUT")++main :: IO ()+main = do+ options <- execParser $ info (optionsParser <**> helper) (progDesc "Analyse the build statistics of INPUT")+ input <- BS.readFile options.inputFile+ let+ jsonNodes :: [JSONNode]+ jsonNodes = mapMaybe Aeson.decodeStrict $ BS.lines input+ let+ wgraph = M.fromList [(node.name, WeighedNode node.deps (node.duration / 1000) 0) | node <- jsonNodes]+ timePath = critPath wgraph nodeEopTime+ putStrLn "10 slowest modules to compile:"+ let slowMods = zip [(1 ::Int)..] . take 10 . sortBy (flip compare `on` (nodeEopTime . snd)) . M.toList $ wgraph+ for_ slowMods $ \(ix, (modName, node)) ->+ putStrLn $ printf "%2d, %-5.2fs, %s" ix (node.nodeEopTime / 1000) modName+ putStrLn $ printf "Critical path, %-5.2fs total, composed of %d modules:" (fst timePath/1000) (length $ snd timePath)+ traverse_ (uncurry (printf "%-5.2fs, %s\n") . first (/1000)) $ snd timePath+ putStrLn $ "TOTAL: " <> show ((/1000) . sum . map nodeEopTime . M.elems $ wgraph)+ writeFile (options.inputFile ++ ".trace.json")+ $ encodingToLazyByteString+ $ Encoding.list (\ModEvent{..} -> mkCompleteEvent (pack eventModName) "module" (eventStart * 1000) ((eventEnd - eventStart) * 1000) 1 eventThreadId)+ $ simulate options.simulatedCores wgraph
+ src/Simulate.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE PatternGuards #-}+module Simulate where++import Data.OrdPSQ (OrdPSQ)+import Data.Map.Strict (Map)+import Data.Maybe+import Data.List (maximumBy)+import Data.Function (on)++import WeighedNode++import qualified Data.OrdPSQ as OrdPSQ+import qualified Data.Map.Strict as M+import qualified Data.Set as S+++-- | Module info used in our simulation+data SimModInfo =+ SimModInfo+ { simModRevDeps :: [ModName]+ , simNumDeps :: !Int+ , simModTime :: !Double+ }+ deriving (Show)++createSimModInfo :: WeighedGraph -> Map ModName SimModInfo+createSimModInfo wg = foldl' recordRevDeps initialGraph (M.toList wg)+ where+ numDeps = length . filter (`M.member` wg) . nodeDeps+ initialGraph = M.map (\x -> SimModInfo [] (numDeps x) (nodeEopTime x)) wg+ recordRevDeps :: Map ModName SimModInfo -> (ModName, WeighedNode) -> Map ModName SimModInfo+ recordRevDeps !old (modName, WeighedNode {nodeDeps = nodeDeps }) =+ foldl' addRevDep old nodeDeps+ where+ addRevDep !o depName =+ M.adjust (\x -> x { simModRevDeps = modName : simModRevDeps x }) depName o++data State =+ State+ { stateQueue :: !(OrdPSQ ModName Int SimModInfo)+ , stateActive :: !(OrdPSQ ModName Double (Double, Int, SimModInfo))+ , stateTime :: !Double+ , stateGaps :: !(S.Set Int)+ , stateOut :: ![ModEvent]+ }+ deriving (Show)++data ModEvent = ModEvent+ { eventStart :: !Double+ , eventEnd :: !Double+ , eventModName :: !ModName+ , eventThreadId :: !Int+ }+ deriving (Show)++goSimulate :: State -> Maybe State+goSimulate st@State{..} = case OrdPSQ.minView stateQueue of+ Just (k, 0, minfo@SimModInfo{..}, stateQueue') + | Just (threadId, stateGaps') <- S.minView stateGaps ->+ let+ stateActive' = OrdPSQ.insert k (stateTime + simModTime) (stateTime, threadId, minfo) stateActive+ in Just $ st+ { stateQueue = stateQueue'+ , stateActive = stateActive'+ , stateGaps = stateGaps'+ }+ _ -> -- not ready to pop as we are waiting for dependencies+ case OrdPSQ.findMin stateActive of+ Nothing -> Nothing+ Just (_, endTime , _) -> Just $ dropDone (st { stateTime = endTime })++dropDone+ :: State+ -> State+dropDone st@State{..} =+ case OrdPSQ.minView stateActive of+ Nothing -> st -- empty+ Just (k, end, (startTime, threadId, modSum), active') ->+ if end <= stateTime then+ dropDone $ updateRevDeps (simModRevDeps modSum) $ st { stateActive = active', stateOut = ModEvent startTime end k threadId :stateOut, stateGaps = S.insert threadId stateGaps }+ else+ st++updateRevDeps :: [ModName] -> State -> State+updateRevDeps modNms st = st {stateQueue = foldl' (\o k -> snd $ OrdPSQ.alter f k o) (stateQueue st) modNms}+ where+ f Nothing = ((), Nothing)+ f (Just (p, v)) = ((), Just (p-1,v))++initialState :: Int -> WeighedGraph -> State+initialState size wg =+ State+ { stateQueue = initialQueue+ , stateActive = OrdPSQ.empty+ , stateTime = 0+ , stateGaps = S.fromList [0..size-1]+ , stateOut = []+ }+ where+ initialQueue =+ OrdPSQ.fromList+ . map (\(k, simModInfo) -> (k, simNumDeps simModInfo, simModInfo))+ . M.toList+ $ createSimModInfo wg++simulate :: Int -> WeighedGraph -> [ModEvent]+simulate size wg = go (initialState size wg)+ where+ go st = case goSimulate st of+ Nothing -> stateOut st+ Just st' -> go st'+++critPath :: WeighedGraph -> (WeighedNode -> Double) -> (Double, [(Double, ModName)])+critPath wg measure = maxFst . M.elems $ critPathGraph+ where+ maxFst [] = (0, [])+ maxFst xs = maximumBy (compare `on` fst) xs+ critPathGraph = M.mapWithKey critPathFrom wg+ lookupCrit key = M.lookup key critPathGraph+ critPathFrom nodeName node = (measure node + restMeasure, (measure node, nodeName):restPath)+ where+ (restMeasure, restPath) = maxFst . mapMaybe lookupCrit $ nodeDeps node
+ src/WeighedNode.hs view
@@ -0,0 +1,14 @@+module WeighedNode where+import Data.Map.Strict (Map)++type ModName = String++data WeighedNode =+ WeighedNode+ { nodeDeps :: [ModName]+ , nodeEopTime :: !Double+ , nodeAllocs :: !Double+ }+ deriving (Show)++type WeighedGraph = Map ModName WeighedNode