{- |
Module                  : DrCabal.Profile.Stacked
Copyright               : (c) 2022 Dmitrii Kovanikov
SPDX-License-Identifier : MPL-2.0
Maintainer              : Dmitrii Kovanikov <kovanikov@gmail.com>
Stability               : Experimental
Portability             : Portable

Stacked profiling output mode.
-}

module DrCabal.Profile.Stacked
    ( createStackedChart
    ) where

import Colourista.Pure (blue, cyan, magenta, red, yellow)
import Colourista.Short (b, i)

import DrCabal.Model (Entry (..), Status (..))
import DrCabal.Profile.Format (fmt, fmtDecimalPlaces, fmtNanos)

import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Text as Text


data Phase = Phase
    { Phase -> Word64
phaseDownloading :: Word64
    , Phase -> Word64
phaseStarting    :: Word64
    , Phase -> Word64
phaseBuilding    :: Word64
    , Phase -> Word64
phaseHaddock     :: Word64
    , Phase -> Word64
phaseInstalling  :: Word64
    }

phaseTotal :: Phase -> Word64
phaseTotal :: Phase -> Word64
phaseTotal (Phase Word64
p1 Word64
p2 Word64
p3 Word64
p4 Word64
p5) = Word64
p1 forall a. Num a => a -> a -> a
+ Word64
p2 forall a. Num a => a -> a -> a
+ Word64
p3 forall a. Num a => a -> a -> a
+ Word64
p4 forall a. Num a => a -> a -> a
+ Word64
p5

groupEntries :: [Entry] -> Map Text [(Status, Word64)]
groupEntries :: [Entry] -> Map Text [(Status, Word64)]
groupEntries = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map Text [(Status, Word64)] -> Entry -> Map Text [(Status, Word64)]
insert forall a. Monoid a => a
mempty
  where
    insert :: Map Text [(Status, Word64)] -> Entry -> Map Text [(Status, Word64)]
    insert :: Map Text [(Status, Word64)] -> Entry -> Map Text [(Status, Word64)]
insert Map Text [(Status, Word64)]
m Entry{Word64
Text
Status
entryLibrary :: Entry -> Text
entryStart :: Entry -> Word64
entryStatus :: Entry -> Status
entryLibrary :: Text
entryStart :: Word64
entryStatus :: Status
..} = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe [a] -> [a]
toVal (Status
entryStatus, Word64
entryStart)) Text
entryLibrary Map Text [(Status, Word64)]
m
      where
        toVal :: a -> Maybe [a] -> [a]
        toVal :: forall a. a -> Maybe [a] -> [a]
toVal a
x Maybe [a]
Nothing   = [a
x]
        toVal a
x (Just [a]
xs) = a
x forall a. a -> [a] -> [a]
: [a]
xs

calculatePhases :: Word64 -> Map Text [(Status, Word64)] -> Map Text Phase
calculatePhases :: Word64 -> Map Text [(Status, Word64)] -> Map Text Phase
calculatePhases Word64
start = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word64 -> [(Status, Word64)] -> Phase
entriesToPhase Word64
start)

entriesToPhase :: Word64 -> [(Status, Word64)] -> Phase
entriesToPhase :: Word64 -> [(Status, Word64)] -> Phase
entriesToPhase Word64
start [(Status, Word64)]
times = Phase
    { phaseDownloading :: Word64
phaseDownloading = Word64
calcDownloading
    , phaseStarting :: Word64
phaseStarting    = Word64
calcStarting
    , phaseBuilding :: Word64
phaseBuilding    = Word64
calcBuilding
    , phaseHaddock :: Word64
phaseHaddock     = Word64
calcHaddock
    , phaseInstalling :: Word64
phaseInstalling  = Word64
calcInstalling
    }
  where
    downloading, downloaded, starting, building, haddock, installing, completed :: Maybe Word64
    downloading :: Maybe Word64
downloading = forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup Status
Downloading [(Status, Word64)]
times
    downloaded :: Maybe Word64
downloaded  = forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup Status
Downloaded  [(Status, Word64)]
times
    starting :: Maybe Word64
starting    = forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup Status
Starting    [(Status, Word64)]
times
    building :: Maybe Word64
