{-# LANGUAGE PatternGuards, RecordWildCards #-}

module Development.Shake.Internal.Profile(writeProfile) where

import General.Template
import Data.Tuple.Extra
import Data.Function
import Data.List.Extra
import Data.Maybe
import System.FilePath
import System.IO.Extra
import Numeric.Extra
import General.Extra
import Development.Shake.Internal.Errors
import Development.Shake.Internal.Core.Types
import Development.Shake.Internal.Core.Database
import Development.Shake.Internal.Value
import qualified Data.HashSet as Set
import Development.Shake.Internal.Paths
import Development.Shake.Classes
import System.Time.Extra
import qualified Data.HashMap.Strict as Map
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.ByteString.Char8 as BS
import General.Intern(Id)


-- | Given a map of representing a dependency order (with a show for error messages), find an ordering for the items such
--   that no item points to an item before itself.
--   Raise an error if you end up with a cycle.
dependencyOrder :: (Eq a, Hashable a) => (a -> String) -> Map.HashMap a [a] -> [a]
-- Algorithm:
--    Divide everyone up into those who have no dependencies [Id]
--    And those who depend on a particular Id, Dep :-> Maybe [(Key,[Dep])]
--    Where d :-> Just (k, ds), k depends on firstly d, then remaining on ds
--    For each with no dependencies, add to list, then take its dep hole and
--    promote them either to Nothing (if ds == []) or into a new slot.
--    k :-> Nothing means the key has already been freed
dependencyOrder :: (a -> String) -> HashMap a [a] -> [a]
dependencyOrder a -> String
shw HashMap a [a]
status = [a] -> HashMap a (Maybe [(a, [a])]) -> [a]
f (((a, [a]) -> a) -> [(a, [a])] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, [a]) -> a
forall a b. (a, b) -> a
fst [(a, [a])]
noDeps) (HashMap a (Maybe [(a, [a])]) -> [a])
-> HashMap a (Maybe [(a, [a])]) -> [a]
forall a b. (a -> b) -> a -> b
$ ([(a, [a])] -> Maybe [(a, [a])])
-> HashMap a [(a, [a])] -> HashMap a (Maybe [(a, [a])])
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
Map.map [(a, [a])] -> Maybe [(a, [a])]
forall a. a -> Maybe a
Just (HashMap a [(a, [a])] -> HashMap a (Maybe [(a, [a])]))
-> HashMap a [(a, [a])] -> HashMap a (Maybe [(a, [a])])
forall a b. (a -> b) -> a -> b
$ ([(a, [a])] -> [(a, [a])] -> [(a, [a])])
-> [(a, [(a, [a])])] -> HashMap a [(a, [a])]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
Map.fromListWith [(a, [a])] -> [(a, [a])] -> [(a, [a])]
forall a. [a] -> [a] -> [a]
(++) [(a
d, [(a
k,[a]
ds)]) | (a
k,a
d:[a]
ds) <- [(a, [a])]
hasDeps]
    where
        ([(a, [a])]
noDeps, [(a, [a])]
hasDeps) = ((a, [a]) -> Bool) -> [(a, [a])] -> ([(a, [a])], [(a, [a])])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ([a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a] -> Bool) -> ((a, [a]) -> [a]) -> (a, [a]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [a]) -> [a]
forall a b. (a, b) -> b
snd) ([(a, [a])] -> ([(a, [a])], [(a, [a])]))
-> [(a, [a])] -> ([(a, [a])], [(a, [a])])
forall a b. (a -> b) -> a -> b
$ HashMap a [a] -> [(a, [a])]
forall k v. HashMap k v -> [(k, v)]
Map.toList HashMap a [a]
status

        f :: [a] -> HashMap a (Maybe [(a, [a])]) -> [a]
f [] HashMap a (Maybe [(a, [a])])
mp | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
bad = []
                | Bool
otherwise = SomeException -> [a]
forall a. SomeException -> a
throwImpure (SomeException -> [a]) -> SomeException -> [a]
forall a b. (a -> b) -> a -> b
$ Partial => String -> SomeException
String -> SomeException
errorInternal (String -> SomeException) -> String -> SomeException
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
                    String
"Internal invariant broken, database seems to be cyclic" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
                    (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"    " String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
bad [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                    [String
"... plus " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
badOverflow) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" more ..." | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
badOverflow]
            where ([String]
bad,[String]
badOverflow) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
10 [a -> String
shw a
i | (a
i, Just [(a, [a])]
_) <- HashMap a (Maybe [(a, [a])]) -> [(a, Maybe [(a, [a])])]
forall k v. HashMap k v -> [(k, v)]
Map.toList HashMap a (Maybe [(a, [a])])
mp]

        f (a
x:[a]
xs) HashMap a (Maybe [(a, [a])])
mp = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> HashMap a (Maybe [(a, [a])]) -> [a]
f ([a]
now[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
xs) HashMap a (Maybe [(a, [a])])
later
            where Just [(a, [a])]
free = Maybe [(a, [a])]
-> a -> HashMap a (Maybe [(a, [a])]) -> Maybe [(a, [a])]
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
Map.lookupDefault ([(a, [a])] -> Maybe [(a, [a])]
forall a. a -> Maybe a
Just []) a
x HashMap a (Maybe [(a, [a])])
mp
                  ([a]
now,HashMap a (Maybe [(a, [a])])
later) = (([a], HashMap a (Maybe [(a, [a])]))
 -> (a, [a]) -> ([a], HashMap a (Maybe [(a, [a])])))
-> ([a], HashMap a (Maybe [(a, [a])]))
-> [(a, [a])]
-> ([a], HashMap a (Maybe [(a, [a])]))
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([a], HashMap a (Maybe [(a, [a])]))
-> (a, [a]) -> ([a], HashMap a (Maybe [(a, [a])]))
forall k a.
(Eq k, Hashable k) =>
([a], HashMap k (Maybe [(a, [k])]))
-> (a, [k]) -> ([a], HashMap k (Maybe [(a, [k])]))
g ([], a
-> Maybe [(a, [a])]
-> HashMap a (Maybe [(a, [a])])
-> HashMap a (Maybe [(a, [a])])
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
Map.insert a
x Maybe [(a, [a])]
forall a. Maybe a
Nothing HashMap a (Maybe [(a, [a])])
mp) [(a, [a])]
free

        g :: ([a], HashMap k (Maybe [(a, [k])]))
-> (a, [k]) -> ([a], HashMap k (Maybe [(a, [k])]))
g ([a]
free, HashMap k (Maybe [(a, [k])])
mp) (a
k, []) = (a
ka -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
free, HashMap k (Maybe [(a, [k])])
mp)
        g ([a]
free, HashMap k (Maybe [(a, [k])])
mp) (a
k, k
d:[k]
ds) = case Maybe [(a, [k])]
-> k -> HashMap k (Maybe [(a, [k])]) -> Maybe [(a, [k])]
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
Map.lookupDefault ([(a, [k])] -> Maybe [(a, [k])]
forall a. a -> Maybe a
Just []) k
d HashMap k (Maybe [(a, [k])])
mp of
            Maybe [(a, [k])]
Nothing -> ([a], HashMap k (Maybe [(a, [k])]))
-> (a, [k]) -> ([a], HashMap k (Maybe [(a, [k])]))
g ([a]
free, HashMap k (Maybe [(a, [k])])
mp) (a
k, [k]
ds)
            Just [(a, [k])]
todo -> ([a]
free, k
-> Maybe [(a, [k])]
-> HashMap k (Maybe [(a, [k])])
-> HashMap k (Maybe [(a, [k])])
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
Map.insert k
d ([(a, [k])] -> Maybe [(a, [k])]
forall a. a -> Maybe a
Just ([(a, [k])] -> Maybe [(a, [k])]) -> [(a, [k])] -> Maybe [(a, [k])]
forall a b. (a -> b) -> a -> b
$ (a
k,[k]
ds) (a, [k]) -> [(a, [k])] -> [(a, [k])]
forall a. a -> [a] -> [a]
: [(a, [k])]
todo) HashMap k (Maybe [(a, [k])])
mp)


-- | Eliminate all errors from the database, pretending they don't exist
resultsOnly :: Map.HashMap Id (Key, Status) -> Map.HashMap Id (Key, Result (Either BS.ByteString Value))
resultsOnly :: HashMap Id (Key, Status)
-> HashMap Id (Key, Result (Either ByteString Value))
resultsOnly HashMap Id (Key, Status)
mp = ((Key, Status) -> (Key, Result (Either ByteString Value)))
-> HashMap Id (Key, Status)
-> HashMap Id (Key, Result (Either ByteString Value))
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
Map.map (\(Key
k, Status
v) -> (Key
k, let Just Result (Either ByteString Value)
r = Status -> Maybe (Result (Either ByteString Value))
getResult Status
v in Result (Either ByteString Value)
r{depends :: [Depends]
depends = (Depends -> Depends) -> [Depends] -> [Depends]
forall a b. (a -> b) -> [a] -> [b]
map ([Id] -> Depends
Depends ([Id] -> Depends) -> (Depends -> [Id]) -> Depends -> Depends
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Id -> Bool) -> [Id] -> [Id]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (Key, Status) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Key, Status) -> Bool)
-> (Id -> Maybe (Key, Status)) -> Id -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Id -> HashMap Id (Key, Status) -> Maybe (Key, Status))
-> HashMap Id (Key, Status) -> Id -> Maybe (Key, Status)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Id -> HashMap Id (Key, Status) -> Maybe (Key, Status)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup HashMap Id (Key, Status)
keep) ([Id] -> [Id]) -> (Depends -> [Id]) -> Depends -> [Id]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Depends -> [Id]
fromDepends) ([Depends] -> [Depends]) -> [Depends] -> [Depends]
forall a b. (a -> b) -> a -> b
$ Result (Either ByteString Value) -> [Depends]
forall a. Result a -> [Depends]
depends Result (Either ByteString Value)
r})) HashMap Id (Key, Status)
keep
    where keep :: HashMap Id (Key, Status)
