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
computeCriticalPath :: Map Text [(Status, Word64)] -> [Text]
computeCriticalPath :: Map Text [(Status, Word64)] -> [Text]
computeCriticalPath Map Text [(Status, Word64)]
libs = case forall k a. Map k a -> Maybe (a, Map k a)
Map.maxView Map Word64 Text
finishTimeToLibs of
Maybe (Text, Map Word64 Text)
Nothing -> []
Just (Text
lastLib, Map Word64 Text
_) -> Text
lastLib forall a. a -> [a] -> [a]
: forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr Text -> Maybe (Text, Text)
go Text
lastLib
where
libsList :: [(Text, [Word64])]
libsList :: [(Text, [Word64])]
libsList = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd)) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.assocs Map Text [(Status, Word64)]
libs
libsByStartTime :: Map Text Word64
libsByStartTime :: Map Text Word64
libsByStartTime = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
List.minimum) [(Text, [Word64])]
libsList
finishTimeToLibs :: Map Word64 Text
finishTimeToLibs :: Map Word64 Text
finishTimeToLibs = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a, b) -> (b, a)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
List.maximum) [(Text, [Word64])]
libsList
go :: Text -> Maybe (Text, Text)
go :: Text -> Maybe (Text, Text)
go Text
lib = do
Word64
phase <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
lib Map Text Word64
libsByStartTime
let (Map Word64 Text
finishedBefore, Map Word64 Text
_) = forall k a. Ord k => k -> Map k a -> (Map k a, Map k a)
Map.split Word64
phase Map Word64 Text
finishTimeToLibs
Text
prevLib <- forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> Maybe (a, Map k a)
Map.maxView Map Word64 Text
finishedBefore
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
prevLib, Text
prevLib)
formatChart :: Word64 -> Word64 -> Int -> [Text] -> Map Text Phase -> Text
formatChart :: Word64 -> Word64 -> Int -> [Text] -> Map Text Phase -> Text
formatChart Word64
start Word64
end Int
width [Text]
critPath 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
" " forall a. Semigroup a => a -> a -> a
<> forall str. (IsString str, Semigroup str) => str -> str
b Text
"*" forall a. Semigroup a => a -> a -> a
<> Text
" Critical path"
, 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 (sum along critpath)" 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
[ Text
fmtCritPath
, 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
" "
]
where
isOnCritPath :: Bool
isOnCritPath :: Bool
isOnCritPath = Text
libName forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Text]
critPath
fmtCritPath :: Text
fmtCritPath :: Text
fmtCritPath
| Bool
isOnCritPath = forall str. (IsString str, Semigroup str) => str -> str
b forall a b. (a -> b) -> a -> b
$ Text
paddedLibName forall a. Semigroup a => a -> a -> a
<> Text
"*"
| Bool
otherwise = Text
paddedLibName forall a. Semigroup a => a -> a -> a
<> Text
" "
where
paddedLibName :: Text
paddedLibName = Int -> Char -> Text -> Text
Text.justifyRight Int
libSize Char
' ' Text
libName
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
let grouped :: Map Text [(Status, Word64)]
grouped = [Entry] -> Map Text [(Status, Word64)]
groupEntries [Entry]
entries in
let critPath :: [Text]
critPath = Map Text [(Status, Word64)] -> [Text]
computeCriticalPath Map Text [(Status, Word64)]
grouped in
Word64 -> Word64 -> Int -> [Text] -> Map Text Phase -> Text
formatChart Word64
start Word64
end Int
width [Text]
critPath forall a b. (a -> b) -> a -> b
$ Word64 -> Map Text [(Status, Word64)] -> Map Text Phase
calculatePhases Word64
start Map Text [(Status, Word64)]
grouped