building    = forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup Status
Building    [(Status, Word64)]
times
    haddock :: Maybe Word64
haddock     = forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup Status
Haddock     [(Status, Word64)]
times
    installing :: Maybe Word64
installing  = forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup Status
Installing  [(Status, Word64)]
times
    completed :: Maybe Word64
completed   = forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup Status
Completed   [(Status, Word64)]
times

    minusw :: Word64 -> Word64 -> Word64
    Word64
x minusw :: Word64 -> Word64 -> Word64
`minusw` Word64
y
        | Word64
x forall a. Ord a => a -> a -> Bool
<= Word64
y    = Word64
0
        | Bool
otherwise = Word64
x forall a. Num a => a -> a -> a
- Word64
y

    calcDownloading :: Word64
    calcDownloading :: Word64
calcDownloading = case (Maybe Word64
downloading, Maybe Word64
downloaded) of
        (Just Word64
dStart, Just Word64
dEnd) -> Word64
dEnd Word64 -> Word64 -> Word64
`minusw` Word64
dStart
        (Maybe Word64, Maybe Word64)
_                        -> Word64
0

    calcStarting :: Word64
    calcStarting :: Word64
calcStarting = case Maybe Word64
building of
        Maybe Word64
Nothing -> Word64
0
        Just Word64
bt -> case Maybe Word64
starting of
            Just Word64
st -> Word64
bt Word64 -> Word64 -> Word64
`minusw` Word64
st
            Maybe Word64
Nothing -> Word64
bt Word64 -> Word64 -> Word64
`minusw` Word64
start

    calcBuilding :: Word64
    calcBuilding :: Word64
calcBuilding = case Maybe Word64
haddock forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Word64
installing of
      Maybe Word64
Nothing -> Word64
0
      Just Word64
ba -> case Maybe Word64
building of
        Maybe Word64
Nothing -> Word64
ba Word64 -> Word64 -> Word64
`minusw` Word64
start
        Just Word64
bt -> Word64
ba Word64 -> Word64 -> Word64
`minusw` Word64
bt

    calcHaddock :: Word64
    calcHaddock :: Word64
calcHaddock = case Maybe Word64
haddock of
        Maybe Word64
Nothing -> Word64
0
        Just Word64
hd -> case Maybe Word64
installing of
            Maybe Word64
Nothing -> Word64
hd Word64 -> Word64 -> Word64
`minusw` Word64
start
            Just Word64
it -> Word64
it Word64 -> Word64 -> Word64
`minusw` Word64
hd

    calcInstalling :: Word64
    calcInstalling :: Word64
calcInstalling = case Maybe Word64
completed of
        Maybe Word64
Nothing -> Word64
0
        Just Word64
ct -> case Maybe Word64
installing of
            Maybe Word64
Nothing -> Word64
ct Word64 -> Word64 -> Word64
`minusw` Word64
start
            Just Word64
it -> Word64
ct Word64 -> Word64 -> Word64
`minusw` Word64
it

formatChart :: Word64 -> Word64 -> Int -> Map Text Phase -> Text
formatChart :: Word64 -> Word64 -> Int -> Map Text Phase -> Text
formatChart Word64
start Word64
end Int
width Map Text Phase
libs = forall t. IsText t "unlines" => [t] -> t
unlines forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Text]
legend
    , [Text]
summary
    , [Text]
profile
    ]
  where
    block :: Text
    block :: Text
block = Text
"▇"

    legend :: [Text]
    legend :: [Text]
