├── .gitignore ├── Setup.hs ├── ChangeLog.md ├── test └── Spec.hs ├── app └── Main.hs ├── README.md ├── stack.yaml.lock ├── package.yaml ├── LICENSE ├── ghc-compile-stats.cabal ├── stack.yaml └── src └── GhcCompileStats.hs /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | *~ -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Changelog for ghc-compile-stats 2 | 3 | ## Unreleased changes 4 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "Test suite not yet implemented" 3 | -------------------------------------------------------------------------------- /app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import GhcCompileStats 4 | 5 | main :: IO () 6 | main = ghcCompileStatsMain 7 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ghc-compile-stats 2 | 3 | silly lil program that you pipe ur GHC/cabal output into and it tells you how long modules take t compile 4 | 5 | the timing info will give weird results with `-j` enabled in `ghc-options` so compile in serial to get module details 6 | 7 | but even with `-j` it's good to know how many modules you're skipping and how many you're compiling 8 | 9 | ## install 10 | 11 | ``` 12 | $ stack build 13 | $ stack install . 14 | ``` 15 | 16 | ## usage 17 | 18 | ``` 19 | $ cabal build | ghc-compile-stats 20 | ``` 21 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | size: 590102 10 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/27.yaml 11 | sha256: 79a786674930a89301b0e908fad2822a48882f3d01486117693c377b8edffdbe 12 | original: 13 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/27.yaml 14 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: ghc-compile-stats 2 | version: 0.1.0.0 3 | github: "githubuser/ghc-compile-stats" 4 | license: BSD3 5 | author: "Author name here" 6 | maintainer: "example@example.com" 7 | copyright: "2022 Author name here" 8 | 9 | extra-source-files: 10 | - README.md 11 | - ChangeLog.md 12 | 13 | # Metadata used when publishing your package 14 | # synopsis: Short description of your package 15 | # category: Web 16 | 17 | # To avoid duplicated efforts in documentation and dealing with the 18 | # complications of embedding Haddock markup inside cabal files, it is 19 | # common to point users to the README.md file. 20 | description: Please see the README on GitHub at 21 | 22 | dependencies: 23 | - base >= 4.7 && < 5 24 | - conduit 25 | - chronos 26 | - containers 27 | - mtl 28 | - bytestring 29 | - text 30 | - clock 31 | 32 | library: 33 | source-dirs: src 34 | 35 | executables: 36 | ghc-compile-stats: 37 | main: Main.hs 38 | source-dirs: app 39 | ghc-options: 40 | - -threaded 41 | - -rtsopts 42 | - -with-rtsopts=-N 43 | dependencies: 44 | - ghc-compile-stats 45 | 46 | tests: 47 | ghc-compile-stats-test: 48 | main: Spec.hs 49 | source-dirs: test 50 | ghc-options: 51 | - -threaded 52 | - -rtsopts 53 | - -with-rtsopts=-N 54 | dependencies: 55 | - ghc-compile-stats 56 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Author name here (c) 2022 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /ghc-compile-stats.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.34.4. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: ghc-compile-stats 8 | version: 0.1.0.0 9 | description: Please see the README on GitHub at 10 | homepage: https://github.com/githubuser/ghc-compile-stats#readme 11 | bug-reports: https://github.com/githubuser/ghc-compile-stats/issues 12 | author: Author name here 13 | maintainer: example@example.com 14 | copyright: 2022 Author name here 15 | license: BSD3 16 | license-file: LICENSE 17 | build-type: Simple 18 | extra-source-files: 19 | README.md 20 | ChangeLog.md 21 | 22 | source-repository head 23 | type: git 24 | location: https://github.com/githubuser/ghc-compile-stats 25 | 26 | library 27 | exposed-modules: 28 | GhcCompileStats 29 | other-modules: 30 | Paths_ghc_compile_stats 31 | hs-source-dirs: 32 | src 33 | build-depends: 34 | base >=4.7 && <5 35 | , bytestring 36 | , chronos 37 | , clock 38 | , conduit 39 | , containers 40 | , mtl 41 | , text 42 | default-language: Haskell2010 43 | 44 | executable ghc-compile-stats 45 | main-is: Main.hs 46 | other-modules: 47 | Paths_ghc_compile_stats 48 | hs-source-dirs: 49 | app 50 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 51 | build-depends: 52 | base >=4.7 && <5 53 | , bytestring 54 | , chronos 55 | , clock 56 | , conduit 57 | , containers 58 | , ghc-compile-stats 59 | , mtl 60 | , text 61 | default-language: Haskell2010 62 | 63 | test-suite ghc-compile-stats-test 64 | type: exitcode-stdio-1.0 65 | main-is: Spec.hs 66 | other-modules: 67 | Paths_ghc_compile_stats 68 | hs-source-dirs: 69 | test 70 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 71 | build-depends: 72 | base >=4.7 && <5 73 | , bytestring 74 | , chronos 75 | , clock 76 | , conduit 77 | , containers 78 | , ghc-compile-stats 79 | , mtl 80 | , text 81 | default-language: Haskell2010 82 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # 15 | # The location of a snapshot can be provided as a file or url. Stack assumes 16 | # a snapshot provided as a file might change, whereas a url resource does not. 17 | # 18 | # resolver: ./custom-snapshot.yaml 19 | # resolver: https://example.com/snapshots/2018-01-01.yaml 20 | resolver: 21 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/27.yaml 22 | 23 | # User packages to be built. 24 | # Various formats can be used as shown in the example below. 25 | # 26 | # packages: 27 | # - some-directory 28 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 29 | # subdirs: 30 | # - auto-update 31 | # - wai 32 | packages: 33 | - . 34 | # Dependency packages to be pulled from upstream that are not in the resolver. 35 | # These entries can reference officially published versions as well as 36 | # forks / in-progress versions pinned to a git hash. For example: 37 | # 38 | # extra-deps: 39 | # - acme-missiles-0.3 40 | # - git: https://github.com/commercialhaskell/stack.git 41 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 42 | # 43 | # extra-deps: [] 44 | 45 | # Override default flag values for local packages and extra-deps 46 | # flags: {} 47 | 48 | # Extra package databases containing global packages 49 | # extra-package-dbs: [] 50 | 51 | # Control whether we use the GHC we find on the path 52 | # system-ghc: true 53 | # 54 | # Require a specific version of stack, using version ranges 55 | # require-stack-version: -any # Default 56 | # require-stack-version: ">=2.7" 57 | # 58 | # Override the architecture used by stack, especially useful on Windows 59 | # arch: i386 60 | # arch: x86_64 61 | # 62 | # Extra directories used by stack for building 63 | # extra-include-dirs: [/path/to/dir] 64 | # extra-lib-dirs: [/path/to/dir] 65 | # 66 | # Allow a newer minor version of GHC than the snapshot specifies 67 | # compiler-check: newer-minor 68 | -------------------------------------------------------------------------------- /src/GhcCompileStats.hs: -------------------------------------------------------------------------------- 1 | {-# language StrictData, RecordWildCards #-} 2 | {-# language GeneralizedNewtypeDeriving, DerivingStrategies #-} 3 | 4 | module GhcCompileStats where 5 | 6 | import Prelude 7 | 8 | import Chronos hiding (getTime, now) 9 | import Data.Foldable 10 | import System.Clock 11 | import qualified Data.List as List 12 | import Data.Semigroup 13 | import qualified Data.Text as Text 14 | import Control.Monad.Reader 15 | import Data.Set (Set) 16 | import qualified Data.Set as Set 17 | import Conduit 18 | import Data.IORef 19 | import Data.Char 20 | 21 | data GhcCompileStats = GhcCompileStats 22 | { gcsFirstModule :: String 23 | , gcsModulesCompiled :: Int 24 | , gcsModulesSkipped :: Int 25 | , gcsTotalModules :: Int 26 | , gcsTemplateHaskellModules :: Int 27 | , gcsModuleTimeSpecs :: Set ModuleTimeSpec 28 | } 29 | 30 | data ModuleTimeSpec = ModuleTimeSpec 31 | { moduleTimeSpec :: TimeSpec 32 | , moduleNumber :: Int 33 | , moduleName :: String 34 | } 35 | deriving (Eq, Ord, Show) 36 | 37 | data GhcStatsEnv = GhcStatsEnv 38 | { gseModules :: Set ModuleTimeSpec 39 | , gseMinimumModule :: Min Int 40 | , gseMaximumModule :: Max Int 41 | , gseTotalModules :: Max Int 42 | , gseCompiledModuleCount :: Sum Int 43 | , gseLastModuleTimestamp :: Max TimeSpec 44 | , gseLastModuleName :: Last String 45 | } 46 | deriving Show 47 | 48 | instance Semigroup GhcStatsEnv where 49 | g0 <> g1 = 50 | GhcStatsEnv 51 | { gseModules = 52 | gseModules g0 <> gseModules g1 53 | , gseMinimumModule = 54 | gseMinimumModule g0 <> gseMinimumModule g1 55 | , gseMaximumModule = 56 | gseMaximumModule g0 <> gseMaximumModule g1 57 | , gseCompiledModuleCount = 58 | gseCompiledModuleCount g0 <> gseCompiledModuleCount g1 59 | , gseLastModuleTimestamp = 60 | gseLastModuleTimestamp g0 <> gseLastModuleTimestamp g1 61 | , gseLastModuleName = 62 | gseLastModuleName g0 <> gseLastModuleName g1 63 | , gseTotalModules = 64 | gseTotalModules g0 <> gseTotalModules g1 65 | } 66 | 67 | instance Monoid GhcStatsEnv where 68 | mempty = 69 | GhcStatsEnv 70 | { gseModules = 71 | mempty 72 | , gseMinimumModule = 73 | mempty 74 | , gseMaximumModule = 75 | mempty 76 | , gseCompiledModuleCount = 77 | mempty 78 | , gseLastModuleTimestamp = 79 | mempty 80 | , gseLastModuleName = 81 | Last "" 82 | , gseTotalModules = 83 | mempty 84 | } 85 | 86 | newGhcStatsEnv :: IO (IORef GhcStatsEnv) 87 | newGhcStatsEnv = do 88 | nsecs <- getTime Monotonic 89 | newIORef mempty { gseLastModuleTimestamp = Max nsecs } 90 | 91 | runModuleStatsM :: ModuleStatsM a -> IO a 92 | runModuleStatsM action = do 93 | ghcStatsEnv <- newGhcStatsEnv 94 | runReaderT (unModuleStatsM action) ghcStatsEnv 95 | 96 | evalModuleStatsM :: ModuleStatsM a -> IO GhcStatsEnv 97 | evalModuleStatsM action = do 98 | ghcStatsEnv <- newGhcStatsEnv 99 | runReaderT (unModuleStatsM action) ghcStatsEnv 100 | readIORef ghcStatsEnv 101 | 102 | newtype ModuleStatsM a = ModuleStatsM 103 | { unModuleStatsM :: ReaderT (IORef GhcStatsEnv) IO a 104 | } 105 | deriving newtype 106 | (Functor, Applicative, Monad, MonadIO, MonadReader (IORef GhcStatsEnv), MonadUnliftIO, MonadThrow) 107 | 108 | tell :: GhcStatsEnv -> ModuleStatsM () 109 | tell gse = do 110 | env <- ask 111 | liftIO $ atomicModifyIORef' env (\a -> (a <> gse, ())) 112 | 113 | getLastTimestamp :: ModuleStatsM TimeSpec 114 | getLastTimestamp = do 115 | gseRef <- ask 116 | gse <- liftIO $ readIORef gseRef 117 | pure $ getMax $ gseLastModuleTimestamp gse 118 | 119 | type ModuleStream i o r = ConduitT i o ModuleStatsM r 120 | 121 | -- | An extremely dumb program. Pipe the output of a @cabal build@ to this 122 | -- function, and it'll record the time of each line, record how many 123 | -- modules were skipped, etc. 124 | -- 125 | -- If you care about how long individual modules take to compile, disable 126 | -- parallelism. Otherwise modules will appear on the list as they are 127 | -- started, but the next module will not necessarily appear when the prior 128 | -- one has completed. 129 | ghcCompileStatsMain :: IO () 130 | ghcCompileStatsMain = do 131 | ghcStatsEnv <- 132 | newGhcStatsEnv 133 | runConduit $ transPipe (\a -> runReaderT (unModuleStatsM a) ghcStatsEnv) 134 | $ stdinC 135 | .| linesUnboundedAsciiC 136 | .| decodeUtf8C 137 | .| mapC Text.unpack 138 | .| mapM_C parseLine 139 | ghcStats <- readIORef ghcStatsEnv 140 | putStrLn " * * * Module Statistics * * * " 141 | putStrLn "" 142 | for_ (gseModules ghcStats) $ \ModuleTimeSpec {..} -> do 143 | let 144 | readableTime = 145 | Text.unpack 146 | $ encodeTimespan SubsecondPrecisionAuto 147 | $ Timespan 148 | $ fromInteger 149 | $ toNanoSecs moduleTimeSpec 150 | logs 151 | [ "Module: [" 152 | , moduleName 153 | , "] compiled in " 154 | , readableTime 155 | ] 156 | let compiledModuleCount = 157 | getSum $ gseCompiledModuleCount ghcStats 158 | logs 159 | [ "Modules Compiled: " 160 | , show compiledModuleCount 161 | ] 162 | let biggestModuleNumber = 163 | getMax $ gseMaximumModule ghcStats 164 | smallestModuleNumber = 165 | getMin $ gseMinimumModule ghcStats 166 | totalModules = 167 | getMax $ gseTotalModules ghcStats 168 | skippedAfter = 169 | totalModules - biggestModuleNumber 170 | rangeForCompilation = 171 | biggestModuleNumber - smallestModuleNumber + 1 172 | skippedModules = 173 | skippedAfter + rangeForCompilation - compiledModuleCount 174 | 175 | logs 176 | [ "Modules skipped: " 177 | , show skippedModules 178 | ] 179 | 180 | logs :: MonadIO m => [String] -> m () 181 | logs = liftIO . putStrLn . mconcat 182 | 183 | now :: ModuleStatsM TimeSpec 184 | now = liftIO $ getTime Monotonic 185 | 186 | parseLine :: String -> ModuleStatsM () 187 | parseLine initialLine = do 188 | currentTime <- now 189 | logs [initialLine] 190 | case initialLine of 191 | '[' : rest -> do 192 | case reads rest of 193 | (currentModuleNumber, (' ' : 'o' : 'f' : ' ' : rest')) : _ -> do 194 | tell mempty 195 | { gseMinimumModule = 196 | Min currentModuleNumber 197 | , gseMaximumModule = 198 | Max currentModuleNumber 199 | , gseCompiledModuleCount = 200 | Sum 1 201 | } 202 | 203 | case reads rest' of 204 | (totalModules, (']' : ' ' : rest'')) : _ -> do 205 | tell mempty 206 | { gseTotalModules = Max totalModules 207 | } 208 | 209 | case List.stripPrefix "Compiling " rest'' of 210 | Just rest''' -> do 211 | let 212 | (moduleName, rest'''') = 213 | break isSpace rest''' 214 | previousTimestamp <- getLastTimestamp 215 | let 216 | moduleTimeSpec = 217 | ModuleTimeSpec 218 | { moduleTimeSpec = 219 | diffTimeSpec currentTime previousTimestamp 220 | , moduleNumber = 221 | currentModuleNumber 222 | , moduleName = 223 | moduleName 224 | } 225 | tell mempty 226 | { gseModules = 227 | Set.singleton moduleTimeSpec 228 | , gseLastModuleTimestamp = 229 | Max currentTime 230 | , gseLastModuleName = 231 | Last moduleName 232 | } 233 | 234 | 235 | Nothing -> 236 | logs 237 | [ "Failed to get module name from: " 238 | , rest'' 239 | ] 240 | 241 | _ -> 242 | logs 243 | [ "Failed to parse line: " 244 | , initialLine 245 | ] 246 | 247 | _ -> 248 | pure () 249 | --------------------------------------------------------------------------------