<commit_before>-------------------------------------------------------------------------------
--- $Id: ReadEvents.hs#3 2009/03/23 17:11:32 REDMOND\\satnams $
--- $Source: //depot/satnams/haskell/ThreadScope/ReadEvents.hs $
-------------------------------------------------------------------------------

module ReadEvents
where

import Data.Array
import qualified Data.Function
import Data.IORef
import Data.List
import Text.Printf

import EventlogViewerCommon

import Graphics.UI.Gtk

import qualified GHC.RTS.Events as GHCEvents
import GHC.RTS.Events hiding (Event)

-------------------------------------------------------------------------------

rawEventsToHECs :: [GHCEvents.Event] -> HECs
rawEventsToHECs eventList
  = [filterHEC eventList hec | hec <- capabilities]
    where
    capabilities = ennumerateCapabilities eventList
    
-------------------------------------------------------------------------------

filterHEC events hec
  = (hec, listArray (0, nrEvents-1) eventsForThisHEC)
    where
    eventsForThisHEC = filter (eventFromHEC hec) events
    nrEvents = length eventsForThisHEC
 
-------------------------------------------------------------------------------

eventFromHEC :: Int -> GHCEvents.Event -> Bool
eventFromHEC hec event 
  = cap (spec event) == hec

-------------------------------------------------------------------------------

registerEventsFromFile :: String -> IORef (Maybe [Int]) -> MaybeHECsIORef ->
                          IORef Double -> IORef Integer ->
                          Window -> Viewport -> Label -> Statusbar -> ContextId -> IO ()
registerEventsFromFile filename capabilitiesIORef eventArrayIORef scale
                       lastTxIORef window viewport profileNameLabel summarybar
                       summary_ctx
  = do Right fmt <- readEventLogFromFile filename 
       let pes = events (dat fmt)
           sorted = sortBy (Data.Function.on compare time) (reverse pes)
           hecs = rawEventsToHECs sorted
           lastTx = event2ms (last sorted) -- Last event time in ms
           capabilities = ennumerateCapabilities pes
       -- Update the IORefs used for drawing callbacks
       writeIORef capabilitiesIORef (Just capabilities)
       writeIORef eventArrayIORef (Just hecs)
       writeIORef lastTxIORef lastTx
       writeIORef scale defaultScaleValue
       let duration = lastTx 
           nrEvents = length pes

       -- Adjust height to fit capabilities
       (width, _) <- widgetGetSize window
       widgetSetSizeRequest window width ((length capabilities)*gapcap+oycap+120)

       -- Set the status bar
       statusbarPush summarybar summary_ctx (show nrEvents ++ " events. Duration " ++ (printf "%.3f" (((fromIntegral duration)::Double) * 1.0e-6)) ++ " seconds.")   


       ------------------------------------------------------------------------
       --- Set the label for the name of the event log
       profileNameLabel `labelSetText` filename

       
-------------------------------------------------------------------------------
<commit_msg>write error for bad file type<commit_after>-------------------------------------------------------------------------------
--- $Id: ReadEvents.hs#4 2009/03/24 09:58:18 REDMOND\\satnams $
--- $Source: //depot/satnams/haskell/ThreadScope/ReadEvents.hs $
-------------------------------------------------------------------------------

module ReadEvents
where

import Data.Array
import qualified Data.Function
import Data.IORef
import Data.List
import Text.Printf

import EventlogViewerCommon

import Graphics.UI.Gtk

import qualified GHC.RTS.Events as GHCEvents
import GHC.RTS.Events hiding (Event)

-------------------------------------------------------------------------------

rawEventsToHECs :: [GHCEvents.Event] -> HECs
rawEventsToHECs eventList
  = [filterHEC eventList hec | hec <- capabilities]
    where
    capabilities = ennumerateCapabilities eventList
    
-------------------------------------------------------------------------------

filterHEC events hec
  = (hec, listArray (0, nrEvents-1) eventsForThisHEC)
    where
    eventsForThisHEC = filter (eventFromHEC hec) events
    nrEvents = length eventsForThisHEC
 
-------------------------------------------------------------------------------

eventFromHEC :: Int -> GHCEvents.Event -> Bool
eventFromHEC hec event 
  = cap (spec event) == hec

-------------------------------------------------------------------------------

registerEventsFromFile :: String -> IORef (Maybe [Int]) -> MaybeHECsIORef ->
                          IORef Double -> IORef Integer ->
                          Window -> Viewport -> Label -> Statusbar -> ContextId -> IO ()
registerEventsFromFile filename capabilitiesIORef eventArrayIORef scale
                       lastTxIORef window viewport profileNameLabel summarybar
                       summary_ctx
  = do eitherFmt <- readEventLogFromFile filename 
       case eitherFmt of
        Right fmt -> 
         do let pes = events (dat fmt)
                sorted = sortBy (Data.Function.on compare time) (reverse pes)
                hecs = rawEventsToHECs sorted
                lastTx = event2ms (last sorted) -- Last event time in ms
                capabilities = ennumerateCapabilities pes
            -- Update the IORefs used for drawing callbacks
            writeIORef capabilitiesIORef (Just capabilities)
            writeIORef eventArrayIORef (Just hecs)
            writeIORef lastTxIORef lastTx
            writeIORef scale defaultScaleValue
            let duration = lastTx 
                nrEvents = length pes

            -- Adjust height to fit capabilities
            (width, _) <- widgetGetSize window
            widgetSetSizeRequest window width ((length capabilities)*gapcap+oycap+120)

            -- Set the status bar
            statusbarPush summarybar summary_ctx (show nrEvents ++ " events. Duration " ++ (printf "%.3f" (((fromIntegral duration)::Double) * 1.0e-6)) ++ " seconds.")   

            ------------------------------------------------------------------------
            --- Set the label for the name of the event log
            profileNameLabel `labelSetText` filename

        Left msg -> putStrLn msg
       
-------------------------------------------------------------------------------

{'fraction_non_alphanumeric': 0.2595007155350612, 'fraction_numerical': 0.007950389569088886, 'mean_word_length': 1.3304927751018896, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 31, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5271588', 'n_tokens_mistral': 1517, 'n_tokens_neox': 1399, 'n_words': 426}