[GHC] #11645: Heap profiling - hp2ps: samples out of sequence

[GHC]

#11645: Heap profiling - hp2ps: samples out of sequence
-------------------------------------+-------------------------------------
        Reporter:  thomie            |                Owner:  (none)
            Type:  bug               |               Status:  new
        Priority:  normal            |            Milestone:
       Component:  Profiling         |              Version:  8.0.1-rc2
      Resolution:                    |             Keywords:
Operating System:  Unknown/Multiple  |         Architecture:
                                     |  Unknown/Multiple
 Type of failure:  None/Unknown      |            Test Case:
                                     |  libraries/hpc/tests/fork/hpc_fork
      Blocked By:                    |             Blocking:
 Related Tickets:  #664              |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by Fuuzetsu):

 I hit this today on 8.2.1. This is on a proprietary project so I am unable
 to provide any substantial code to aid debugging this. Below is a highly
 inefficient program which re-sequences .hp so that you can at least use
 the data.

 {{{#!hs
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Main (main) where

 import           Control.Monad (guard)
 import           Data.Attoparsec.Combinator as P
 import           Data.Attoparsec.Text as P
 import           Data.List (sort)
 import           Data.Monoid ((<>))
 import           Data.Text as T
 import qualified Data.Text.IO as T
 import           System.Environment (getArgs)
 import           System.Exit (exitFailure)
 import           System.IO (hPutStrLn, stderr)

 data Sample = Sample !Double ![Text]
   deriving (Eq)

 instance Ord Sample where
   compare (Sample x _) (Sample y _) = compare x y

 data F = F ![Text] ![Sample]

 parseF :: Parser F
 parseF = do
   ls <- P.manyTill (P.takeTill isEndOfLine <* endOfLine) (P.lookAhead
 "BEGIN_SAMPLE")
   s <- P.many' parseSample
   pure $! F ls s

 parseSample :: Parser Sample
 parseSample = do
   s <- "BEGIN_SAMPLE " *> double <* endOfLine
   let endSample = do
         es <- "END_SAMPLE " *> double <* endOfLine
         guard (es == s)
       l = P.takeTill isEndOfLine <* endOfLine
   ls <- P.manyTill l endSample
   pure $! Sample s ls

 renderSample :: Sample -> Text
 renderSample (Sample d ls) = T.unlines $
   ("BEGIN_SAMPLE " <> T.pack (show d))
   : ls
   ++ [ "END_SAMPLE " <> T.pack (show d) ]

 main :: IO ()
 main = getArgs >>= \case
   [input, output] -> do
     c <- T.readFile input
     case parseOnly parseF c of
       Left err -> do
         hPutStrLn stderr ("Parse failed: " <> err)
         exitFailure
       Right (F startLines samples) -> do
         let s' = T.concat . Prelude.map renderSample $ sort samples
         T.writeFile output (T.unlines startLines <> s')
   _ -> do
     hPutStrLn stderr "usage: fix-hp inputFile outputFile"
     exitFailure
 }}}

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/11645#comment:8>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler