Fix render of heap profiles in -p mode

Fixes #191

Author: mpickering

src/Eventlog/Data.hs

@@ -40,11 +40,11 @@ generateJsonData a (ProfData h binfo ccMap fs traces heap_info ipes _ticky_count
         sortBy (flip (comparing (fst . snd))) $ Map.toList keeps
       -- Only supply the cost centre view in cost centre profiling mode.
       cc_descs = case hHeapProfileType h of
-                Just HeapProfBreakdownCostCentre -> Just (outputTree ccMap mdescs)
+                (FromEventlog (Just HeapProfBreakdownCostCentre)) -> Just (outputTree ccMap mdescs)
                 _ -> Nothing
 
       use_ipes = case hHeapProfileType h of
-                   Just HeapProfBreakdownInfoTable -> Just ipes
+                   (FromEventlog (Just HeapProfBreakdownInfoTable)) -> Just ipes
                    _ -> Nothing
 
       -- If we have IPE info, try to translate info table pointers to names

src/Eventlog/Events.hs

@@ -344,7 +344,7 @@ elHeader EL{..} =
   let title = maybe "" T.unwords pargs
       date = formatDate clocktimeSec
       ppSamplingRate = T.pack . maybe "<Not available>" (show . fromNano) $ samplingRate
-  in \v -> Header title date heapProfileType ppSamplingRate "" "" v (T.unpack . head <$> pargs)
+  in \v -> Header title date (FromEventlog heapProfileType) ppSamplingRate "" "" v (T.unpack . head <$> pargs)
 
 
 elBucketMap :: EL -> BucketMap

src/Eventlog/HeapProf.hs

@@ -27,7 +27,7 @@ chunkT s =
       [job, date, smpU, valU] =
         zipWith header [sJOB, sDATE, sSAMPLE_UNIT, sVALUE_UNIT] hs
       fs = chunkSamples ss
-  in  (\v -> Header job date Nothing (pack "") smpU valU v Nothing
+  in  (\v -> Header job date FromHPFile (pack "") smpU valU v Nothing
       ,  fs
       )
 

src/Eventlog/HtmlTemplate.hs

@@ -19,7 +19,7 @@ import Data.FileEmbed
 import Eventlog.Data
 import Eventlog.Javascript
 import Eventlog.Args
-import Eventlog.Types (Header(..), HeapProfBreakdown(..))
+import Eventlog.Types (Header(..), HeapProfBreakdown(..), ProfileType(..))
 import Eventlog.Rendering.Bootstrap
 import Eventlog.Rendering.Types
 import Eventlog.VegaTemplate
@@ -162,11 +162,15 @@ perTabFooter :: Header -> Html
 perTabFooter header' = do
     H.div ! class_ "row" $ do
       H.div ! class_ "col" $ do
-          toHtml $ maybe "No heap profile" ppHeapProfileType (hHeapProfileType header')
+          toHtml $ render_type (hHeapProfileType header')
           ", created at "
           code $ toHtml $ hDate header'
           " by "
           code $ toHtml $ hJob header'
+  where
+    render_type FromHPFile              = "heap profile"
+    render_type (FromEventlog Nothing)  = "No heap profile"
+    render_type (FromEventlog (Just t)) = ppHeapProfileType t
 
 
 select_data :: IncludeTraceData -> ChartType -> [Text]
@@ -248,7 +252,11 @@ metaTab header' _as =
             " seconds between heap samples"
 
 has_heap_profile :: Header -> Bool
-has_heap_profile h = isJust (hHeapProfileType h)
+has_heap_profile h =
+  case (hHeapProfileType h) of
+    FromHPFile -> True
+    FromEventlog t -> isJust t
+
 
 allHeapTabs :: Header -> Args -> HeapProfileData -> [TabGroup]
 allHeapTabs header' as x =

src/Eventlog/Types.hs

@@ -19,14 +19,16 @@ data Header =
   Header
   { hJob         :: Text
   , hDate        :: Text
-  , hHeapProfileType :: Maybe HeapProfBreakdown
+  , hHeapProfileType :: ProfileType
   , hSamplingRate :: Text
   , hSampleUnit  :: Text
   , hValueUnit   :: Text
   , hCount       :: Int
   , hProgPath    :: Maybe FilePath
   } deriving Show
 
+data ProfileType = FromHPFile | FromEventlog (Maybe HeapProfBreakdown) deriving Show
+
 
 -- The bucket is a key to uniquely identify a band
 newtype Bucket = Bucket Text