1{-# LANGUAGE CPP #-}
2{-# LANGUAGE FlexibleContexts #-}
3module GHC.RTS.EventParserUtils (
4        EventParser(..),
5        EventParsers(..),
6
7        getString,
8        getText,
9        getTextNul,
10        mkEventTypeParsers,
11        simpleEvent,
12        skip,
13    ) where
14
15import Data.Array
16import Data.Binary
17import Data.Binary.Get ()
18import Data.Binary.Put ()
19import Data.IntMap (IntMap)
20import Data.List
21import Data.Text (Text)
22import qualified Data.Binary.Get as G
23import qualified Data.ByteString.Char8 as B8
24import qualified Data.IntMap as M
25import qualified Data.Text.Encoding as TE
26import qualified Data.Text.Lazy as TL
27import qualified Data.Text.Lazy.Encoding as TLE
28
29#define EVENTLOG_CONSTANTS_ONLY
30#include "EventLogFormat.h"
31
32import GHC.RTS.EventTypes
33
34newtype EventParsers = EventParsers (Array Int (Get EventInfo))
35
36getString :: Integral a => a -> Get String
37getString len = do
38  bytes <- G.getByteString $ fromIntegral len
39  return $! B8.unpack bytes
40
41-- | Decode a given length of bytes as a 'Text'
42getText
43  :: Integral a
44  => a -- ^ Number of bytes to decode
45  -> Get Text
46getText len = do
47  bytes <- G.getByteString $ fromIntegral len
48  case TE.decodeUtf8' bytes of
49    Left err -> fail $ show err
50    Right text -> return text
51
52-- | Decode a null-terminated string as a 'Text'
53getTextNul :: Get Text
54getTextNul = do
55  chunks <- G.getLazyByteStringNul
56  case TLE.decodeUtf8' chunks of
57    Left err -> fail $ show err
58    Right text -> return $ TL.toStrict text
59
60skip :: Integral a => a -> Get ()
61skip n = G.skip (fromIntegral n)
62
63--
64-- Code to build the event parser table.
65--
66
67--
68-- | Event parser data. Parsers are either fixed or vairable size.
69--
70data EventParser a
71    = FixedSizeParser {
72        fsp_type        :: Int,
73        fsp_size        :: EventTypeSize,
74        fsp_parser      :: Get a
75    }
76    | VariableSizeParser {
77        vsp_type        :: Int,
78        vsp_parser      :: Get a
79    }
80
81getParser :: EventParser a -> Get a
82getParser (FixedSizeParser _ _ p) = p
83getParser (VariableSizeParser _ p) = p
84
85getType :: EventParser a -> Int
86getType (FixedSizeParser t _ _) = t
87getType (VariableSizeParser t _) = t
88
89isFixedSize :: EventParser a -> Bool
90isFixedSize (FixedSizeParser {}) = True
91isFixedSize (VariableSizeParser {}) = False
92
93simpleEvent :: Int -> a -> EventParser a
94simpleEvent t p = FixedSizeParser t 0 (return p)
95
96-- Our event log format allows new fields to be added to events over
97-- time.  This means that our parser must be able to handle:
98--
99--  * old versions of an event, with fewer fields than expected,
100--  * new versions of an event, with more fields than expected
101--
102-- The event log file declares the size for each event type, so we can
103-- select the correct parser for the event type based on its size.  We
104-- do this once after parsing the header: given the EventTypes, we build
105-- an array of event parsers indexed by event type.
106--
107-- For each event type, we may have multiple parsers for different
108-- versions of the event, indexed by size.  These are listed in the
109-- eventTypeParsers list below.  For the given log file we select the
110-- parser for the most recent version (largest size doesn't exceed the size
111-- declared in the header).  If this is a newer version of the event
112-- than we understand, there may be extra bytes that we have to read
113-- and discard in the parser for this event type.
114--
115-- Summary:
116--   if size is smaller that we expect:
117--     parse the earier version, or ignore the event
118--   if size is just right:
119--     parse it
120--   if size is too big:
121--     parse the bits we understand and discard the rest
122
123mkEventTypeParsers :: IntMap EventType
124                   -> [EventParser EventInfo]
125                   -> Array Int (Get EventInfo)
126mkEventTypeParsers etypes event_parsers
127 = accumArray (flip const) undefined (0, max_event_num)
128    [ (num, parser num) | num <- [0..max_event_num] ]
129  where
130    max_event_num = maximum (M.keys etypes)
131    undeclared_etype num = fail ("undeclared event type: " ++ show num)
132    parser_map = makeParserMap event_parsers
133    parser num =
134            -- Get the event's size from the header,
135            -- the first Maybe describes whether the event was declared in the header.
136            -- the second Maybe selects between variable and fixed size events.
137        let mb_mb_et_size = do et <- M.lookup num etypes
138                               return $ size et
139            -- Find a parser for the event with the given size.
140            maybe_parser mb_et_size = do possible <- M.lookup num parser_map
141                                         best_parser <- case mb_et_size of
142                                            Nothing -> getVariableParser possible
143                                            Just et_size -> getFixedParser et_size possible
144                                         return $ getParser best_parser
145            in case mb_mb_et_size of
146                -- This event is declared in the log file's header
147                Just mb_et_size -> case maybe_parser mb_et_size of
148                    -- And we have a valid parser for it.
149                    Just p -> p
150                    -- But we don't have a valid parser for it.
151                    Nothing -> noEventTypeParser num mb_et_size
152                -- This event is not declared in the log file's header
153                Nothing -> undeclared_etype num
154
155-- Find the first variable length parser.
156getVariableParser :: [EventParser a] -> Maybe (EventParser a)
157getVariableParser [] = Nothing
158getVariableParser (x:xs) = case x of
159    FixedSizeParser _ _ _ -> getVariableParser xs
160    VariableSizeParser _ _ -> Just x
161
162-- Find the best fixed size parser, that is to say, the parser for the largest
163-- event that does not exceed the size of the event as declared in the log
164-- file's header.
165getFixedParser :: EventTypeSize -> [EventParser a] -> Maybe (EventParser a)
166getFixedParser size parsers =
167        do parser <- ((filter isFixedSize) `pipe`
168                      (filter (\x -> (fsp_size x) <= size)) `pipe`
169                      (sortBy descending_size) `pipe`
170                      maybe_head) parsers
171           return $ padParser size parser
172    where pipe f g = g . f
173          descending_size (FixedSizeParser _ s1 _) (FixedSizeParser _ s2 _) =
174            compare s2 s1
175          descending_size _ _ = undefined
176          maybe_head [] = Nothing
177          maybe_head (x:_) = Just x
178
179padParser :: EventTypeSize -> (EventParser a) -> (EventParser a)
180padParser _    (VariableSizeParser t p) = VariableSizeParser t p
181padParser size (FixedSizeParser t orig_size orig_p) = FixedSizeParser t size p
182    where p = if (size == orig_size)
183                then orig_p
184                else do d <- orig_p
185                        skip (size - orig_size)
186                        return d
187
188makeParserMap :: [EventParser a] -> IntMap [EventParser a]
189makeParserMap = foldl buildParserMap M.empty
190    where buildParserMap map' parser =
191              M.alter (addParser parser) (getType parser) map'
192          addParser p Nothing = Just [p]
193          addParser p (Just ps) = Just (p:ps)
194
195noEventTypeParser :: Int -> Maybe EventTypeSize
196                  -> Get EventInfo
197noEventTypeParser num mb_size = do
198  bytes <- case mb_size of
199             Just n  -> return n
200             Nothing -> get :: Get Word16
201  skip bytes
202  return UnknownEvent{ ref = fromIntegral num }
203