legend =
        [ forall str. (IsString str, Semigroup str) => str -> str
b Text
"Legend"
        , Text
"  " forall a. Semigroup a => a -> a -> a
<> [Text] -> Text -> Text
fmt [forall str. IsString str => str
cyan]    Text
block forall a. Semigroup a => a -> a -> a
<> Text
"  Downloading"
        , Text
"  " forall a. Semigroup a => a -> a -> a
<> [Text] -> Text -> Text
fmt [forall str. IsString str => str
blue]    Text
block forall a. Semigroup a => a -> a -> a
<> Text
"  Starting"
        , Text
"  " forall a. Semigroup a => a -> a -> a
<> [Text] -> Text -> Text
fmt [forall str. IsString str => str
red]     Text
block forall a. Semigroup a => a -> a -> a
<> Text
"  Building"
        , Text
"  " forall a. Semigroup a => a -> a -> a
<> [Text] -> Text -> Text
fmt [forall str. IsString str => str
magenta] Text
block forall a. Semigroup a => a -> a -> a
<> Text
"  Haddock"
        , Text
"  " forall a. Semigroup a => a -> a -> a
<> [Text] -> Text -> Text
fmt [forall str. IsString str => str
yellow]  Text
block forall a. Semigroup a => a -> a -> a
<> Text
"  Installing"
        , Text
""
        ]

    summary :: [Text]
    summary :: [Text]
summary =
        [ forall str. (IsString str, Semigroup str) => str -> str
b Text
"Summary"
        , forall str. (IsString str, Semigroup str) => str -> str
i Text
"  Wall time              " forall a. Semigroup a => a -> a -> a
<> Text
" : " forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
fmtNanos (Word64
end forall a. Num a => a -> a -> a
- Word64
start)
        , forall str. (IsString str, Semigroup str) => str -> str
i Text
"  Dependency sum time    " forall a. Semigroup a => a -> a -> a
<> Text
" : " forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
fmtNanos Word64
totalAllPhases
        , forall str. (IsString str, Semigroup str) => str -> str
i Text
"  Total dependencies     " forall a. Semigroup a => a -> a -> a
<> Text
" : " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show (forall k a. Map k a -> Int
Map.size Map Text Phase
libs)
        , forall str. (IsString str, Semigroup str) => str -> str
i Text
"  Parallelism level      " forall a. Semigroup a => a -> a -> a
<> Text
" : " forall a. Semigroup a => a -> a -> a
<> Int -> Float -> Text
fmtDecimalPlaces Int
2 Float
parallelism
        , forall str. (IsString str, Semigroup str) => str -> str
i Text
"  Single block resolution" forall a. Semigroup a => a -> a -> a
<> Text
" : " forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
fmtNanos Word64
blockMeasure
        , Text
""
        ]

    profile :: [Text]
    profile :: [Text]
profile = forall str. (IsString str, Semigroup str) => str -> str
b Text
"Profile" forall a. a -> [a] -> [a]
: [Text]
formattedEntries

    formattedEntries :: [Text]
    formattedEntries :: [Text]
formattedEntries
        = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Phase -> Text
formatRow)
        forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. Phase -> Word64
phaseTotal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Text, Phase)]
entries

    formatRow :: Text -> Phase -> Text
    formatRow :: Text -> Phase -> Text
formatRow Text
libName phase :: Phase
phase@Phase{Word64
phaseInstalling :: Word64
phaseHaddock :: Word64
phaseBuilding :: Word64
phaseStarting :: Word64
phaseDownloading :: Word64
phaseInstalling :: Phase -> Word64
phaseHaddock :: Phase -> Word64
phaseBuilding :: Phase -> Word64
phaseStarting :: Phase -> Word64
phaseDownloading :: Phase -> Word64
..} = forall a. Monoid a => [a] -> a
mconcat
        [ Text -> Phase -> Text
fmtPrefix Text
libName Phase
phase
        , Text -> Word64 -> Text
formatSinglePhase forall str. IsString str => str
cyan    Word64
phaseDownloading
        , Text -> Word64 -> Text
formatSinglePhase forall str. IsString str => str
blue    Word64
phaseStarting
        , Text -> Word64 -> Text
formatSinglePhase forall str. IsString str => str
red     Word64
phaseBuilding
        , Text -> Word64 -> Text
formatSinglePhase forall str. IsString str => str
magenta Word64
phaseHaddock
        , Text -> Word64 -> Text
formatSinglePhase forall str. IsString str => str
yellow  Word64
phaseInstalling
        ]

    entries :: [(Text, Phase)]
    entries :: [(Text, Phase)]
entries = forall k a. Map k a -> [(k, a)]
Map.toList Map Text Phase
libs

    libSize, phaseSize, prefixSize :: Int
    libSize :: Int