keep = ((Key, Status) -> Bool)
-> HashMap Id (Key, Status) -> HashMap Id (Key, Status)
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
Map.filter (Maybe (Result (Either ByteString Value)) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Result (Either ByteString Value)) -> Bool)
-> ((Key, Status) -> Maybe (Result (Either ByteString Value)))
-> (Key, Status)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Maybe (Result (Either ByteString Value))
getResult (Status -> Maybe (Result (Either ByteString Value)))
-> ((Key, Status) -> Status)
-> (Key, Status)
-> Maybe (Result (Either ByteString Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key, Status) -> Status
forall a b. (a, b) -> b
snd) HashMap Id (Key, Status)
mp

removeStep :: Map.HashMap Id (Key, Result a) -> Map.HashMap Id (Key, Result a)
removeStep :: HashMap Id (Key, Result a) -> HashMap Id (Key, Result a)
removeStep = ((Key, Result a) -> Bool)
-> HashMap Id (Key, Result a) -> HashMap Id (Key, Result a)
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
Map.filter (\(Key
k,Result a
_) -> Key
k Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
/= Key
stepKey)

toReport :: Database -> IO [ProfileEntry]
toReport :: Database -> IO [ProfileEntry]
toReport Database
db = do
    HashMap Id (Key, Result (Either ByteString Value))
status <- HashMap Id (Key, Result (Either ByteString Value))
-> HashMap Id (Key, Result (Either ByteString Value))
forall a. HashMap Id (Key, Result a) -> HashMap Id (Key, Result a)
removeStep (HashMap Id (Key, Result (Either ByteString Value))
 -> HashMap Id (Key, Result (Either ByteString Value)))
-> (HashMap Id (Key, Status)
    -> HashMap Id (Key, Result (Either ByteString Value)))
