diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,11 @@ +# Changelog + +`dr-cabal` uses [PVP Versioning][1]. +The changelog is available [on GitHub][2]. + +## 0.0.0.0 — July 31, 2022 🌇 + +* Initially created. + +[1]: https://pvp.haskell.org +[2]: https://github.com/chshersh/dr-cabal/releases diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,373 @@ +Mozilla Public License Version 2.0 +================================== + +1. Definitions +-------------- + +1.1. "Contributor" + means each individual or legal entity that creates, contributes to + the creation of, or owns Covered Software. + +1.2. "Contributor Version" + means the combination of the Contributions of others (if any) used + by a Contributor and that particular Contributor's Contribution. + +1.3. "Contribution" + means Covered Software of a particular Contributor. + +1.4. "Covered Software" + means Source Code Form to which the initial Contributor has attached + the notice in Exhibit A, the Executable Form of such Source Code + Form, and Modifications of such Source Code Form, in each case + including portions thereof. + +1.5. "Incompatible With Secondary Licenses" + means + + (a) that the initial Contributor has attached the notice described + in Exhibit B to the Covered Software; or + + (b) that the Covered Software was made available under the terms of + version 1.1 or earlier of the License, but not also under the + terms of a Secondary License. + +1.6. "Executable Form" + means any form of the work other than Source Code Form. + +1.7. "Larger Work" + means a work that combines Covered Software with other material, in + a separate file or files, that is not Covered Software. + +1.8. "License" + means this document. + +1.9. "Licensable" + means having the right to grant, to the maximum extent possible, + whether at the time of the initial grant or subsequently, any and + all of the rights conveyed by this License. + +1.10. "Modifications" + means any of the following: + + (a) any file in Source Code Form that results from an addition to, + deletion from, or modification of the contents of Covered + Software; or + + (b) any new file in Source Code Form that contains any Covered + Software. + +1.11. "Patent Claims" of a Contributor + means any patent claim(s), including without limitation, method, + process, and apparatus claims, in any patent Licensable by such + Contributor that would be infringed, but for the grant of the + License, by the making, using, selling, offering for sale, having + made, import, or transfer of either its Contributions or its + Contributor Version. + +1.12. "Secondary License" + means either the GNU General Public License, Version 2.0, the GNU + Lesser General Public License, Version 2.1, the GNU Affero General + Public License, Version 3.0, or any later versions of those + licenses. + +1.13. "Source Code Form" + means the form of the work preferred for making modifications. + +1.14. "You" (or "Your") + means an individual or a legal entity exercising rights under this + License. For legal entities, "You" includes any entity that + controls, is controlled by, or is under common control with You. For + purposes of this definition, "control" means (a) the power, direct + or indirect, to cause the direction or management of such entity, + whether by contract or otherwise, or (b) ownership of more than + fifty percent (50%) of the outstanding shares or beneficial + ownership of such entity. + +2. License Grants and Conditions +-------------------------------- + +2.1. Grants + +Each Contributor hereby grants You a world-wide, royalty-free, +non-exclusive license: + +(a) under intellectual property rights (other than patent or trademark) + Licensable by such Contributor to use, reproduce, make available, + modify, display, perform, distribute, and otherwise exploit its + Contributions, either on an unmodified basis, with Modifications, or + as part of a Larger Work; and + +(b) under Patent Claims of such Contributor to make, use, sell, offer + for sale, have made, import, and otherwise transfer either its + Contributions or its Contributor Version. + +2.2. Effective Date + +The licenses granted in Section 2.1 with respect to any Contribution +become effective for each Contribution on the date the Contributor first +distributes such Contribution. + +2.3. Limitations on Grant Scope + +The licenses granted in this Section 2 are the only rights granted under +this License. No additional rights or licenses will be implied from the +distribution or licensing of Covered Software under this License. +Notwithstanding Section 2.1(b) above, no patent license is granted by a +Contributor: + +(a) for any code that a Contributor has removed from Covered Software; + or + +(b) for infringements caused by: (i) Your and any other third party's + modifications of Covered Software, or (ii) the combination of its + Contributions with other software (except as part of its Contributor + Version); or + +(c) under Patent Claims infringed by Covered Software in the absence of + its Contributions. + +This License does not grant any rights in the trademarks, service marks, +or logos of any Contributor (except as may be necessary to comply with +the notice requirements in Section 3.4). + +2.4. Subsequent Licenses + +No Contributor makes additional grants as a result of Your choice to +distribute the Covered Software under a subsequent version of this +License (see Section 10.2) or under the terms of a Secondary License (if +permitted under the terms of Section 3.3). + +2.5. Representation + +Each Contributor represents that the Contributor believes its +Contributions are its original creation(s) or it has sufficient rights +to grant the rights to its Contributions conveyed by this License. + +2.6. Fair Use + +This License is not intended to limit any rights You have under +applicable copyright doctrines of fair use, fair dealing, or other +equivalents. + +2.7. Conditions + +Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted +in Section 2.1. + +3. Responsibilities +------------------- + +3.1. Distribution of Source Form + +All distribution of Covered Software in Source Code Form, including any +Modifications that You create or to which You contribute, must be under +the terms of this License. You must inform recipients that the Source +Code Form of the Covered Software is governed by the terms of this +License, and how they can obtain a copy of this License. You may not +attempt to alter or restrict the recipients' rights in the Source Code +Form. + +3.2. Distribution of Executable Form + +If You distribute Covered Software in Executable Form then: + +(a) such Covered Software must also be made available in Source Code + Form, as described in Section 3.1, and You must inform recipients of + the Executable Form how they can obtain a copy of such Source Code + Form by reasonable means in a timely manner, at a charge no more + than the cost of distribution to the recipient; and + +(b) You may distribute such Executable Form under the terms of this + License, or sublicense it under different terms, provided that the + license for the Executable Form does not attempt to limit or alter + the recipients' rights in the Source Code Form under this License. + +3.3. Distribution of a Larger Work + +You may create and distribute a Larger Work under terms of Your choice, +provided that You also comply with the requirements of this License for +the Covered Software. If the Larger Work is a combination of Covered +Software with a work governed by one or more Secondary Licenses, and the +Covered Software is not Incompatible With Secondary Licenses, this +License permits You to additionally distribute such Covered Software +under the terms of such Secondary License(s), so that the recipient of +the Larger Work may, at their option, further distribute the Covered +Software under the terms of either this License or such Secondary +License(s). + +3.4. Notices + +You may not remove or alter the substance of any license notices +(including copyright notices, patent notices, disclaimers of warranty, +or limitations of liability) contained within the Source Code Form of +the Covered Software, except that You may alter any license notices to +the extent required to remedy known factual inaccuracies. + +3.5. Application of Additional Terms + +You may choose to offer, and to charge a fee for, warranty, support, +indemnity or liability obligations to one or more recipients of Covered +Software. However, You may do so only on Your own behalf, and not on +behalf of any Contributor. You must make it absolutely clear that any +such warranty, support, indemnity, or liability obligation is offered by +You alone, and You hereby agree to indemnify every Contributor for any +liability incurred by such Contributor as a result of warranty, support, +indemnity or liability terms You offer. You may include additional +disclaimers of warranty and limitations of liability specific to any +jurisdiction. + +4. Inability to Comply Due to Statute or Regulation +--------------------------------------------------- + +If it is impossible for You to comply with any of the terms of this +License with respect to some or all of the Covered Software due to +statute, judicial order, or regulation then You must: (a) comply with +the terms of this License to the maximum extent possible; and (b) +describe the limitations and the code they affect. Such description must +be placed in a text file included with all distributions of the Covered +Software under this License. Except to the extent prohibited by statute +or regulation, such description must be sufficiently detailed for a +recipient of ordinary skill to be able to understand it. + +5. Termination +-------------- + +5.1. The rights granted under this License will terminate automatically +if You fail to comply with any of its terms. However, if You become +compliant, then the rights granted under this License from a particular +Contributor are reinstated (a) provisionally, unless and until such +Contributor explicitly and finally terminates Your grants, and (b) on an +ongoing basis, if such Contributor fails to notify You of the +non-compliance by some reasonable means prior to 60 days after You have +come back into compliance. Moreover, Your grants from a particular +Contributor are reinstated on an ongoing basis if such Contributor +notifies You of the non-compliance by some reasonable means, this is the +first time You have received notice of non-compliance with this License +from such Contributor, and You become compliant prior to 30 days after +Your receipt of the notice. + +5.2. If You initiate litigation against any entity by asserting a patent +infringement claim (excluding declaratory judgment actions, +counter-claims, and cross-claims) alleging that a Contributor Version +directly or indirectly infringes any patent, then the rights granted to +You by any and all Contributors for the Covered Software under Section +2.1 of this License shall terminate. + +5.3. In the event of termination under Sections 5.1 or 5.2 above, all +end user license agreements (excluding distributors and resellers) which +have been validly granted by You or Your distributors under this License +prior to termination shall survive termination. + +************************************************************************ +* * +* 6. Disclaimer of Warranty * +* ------------------------- * +* * +* Covered Software is provided under this License on an "as is" * +* basis, without warranty of any kind, either expressed, implied, or * +* statutory, including, without limitation, warranties that the * +* Covered Software is free of defects, merchantable, fit for a * +* particular purpose or non-infringing. The entire risk as to the * +* quality and performance of the Covered Software is with You. * +* Should any Covered Software prove defective in any respect, You * +* (not any Contributor) assume the cost of any necessary servicing, * +* repair, or correction. This disclaimer of warranty constitutes an * +* essential part of this License. No use of any Covered Software is * +* authorized under this License except under this disclaimer. * +* * +************************************************************************ + +************************************************************************ +* * +* 7. Limitation of Liability * +* -------------------------- * +* * +* Under no circumstances and under no legal theory, whether tort * +* (including negligence), contract, or otherwise, shall any * +* Contributor, or anyone who distributes Covered Software as * +* permitted above, be liable to You for any direct, indirect, * +* special, incidental, or consequential damages of any character * +* including, without limitation, damages for lost profits, loss of * +* goodwill, work stoppage, computer failure or malfunction, or any * +* and all other commercial damages or losses, even if such party * +* shall have been informed of the possibility of such damages. This * +* limitation of liability shall not apply to liability for death or * +* personal injury resulting from such party's negligence to the * +* extent applicable law prohibits such limitation. Some * +* jurisdictions do not allow the exclusion or limitation of * +* incidental or consequential damages, so this exclusion and * +* limitation may not apply to You. * +* * +************************************************************************ + +8. Litigation +------------- + +Any litigation relating to this License may be brought only in the +courts of a jurisdiction where the defendant maintains its principal +place of business and such litigation shall be governed by laws of that +jurisdiction, without reference to its conflict-of-law provisions. +Nothing in this Section shall prevent a party's ability to bring +cross-claims or counter-claims. + +9. Miscellaneous +---------------- + +This License represents the complete agreement concerning the subject +matter hereof. If any provision of this License is held to be +unenforceable, such provision shall be reformed only to the extent +necessary to make it enforceable. Any law or regulation which provides +that the language of a contract shall be construed against the drafter +shall not be used to construe this License against a Contributor. + +10. Versions of the License +--------------------------- + +10.1. New Versions + +Mozilla Foundation is the license steward. Except as provided in Section +10.3, no one other than the license steward has the right to modify or +publish new versions of this License. Each version will be given a +distinguishing version number. + +10.2. Effect of New Versions + +You may distribute the Covered Software under the terms of the version +of the License under which You originally received the Covered Software, +or under the terms of any subsequent version published by the license +steward. + +10.3. Modified Versions + +If you create software not governed by this License, and you want to +create a new license for such software, you may create and use a +modified version of this License if you rename the license and remove +any references to the name of the license steward (except to note that +such modified license differs from this License). + +10.4. Distributing Source Code Form that is Incompatible With Secondary +Licenses + +If You choose to distribute Source Code Form that is Incompatible With +Secondary Licenses under the terms of this version of the License, the +notice described in Exhibit B of this License must be attached. + +Exhibit A - Source Code Form License Notice +------------------------------------------- + + This Source Code Form is subject to the terms of the Mozilla Public + License, v. 2.0. If a copy of the MPL was not distributed with this + file, You can obtain one at http://mozilla.org/MPL/2.0/. + +If it is not possible or desirable to put the notice in a particular +file, then You may include the notice in a location (such as a LICENSE +file in a relevant directory) where a recipient would be likely to look +for such a notice. + +You may add additional accurate notices of copyright ownership. + +Exhibit B - "Incompatible With Secondary Licenses" Notice +--------------------------------------------------------- + + This Source Code Form is "Incompatible With Secondary Licenses", as + defined by the Mozilla Public License, v. 2.0. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,139 @@ +# dr-cabal + +[![GitHub CI](https://github.com/chshersh/dr-cabal/workflows/CI/badge.svg)](https://github.com/chshersh/dr-cabal/actions) +[![Hackage](https://img.shields.io/hackage/v/dr-cabal.svg?logo=haskell)](https://hackage.haskell.org/package/dr-cabal) +[![MPL-2.0 license](https://img.shields.io/badge/license-MPL--2.0-blue.svg)](LICENSE) + +`dr-cabal` is a CLI tool for profiling Haskell dependencies build times. + +![dr-cabal example](https://raw.githubusercontent.com/chshersh/dr-cabal/main/images/dr-cabal-example.png) + +> ℹ️ **DISCLAIMER:** This project is developed and maintained in +> free time by volunteers. The development may continue for decades or +> may stop tomorrow. You can use +> [GitHub Sponsorship](https://github.com/sponsors/chshersh) to support +> the development of this project. + +## Install + +`dr-cabal` is a Haskell CLI tool and can be installed either from +Hackage or from this repository. + +### Prerequisites + +To start using `dr-cabal`, make sure you have the required version of +`cabal-install` (a Haskell build tool) and GHC (a Haskell compiler) +installed: + +* [Cabal ⩾ 3.6.2.0](https://www.haskell.org/cabal/) +* [GHC ⩾ 9.0.2](https://www.haskell.org/downloads/) + +### Hackage + +To install the latest version of `dr-cabal` from +[Hackage](https://hackage.haskell.org/package/dr-cabal), +follow these steps: + +1. Update Hackage index: + + ```shell + cabal update + ``` + +2. Build `dr-cabal` from Hackage and copy the resulting executable + into the desired location: + + ```shell + cabal install dr-cabal \ + --install-method=copy \ + --overwrite-policy=always \ + --with-compiler=ghc-9.0.2 + --installdir=$HOME/.local/bin + ``` + +> ℹ️ **NOTE:** Make sure the `$HOME/.local/bin` directory or the +> directory of your choice is listed in `$PATH`. + +### Sources + +To build the latest version of `dr-cabal` from sources, +follow these steps: + +1. Clone this repository: + + ```shell + git clone https://github.com/chshersh/dr-cabal.git + cd dr-cabal + ``` + +2. Build the package: + + ```shell + cabal build + ``` + +3. Copy executable to the desired location: + + ```shell + cp $(cabal list-bin exe:dr-cabal) ~/.local/bin/dr-cabal + ``` + +> ℹ️ **NOTE:** Make sure the `~/.local/bin` directory or the +> directory of your choice is listed in `$PATH`. + +## How to use? + +`dr-cabal` usages comprises two steps: + +1. 👀 Watching `cabal build` output and recording data into a JSON file. +2. 🌈 Producing pretty profiling results. + +### Watch + +> ⚠️ **WARNING:** To get meaningful results, the `dr-cabal watch` +> command needs to be run when none of the dependencies are build. If +> you've already build you project, including dependencies, you can +> purge global Cabal cache using the following command: +> +> ```shell +> rm -rf ~/.cabal +> ``` +> +> You may prefer a less invasive approach if you have custom global +> Cabal configurations: +> +> ```shell +> rm -rf ~/.cabal/store +> ``` +> +> However, with the latter solution you won't see the `Downloading` +> phase in the profiling output. + +Run the following command inside the project directory, for which you +want to build the profile chart: + +```shell +cabal build all | dr-cabal watch --output=dr-cabal-debug.json +``` + +This command watches the `cabal build` output and records all the +relevant steps in the `dr-cabal-debug.json` file. + +If everything is good, you should see output similar to the below one: + +![dr-cabal watch example](https://raw.githubusercontent.com/chshersh/dr-cabal/main/images/dr-cabal-watch.gif) + +### Profile + +Once you successfully produced a JSON file with all the recorded +steps, run the following command to pretty-print the profiling output: + +> ⚠️ **WARNING:** For better results, make your terminal full-screen. + +```shell +cabal profile --input=dr-cabal-debug.json +``` + +You'll see the output like on the image below: + +![dr-cabal bigger example](https://raw.githubusercontent.com/chshersh/dr-cabal/main/images/dr-cabal-itself.png) diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,1 @@ +module Main (main) where import DrCabal (main) diff --git a/dr-cabal.cabal b/dr-cabal.cabal new file mode 100644 --- /dev/null +++ b/dr-cabal.cabal @@ -0,0 +1,104 @@ +cabal-version: 3.0 +name: dr-cabal +version: 0.0.0.0 +synopsis: See README for more info +description: + CLI tool for profiling Haskell dependencies build times. + See [README.md](https://github.com/chshersh/dr-cabal#dr-cabal) for more details. +homepage: https://github.com/chshersh/dr-cabal +bug-reports: https://github.com/chshersh/dr-cabal/issues +license: MPL-2.0 +license-file: LICENSE +author: Dmitrii Kovanikov +maintainer: Dmitrii Kovanikov +copyright: 2022 Dmitrii Kovanikov +category: Profiling,Development +build-type: Simple +extra-doc-files: README.md + CHANGELOG.md +tested-with: GHC == 9.2.3 + GHC == 9.0.2 + +source-repository head + type: git + location: https://github.com/chshersh/dr-cabal.git + +common common-options + build-depends: base >= 4.15 && < 4.17 + , relude ^>= 1.1 + + mixins: base hiding (Prelude) + , relude (Relude as Prelude) + , relude + + ghc-options: -Wall + -Wcompat + -Widentities + -Wincomplete-uni-patterns + -Wincomplete-record-updates + -Wredundant-constraints + -Wnoncanonical-monad-instances + if impl(ghc >= 8.2) + ghc-options: -fhide-source-paths + if impl(ghc >= 8.4) + ghc-options: -Wmissing-export-lists + -Wpartial-fields + if impl(ghc >= 8.8) + ghc-options: -Wmissing-deriving-strategies + -fwrite-ide-info + -hiedir=.hie + + -- annoying warning about unused base + -- if impl(ghc >= 8.10) + -- ghc-options: -Wunused-packages + + if impl(ghc >= 9.0) + ghc-options: -Winvalid-haddock + if impl(ghc >= 9.2) + ghc-options: -Wredundant-bang-patterns + -Woperator-whitespace + + default-language: Haskell2010 + default-extensions: ConstraintKinds + DeriveGeneric + DerivingStrategies + GeneralizedNewtypeDeriving + InstanceSigs + KindSignatures + LambdaCase + OverloadedStrings + RecordWildCards + ScopedTypeVariables + StandaloneDeriving + StrictData + TupleSections + TypeApplications + ViewPatterns + +library + import: common-options + hs-source-dirs: src + exposed-modules: + DrCabal + DrCabal.Cli + DrCabal.Model + DrCabal.Profile + DrCabal.Watch + + build-depends: + , aeson ^>= 2.1 + , aeson-pretty ^>= 0.8.9 + , ansi-terminal ^>= 0.11 + , async ^>= 2.2 + , bytestring ^>= 0.11 + , colourista ^>= 0.1 + , optparse-applicative ^>= 0.17 + +executable dr-cabal + import: common-options + hs-source-dirs: app + main-is: Main.hs + build-depends: dr-cabal + ghc-options: -threaded + -rtsopts + -with-rtsopts=-N diff --git a/src/DrCabal.hs b/src/DrCabal.hs new file mode 100644 --- /dev/null +++ b/src/DrCabal.hs @@ -0,0 +1,27 @@ +{- | +Module : DrCabal +Copyright : (c) 2022 Dmitrii Kovanikov +SPDX-License-Identifier : MPL-2.0 +Maintainer : Dmitrii Kovanikov +Stability : Experimental +Portability : Portable + +See README for more info. +-} + +module DrCabal + ( main + ) where + +import DrCabal.Cli (Command (..), readCommand) +import DrCabal.Profile (runProfile) +import DrCabal.Watch (runWatch) + + +main :: IO () +main = readCommand >>= runDrCabal + +runDrCabal :: Command -> IO () +runDrCabal = \case + Watch args -> runWatch args + Profile args -> runProfile args diff --git a/src/DrCabal/Cli.hs b/src/DrCabal/Cli.hs new file mode 100644 --- /dev/null +++ b/src/DrCabal/Cli.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE ApplicativeDo #-} + +{- | +Module : DrCabal.Cli +Copyright : (c) 2022 Dmitrii Kovanikov +SPDX-License-Identifier : MPL-2.0 +Maintainer : Dmitrii Kovanikov +Stability : Experimental +Portability : Portable + +CLI parser for @dr-cabal@. +-} + +module DrCabal.Cli + ( Command (..) + , readCommand + + , WatchArgs (..) + , ProfileArgs (..) + ) where + +import qualified Options.Applicative as Opt + +data Command + = Watch WatchArgs + | Profile ProfileArgs + +newtype WatchArgs = WatchArgs + { watchArgsOutput :: FilePath + } + +newtype ProfileArgs = ProfileArgs + { profileArgsInput :: FilePath + } + +readCommand :: IO Command +readCommand = Opt.execParser opts + where + opts = Opt.info (Opt.helper <*> commandP) $ mconcat + [ Opt.fullDesc + , Opt.progDesc "Profile cabal dependency build output" + , Opt.header "dr-cabal - a CLI tool to treat cabal output" + ] + +-- | All possible commands. +commandP :: Opt.Parser Command +commandP = Opt.subparser $ mconcat + [ Opt.command "watch" + $ Opt.info (Opt.helper <*> watchP) + $ Opt.progDesc "Watch cabal output and save it" + , Opt.command "profile" + $ Opt.info (Opt.helper <*> profileP) + $ Opt.progDesc "Output pretty cabal profile results" + ] + +watchP :: Opt.Parser Command +watchP = do + watchArgsOutput <- Opt.strOption $ mconcat + [ Opt.long "output" + , Opt.short 'o' + , Opt.metavar "FILE_PATH" + , Opt.help "Save cabal output to a file in a JSON format" + ] + + pure $ Watch WatchArgs{..} + +profileP :: Opt.Parser Command +profileP = do + profileArgsInput <- Opt.strOption $ mconcat + [ Opt.long "input" + , Opt.short 'i' + , Opt.metavar "FILE_PATH" + , Opt.help "Read profile input from a JSON file, created by 'dr-cabal watch'" + ] + + pure $ Profile ProfileArgs{..} diff --git a/src/DrCabal/Model.hs b/src/DrCabal/Model.hs new file mode 100644 --- /dev/null +++ b/src/DrCabal/Model.hs @@ -0,0 +1,61 @@ +{- | +Module : DrCabal.Model +Copyright : (c) 2022 Dmitrii Kovanikov +SPDX-License-Identifier : MPL-2.0 +Maintainer : Dmitrii Kovanikov +Stability : Experimental +Portability : Portable + +Data types to model the domain of the @cabal@ output. +-} + +module DrCabal.Model + ( Line (..) + , Status (..) + , Entry (..) + ) where + +import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, withText, (.:), (.=)) + + +data Line = Line + { lineTime :: Word64 + , lineLine :: ByteString + } deriving stock (Show) + +data Status + = Downloading + | Downloaded + | Starting + | Building + | Installing + | Completed + deriving stock (Show, Read, Eq, Ord, Enum, Bounded) + +instance ToJSON Status where + toJSON = toJSON @Text . show + +instance FromJSON Status where + parseJSON = withText "Status" $ \(toString -> t) -> case readMaybe t of + Nothing -> fail $ "Unexpected status: " <> t + Just status -> pure status + +data Entry = Entry + { entryStatus :: Status + , entryStart :: Word64 + , entryLibrary :: Text + } deriving stock (Show) + +instance ToJSON Entry where + toJSON Entry{..} = object + [ "status" .= entryStatus + , "startTime" .= entryStart + , "library" .= entryLibrary + ] + +instance FromJSON Entry where + parseJSON = withObject "Entry" $ \o -> do + entryStatus <- o .: "status" + entryStart <- o .: "startTime" + entryLibrary <- o .: "library" + pure Entry{..} diff --git a/src/DrCabal/Profile.hs b/src/DrCabal/Profile.hs new file mode 100644 --- /dev/null +++ b/src/DrCabal/Profile.hs @@ -0,0 +1,255 @@ +{- | +Module : DrCabal.Profile +Copyright : (c) 2022 Dmitrii Kovanikov +SPDX-License-Identifier : MPL-2.0 +Maintainer : Dmitrii Kovanikov +Stability : Experimental +Portability : Portable + +@dr-cabal profile@ command. +-} + +module DrCabal.Profile + ( runProfile + ) where + +import Colourista.Pure (blue, cyan, formatWith, red, yellow) +import Colourista.Short (b, i, u) +import Data.Aeson (eitherDecodeFileStrict') +import System.Console.ANSI (getTerminalSize) + +import DrCabal.Cli (ProfileArgs (..)) +import DrCabal.Model (Entry (..), Status (..)) + +import qualified Colourista +import qualified Data.List as List +import qualified Data.Map.Strict as Map +import qualified Data.Text as Text + + +runProfile :: ProfileArgs -> IO () +runProfile ProfileArgs{..} = do + terminalWidth <- getTerminalSize >>= \case + Just (_height, width) -> pure width + Nothing -> do + putText $ unlines + [ "Error getting the terminal width. If you see this error, open an issue" + , "in the 'dr-cabal' issue tracker and provide as many details as possible" + , "" + , " * " <> u "https://github.com/chshersh/dr-cabal/issues/new" + ] + exitFailure + + entries <- readFromFile profileArgsInput + let chart = createProfileChart terminalWidth entries + putTextLn chart + +readFromFile :: FilePath -> IO [Entry] +readFromFile file = eitherDecodeFileStrict' file >>= \case + Left err -> do + Colourista.errorMessage $ "Error parsing file: " <> toText file + Colourista.redMessage $ " " <> toText err + exitFailure + Right entries -> pure entries + +createProfileChart :: Int -> [Entry] -> Text +createProfileChart width l = case l of + [] -> unlines + [ "No cabal build entries found. Have you already built dependency?" + , "Try removing global cabal store cache and rerunning 'dr-cabal watch' again." + ] + entries -> + let start = List.minimum $ map entryStart entries in + let end = List.maximum $ map entryStart entries in + formatChart start end width $ calculatePhases start $ groupEntries entries + +groupEntries :: [Entry] -> Map Text [(Status, Word64)] +groupEntries = foldl' insert mempty + where + insert :: Map Text [(Status, Word64)] -> Entry -> Map Text [(Status, Word64)] + insert m Entry{..} = Map.alter (Just . toVal (entryStatus, entryStart)) entryLibrary m + where + toVal :: a -> Maybe [a] -> [a] + toVal x Nothing = [x] + toVal x (Just xs) = x : xs + +data Phase = Phase + { phaseDownloading :: Word64 + , phaseStarting :: Word64 + , phaseBuilding :: Word64 + , phaseInstalling :: Word64 + } + +phaseTotal :: Phase -> Word64 +phaseTotal (Phase p1 p2 p3 p4) = p1 + p2 + p3 + p4 + +calculatePhases :: Word64 -> Map Text [(Status, Word64)] -> Map Text Phase +calculatePhases start = fmap (entriesToPhase start) + +entriesToPhase :: Word64 -> [(Status, Word64)] -> Phase +entriesToPhase start times = Phase + { phaseDownloading = calcDownloading + , phaseStarting = calcStarting + , phaseBuilding = calcBuilding + , phaseInstalling = calcInstalling + } + where + downloading, downloaded, starting, building, installing, completed :: Maybe Word64 + downloading = List.lookup Downloading times + downloaded = List.lookup Downloaded times + starting = List.lookup Starting times + building = List.lookup Building times + installing = List.lookup Installing times + completed = List.lookup Completed times + + minusw :: Word64 -> Word64 -> Word64 + x `minusw` y + | x <= y = 0 + | otherwise = x - y + + calcDownloading :: Word64 + calcDownloading = case (downloading, downloaded) of + (Just dStart, Just dEnd) -> dEnd `minusw` dStart + _ -> 0 + + calcStarting :: Word64 + calcStarting = case building of + Nothing -> 0 + Just bt -> case starting of + Just st -> bt `minusw` st + Nothing -> bt `minusw` start + + calcBuilding :: Word64 + calcBuilding = case installing of + Nothing -> 0 + Just it -> case building of + Nothing -> it `minusw` start + Just bt -> it `minusw` bt + + calcInstalling :: Word64 + calcInstalling = case completed of + Nothing -> 0 + Just ct -> case installing of + Nothing -> ct `minusw` start + Just it -> ct `minusw` it + +formatChart :: Word64 -> Word64 -> Int -> Map Text Phase -> Text +formatChart start end width libs = unlines $ concat $ + [ legend + , summary + , profile + ] + where + block :: Text + block = "▇" + + legend :: [Text] + legend = + [ b "Legend" + , " " <> fmt [cyan] block <> " Downloading" + , " " <> fmt [blue] block <> " Starting" + , " " <> fmt [red] block <> " Building" + , " " <> fmt [yellow] block <> " Installing" + , "" + ] + + summary :: [Text] + summary = + [ b "Summary" + , i " Total dependency build time" <> " : " <> fmtNanos (end - start) + , i " Single block resolution " <> " : " <> fmtNanos blockMeasure + , "" + ] + + profile :: [Text] + profile = + [ b "Profile" + ] ++ + formattedEntries + + formattedEntries :: [Text] + formattedEntries + = map (uncurry formatRow) + $ sortOn (Down . phaseTotal . snd) entries + + formatRow :: Text -> Phase -> Text + formatRow libName phase@Phase{..} = mconcat + [ fmtPrefix libName phase + , formatSinglePhase cyan phaseDownloading + , formatSinglePhase blue phaseStarting + , formatSinglePhase red phaseBuilding + , formatSinglePhase yellow phaseInstalling + ] + + entries :: [(Text, Phase)] + entries = Map.toList libs + + libSize, phaseSize, prefixSize :: Int + libSize = List.maximum $ map (Text.length . fst) entries + phaseSize = List.maximum $ map (Text.length . fmtPhase . snd) entries + prefixSize = List.maximum $ map (Text.length . uncurry fmtPrefix) entries + + longestPhase :: Word64 + longestPhase = List.maximum $ map (phaseTotal . snd) entries + + fmtPhase :: Phase -> Text + fmtPhase = fmtNanos . phaseTotal + + fmtPrefix :: Text -> Phase -> Text + fmtPrefix libName phase = mconcat + [ Text.justifyRight libSize ' ' libName + , " [" + , Text.justifyLeft phaseSize ' ' $ fmtPhase phase + , "] " + , "│" + , " " + ] + + -- How many nanoseconds each block represents? + -- blocks take: + -- width minus prefix size + -- minus 4 for remainders of each phase + blockMeasure :: Word64 + blockMeasure = longestPhase `div` fromIntegral (width - prefixSize - 4) + + formatSinglePhase :: Text -> Word64 -> Text + formatSinglePhase colour phase + | phase == 0 = "" + | otherwise = fmt [colour] $ stimes blockCount block + where + blockCount :: Word64 + blockCount = blockRemainder + div phase blockMeasure + + blockRemainder :: Word64 + blockRemainder = if phase `mod` blockMeasure > 0 then 1 else 0 + +fmt :: [Text] -> Text -> Text +fmt = formatWith + + +fmtNanos :: Word64 -> Text +fmtNanos time + | time < ns = "0ns" + | time < mcs = show nanos <> "ns" + | time < ms = show micros <> "mcs" + | time < s = show millis <> "ms" + | time < m = show seconds <> "s" <> emptyIfZero millis "ms" + | otherwise = show minutes <> "m" <> emptyIfZero seconds "s" + where + ns, mcs, ms, s, m :: Word64 + ns = 1 + mcs = 1000 * ns + ms = 1000 * mcs + s = 1000 * ms + m = 60 * s + + nanos :: Word64 + nanos = time `mod` mcs + micros = (time `div` mcs) `mod` 1000 + millis = (time `div` ms) `mod` 1000 + seconds = (time `div` s) `mod` 60 + minutes = time `div` m + + emptyIfZero :: Word64 -> Text -> Text + emptyIfZero 0 _ = "" + emptyIfZero t unit = show t <> unit diff --git a/src/DrCabal/Watch.hs b/src/DrCabal/Watch.hs new file mode 100644 --- /dev/null +++ b/src/DrCabal/Watch.hs @@ -0,0 +1,162 @@ +{-# LANGUAGE NumericUnderscores #-} + +{- | +Module : DrCabal.Watch +Copyright : (c) 2019 Alexander Gugel + (c) 2022 Dmitrii Kovanikov +SPDX-License-Identifier : MPL-2.0 +Maintainer : Dmitrii Kovanikov +Stability : Experimental +Portability : Portable + +Implementation of the @dr-cabal watch@ command. +-} + +module DrCabal.Watch + ( runWatch + ) where + +import Colourista.Short (b) +import Control.Concurrent (threadDelay) +import Control.Concurrent.Async (wait, withAsync) +import Data.Aeson.Encode.Pretty (encodePretty) +import GHC.Clock (getMonotonicTimeNSec) +import System.Console.ANSI (clearLine, setCursorColumn) +import System.IO (isEOF) + +import DrCabal.Cli (WatchArgs (..)) +import DrCabal.Model (Entry (..), Line (..)) + +import qualified Colourista +import qualified Data.ByteString as ByteString +import qualified Data.Text as Text + + +runWatch :: WatchArgs -> IO () +runWatch WatchArgs{..} = do + watchRef <- newIORef [Start] + + withAsync (watchWorker watchRef) $ \workerAsync -> do + readFromStdin watchRef watchArgsOutput + wait workerAsync + +readFromStdin :: IORef [WatchAction] -> FilePath -> IO () +readFromStdin watchRef outputPath = go [] + where + go :: [Line] -> IO () + go cabalOutput = do + isEndOfInput <- isEOF + if isEndOfInput + then do + pushAction watchRef $ End outputPath cabalOutput + else do + time <- getMonotonicTimeNSec + line <- ByteString.getLine + + -- output line to the watch worker for output redirection + pushAction watchRef $ Consume line + + go $ Line time line : cabalOutput + +linesToEntries :: [Line] -> [Entry] +linesToEntries = mapMaybe parseLine . reverse + +parseLine :: Line -> Maybe Entry +parseLine Line{..} = do + let txtLine = decodeUtf8 lineLine + txtStatus : library : _ <- Just $ words txtLine + + -- parse status string to the 'Status' type + status <- readMaybe $ toString txtStatus + + -- check if this line is a library: '-' separates library name and its version + guard $ Text.elem '-' library + + pure $ Entry + { entryStatus = status + , entryStart = lineTime + , entryLibrary = library + } + +data WatchAction + = Start + | Consume ByteString + | End FilePath [Line] + +-- | Add 'WatchAction' to end of the list +pushAction :: IORef [WatchAction] -> WatchAction -> IO () +pushAction watchRef action = + atomicModifyIORef' watchRef $ \actions -> (actions ++ [action], ()) + +data WorkerCommand + = Greeting + | WriteLine ByteString + | Wait + | Finish FilePath [Line] + +watchWorker :: IORef [WatchAction] -> IO () +watchWorker watchRef = go "Watching build output" (cycle spinnerFrames) + where + spinnerFrames :: [Text] + spinnerFrames = + [ "⠋" + , "⠙" + , "⠹" + , "⠸" + , "⠼" + , "⠴" + , "⠦" + , "⠧" + , "⠇" + , "⠏" + ] + + go :: Text -> [Text] -> IO () + go _ [] = do + Colourista.errorMessage $ + "Panic! At the 'dr-cabal'! Impossible happened: list of frames is empty" + exitFailure + go prevLine (frame : frames) = do + command <- atomicModifyIORef' watchRef popAction + case command of + Greeting -> do + Colourista.formattedMessage + [Colourista.blue, Colourista.bold] + "Watching cabal output..." + + go prevLine (frame : frames) + WriteLine line -> do + resetLine + let l = decodeUtf8 line + putText $ frame <> " " <> l + hFlush stdout + threadDelay 80_000 -- wait 80 ms to update spinner + go l frames + Wait -> do + resetLine + putText $ frame <> " " <> prevLine + hFlush stdout + threadDelay 80_000 -- wait 80 ms to update spinner + go prevLine frames + Finish outputPath lns -> do + writeFileLBS outputPath $ encodePretty $ linesToEntries lns + resetLine + putTextLn $ unlines + [ b "Build finished successfully!" + , "" + , "To see the profiling output, run the following command:" + , "" + , " dr-cabal profile --input=" <> toText outputPath + ] + + popAction :: [WatchAction] -> ([WatchAction], WorkerCommand) + popAction [] = ([], Wait) + popAction (x : xs) = case x of + Start -> (xs, Greeting) + Consume l -> (xs, WriteLine l) + End path lns -> ([], Finish path lns) + + resetLine :: IO () + resetLine = do + clearLine + setCursorColumn 0