libSize    = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
List.maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text -> Int
Text.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Text, Phase)]
entries
    phaseSize :: Int
phaseSize  = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
List.maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text -> Int
Text.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Phase -> Text
fmtPhase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Text, Phase)]
entries
    prefixSize :: Int
prefixSize = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
List.maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text -> Int
Text.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Phase -> Text
fmtPrefix) [(Text, Phase)]
entries

    longestPhase :: Word64
    longestPhase :: Word64
longestPhase = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
List.maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Phase -> Word64
phaseTotal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Text, Phase)]
entries

    totalAllPhases :: Word64
    totalAllPhases :: Word64
totalAllPhases = forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Phase -> Word64
phaseTotal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Text, Phase)]
entries

    parallelism :: Float
    parallelism :: Float
parallelism = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
totalAllPhases forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
end forall a. Num a => a -> a -> a
- Word64
start)

    fmtPhase :: Phase -> Text
    fmtPhase :: Phase -> Text
fmtPhase = Word64 -> Text
fmtNanos forall b c a. (b -> c) -> (a -> b) -> a -> c
. Phase -> Word64
phaseTotal

    fmtPrefix :: Text -> Phase -> Text
    fmtPrefix :: Text -> Phase -> Text
fmtPrefix Text
libName Phase
phase = forall a. Monoid a => [a] -> a
mconcat
        [ Int -> Char -> Text -> Text
Text.justifyRight Int
libSize Char
' ' Text
libName
        , Text
" ["
        , Int -> Char -> Text -> Text
Text.justifyLeft Int
phaseSize Char
' ' forall a b. (a -> b) -> a -> b
$ Phase -> Text
fmtPhase Phase
phase
        , Text
"] "
        , Text
"│"
        , Text
" "
        ]

    -- How many nanoseconds each block represents?
    -- blocks take:
    -- width minus prefix size
    --       minus 4 for remainders of each phase
    blockMeasure :: Word64
    blockMeasure :: Word64
blockMeasure = Word64
longestPhase forall a. Integral a => a -> a -> a
`div` forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
width forall a. Num a => a -> a -> a
- Int
prefixSize forall a. Num a => a -> a -> a
- Int
4)

    formatSinglePhase :: Text -> Word64 -> Text
    formatSinglePhase :: Text -> Word64 -> Text
formatSinglePhase Text
colour Word64
phase
        | Word64
phase forall a. Eq a => a -> a -> Bool
== Word64
0 = Text
""
        | Bool
otherwise  = [Text] -> Text -> Text
fmt [Text
colour] forall a b. (a -> b) -> a -> b
$ forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes Word64
blockCount Text
block
      where
        blockCount :: Word64
        blockCount :: Word64
blockCount = Word64
blockRemainder forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> a -> a
div Word64
phase Word64
blockMeasure

        blockRemainder :: Word64
        blockRemainder :: Word64
blockRemainder = if Word64
phase forall a. Integral a => a -> a -> a
`mod` Word64
blockMeasure forall a. Ord a => a -> a -> Bool
> Word64
0 then Word64
1 else Word64
0

createStackedChart :: Int -> [Entry] -> Text
createStackedChart :: Int -> [Entry] -> Text
createStackedChart Int
width [Entry]
l = case [Entry]
l of
    [] -> forall t. IsText t "unlines" => [t] -> t
unlines
        [ Text
"No cabal build entries found. Have you already built dependency?"
        , Text
"Try removing global cabal store cache and rerunning 'dr-cabal watch' again."
        ]
    [Entry]
entries ->
        let start :: Word64
start = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
List.minimum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Entry -> Word64
entryStart [Entry]
entries in
        let end :: Word64
end   = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
List.maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Entry -> Word64
entryStart [Entry]
entries in
        Word64 -> Word64 -> Int -> Map Text Phase -> Text
formatChart Word64
start Word64
end Int
width forall a b. (a -> b) -> a -> b
$ Word64 -> Map Text [(Status, Word64)] -> Map Text Phase
calculatePhases Word64
start forall a b. (a -> b) -> a -> b
$ [Entry] -> Map Text [(Status, Word64)]
groupEntries [Entry]
entries