-> HashMap Id (Key, Status)
-> HashMap Id (Key, Result (Either ByteString Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Id (Key, Status)
-> HashMap Id (Key, Result (Either ByteString Value))
resultsOnly (HashMap Id (Key, Status)
 -> HashMap Id (Key, Result (Either ByteString Value)))
-> IO (HashMap Id (Key, Status))
-> IO (HashMap Id (Key, Result (Either ByteString Value)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Database -> IO (HashMap Id (Key, Status))
forall k v. DatabasePoly k v -> IO (HashMap Id (k, v))
getKeyValuesFromId Database
db
    let order :: [Id]
order = let shw :: Id -> String
shw Id
i = String
-> ((Key, Result (Either ByteString Value)) -> String)
-> Maybe (Key, Result (Either ByteString Value))
-> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"<unknown>" (Key -> String
forall a. Show a => a -> String
show (Key -> String)
-> ((Key, Result (Either ByteString Value)) -> Key)
-> (Key, Result (Either ByteString Value))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key, Result (Either ByteString Value)) -> Key
forall a b. (a, b) -> a
fst) (Maybe (Key, Result (Either ByteString Value)) -> String)
-> Maybe (Key, Result (Either ByteString Value)) -> String
forall a b. (a -> b) -> a -> b
$ Id
-> HashMap Id (Key, Result (Either ByteString Value))
-> Maybe (Key, Result (Either ByteString Value))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Id
i HashMap Id (Key, Result (Either ByteString Value))
status
                in (Id -> String) -> HashMap Id [Id] -> [Id]
forall a.
(Eq a, Hashable a) =>
(a -> String) -> HashMap a [a] -> [a]
dependencyOrder Id -> String
shw (HashMap Id [Id] -> [Id]) -> HashMap Id [Id] -> [Id]
forall a b. (a -> b) -> a -> b
$ ((Key, Result (Either ByteString Value)) -> [Id])
-> HashMap Id (Key, Result (Either ByteString Value))
-> HashMap Id [Id]
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
Map.map ((Depends -> [Id]) -> [Depends] -> [Id]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Depends -> [Id]
fromDepends ([Depends] -> [Id])
-> ((Key, Result (Either ByteString Value)) -> [Depends])
-> (Key, Result (Either ByteString Value))
-> [Id]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result (Either ByteString Value) -> [Depends]
forall a. Result a -> [Depends]
depends (Result (Either ByteString Value) -> [Depends])
-> ((Key, Result (Either ByteString Value))
    -> Result (Either ByteString Value))
-> (Key, Result (Either ByteString Value))
-> [Depends]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key, Result (Either ByteString Value))
-> Result (Either ByteString Value)
forall a b. (a, b) -> b
snd) HashMap Id (Key, Result (Either ByteString Value))
status
        ids :: HashMap Id Int
ids = [(Id, Int)] -> HashMap Id Int
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(Id, Int)] -> HashMap Id Int) -> [(Id, Int)] -> HashMap Id Int
forall a b. (a -> b) -> a -> b
$ [Id] -> [Int] -> [(Id, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Id]
order [Int
0..]

        steps :: HashMap Step Int
steps = let xs :: [Step]
xs = HashSet Step -> [Step]
forall a. HashSet a -> [a]
Set.toList (HashSet Step -> [Step]) -> HashSet Step -> [Step]
forall a b. (a -> b) -> a -> b
$ [Step] -> HashSet Step
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList ([Step] -> HashSet Step) -> [Step] -> HashSet Step
forall a b. (a -> b) -> a -> b
$ [[Step]] -> [Step]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Step
changed, Step
built] | (Key
_,Result{Float
[Depends]
[Trace]
Either ByteString Value
Step
traces :: forall a. Result a -> [Trace]
execution :: forall a. Result a -> Float
changed :: forall a. Result a -> Step
built :: forall a. Result a -> Step
result :: forall a. Result a -> a
traces :: [Trace]
execution :: Float
depends :: [Depends]
result :: Either ByteString Value
built :: Step
changed :: Step
depends :: forall a. Result a -> [Depends]
..}) <- HashMap Id (Key, Result (Either ByteString Value))
-> [(Key, Result (Either ByteString Value))]
forall k v. HashMap k v -> [v]
Map.elems HashMap Id (Key, Result (Either ByteString Value))
status]
                in [(Step, Int)] -> HashMap Step Int
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(Step, Int)] -> HashMap Step Int)
-> [(Step, Int)] -> HashMap Step Int
forall a b. (a -> b) -> a -> b
$ [Step] -> [Int] -> [(Step, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Step -> Step -> Ordering) -> [Step] -> [Step]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Step -> Step -> Ordering) -> Step -> Step -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Step -> Step -> Ordering
forall a. Ord a => a -> a -> Ordering
compare) [Step]
xs) [Int
0..]

        f :: (a, Result a) -> ProfileEntry
f (a
k, Result{a
Float
[Depends]
[Trace]
Step
traces :: [Trace]
execution :: Float
depends :: [Depends]
changed :: Step
built :: Step
result :: a
traces :: forall a. Result a -> [Trace]
execution :: forall a. Result a -> Float
changed :: forall a. Result a -> Step
built :: forall a. Result a -> Step
result :: forall a. Result a -> a
depends :: forall a. Result a -> [Depends]
..}) = ProfileEntry :: String
-> Int
-> Int
-> [[Int]]
-> Double
-> [ProfileTrace]
-> ProfileEntry
ProfileEntry
            {prfName :: String
prfName = a -> String
forall a. Show a => a -> String
show a
k
            ,prfBuilt :: Int
prfBuilt = Step -> Int
fromStep Step
built
            ,prfChanged :: Int
prfChanged = Step -> Int
fromStep Step
changed
            ,prfDepends :: [[Int]]
prfDepends = ([Int] -> Bool) -> [[Int]] -> [[Int]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Int] -> Bool) -> [Int] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ (Depends -> [Int]) -> [Depends] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map ((Id -> Maybe Int) -> [Id] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Id -> HashMap Id Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`Map.lookup` HashMap Id Int
ids) ([Id] -> [Int]) -> (Depends -> [Id]) -> Depends -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Depends -> [Id]
fromDepends) [Depends]
depends
            ,prfExecution :: Double
prfExecution = Float -> Double
floatToDouble Float
execution
            ,prfTraces :: [ProfileTrace]
prfTraces = (Trace -> ProfileTrace) -> [Trace] -> [ProfileTrace]
forall a b. (a -> b) -> [a] -> [b]
map Trace -> ProfileTrace
fromTrace ([Trace] -> [ProfileTrace]) -> [Trace] -> [ProfileTrace]
forall a b. (a -> b) -> a -> b
$ (Trace -> Float) -> [Trace] -> [Trace]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Trace -> Float
traceStart [Trace]
traces
            }
            where fromStep :: Step -> Int
fromStep Step
i = Maybe Int -> Int
forall a. Partial => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Step -> HashMap Step Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Step
i HashMap Step Int
steps
                  fromTrace :: Trace -> ProfileTrace
