    {-# LANGUAGE CPP #-}
    {-# LANGUAGE FlexibleContexts #-}
    module GHC.RTS.EventParserUtils (
            EventParser(..),
            EventParsers(..),

            getString,
            getText,
            getTextNul,
            mkEventTypeParsers,
            simpleEvent,
            skip,
        ) where

    import Data.Array
    import Data.Binary
    import Data.Binary.Get ()
    import Data.Binary.Put ()
    import Data.IntMap (IntMap)
    import Data.List
    import Data.Text (Text)
    import qualified Data.Binary.Get as G
    import qualified Data.ByteString.Char8 as B8
    import qualified Data.IntMap as M
    import qualified Data.Text.Encoding as TE
    import qualified Data.Text.Lazy as TL
    import qualified Data.Text.Lazy.Encoding as TLE

    #define EVENTLOG_CONSTANTS_ONLY
    #include "EventLogFormat.h"

    import GHC.RTS.EventTypes

    newtype EventParsers = EventParsers (Array Int (Get EventInfo))

    getString :: Integral a => a -> Get String
    getString :: forall a. Integral a => a -> Get String
    getString a
    len = do
      bytes <- Int -> Get ByteString
    G.getByteString (Int -> Get ByteString) -> Int -> Get ByteString
    forall a b. (a -> b) -> a -> b
    $ a -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    len
      return $! B8.unpack bytes

    -- | Decode a given length of bytes as a 'Text'
    getText
      :: Integral a
      => a -- ^ Number of bytes to decode
      -> Get Text
    getText :: forall a. Integral a => a -> Get Text
    getText a
    len = do
      bytes <- Int -> Get ByteString
    G.getByteString (Int -> Get ByteString) -> Int -> Get ByteString
    forall a b. (a -> b) -> a -> b
    $ a -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    len
      case TE.decodeUtf8' bytes of
        Left UnicodeException
    err -> String -> Get Text
    forall a. String -> Get a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Get Text) -> String -> Get Text
    forall a b. (a -> b) -> a -> b
    $ UnicodeException -> String
    forall a. Show a => a -> String
    show UnicodeException
    err
        Right Text
    text -> Text -> Get Text
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    text

    -- | Decode a null-terminated string as a 'Text'
    getTextNul :: Get Text
    getTextNul :: Get Text
    getTextNul = do
      chunks <- Get ByteString
    G.getLazyByteStringNul
      case TLE.decodeUtf8' chunks of
        Left UnicodeException
    err -> String -> Get Text
    forall a. String -> Get a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Get Text) -> String -> Get Text
    forall a b. (a -> b) -> a -> b
    $ UnicodeException -> String
    forall a. Show a => a -> String
    show UnicodeException
    err
        Right Text
    text -> Text -> Get Text
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> Get Text) -> Text -> Get Text
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    TL.toStrict Text
    text

    -- | Skip over n bytes of input
    skip :: Integral a => a -> Get ()
    skip :: forall a. Integral a => a -> Get ()
    skip a
    n = Int -> Get ()
    G.skip (a -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    n)

    --
    -- Code to build the event parser table.
    --

    --
    -- | Event parser data. Parsers are either fixed or variable size.
    --
    data EventParser a
        = FixedSizeParser {
            forall a. EventParser a -> Int
    fsp_type        :: Int,
            forall a. EventParser a -> Word16
    fsp_size        :: EventTypeSize,
            forall a. EventParser a -> Get a
    fsp_parser      :: Get a
        }
        | VariableSizeParser {
            forall a. EventParser a -> Int
    vsp_type        :: Int,
            forall a. EventParser a -> Get a
    vsp_parser      :: Get a
        }

    getParser :: EventParser a -> Get a
    getParser :: forall a. EventParser a -> Get a
    getParser (FixedSizeParser Int
    _ Word16
    _ Get a
    p) = Get a
    p
    getParser (VariableSizeParser Int
    _ Get a
    p) = Get a
    p

    getType :: EventParser a -> Int
    getType :: forall a. EventParser a -> Int
    getType (FixedSizeParser Int
    t Word16
    _ Get a
    _) = Int
    t
    getType (VariableSizeParser Int
    t Get a
    _) = Int
    t

    isFixedSize :: EventParser a -> Bool
    isFixedSize :: forall a. EventParser a -> Bool
    isFixedSize (FixedSizeParser {}) = Bool
    True
    isFixedSize (VariableSizeParser {}) = Bool
    False

    simpleEvent :: Int -> a -> EventParser a
    simpleEvent :: forall a. Int -> a -> EventParser a
    simpleEvent Int
    t a
    p = Int -> Word16 -> Get a -> EventParser a
    forall a. Int -> Word16 -> Get a -> EventParser a
    FixedSizeParser Int
    t Word16
    0 (a -> Get a
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    p)

    -- Our event log format allows new fields to be added to events over
    -- time.  This means that our parser must be able to handle:
    --
    --  * old versions of an event, with fewer fields than expected,
    --  * new versions of an event, with more fields than expected
    --
    -- The event log file declares the size for each event type, so we can
    -- select the correct parser for the event type based on its size.  We
    -- do this once after parsing the header: given the EventTypes, we build
    -- an array of event parsers indexed by event type.
    --
    -- For each event type, we may have multiple parsers for different
    -- versions of the event, indexed by size.  These are listed in the
    -- eventTypeParsers list below.  For the given log file we select the
    -- parser for the most recent version (largest size doesn't exceed the size
    -- declared in the header).  If this is a newer version of the event
    -- than we understand, there may be extra bytes that we have to read
    -- and discard in the parser for this event type.
    --
    -- Summary:
    --   if size is smaller that we expect:
    --     parse the earlier version, or ignore the event
    --   if size is just right:
    --     parse it
    --   if size is too big:
    --     parse the bits we understand and discard the rest

    mkEventTypeParsers :: IntMap EventType
                       -> [EventParser EventInfo]
                       -> Array Int (Get EventInfo)
    mkEventTypeParsers :: IntMap EventType
    -> [EventParser EventInfo] -> Array Int (Get EventInfo)
    mkEventTypeParsers IntMap EventType
    etypes [EventParser EventInfo]
    event_parsers
     = (Get EventInfo -> Get EventInfo -> Get EventInfo)
    -> Get EventInfo
    -> (Int, Int)
    -> [(Int, Get EventInfo)]
    -> Array Int (Get EventInfo)
    forall i e a.
    Ix i =>
    (e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
    accumArray ((Get EventInfo -> Get EventInfo -> Get EventInfo)
    -> Get EventInfo -> Get EventInfo -> Get EventInfo
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Get EventInfo -> Get EventInfo -> Get EventInfo
    forall a b. a -> b -> a
    const) Get EventInfo
    forall a. HasCallStack => a
    undefined (Int
    0, Int
    max_event_num)
        [ (Int
    num, Int -> Get EventInfo
    parser Int
    num) | Int
    num <- [Int
    0..Int
    max_event_num] ]
      where
        max_event_num :: Int
    max_event_num = [Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum (IntMap EventType -> [Int]
    forall a. IntMap a -> [Int]
    M.keys IntMap EventType
    etypes)
        undeclared_etype :: a -> m a
    undeclared_etype a
    num = String -> m a
    forall a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String
    "undeclared event type: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    num)
        parser_map :: IntMap [EventParser EventInfo]
    parser_map = [EventParser EventInfo] -> IntMap [EventParser EventInfo]
    forall a. [EventParser a] -> IntMap [EventParser a]
    makeParserMap [EventParser EventInfo]
    event_parsers
        parser :: Int -> Get EventInfo
    parser Int
    num =
                -- Get the event's size from the header,
                -- the first Maybe describes whether the event was declared in the header.
                -- the second Maybe selects between variable and fixed size events.
            let mb_mb_et_size :: Maybe (Maybe Word16)
    mb_mb_et_size = do et <- Int -> IntMap EventType -> Maybe EventType
    forall a. Int -> IntMap a -> Maybe a
    M.lookup Int
    num IntMap EventType
    etypes
                                   return $ size et
                -- Find a parser for the event with the given size.
                maybe_parser :: Maybe Word16 -> Maybe (Get EventInfo)
    maybe_parser Maybe Word16
    mb_et_size = do possible <- Int
    -> IntMap [EventParser EventInfo] -> Maybe [EventParser EventInfo]
    forall a. Int -> IntMap a -> Maybe a
    M.lookup Int
    num IntMap [EventParser EventInfo]
    parser_map
                                             best_parser <- case mb_et_size of
                                                Maybe Word16
    Nothing -> [EventParser EventInfo] -> Maybe (EventParser EventInfo)
    forall a. [EventParser a] -> Maybe (EventParser a)
    getVariableParser [EventParser EventInfo]
    possible
                                                Just Word16
    et_size -> Word16 -> [EventParser EventInfo] -> Maybe (EventParser EventInfo)
    forall a. Word16 -> [EventParser a] -> Maybe (EventParser a)
    getFixedParser Word16
    et_size [EventParser EventInfo]
    possible
                                             return $ getParser best_parser
                in case Maybe (Maybe Word16)
    mb_mb_et_size of
                    -- This event is declared in the log file's header
                    Just Maybe Word16
    mb_et_size -> case Maybe Word16 -> Maybe (Get EventInfo)
    maybe_parser Maybe Word16
    mb_et_size of
                        -- And we have a valid parser for it.
                        Just Get EventInfo
    p -> Get EventInfo
    p
                        -- But we don't have a valid parser for it.
                        Maybe (Get EventInfo)
    Nothing -> Int -> Maybe Word16 -> Get EventInfo
    noEventTypeParser Int
    num Maybe Word16
    mb_et_size
                    -- This event is not declared in the log file's header
                    Maybe (Maybe Word16)
    Nothing -> Int -> Get EventInfo
    forall {m :: * -> *} {a} {a}. (MonadFail m, Show a) => a -> m a
    undeclared_etype Int
    num

    -- Find the first variable length parser.
    getVariableParser :: [EventParser a] -> Maybe (EventParser a)
    getVariableParser :: forall a. [EventParser a] -> Maybe (EventParser a)
    getVariableParser [] = Maybe (EventParser a)
    forall a. Maybe a
    Nothing
    getVariableParser (EventParser a
    x:[EventParser a]
    xs) = case EventParser a
    x of
        FixedSizeParser Int
    _ Word16
    _ Get a
    _ -> [EventParser a] -> Maybe (EventParser a)
    forall a. [EventParser a] -> Maybe (EventParser a)
    getVariableParser [EventParser a]
    xs
        VariableSizeParser Int
    _ Get a
    _ -> EventParser a -> Maybe (EventParser a)
    forall a. a -> Maybe a
    Just EventParser a
    x

    -- Find the best fixed size parser, that is to say, the parser for the largest
    -- event that does not exceed the size of the event as declared in the log
    -- file's header.
    getFixedParser :: EventTypeSize -> [EventParser a] -> Maybe (EventParser a)
    getFixedParser :: forall a. Word16 -> [EventParser a] -> Maybe (EventParser a)
    getFixedParser Word16
    size [EventParser a]
    parsers =
            do parser <- (((EventParser a -> Bool) -> [EventParser a] -> [EventParser a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter EventParser a -> Bool
    forall a. EventParser a -> Bool
    isFixedSize) ([EventParser a] -> [EventParser a])
    -> ([EventParser a] -> [EventParser a])
    -> [EventParser a]
    -> [EventParser a]
    forall {a} {b} {c}. (a -> b) -> (b -> c) -> a -> c
    `pipe`
                          ((EventParser a -> Bool) -> [EventParser a] -> [EventParser a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\EventParser a
    x -> (EventParser a -> Word16
    forall a. EventParser a -> Word16
    fsp_size EventParser a
    x) Word16 -> Word16 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word16
    size)) ([EventParser a] -> [EventParser a])
    -> ([EventParser a] -> [EventParser a])
    -> [EventParser a]
    -> [EventParser a]
    forall {a} {b} {c}. (a -> b) -> (b -> c) -> a -> c
    `pipe`
                          ((EventParser a -> EventParser a -> Ordering)
    -> [EventParser a] -> [EventParser a]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy EventParser a -> EventParser a -> Ordering
    forall {a} {a}. EventParser a -> EventParser a -> Ordering
    descending_size) ([EventParser a] -> [EventParser a])
    -> ([EventParser a] -> Maybe (EventParser a))
    -> [EventParser a]
    -> Maybe (EventParser a)
    forall {a} {b} {c}. (a -> b) -> (b -> c) -> a -> c
    `pipe`
                          [EventParser a] -> Maybe (EventParser a)
    forall {a}. [a] -> Maybe a
    maybe_head) [EventParser a]
    parsers
               return $ padParser size parser
        where pipe :: (a -> b) -> (b -> c) -> a -> c
    pipe a -> b
    f b -> c
    g = b -> c
    g (b -> c) -> (a -> b) -> a -> c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> b
    f
              descending_size :: EventParser a -> EventParser a -> Ordering
    descending_size (FixedSizeParser Int
    _ Word16
    s1 Get a
    _) (FixedSizeParser Int
    _ Word16
    s2 Get a
    _) =
                Word16 -> Word16 -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare Word16
    s2 Word16
    s1
              descending_size EventParser a
    _ EventParser a
    _ = Ordering
    forall a. HasCallStack => a
    undefined
              maybe_head :: [a] -> Maybe a
    maybe_head [] = Maybe a
    forall a. Maybe a
    Nothing
              maybe_head (a
    x:[a]
    _) = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    x

    padParser :: EventTypeSize -> (EventParser a) -> (EventParser a)
    padParser :: forall a. Word16 -> EventParser a -> EventParser a
    padParser Word16
    _    (VariableSizeParser Int
    t Get a
    p) = Int -> Get a -> EventParser a
    forall a. Int -> Get a -> EventParser a
    VariableSizeParser Int
    t Get a
    p
    padParser Word16
    size (FixedSizeParser Int
    t Word16
    orig_size Get a
    orig_p) = Int -> Word16 -> Get a -> EventParser a
    forall a. Int -> Word16 -> Get a -> EventParser a
    FixedSizeParser Int
    t Word16
    size Get a
    p
        where p :: Get a
    p = if (Word16
    size Word16 -> Word16 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word16
    orig_size)
                    then Get a
    orig_p
                    else do d <- Get a
    orig_p
                            skip (size - orig_size)
                            return d

    makeParserMap :: [EventParser a] -> IntMap [EventParser a]
    makeParserMap :: forall a. [EventParser a] -> IntMap [EventParser a]
    makeParserMap = (IntMap [EventParser a] -> EventParser a -> IntMap [EventParser a])
    -> IntMap [EventParser a]
    -> [EventParser a]
    -> IntMap [EventParser a]
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl IntMap [EventParser a] -> EventParser a -> IntMap [EventParser a]
    forall {a}.
    IntMap [EventParser a] -> EventParser a -> IntMap [EventParser a]
    buildParserMap IntMap [EventParser a]
    forall a. IntMap a
    M.empty
        where buildParserMap :: IntMap [EventParser a] -> EventParser a -> IntMap [EventParser a]
    buildParserMap IntMap [EventParser a]
    map' EventParser a
    parser =
                  (Maybe [EventParser a] -> Maybe [EventParser a])
    -> Int -> IntMap [EventParser a] -> IntMap [EventParser a]
    forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
    M.alter (EventParser a -> Maybe [EventParser a] -> Maybe [EventParser a]
    forall {a}. a -> Maybe [a] -> Maybe [a]
    addParser EventParser a
    parser) (EventParser a -> Int
    forall a. EventParser a -> Int
    getType EventParser a
    parser) IntMap [EventParser a]
    map'
              addParser :: a -> Maybe [a] -> Maybe [a]
    addParser a
    p Maybe [a]
    Nothing = [a] -> Maybe [a]
    forall a. a -> Maybe a
    Just [a
    p]
              addParser a
    p (Just [a]
    ps) = [a] -> Maybe [a]
    forall a. a -> Maybe a
    Just (a
    pa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    ps)

    noEventTypeParser :: Int -> Maybe EventTypeSize
                      -> Get EventInfo
    noEventTypeParser :: Int -> Maybe Word16 -> Get EventInfo
    noEventTypeParser Int
    num Maybe Word16
    mb_size = do
      bytes <- case Maybe Word16
    mb_size of
                 Just Word16
    n  -> Word16 -> Get Word16
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Word16
    n
                 Maybe Word16
    Nothing -> Get Word16
    forall t. Binary t => Get t
    get :: Get Word16
      skip bytes
      return UnknownEvent{ ref = fromIntegral num }