fromTrace (Trace ByteString
a Float
b Float
c) = String -> Double -> Double -> ProfileTrace
ProfileTrace (ByteString -> String
BS.unpack ByteString
a) (Float -> Double
floatToDouble Float
b) (Float -> Double
floatToDouble Float
c)
    [ProfileEntry] -> IO [ProfileEntry]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ProfileEntry
-> ((Key, Result (Either ByteString Value)) -> ProfileEntry)
-> Maybe (Key, Result (Either ByteString Value))
-> ProfileEntry
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SomeException -> ProfileEntry
forall a. SomeException -> a
throwImpure (SomeException -> ProfileEntry) -> SomeException -> ProfileEntry
forall a b. (a -> b) -> a -> b
$ Partial => String -> SomeException
String -> SomeException
errorInternal String
"toReport") (Key, Result (Either ByteString Value)) -> ProfileEntry
forall a a. Show a => (a, Result a) -> ProfileEntry
f (Maybe (Key, Result (Either ByteString Value)) -> ProfileEntry)
-> Maybe (Key, Result (Either ByteString Value)) -> ProfileEntry
forall a b. (a -> b) -> a -> b
$ Id
-> HashMap Id (Key, Result (Either ByteString Value))
-> Maybe (Key, Result (Either ByteString Value))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Id
i HashMap Id (Key, Result (Either ByteString Value))
status | Id
i <- [Id]
order]


data ProfileEntry = ProfileEntry
    {ProfileEntry -> String
prfName :: String, ProfileEntry -> Int
prfBuilt :: Int, ProfileEntry -> Int
prfChanged :: Int, ProfileEntry -> [[Int]]
prfDepends :: [[Int]], ProfileEntry -> Double
prfExecution :: Double, ProfileEntry -> [ProfileTrace]
prfTraces :: [ProfileTrace]}
data ProfileTrace = ProfileTrace
    {ProfileTrace -> String
prfCommand :: String, ProfileTrace -> Double
prfStart :: Double, ProfileTrace -> Double
prfStop :: Double}
prfTime :: ProfileTrace -> Double
prfTime ProfileTrace{Double
String
prfStop :: Double
prfStart :: Double
prfCommand :: String
prfStop :: ProfileTrace -> Double
prfStart :: ProfileTrace -> Double
prfCommand :: ProfileTrace -> String
..} = Double
prfStop Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
prfStart

-- | Generates an report given some build system profiling data.
writeProfile :: FilePath -> Database -> IO ()
writeProfile :: String -> Database -> IO ()
writeProfile String
out Database
db = String -> [ProfileEntry] -> IO ()
writeProfileInternal String
out ([ProfileEntry] -> IO ()) -> IO [ProfileEntry] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Database -> IO [ProfileEntry]
toReport Database
db

writeProfileInternal :: FilePath -> [ProfileEntry] -> IO ()
writeProfileInternal :: String -> [ProfileEntry] -> IO ()
writeProfileInternal String
out [ProfileEntry]
xs
    | String -> String
takeExtension String
out String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".js" = String -> String -> IO ()
writeFileBinary String
out (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"var profile = \n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [ProfileEntry] -> String
generateJSON [ProfileEntry]
xs
    | String -> String
takeExtension String
out String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".json" = String -> String -> IO ()
writeFileBinary String
out (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [ProfileEntry] -> String
generateJSON [ProfileEntry]
xs
    | String -> String
takeExtension String
out String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".trace" = String -> String -> IO ()
writeFileBinary String
out (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [ProfileEntry] -> String
generateTrace [ProfileEntry]
xs
    | String
out String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-" = String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [ProfileEntry] -> [String]
generateSummary [ProfileEntry]
xs
    -- NOTE: On my laptop writing 1.5Mb of profile report takes 0.6s.
    --       This is fundamentals of my laptop, not a Haskell profiling issue.
    --       Verified with similar "type foo > bar" commands taking similar time.
    | Bool
otherwise = String -> ByteString -> IO ()
LBS.writeFile String
out (ByteString -> IO ()) -> IO ByteString -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [ProfileEntry] -> IO ByteString
generateHTML [ProfileEntry]
xs


generateSummary :: [ProfileEntry] -> [String]
generateSummary :: [ProfileEntry] -> [String]
generateSummary [ProfileEntry]
xs =
    [String
"* This database has tracked " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (ProfileEntry -> Int) -> [ProfileEntry] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ProfileEntry -> Int
prfChanged [ProfileEntry]
xs) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" runs."
    ,let f :: [a] -> String
f = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> ([a] -> Int) -> [a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length in String
"* There are " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [ProfileEntry] -> String
forall a. [a] -> String
f [ProfileEntry]
xs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" rules (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [ProfileEntry] -> String
forall a. [a] -> String
f [ProfileEntry]
ls String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" rebuilt in the last run)."
    ,let f :: [ProfileEntry] -> String
f = Int -> String
forall a. Show a => a -> String
show (Int -> String)
-> ([ProfileEntry] -> Int) -> [ProfileEntry] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int)
-> ([ProfileEntry] -> [Int]) -> [ProfileEntry] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProfileEntry -> Int) -> [ProfileEntry] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([ProfileTrace] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ProfileTrace] -> Int)
-> (ProfileEntry -> [ProfileTrace]) -> ProfileEntry -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProfileEntry -> [ProfileTrace]
prfTraces) in String
"* Building required " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [ProfileEntry] -> String
f [ProfileEntry]
xs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" traced commands (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [ProfileEntry] -> String
f [ProfileEntry]
ls String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in the last run)."
    ,String
"* The total (unparallelised) time is " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
showDuration ([Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ (ProfileEntry -> Double) -> [ProfileEntry] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ProfileEntry -> Double
prfExecution [ProfileEntry]
xs) String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
" of which " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
showDuration ([Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ (ProfileTrace -> Double) -> [ProfileTrace] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ProfileTrace -> Double
prfTime ([ProfileTrace] -> [Double]) -> [ProfileTrace] -> [Double]
forall a b. (a -> b) -> a -> b
$ (ProfileEntry -> [ProfileTrace])
-> [ProfileEntry] -> [ProfileTrace]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ProfileEntry -> [ProfileTrace]
prfTraces [ProfileEntry]
xs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is traced commands."
    ,let f :: [(Double, String)] -> String
f [(Double, String)]
xs = if [(Double, String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Double, String)]
xs then String
"0s" else (\(Double
a,String
b) -> Double -> String
showDuration Double
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")") ((Double, String) -> String) -> (Double, String) -> String
forall a b. (a -> b) -> a -> b
$ ((Double, String) -> (Double, String) -> Ordering)
-> [(Double, String)] -> (Double, String)
forall a. (a -> a -> Ordering) -> [a] -> a
maximumBy' (Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Double -> Double -> Ordering)
-> ((Double, String) -> Double)
-> (Double, String)
-> (Double, String)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Double, String) -> Double
forall a b. (a, b) -> a
fst) [(Double, String)]
xs in
        String
"* The longest rule takes " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(Double, String)] -> String
f ((ProfileEntry -> (Double, String))
-> [ProfileEntry] -> [(Double, String)]
forall a b. (a -> b) -> [a] -> [b]
map (ProfileEntry -> Double
prfExecution (ProfileEntry -> Double)
-> (ProfileEntry -> String) -> ProfileEntry -> (Double, String)
forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
&&& ProfileEntry -> String
prfName) [ProfileEntry]
xs) String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
", and the longest traced command takes " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(Double, String)] -> String
f ((ProfileTrace -> (Double, String))
-> [ProfileTrace] -> [(Double, String)]
forall a b. (a -> b) -> [a] -> [b]
map (ProfileTrace -> Double
prfTime (ProfileTrace -> Double)
-> (ProfileTrace -> String) -> ProfileTrace -> (Double, String)
forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
&&& ProfileTrace -> String
prfCommand) ([ProfileTrace] -> [(Double, String)])
-> [ProfileTrace] -> [(Double, String)]
forall a b. (a -> b) -> a -> b
$ (ProfileEntry -> [ProfileTrace])
-> [ProfileEntry] -> [ProfileTrace]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ProfileEntry -> [ProfileTrace]
prfTraces [ProfileEntry]
xs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
    ,let sumLast :: Double
sumLast = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ (ProfileTrace -> Double) -> [ProfileTrace] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ProfileTrace -> Double
prfTime ([ProfileTrace] -> [Double]) -> [ProfileTrace] -> [Double]
forall a b. (a -> b) -> a -> b
$ (ProfileEntry -> [ProfileTrace])
-> [ProfileEntry] -> [ProfileTrace]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ProfileEntry -> [ProfileTrace]
prfTraces [ProfileEntry]
ls
         maxStop :: Double
maxStop = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ Double
0 Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: (ProfileTrace -> Double) -> [ProfileTrace] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ProfileTrace -> Double
prfStop ((ProfileEntry -> [ProfileTrace])
-> [ProfileEntry] -> [ProfileTrace]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ProfileEntry -> [ProfileTrace]
prfTraces [ProfileEntry]
ls) in
        String
"* Last run gave an average parallelism of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Double -> String
forall a. RealFloat a => Int -> a -> String
showDP Int
2 (if Double
maxStop Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 then Double
0 else Double
sumLast Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
maxStop) String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
" times over " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
showDuration Double
maxStop String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
    ]
    where ls :: [ProfileEntry]
ls = (ProfileEntry -> Bool) -> [ProfileEntry] -> [ProfileEntry]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) Int
0 (Int -> Bool) -> (ProfileEntry -> Int) -> ProfileEntry -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProfileEntry -> Int
prfBuilt) [ProfileEntry]
xs


generateHTML :: [ProfileEntry] -> IO LBS.ByteString
generateHTML :: [ProfileEntry] -> IO ByteString
generateHTML [ProfileEntry]
xs = do
    ByteString
report <- String -> IO ByteString
readDataFileHTML String
"profile.html"
    let f :: String -> f ByteString
f String
"data/profile-data.js" = ByteString -> f ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
LBS.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"var profile =\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [ProfileEntry] -> String
generateJSON [ProfileEntry]
xs
    (String -> IO ByteString) -> ByteString -> IO ByteString
runTemplate String -> IO ByteString
forall (f :: * -> *). Applicative f => String -> f ByteString
f ByteString
report


generateTrace :: [ProfileEntry] -> String
generateTrace :: [ProfileEntry] -> String
generateTrace [ProfileEntry]
xs = [String] -> String
jsonListLines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
    Integer -> [ProfileTrace] -> [String]
forall a. Show a => a -> [ProfileTrace] -> [String]
showEntries Integer
0 [ProfileTrace
y{prfCommand :: String
prfCommand=ProfileEntry -> String
prfName ProfileEntry
x} | ProfileEntry
x <- [ProfileEntry]
onlyLast, ProfileTrace
y <- ProfileEntry -> [ProfileTrace]
prfTraces ProfileEntry
x] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    Integer -> [ProfileTrace] -> [String]
forall a. Show a => a -> [ProfileTrace] -> [String]
showEntries Integer
1 ((ProfileEntry -> [ProfileTrace])
-> [ProfileEntry] -> [ProfileTrace]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ProfileEntry -> [ProfileTrace]
prfTraces [ProfileEntry]
onlyLast)
    where
        onlyLast :: [ProfileEntry]
onlyLast = (ProfileEntry -> Bool) -> [ProfileEntry] -> [ProfileEntry]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ProfileEntry
x -> ProfileEntry -> Int
prfBuilt ProfileEntry
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) [ProfileEntry]
xs
        showEntries :: a -> [ProfileTrace] -> [String]
showEntries a
pid [ProfileTrace]
xs = ((Int, ProfileTrace) -> String)
-> [(Int, ProfileTrace)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (a -> (Int, ProfileTrace) -> String
forall a a. (Show a, Show a) => a -> (a, ProfileTrace) -> String
showEntry a
pid) ([(Int, ProfileTrace)] -> [String])
-> [(Int, ProfileTrace)] -> [String]
forall a b. (a -> b) -> a -> b
$ ([ProfileTrace], [(Int, ProfileTrace)]) -> [(Int, ProfileTrace)]
forall a b. (a, b) -> b
snd (([ProfileTrace], [(Int, ProfileTrace)]) -> [(Int, ProfileTrace)])
-> ([ProfileTrace], [(Int, ProfileTrace)]) -> [(Int, ProfileTrace)]
forall a b. (a -> b) -> a -> b
$ ([ProfileTrace]
 -> ProfileTrace -> ([ProfileTrace], (Int, ProfileTrace)))
-> [ProfileTrace]
-> [ProfileTrace]
-> ([ProfileTrace], [(Int, ProfileTrace)])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL [ProfileTrace]
-> ProfileTrace -> ([ProfileTrace], (Int, ProfileTrace))
alloc [] ([ProfileTrace] -> ([ProfileTrace], [(Int, ProfileTrace)]))
-> [ProfileTrace] -> ([ProfileTrace], [(Int, ProfileTrace)])
forall a b. (a -> b) -> a -> b
$ (ProfileTrace -> Double) -> [ProfileTrace] -> [ProfileTrace]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ProfileTrace -> Double
prfStart [ProfileTrace]
xs

        alloc :: [ProfileTrace] -> ProfileTrace -> ([ProfileTrace], (Int, ProfileTrace))
        -- FIXME: I don't really understand what this code is doing, or the invariants it ensures
        alloc :: [ProfileTrace]
-> ProfileTrace -> ([ProfileTrace], (Int, ProfileTrace))
alloc [ProfileTrace]
as ProfileTrace
r | ([ProfileTrace]
a1,ProfileTrace
_:[ProfileTrace]
a2) <- (ProfileTrace -> Bool)
-> [ProfileTrace] -> ([ProfileTrace], [ProfileTrace])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\ProfileTrace
a -> ProfileTrace -> Double
prfStop ProfileTrace
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= ProfileTrace -> Double
prfStart ProfileTrace
r) [ProfileTrace]
as = ([ProfileTrace]
a1[ProfileTrace] -> [ProfileTrace] -> [ProfileTrace]
forall a. [a] -> [a] -> [a]
++ProfileTrace
rProfileTrace -> [ProfileTrace] -> [ProfileTrace]
forall a. a -> [a] -> [a]
:[ProfileTrace]
a2, ([ProfileTrace] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ProfileTrace]
a1,ProfileTrace
r))
                   | Bool
otherwise = ([ProfileTrace]
as[ProfileTrace] -> [ProfileTrace] -> [ProfileTrace]
forall a. [a] -> [a] -> [a]
++[ProfileTrace
r], ([ProfileTrace] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ProfileTrace]
as,ProfileTrace
r))

        showEntry :: a -> (a, ProfileTrace) -> String
showEntry a
pid (a
tid, ProfileTrace{Double
String
prfStop :: Double
prfStart :: Double
prfCommand :: String
prfStop :: ProfileTrace -> Double
prfStart :: ProfileTrace -> Double
prfCommand :: ProfileTrace -> String
..}) = [(String, String)] -> String
forall a. Show a => [(a, String)] -> String
jsonObject
            [(String
"args",String
"{}"), (String
"ph",String -> String
forall a. Show a => a -> String
show String
"X"), (String
"cat",String -> String
forall a. Show a => a -> String
show String
"target")
            ,(String
"name",String -> String
forall a. Show a => a -> String
show String
prfCommand), (String
"tid",a -> String
forall a. Show a => a -> String
show a
tid), (String
"pid",a -> String
forall a. Show a => a -> String
show a
pid)
            ,(String
"ts",Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Double
1000000Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
prfStart), (String
"dur",Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Double
1000000Double -> Double -> Double
forall a. Num a => a -> a -> a
*(Double
prfStopDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
prfStart))]


generateJSON :: [ProfileEntry] -> String
generateJSON :: [ProfileEntry] -> String
generateJSON = [String] -> String
jsonListLines ([String] -> String)
-> ([ProfileEntry] -> [String]) -> [ProfileEntry] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProfileEntry -> String) -> [ProfileEntry] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ProfileEntry -> String
showEntry
    where
        showEntry :: ProfileEntry -> String
showEntry ProfileEntry{Double
Int
String
[[Int]]
[ProfileTrace]
prfTraces :: [ProfileTrace]
prfExecution :: Double
prfDepends :: [[Int]]
prfChanged :: Int
prfBuilt :: Int
prfName :: String
prfTraces :: ProfileEntry -> [ProfileTrace]
prfExecution :: ProfileEntry -> Double
prfDepends :: ProfileEntry -> [[Int]]
prfChanged :: ProfileEntry -> Int
prfBuilt :: ProfileEntry -> Int
prfName :: ProfileEntry -> String
..} = [String] -> String
jsonList ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
            [String -> String
forall a. Show a => a -> String
show String
prfName
            ,Double -> String
forall a. RealFloat a => a -> String
showTime Double
prfExecution
            ,Int -> String
forall a. Show a => a -> String
show Int
prfBuilt
            ,Int -> String
forall a. Show a => a -> String
show Int
prfChanged] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
            [[[Int]] -> String
forall a. Show a => a -> String
show [[Int]]
prfDepends | Bool -> Bool
not ([[Int]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Int]]
prfDepends) Bool -> Bool -> Bool
|| Bool -> Bool
not ([ProfileTrace] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ProfileTrace]
prfTraces)] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
            [[String] -> String
jsonList ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (ProfileTrace -> String) -> [ProfileTrace] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ProfileTrace -> String
showTrace [ProfileTrace]
prfTraces | Bool -> Bool
not ([ProfileTrace] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ProfileTrace]
prfTraces)]
        showTrace :: ProfileTrace -> String
showTrace ProfileTrace{Double
String
prfStop :: Double
prfStart :: Double
prfCommand :: String
prfStop :: ProfileTrace -> Double
prfStart :: ProfileTrace -> Double
prfCommand :: ProfileTrace -> String
..} = [String] -> String
jsonList
            [String -> String
forall a. Show a => a -> String
show String
prfCommand, Double -> String
forall a. RealFloat a => a -> String
showTime Double
prfStart, Double -> String
forall a. RealFloat a => a -> String
showTime Double
prfStop]
        showTime :: a -> String
showTime a
x = if Char
'.' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
y then (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0') String
y else String
y
            where y :: String
y = Int -> a -> String
forall a. RealFloat a => Int -> a -> String
showDP Int
4 a
x

jsonListLines :: [String] -> String
jsonListLines [String]
xs = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n," [String]
xs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n]"
jsonList :: [String] -> String
jsonList [String]
xs = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
xs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
jsonObject :: [(a, String)] -> String
jsonObject [(a, String)]
xs = String
"{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [a -> String
forall a. Show a => a -> String
show a
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b | (a
a,String
b) <- [(a, String)]
xs] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"