diff --git a/ChangeLog b/ChangeLog
new file mode 100644
--- /dev/null
+++ b/ChangeLog
@@ -0,0 +1,3 @@
+2014-02-12  Edsko de Vries  <edsko@well-typed.com>
+
+  * Initial release 
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2013-2014 Well-Typed LLP
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Edsko de Vries nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/ghc-events-analyze.cabal b/ghc-events-analyze.cabal
new file mode 100644
--- /dev/null
+++ b/ghc-events-analyze.cabal
@@ -0,0 +1,79 @@
+name:                ghc-events-analyze
+version:             0.2.0
+synopsis:            Analyze and visualize event logs 
+description:         ghc-events-analyze is a simple Haskell profiling tool that
+                     uses GHC's eventlog system. It helps with some profiling
+                     use cases that are not covered by the existing GHC
+                     profiling modes or tools. It has two major features:
+                     .
+                     1. While ThreadScope shows CPU activity across all your
+                     cores, ghc-events-analyze shows CPU activity across all
+                     your Haskell threads.
+                     .
+                     2. It lets you label periods of time during program
+                     execution (by instrumenting your code with special trace
+                     calls) and then lets you visualize those time periods or
+                     get statistics on them.
+                     .
+                     It is very useful for profiling code when ghc's normal
+                     profiling mode is not available, or when using profiling
+                     mode would perturb the code too much. It is also useful
+                     when you want time-profiling information with a breakdown
+                     over time rather than totals for the whole run. 
+license:             BSD3
+license-file:        LICENSE
+author:              Edsko de Vries, Duncan Coutts, Mikolaj Konarski
+maintainer:          edsko@well-typed.com
+copyright:           2013-2014 Well-Typed LLP
+category:            Development, Profiling, Trace
+build-type:          Simple
+extra-source-files:  ChangeLog
+cabal-version:       >=1.10
+
+source-repository head
+  type: git 
+  location: https://github.com/edsko/ghc-events-analyze 
+
+executable ghc-events-analyze 
+  main-is:             GHC/RTS/Events/Analyze.hs
+  other-modules:       GHC.RTS.Events.Analyze.Analysis
+                       GHC.RTS.Events.Analyze.Options
+                       GHC.RTS.Events.Analyze.StrictState
+                       GHC.RTS.Events.Analyze.Utils
+                       GHC.RTS.Events.Analyze.Types
+                       GHC.RTS.Events.Analyze.Script
+                       GHC.RTS.Events.Analyze.Script.Standard
+                       GHC.RTS.Events.Analyze.Reports.Totals
+                       GHC.RTS.Events.Analyze.Reports.Timed
+                       GHC.RTS.Events.Analyze.Reports.Timed.SVG
+
+  build-depends:       base                 >= 4.5  && < 4.8,
+                       ghc-events           >= 0.4  && < 0.5,
+                       optparse-applicative >= 0.7  && < 0.8,
+                       diagrams-lib         >= 1.0  && < 1.1,
+                       diagrams-svg         >= 1.0  && < 1.1,
+                       SVGFonts             >= 1.4  && < 1.5,
+                       containers           >= 0.5  && < 0.6,
+                       lens                 >= 3.10 && < 4.1,
+                       mtl                  >= 2.1  && < 2.2,
+                       transformers         >= 0.3  && < 0.4,
+                       filepath             >= 1.3  && < 1.4,
+                       parsec               >= 3.1  && < 3.2,
+                       th-lift              >= 0.6  && < 0.7,
+                       -- No version: whatever is bundled with ghc
+                       template-haskell
+
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+  ghc-options:         -Wall -rtsopts
+
+  default-extensions:  NamedFieldPuns
+                       RecordWildCards
+                       NoMonomorphismRestriction
+                       ScopedTypeVariables
+                       ViewPatterns
+                       BangPatterns
+                       RankNTypes
+                       MultiParamTypeClasses
+  other-extensions:    TemplateHaskell
+                       QuasiQuotes
diff --git a/src/GHC/RTS/Events/Analyze.hs b/src/GHC/RTS/Events/Analyze.hs
new file mode 100644
--- /dev/null
+++ b/src/GHC/RTS/Events/Analyze.hs
@@ -0,0 +1,59 @@
+module Main where
+
+import Control.Applicative ((<$>))
+import Control.Monad (when)
+import System.FilePath (replaceExtension, takeFileName)
+import Text.Parsec.String (parseFromFile)
+
+import GHC.RTS.Events.Analyze.Analysis
+import GHC.RTS.Events.Analyze.Options
+import qualified GHC.RTS.Events.Analyze.Reports.Totals    as Totals
+import qualified GHC.RTS.Events.Analyze.Reports.Timed     as Timed
+import qualified GHC.RTS.Events.Analyze.Reports.Timed.SVG as TimedSVG
+import GHC.RTS.Events.Analyze.Script
+import GHC.RTS.Events.Analyze.Script.Standard
+
+main :: IO ()
+main = do
+    options@Options{..} <- parseOptions
+    analysis            <- analyze options <$> readEventLog optionsInput
+
+    (timedScriptName,  timedScript)  <- getScript optionsScriptTimed  defaultScriptTimed
+    (totalsScriptName, totalsScript) <- getScript optionsScriptTotals defaultScriptTotals
+
+    let quantized = quantize optionsNumBuckets analysis
+        totals    = Totals.createReport analysis totalsScript
+        timed     = Timed.createReport analysis quantized timedScript
+
+    let writeReport :: Bool
+                    -> String
+                    -> String
+                    -> (FilePath -> IO ())
+                    -> IO ()
+        writeReport isEnabled
+                    scriptName
+                    newExt
+                    mkReport = when isEnabled $ do
+          let output = replaceExtension (takeFileName optionsInput) newExt
+          mkReport output
+          putStrLn $ "Generated " ++ output ++ " using " ++ scriptName
+
+    writeReport optionsGenerateTotalsText
+                totalsScriptName
+                "totals.txt" $ Totals.writeReport totals
+
+    writeReport optionsGenerateTimedSVG
+                timedScriptName
+                "timed.svg" $ TimedSVG.writeReport options quantized timed
+
+    writeReport optionsGenerateTimedText
+                timedScriptName
+                "timed.txt" $ Timed.writeReport timed
+
+getScript :: FilePath -> Script -> IO (String, Script)
+getScript ""   def = return ("default script", def)
+getScript path _   = do
+  mScript <- parseFromFile pScript path
+  case mScript of
+    Left  err    -> fail (show err)
+    Right script -> return (path, script)
diff --git a/src/GHC/RTS/Events/Analyze/Analysis.hs b/src/GHC/RTS/Events/Analyze/Analysis.hs
new file mode 100644
--- /dev/null
+++ b/src/GHC/RTS/Events/Analyze/Analysis.hs
@@ -0,0 +1,264 @@
+module GHC.RTS.Events.Analyze.Analysis (
+    -- * Auxiliary
+    readEventLog
+    -- * Basic analysis
+  , events
+  , threadInfo
+  , numThreads
+  , analyze
+    -- * Using EventAnalysis
+  , eventTotal
+  , compareEventIds
+    -- * Quantization
+  , quantize
+  ) where
+
+import Prelude hiding (id, log)
+import Control.Applicative ((<$>), (<|>))
+import Control.Lens ((%=), (.=), use)
+import Control.Monad (forM_, when)
+import Data.Maybe (fromMaybe)
+import Data.Map.Strict (Map)
+import GHC.RTS.Events hiding (events)
+import qualified Data.Map.Strict as Map
+
+import GHC.RTS.Events.Analyze.Utils
+import GHC.RTS.Events.Analyze.StrictState (State, execState)
+import GHC.RTS.Events.Analyze.Types
+import GHC.RTS.Events.Analyze.Script
+
+{-------------------------------------------------------------------------------
+  Auxiliary
+-------------------------------------------------------------------------------}
+
+sortedEvents :: EventLog -> [Event]
+sortedEvents (EventLog _header (Data es)) = map ce_event (sortEvents es)
+
+readEventLog :: FilePath -> IO EventLog
+readEventLog  = throwLeftStr . readEventLogFromFile
+
+{-------------------------------------------------------------------------------
+  Basic analysis of the eventlog, making the information more easily accessible.
+  In particular, many events come in pairs (start thread/end thread, etc.);
+  the analysis combines such events.
+-------------------------------------------------------------------------------}
+
+analyze :: Options -> EventLog -> EventAnalysis
+analyze Options{..} log =
+    let analysis = execState (mapM_ analyzeEvent (sortedEvents log))
+                             initialEventAnalysis
+    in analysis { eventTotals = computeTotals (_events analysis) }
+  where
+    analyzeEvent :: Event -> State EventAnalysis ()
+    analyzeEvent (Event time spec) = case spec of
+        -- CapCreate/CapDelete are the "new" events (ghc >= 7.6)
+        -- Startup/Shutdown are older (to support older eventlogs)
+        CapCreate _cap             -> recordStartup  time
+        CapDelete _cap             -> recordShutdown time
+        Startup _numCaps           -> recordStartup  time
+        Shutdown                   -> recordShutdown time
+        -- Thread info
+        CreateThread tid           -> recordThreadCreation tid time
+        (finishThread -> Just tid) -> recordThreadFinish tid time
+        -- Start/end events
+        ThreadLabel tid l          -> labelThread tid l
+        (startId -> Just eid)      -> recordEventStart eid time
+        (stopId  -> Just eid)      -> recordEventStop eid time
+        _                          -> return ()
+
+    startId :: EventInfo -> Maybe EventId
+    startId (RunThread tid)                                   = Just $ EventThread tid
+    startId StartGC                                           = Just $ EventGC
+    startId (UserMessage (prefix optionsUserStart -> Just e)) = Just $ EventUser e
+    startId _                                                 = Nothing
+
+    stopId :: EventInfo -> Maybe EventId
+    stopId (StopThread tid _)                               = Just $ EventThread tid
+    stopId EndGC                                            = Just $ EventGC
+    stopId (UserMessage (prefix optionsUserStop -> Just e)) = Just $ EventUser e
+    stopId _                                                = Nothing
+
+-- We take the _first_ CapCreate to be the official startup time
+recordStartup :: Timestamp -> State EventAnalysis ()
+recordStartup time = startup %= (<|> Just time)
+
+-- We take the _last_ CapDelete to be the official shutdown tiem
+recordShutdown :: Timestamp -> State EventAnalysis ()
+recordShutdown time = shutdown .= Just time
+
+recordEventStart :: EventId -> Timestamp -> State EventAnalysis ()
+recordEventStart eid start = do
+    (oldValue, newOpen) <- Map.insertLookupWithKey push eid (start, 1) <$> use openEvents
+    openEvents .= newOpen
+    case (eid, oldValue) of
+      -- Pretend user events stop on the _first_ StartGC
+      (EventGC, Nothing) -> simulateUserEventsStopAt start
+      _                  -> return ()
+  where
+    push _ (_newStart, _newCount) (oldStart, oldCount) =
+      -- _newCount will always be 1; _newStart is irrelevant
+      let count' = oldCount + 1
+      in count' `seq` (oldStart, count')
+
+recordEventStop :: EventId -> Timestamp -> State EventAnalysis ()
+recordEventStop eid stop = do
+    (newValue, newOpen) <- Map.updateLookupWithKey pop eid <$> use openEvents
+    case newValue of
+      Just (start, 0) -> do
+        openEvents %= Map.delete eid
+        events     %= (:) (eid, start, stop)
+        when (eid == EventGC) $ simulateUserEventsStartAt stop
+      _ ->
+        openEvents .= newOpen
+  where
+    pop _ (start, count) =
+      let count' = count - 1
+      in count' `seq` Just (start, count')
+
+simulateUserEventsStopAt :: Timestamp -> State EventAnalysis ()
+simulateUserEventsStopAt stop = do
+    nowOpen <- Map.toList <$> use openEvents
+    forM_ nowOpen $ \(eid, (start, _count)) -> case eid of
+      EventGC       -> return ()
+      EventThread _ -> return ()
+      EventUser _   -> events %= (:) (eid, start, stop)
+
+simulateUserEventsStartAt :: Timestamp -> State EventAnalysis ()
+simulateUserEventsStartAt newStart = openEvents %= Map.mapWithKey updUserEvent
+  where
+    updUserEvent :: EventId -> (Timestamp, Int) -> (Timestamp, Int)
+    updUserEvent eid (oldStart, count) = case eid of
+      EventGC       -> (oldStart, count)
+      EventThread _ -> (oldStart, count)
+      EventUser _   -> (newStart, count)
+
+recordThreadCreation :: ThreadId -> Timestamp -> State EventAnalysis ()
+recordThreadCreation tid start =
+    threadInfo tid .= Just (start, start, show tid)
+
+recordThreadFinish :: ThreadId -> Timestamp -> State EventAnalysis ()
+recordThreadFinish tid stop = do
+    -- The "thread finished" doubles as a "thread stop"
+    recordEventStop (EventThread tid) stop
+    threadInfo tid %= fmap updStop
+  where
+    updStop (start, _stop, l) = (start, stop, l)
+
+labelThread :: ThreadId -> String -> State EventAnalysis ()
+labelThread tid l =
+    threadInfo tid %= fmap updLabel
+  where
+    updLabel (start, stop, l') = (start, stop, l ++ " (" ++ l' ++ ")")
+
+finishThread :: EventInfo -> Maybe ThreadId
+finishThread (StopThread tid ThreadFinished) = Just tid
+finishThread _                               = Nothing
+
+initialEventAnalysis :: EventAnalysis
+initialEventAnalysis = EventAnalysis {
+    _events      = []
+  , __threadInfo = Map.empty
+  , _openEvents  = Map.empty
+  , eventTotals  = error "eventTotals computed at the end"
+  , _startup     = Nothing
+  , _shutdown    = Nothing
+  }
+
+computeTotals :: [(EventId, Timestamp, Timestamp)] -> Map EventId Timestamp
+computeTotals = go Map.empty
+  where
+    go :: Map EventId Timestamp
+       -> [(EventId, Timestamp, Timestamp)]
+       -> Map EventId Timestamp
+    go !acc [] = acc
+    go !acc ((eid, start, stop) : es) =
+      go (Map.insertWith (+) eid (stop - start) acc) es
+
+{-------------------------------------------------------------------------------
+  Using EventAnalysis
+-------------------------------------------------------------------------------}
+
+-- | Lookup a total for a given event
+eventTotal :: EventAnalysis -> EventId -> Timestamp
+eventTotal EventAnalysis{..} eid =
+    case Map.lookup eid eventTotals of
+      Nothing -> error $ "Invalid event ID " ++ show eid ++ ". "
+                      ++ "Valid IDs are " ++ show (Map.keys eventTotals)
+      Just t  -> t
+
+-- | Compare event IDs
+compareEventIds :: EventAnalysis -> EventSort
+                -> EventId -> EventId -> Ordering
+compareEventIds analysis sort a b =
+    case sort of
+      SortByName  -> compare a b
+      SortByTotal -> compare (eventTotal analysis b) (eventTotal analysis a)
+
+{-------------------------------------------------------------------------------
+  Quantization
+-------------------------------------------------------------------------------}
+
+quantize :: Int -> EventAnalysis -> Quantized
+quantize numBuckets EventAnalysis{..} = Quantized {
+      quantTimes      = go Map.empty _events
+    , quantThreadInfo = Map.map quantizeThreadInfo __threadInfo
+    , quantBucketSize = bucketSize
+    }
+  where
+    go :: Map EventId (Map Int Double)
+       -> [(EventId, Timestamp, Timestamp)]
+       -> Map EventId (Map Int Double)
+    go !acc [] = acc
+    go !acc ((eid, start, end) : ttimes') =
+      let startBucket, endBucket :: Int
+          startBucket = bucket start
+          endBucket   = bucket end
+
+          updates :: Map Int Double
+          updates = Map.fromAscList
+                  $ [ (b, delta startBucket endBucket start end b)
+                    | b <- [startBucket .. endBucket]
+                    ]
+
+          update :: Maybe (Map Int Double) -> Maybe (Map Int Double)
+          update Nothing    = Just $ updates
+          update (Just old) = let new = Map.unionWith (+) updates old
+                              in new `seq` Just new
+
+      in go (Map.alter update eid acc) ttimes'
+
+    --           (a,                    b)
+    --       |          |   ...    |          |
+    --        startBucket             endBucket
+    --
+    --                      ^^^
+    --                      bucket
+
+    delta :: Int -> Int -> Timestamp -> Timestamp -> Int -> Double
+    delta startBucket endBucket start end b
+      | b == startBucket && startBucket == endBucket =
+         t2d (end - start) / t2d bucketSize
+      | b == startBucket =
+         t2d (bucketEnd b - start) / t2d bucketSize
+      | b == endBucket =
+         t2d (end - bucketStart b) / t2d bucketSize
+      | otherwise =
+         1
+
+    startTime, endTime, bucketSize :: Timestamp
+    startTime  = fromMaybe (error "_startup not set")  _startup
+    endTime    = fromMaybe (error "_shutdown not set") _shutdown
+    bucketSize = (endTime - startTime) `div` fromIntegral numBuckets
+
+    bucketStart, bucketEnd :: Int -> Timestamp
+    bucketStart b = startTime + fromIntegral b * bucketSize
+    bucketEnd   b = bucketStart (b + 1)
+
+    bucket :: Timestamp -> Int
+    bucket t = fromIntegral ((t - startTime) `div` bucketSize)
+
+    t2d :: Timestamp -> Double
+    t2d = fromInteger . toInteger
+
+    quantizeThreadInfo :: (Timestamp, Timestamp, String) -> (Int, Int, String)
+    quantizeThreadInfo (start, stop, label) = (bucket start, bucket stop, label)
diff --git a/src/GHC/RTS/Events/Analyze/Options.hs b/src/GHC/RTS/Events/Analyze/Options.hs
new file mode 100644
--- /dev/null
+++ b/src/GHC/RTS/Events/Analyze/Options.hs
@@ -0,0 +1,116 @@
+module GHC.RTS.Events.Analyze.Options (
+    Options(..)
+  , parseOptions
+  ) where
+
+import Options.Applicative
+
+import GHC.RTS.Events.Analyze.Types
+import GHC.RTS.Events.Analyze.Script
+import GHC.RTS.Events.Analyze.Script.Standard
+
+parseOptions :: IO Options
+parseOptions = customExecParser (prefs showHelpOnError) opts
+  where
+    opts = info (helper <*> parserOptions)
+              ( fullDesc
+             <> progDesc "Quantize and visualize EVENTLOG"
+             <> footer "If no output is selected, generates SVG and totals."
+              )
+
+parserOptions :: Parser Options
+parserOptions =
+      infoOption scriptHelp ( long "help-script"
+                           <> help "Detailed information about scripts"
+                            )
+  <*> (selectDefaultOutput <$> (Options
+    <$> switch     ( long "timed"
+                  <> help "Generate timed report (in SVG format)"
+                   )
+    <*> switch     ( long "timed-txt"
+                  <> help "Generate timed report (in textual format)"
+                   )
+    <*> switch     ( long "totals"
+                  <> help "Generate totals report"
+                   )
+    <*> option     ( long "buckets"
+                  <> short 'b'
+                  <> metavar "INT"
+                  <> help "Use INT buckets for quantization."
+                  <> showDefault
+                  <> value 100
+                   )
+    <*> strOption  ( long "start"
+                  <> metavar "STR"
+                  <> help "Use STR as the prefix for the start of user events"
+                  <> showDefault
+                  <> value "START "
+                   )
+    <*> strOption  ( long "stop"
+                  <> metavar "STR"
+                  <> help "Use STR as the prefix for the end of user events"
+                  <> showDefault
+                  <> value "STOP "
+                   )
+    <*> strOption  ( long "script-totals"
+                  <> metavar "PATH"
+                  <> help "Use the script in PATH for the totals report"
+                  <> value ""
+                   )
+    <*> strOption  ( long "script-timed"
+                  <> metavar "PATH"
+                  <> help "Use the script in PATH for the timed reports"
+                  <> value ""
+                   )
+    <*> argument str (metavar "EVENTLOG")
+  ))
+
+scriptHelp :: String
+scriptHelp = unlines [
+      "Scripts are used to drive report generation. The syntax for scripts is"
+    , ""
+    , "<script>  ::= <command>+"
+    , ""
+    , "<command> ::= \"section\" STRING"
+    , "            | <eventId>      (\"as\" STRING)?"
+    , "            | \"sum\" <filter> (\"as\" STRING)?"
+    , "            | <filter>       (\"by\" <sort>)?"
+    , ""
+    , "<eventId> ::= STRING     -- user event"
+    , "            | INT        -- thread event"
+    , "            | \"GC\"       -- garbage collection"
+    , ""
+    , "<filter>  ::= <eventId>  -- single event"
+    , "            | \"user\"     -- any user event"
+    , "            | \"thread\"   -- any thread event"
+    , "            | \"any\" \"[\" <filter> (\",\" <filter>)* \"]\""
+    , ""
+    , "<sort>    ::= \"total\""
+    , "            | \"name\""
+    , ""
+    , "The default script for the timed reports is\n"
+    ]
+    ++ indent (unparseScript defaultScriptTimed)
+    ++ "\nThe default script for the totals report is\n\n"
+    ++ indent (unparseScript defaultScriptTotals)
+    ++ unlines [
+      "\nCustom scripts are useful extract different kinds of data from the"
+    , "eventlog, or for presentation purposes."
+    ]
+  where
+    indent :: [String] -> String
+    indent = unlines . map ("  " ++)
+
+-- | Select which output is active if no output is selected at all
+selectDefaultOutput :: Options -> Options
+selectDefaultOutput options@Options{..} =
+    if noOutputSelected
+      then options { optionsGenerateTotalsText = True
+                   , optionsGenerateTimedSVG   = True
+                   , optionsGenerateTimedText  = True
+                   }
+      else options
+  where
+    noOutputSelected = not optionsGenerateTotalsText
+                    && not optionsGenerateTimedSVG
+                    && not optionsGenerateTimedText
diff --git a/src/GHC/RTS/Events/Analyze/Reports/Timed.hs b/src/GHC/RTS/Events/Analyze/Reports/Timed.hs
new file mode 100644
--- /dev/null
+++ b/src/GHC/RTS/Events/Analyze/Reports/Timed.hs
@@ -0,0 +1,130 @@
+module GHC.RTS.Events.Analyze.Reports.Timed (
+    Report
+  , ReportFragment(..)
+  , ReportLine(..)
+  , createReport
+  , writeReport
+  ) where
+
+import Data.Function (on)
+import Data.List (sortBy, intercalate)
+import Data.Map (Map)
+import System.IO (Handle, hPutStrLn, withFile, IOMode(WriteMode))
+import Text.Printf (printf)
+import qualified Data.Map as Map
+
+import GHC.RTS.Events.Analyze.Analysis
+import GHC.RTS.Events.Analyze.Script
+import GHC.RTS.Events.Analyze.Types
+import GHC.RTS.Events.Analyze.Utils
+
+{-------------------------------------------------------------------------------
+  Types
+-------------------------------------------------------------------------------}
+
+type Report = [ReportFragment]
+
+data ReportFragment =
+    ReportSection Title
+  | ReportLine ReportLine
+  deriving Show
+
+data ReportLine = ReportLineData {
+    lineHeader     :: String
+  , lineEventIds   :: [EventId]
+  , lineBackground :: Maybe (Int, Int)
+  , lineValues     :: Map Int Double
+  }
+  deriving Show
+
+{-------------------------------------------------------------------------------
+  Report generation
+-------------------------------------------------------------------------------}
+
+createReport :: EventAnalysis -> Quantized -> Script -> Report
+createReport analysis Quantized{..} = concatMap go
+  where
+    go :: Command -> [ReportFragment]
+    go (Section title) =
+      [ReportSection title]
+    go (One eid title) =
+      [ReportLine $ reportLine title (eid, quantTimesForEvent eid)]
+    go (All f sort) =
+      map (ReportLine . reportLine Nothing) (sorted sort $ filtered f)
+    go (Sum f title) =
+      [ReportLine $ sumLines title $ map (reportLine Nothing) (filtered f)]
+
+    reportLine :: Maybe Title -> (EventId, Map Int Double) -> ReportLine
+    reportLine title (eid, qs) = ReportLineData {
+        lineHeader     = showTitle (showEventId quantThreadInfo eid) title
+      , lineEventIds   = [eid]
+      , lineBackground = background eid
+      , lineValues     = qs
+      }
+
+    -- For threads we draw a background showing the thread's lifetime
+    background :: EventId -> Maybe (Int, Int)
+    background EventGC           = Nothing
+    background (EventUser _)     = Nothing
+    background (EventThread tid) =
+      case Map.lookup tid quantThreadInfo of
+        Just (start, stop, _) -> Just (start, stop)
+        Nothing               -> error $ "Invalid thread ID " ++ show tid
+
+    quantTimesForEvent :: EventId -> Map Int Double
+    quantTimesForEvent eid =
+      case Map.lookup eid quantTimes of
+        Nothing    -> error $ "Invalid event ID " ++ show eid ++ ". "
+                           ++ "Valid IDs are " ++ show (Map.keys quantTimes)
+        Just times -> times
+
+    sorted :: Maybe EventSort -> [(EventId, a)] -> [(EventId, a)]
+    sorted Nothing     = id
+    sorted (Just sort) = sortBy (compareEventIds analysis sort `on` fst)
+
+    filtered :: EventFilter -> [(EventId, Map Int Double)]
+    filtered f = filter (matchesFilter f . fst) (Map.toList quantTimes)
+
+sumLines :: Maybe Title -> [ReportLine] -> ReportLine
+sumLines title qs = ReportLineData {
+      lineHeader     = showTitle "TOTAL" title
+    , lineEventIds   = concatMap lineEventIds qs
+    , lineBackground = foldr1 combineBG $ map lineBackground qs
+    , lineValues     = Map.unionsWith (+) $ map lineValues qs
+    }
+  where
+    combineBG :: Maybe (Int, Int) -> Maybe (Int, Int) -> Maybe (Int, Int)
+    combineBG (Just (fr, to)) (Just (fr', to')) = Just (min fr fr', max to to')
+    combineBG _ _ = Nothing
+
+showTitle :: String -> Maybe Title -> String
+showTitle _   (Just title) = title
+showTitle def Nothing      = def
+
+{-------------------------------------------------------------------------------
+  Write the report in textual form
+-------------------------------------------------------------------------------}
+
+writeReport :: Report -> FilePath -> IO ()
+writeReport report path = withFile path WriteMode $ writeReport' report
+
+writeReport' :: Report -> Handle -> IO ()
+writeReport' report h =
+      mapM_ writeLine
+    $ mapEithers id (renderTable (AlignLeft : repeat AlignRight))
+    $ map reportFragment report
+  where
+    writeLine :: Either String [String] -> IO ()
+    writeLine (Left header) = hPutStrLn h $ "\n" ++ header
+    writeLine (Right cells) = hPutStrLn h $ intercalate " " cells
+
+    reportFragment :: ReportFragment -> Either String [String]
+    reportFragment (ReportSection title) = Left title
+    reportFragment (ReportLine line)     = Right (reportLine line)
+
+    reportLine :: ReportLine -> [String]
+    reportLine ReportLineData{..} =
+      lineHeader : map showValue (unsparse 0 lineValues)
+
+    showValue :: Double -> String
+    showValue = printf "%0.2f"
diff --git a/src/GHC/RTS/Events/Analyze/Reports/Timed/SVG.hs b/src/GHC/RTS/Events/Analyze/Reports/Timed/SVG.hs
new file mode 100644
--- /dev/null
+++ b/src/GHC/RTS/Events/Analyze/Reports/Timed/SVG.hs
@@ -0,0 +1,153 @@
+module GHC.RTS.Events.Analyze.Reports.Timed.SVG (
+    writeReport
+  ) where
+
+import Data.Maybe (catMaybes)
+import Data.Monoid (mempty, mconcat, (<>))
+import Diagrams.Backend.SVG (B, renderSVG)
+import Diagrams.Prelude (Diagram, Colour, R2, SizeSpec2D, (#), (|||))
+import GHC.RTS.Events (Timestamp)
+import Graphics.SVGFonts.ReadFont (TextOpts(..))
+import Text.Printf (printf)
+import qualified Data.Map as Map
+import qualified Diagrams.Prelude           as D
+import qualified Graphics.SVGFonts.ReadFont as F
+
+import GHC.RTS.Events.Analyze.Types
+import GHC.RTS.Events.Analyze.Reports.Timed hiding (writeReport)
+
+writeReport :: Options -> Quantized -> Report -> FilePath -> IO ()
+writeReport options quantized report path =
+  uncurry (renderSVG path) $ renderReport options quantized report
+
+type D = Diagram B R2
+
+renderReport :: Options -> Quantized -> Report -> (SizeSpec2D, D)
+renderReport Options{optionsNumBuckets}
+             Quantized{quantBucketSize}
+             report = (D.sizeSpec2D rendered, rendered)
+  where
+    rendered :: D
+    rendered = D.vcat $ map renderSVGFragment (SVGTimeline : fragments)
+
+    fragments :: [SVGFragment]
+    fragments = map renderFragment report
+
+    renderSVGFragment :: SVGFragment -> D
+    renderSVGFragment (SVGSection title) =
+      padHeader (2 * blockSize) title
+    renderSVGFragment (SVGLine header blocks) =
+      -- Add empty block at the start so that the whole thing doesn't shift up
+      padHeader blockSize header ||| (blocks <> (block 0 # D.lw 0))
+    renderSVGFragment SVGTimeline =
+      padHeader blockSize mempty ||| timeline optionsNumBuckets quantBucketSize
+
+    padHeader :: Double -> D -> D
+    padHeader height h =
+         D.translateX (0.5 * blockSize) h
+      <> D.rect headerWidth height # D.alignL # D.lw 0
+
+    headerWidth :: Double
+    headerWidth = blockSize -- extra padding
+                + (maximum . catMaybes . map headerWidthOf $ fragments)
+
+    headerWidthOf :: SVGFragment -> Maybe Double
+    headerWidthOf (SVGLine header _) = Just (D.width header)
+    headerWidthOf _                  = Nothing
+
+data SVGFragment =
+    SVGTimeline
+  | SVGSection D
+  | SVGLine D D
+
+renderFragment :: ReportFragment -> SVGFragment
+renderFragment (ReportSection title) = SVGSection (renderText title (blockSize + 2))
+renderFragment (ReportLine line)     = uncurry SVGLine $ renderLine line
+
+renderLine :: ReportLine -> (D, D)
+renderLine line@ReportLineData{..} =
+    ( renderText lineHeader (blockSize + 2)
+    , blocks <> bgBlocks lineBackground
+    )
+  where
+    blocks :: D
+    blocks = mconcat . map (mkBlock $ lineColor line) $ Map.toList lineValues
+
+    mkBlock :: Colour Double -> (Int, Double) -> D
+    mkBlock c (b, q) = block b # D.fcA (c `D.withOpacity` qOpacity q)
+
+lineColor :: ReportLine -> Colour Double
+lineColor = eventColor . head . lineEventIds
+
+eventColor :: EventId -> Colour Double
+eventColor EventGC         = D.red
+eventColor (EventUser _)   = D.green
+eventColor (EventThread _) = D.blue
+
+
+bgBlocks :: Maybe (Int, Int) -> D
+bgBlocks Nothing         = mempty
+bgBlocks (Just (fr, to)) = mconcat [
+                               block b # D.fcA (D.black `D.withOpacity` 0.1)
+                             | b <- [fr .. to]
+                             ]
+
+renderText :: String -> Double -> D
+renderText str size =
+    D.stroke (F.textSVG' (textOpts str size)) # D.fc D.black # D.lc D.black # D.alignL
+
+textOpts :: String -> Double -> TextOpts
+textOpts str size =
+    TextOpts {
+        txt        = str
+      , fdo        = F.lin
+      , mode       = F.INSIDE_H
+      , spacing    = F.KERN
+      , underline  = False
+      , textWidth  = 0 -- not important
+      , textHeight = size
+      }
+
+-- | Translate quantized value to opacity
+--
+-- For every event and every bucket we record the percentage of that bucket
+-- that the event was using. However, if we use this percentage directly as the
+-- opacity value for the corresponding block in the diagram then a thread that
+-- does _something_, but only a tiny amount, is indistinguishable from a thread
+-- that does nothing -- but typically we are interested in knowing that a
+-- thread does something, anything at all, rather than nothing, while the
+-- difference between using 30% and 40% is probably less important and hard to
+-- visually see anyway.
+qOpacity :: Double -> Double
+qOpacity 0 = 0
+qOpacity q = 0.1 + q * 0.9
+
+block :: Int -> D
+block i = D.translateX (blockSize * fromIntegral i)
+        $ D.rect blockSize blockSize
+
+blockSize :: Double
+blockSize = 10
+
+timeline :: Int -> Timestamp -> D
+timeline numBuckets bucketSize =
+    mconcat [ timelineBlock b # D.translateX (fromIntegral b * blockSize)
+            | b <- [0 .. numBuckets - 1]
+            ]
+  where
+    timelineBlock b
+      | b `rem`5 == 0 = D.strokeLine bigLine   # D.lw 0.5
+                     <> (renderText (bucketTime b) 9 # D.translateY 8)
+      | otherwise     = D.strokeLine smallLine # D.lw 0.5 # D.translateY 1
+
+    bucketTime :: Int -> String
+    bucketTime b = let timeNs :: Timestamp
+                       timeNs = fromIntegral b * bucketSize
+
+                       timeS :: Double
+                       timeS = fromIntegral timeNs / 1000000000
+                   in printf "%0.1fs" timeS
+
+    bigLine   = mkLine [(0, 4), (blockSize, 0)]
+    smallLine = mkLine [(0, 3), (blockSize, 0)]
+    mkLine    = D.fromSegments . map (D.straight . D.r2)
diff --git a/src/GHC/RTS/Events/Analyze/Reports/Totals.hs b/src/GHC/RTS/Events/Analyze/Reports/Totals.hs
new file mode 100644
--- /dev/null
+++ b/src/GHC/RTS/Events/Analyze/Reports/Totals.hs
@@ -0,0 +1,113 @@
+module GHC.RTS.Events.Analyze.Reports.Totals (
+    Report
+  , ReportFragment(..)
+  , ReportLine(..)
+  , createReport
+  , writeReport
+  ) where
+
+import Data.Function (on)
+import Data.List (sortBy, intercalate)
+import GHC.RTS.Events (Timestamp)
+import System.IO (Handle, hPutStrLn, withFile, IOMode(WriteMode))
+import Text.Printf (printf)
+import qualified Data.Map as Map
+
+import GHC.RTS.Events.Analyze.Analysis
+import GHC.RTS.Events.Analyze.Types
+import GHC.RTS.Events.Analyze.Script
+import GHC.RTS.Events.Analyze.Utils
+
+{-------------------------------------------------------------------------------
+  Types
+-------------------------------------------------------------------------------}
+
+type Report = [ReportFragment]
+
+data ReportFragment =
+    ReportSection Title
+  | ReportLine ReportLine
+  deriving Show
+
+data ReportLine = ReportLineData {
+    lineHeader   :: String
+  , lineEventIds :: [EventId]
+  , lineTotal    :: Timestamp
+  }
+  deriving Show
+
+{-------------------------------------------------------------------------------
+  Report generation
+-------------------------------------------------------------------------------}
+
+createReport :: EventAnalysis -> Script -> Report
+createReport analysis@EventAnalysis{..} = concatMap go
+  where
+    go :: Command -> [ReportFragment]
+    go (Section title) =
+      [ReportSection title]
+    go (One eid title) =
+      [ReportLine $ reportLine title (eid, totalForEvent eid)]
+    go (All f sort) =
+      map (ReportLine . reportLine Nothing) (sorted sort $ filtered f)
+    go (Sum f title) =
+      [ReportLine $ sumLines title $ map (reportLine Nothing) (filtered f)]
+
+    reportLine :: Maybe Title -> (EventId, Timestamp) -> ReportLine
+    reportLine title (eid, total) = ReportLineData {
+        lineHeader   = showTitle (showEventId __threadInfo eid) title
+      , lineEventIds = [eid]
+      , lineTotal    = total
+      }
+
+    totalForEvent :: EventId -> Timestamp
+    totalForEvent = eventTotal analysis
+
+    sorted :: Maybe EventSort -> [(EventId, a)] -> [(EventId, a)]
+    sorted Nothing     = id
+    sorted (Just sort) = sortBy (compareEventIds analysis sort `on` fst)
+
+    filtered :: EventFilter -> [(EventId, Timestamp)]
+    filtered f = filter (matchesFilter f . fst) (Map.toList eventTotals)
+
+sumLines :: Maybe Title -> [ReportLine] -> ReportLine
+sumLines title qs = ReportLineData {
+    lineHeader   = showTitle "TOTAL" title
+  , lineEventIds = concatMap lineEventIds qs
+  , lineTotal    = foldr (+) 0 $ map lineTotal qs
+  }
+
+showTitle :: String -> Maybe Title -> String
+showTitle _   (Just title) = title
+showTitle def Nothing      = def
+
+{-------------------------------------------------------------------------------
+  Write report in textual form
+-------------------------------------------------------------------------------}
+
+writeReport :: Report -> FilePath -> IO ()
+writeReport report path = withFile path WriteMode $ writeReport' report
+
+writeReport' :: Report -> Handle -> IO ()
+writeReport' report h =
+      mapM_ writeLine
+    $ mapEithers id (renderTable (AlignLeft : repeat AlignRight))
+    $ map reportFragment report
+  where
+    writeLine :: Either String [String] -> IO ()
+    writeLine (Left header) = hPutStrLn h $ "\n" ++ header
+    writeLine (Right cells) = hPutStrLn h $ intercalate "   " cells
+
+    reportFragment :: ReportFragment -> Either String [String]
+    reportFragment (ReportSection title) = Left title
+    reportFragment (ReportLine line)     = Right (reportLine line)
+
+    reportLine :: ReportLine -> [String]
+    reportLine ReportLineData{..} =
+      [ lineHeader
+      , printf "%dns"   $ lineTotal
+      , printf "%0.3fs" $ toSec lineTotal
+      ]
+
+    toSec :: Timestamp -> Double
+    toSec = (/ 1000000000) . fromInteger . toInteger
diff --git a/src/GHC/RTS/Events/Analyze/Script.hs b/src/GHC/RTS/Events/Analyze/Script.hs
new file mode 100644
--- /dev/null
+++ b/src/GHC/RTS/Events/Analyze/Script.hs
@@ -0,0 +1,240 @@
+{-# OPTIONS_GHC -w -W #-}
+{-# LANGUAGE TemplateHaskell #-}
+module GHC.RTS.Events.Analyze.Script (
+    -- * Types
+    Script
+  , Title
+  , EventFilter(..)
+  , EventSort(..)
+  , Command(..)
+    -- * Script execution
+  , matchesFilter
+    -- * Parsing and unparsing
+  , pScript
+  , unparseScript
+    -- * Quasi-quoting support
+  , scriptQQ
+  ) where
+
+import Control.Applicative ((<$>), (<*>), (*>), (<*))
+import Data.List (intercalate)
+import Data.Word (Word32)
+import Language.Haskell.TH.Lift (deriveLiftMany)
+import Language.Haskell.TH.Quote
+import Language.Haskell.TH.Syntax
+import Text.Parsec
+import Text.Parsec.Language (haskellDef)
+import qualified Text.Parsec.Token as P
+
+import GHC.RTS.Events.Analyze.Types
+
+{-------------------------------------------------------------------------------
+  Script definition
+-------------------------------------------------------------------------------}
+
+-- | A script is used to drive the construction of reports
+type Script = [Command]
+
+-- | Title of a section of an event
+type Title = String
+
+-- | Event filters
+data EventFilter =
+    -- | A single event
+    --
+    -- Examples
+    -- > GC     -- the GC event
+    -- > "foo"  -- user event "foo"
+    -- > 5      -- thread ID 5
+    Is EventId
+
+    -- | Any user event
+    --
+    -- Example
+    -- > user
+  | IsUser
+
+    -- | Any thread event
+    --
+    -- Example
+    -- > thread
+  | IsThread
+
+    -- | Logical or
+    --
+    -- Example
+    -- > [GC, "foo", 5]
+  | Any [EventFilter]
+  deriving Show
+
+-- | Sorting
+data EventSort =
+    -- | Sort by event name
+    --
+    -- Example
+    -- > thread by name
+    SortByName
+
+    -- | Sort by total
+    --
+    -- Example
+    -- > user by name
+  | SortByTotal
+  deriving Show
+
+-- | Commands
+data Command =
+    -- | Start a new section
+    --
+    -- Example
+    -- > section "User events"
+    Section Title
+
+    -- | A single event
+    --
+    -- Example
+    -- > "foo"  -- user event "foo"
+  | One EventId     (Maybe Title)
+
+    -- | Show all the matching events
+    --
+    -- Examples
+    -- > user by total  -- all user events, sorted
+    -- > [4, 2, 3]      -- thread events 4, 2 and 3, in that order
+  | All EventFilter (Maybe EventSort)
+
+    -- | Sum over the specified events
+    --
+    -- Example
+    -- > sum user
+  | Sum EventFilter (Maybe Title)
+  deriving Show
+
+{-------------------------------------------------------------------------------
+  Script execution
+-------------------------------------------------------------------------------}
+
+matchesFilter :: EventFilter -> EventId -> Bool
+matchesFilter (Is eid') eid = eid' == eid
+matchesFilter IsUser    eid = isUserEvent eid
+matchesFilter IsThread  eid = isThreadEvent eid
+matchesFilter (Any fs)  eid = or (map (`matchesFilter` eid) fs)
+
+{-------------------------------------------------------------------------------
+  Lexical analysis
+-------------------------------------------------------------------------------}
+
+lexer :: P.TokenParser ()
+lexer = P.makeTokenParser haskellDef {
+            P.reservedNames = [
+                "section"
+              , "GC"
+              , "user"
+              , "thread"
+              , "as"
+              , "by"
+              , "total"
+              , "name"
+              , "all"
+              ]
+           }
+
+reserved      = P.reserved      lexer
+stringLiteral = P.stringLiteral lexer
+natural       = P.natural       lexer
+squares       = P.squares       lexer
+commaSep1     = P.commaSep1     lexer
+whiteSpace    = P.whiteSpace    lexer
+
+{-------------------------------------------------------------------------------
+  Syntax analysis
+-------------------------------------------------------------------------------}
+
+type Parser a = Parsec String () a
+
+pEventId :: Parser EventId
+pEventId =  (EventUser     <$> stringLiteral <?> "user event")
+        <|> (EventThread   <$> pThreadId     <?> "thread event")
+        <|> (const EventGC <$> reserved "GC")
+  where
+    pThreadId = fromIntegral <$> natural
+
+pEventFilter :: Parser EventFilter
+pEventFilter =  (Is             <$> pEventId)
+            <|> (const IsUser   <$> reserved "user")
+            <|> (const IsThread <$> reserved "thread")
+            <|> (Any            <$> (squares $ commaSep1 pEventFilter))
+
+pCommand :: Parser Command
+pCommand = (Section <$> (reserved "section" *> stringLiteral))
+       <|> (One     <$> pEventId                         <*> pTitle)
+       <|> (Sum     <$> (reserved "sum" *> pEventFilter) <*> pTitle)
+       <|> (All     <$> (reserved "all" *> pEventFilter) <*> pEventSort)
+
+pEventSort :: Parser (Maybe EventSort)
+pEventSort = optionMaybe $ reserved "by" *> (
+                     (const SortByTotal <$> reserved "total")
+                 <|> (const SortByName  <$> reserved "name")
+               )
+
+pTitle :: Parser (Maybe Title)
+pTitle = optionMaybe (reserved "as" *> stringLiteral)
+
+pScript :: Parser Script
+pScript = whiteSpace *> many1 pCommand <* eof
+
+{-------------------------------------------------------------------------------
+  Quasi-quoting
+-------------------------------------------------------------------------------}
+
+$(deriveLiftMany [''EventId, ''EventFilter, ''EventSort, ''Command])
+
+instance Lift Word32 where
+  lift = let conv :: Word32 -> Int ; conv = fromEnum in lift . conv
+
+scriptQQ :: QuasiQuoter
+scriptQQ = QuasiQuoter {
+    quoteExp  = \e -> parseScriptString "<<source>>" e >>= lift
+  , quotePat  = \_ -> fail "Cannot use script as a pattern"
+  , quoteType = \_ -> fail "Cannot use script as a type"
+  , quoteDec  = \_ -> fail "Cannot use script as a declaration"
+  }
+
+parseScriptString :: Monad m => String -> String -> m Script
+parseScriptString source input =
+  case runParser pScript () source input of
+    Left  err    -> fail (show err)
+    Right script -> return script
+
+{-------------------------------------------------------------------------------
+  Unparsing
+-------------------------------------------------------------------------------}
+
+unparseScript :: Script -> [String]
+unparseScript = concatMap unparseCommand
+
+unparseCommand :: Command -> [String]
+unparseCommand (Section title) = ["", title]
+unparseCommand (One eid title) = [unparseEventId eid ++ " " ++ unparseTitle title]
+unparseCommand (All f sort)    = ["all " ++ unparseFilter f ++ " " ++ unparseSort sort]
+unparseCommand (Sum f title)   = ["sum " ++ unparseFilter f ++ " " ++ unparseTitle title]
+
+unparseEventId :: EventId -> String
+unparseEventId EventGC           = "GC"
+unparseEventId (EventUser e)     = e
+unparseEventId (EventThread tid) = show tid
+
+unparseTitle :: Maybe Title -> String
+unparseTitle Nothing  = ""
+unparseTitle (Just t) = "as " ++ t
+
+unparseSort :: Maybe EventSort -> String
+unparseSort Nothing            = ""
+unparseSort (Just SortByName)  = "by name"
+unparseSort (Just SortByTotal) = "by total"
+
+unparseFilter :: EventFilter -> String
+unparseFilter (Is eid) = unparseEventId eid
+unparseFilter IsUser   = "user"
+unparseFilter IsThread = "thread"
+unparseFilter (Any fs) = "[" ++ intercalate "," (map unparseFilter fs) ++ "]"
diff --git a/src/GHC/RTS/Events/Analyze/Script/Standard.hs b/src/GHC/RTS/Events/Analyze/Script/Standard.hs
new file mode 100644
--- /dev/null
+++ b/src/GHC/RTS/Events/Analyze/Script/Standard.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE QuasiQuotes #-}
+module GHC.RTS.Events.Analyze.Script.Standard (
+    defaultScriptTotals
+  , defaultScriptTimed
+  ) where
+
+import GHC.RTS.Events.Analyze.Script
+
+defaultScriptTotals :: Script
+defaultScriptTotals = [scriptQQ|
+    GC
+
+    section "USER EVENTS (user events are corrected for GC)"
+    all user by total
+    sum user
+
+    section "THREAD EVENTS"
+    all thread by name
+    sum thread
+  |]
+
+defaultScriptTimed :: Script
+defaultScriptTimed = [scriptQQ|
+    GC
+
+    section "USER EVENTS"
+    all user by name
+
+    section "THREAD EVENTS"
+    all thread by name
+  |]
diff --git a/src/GHC/RTS/Events/Analyze/StrictState.hs b/src/GHC/RTS/Events/Analyze/StrictState.hs
new file mode 100644
--- /dev/null
+++ b/src/GHC/RTS/Events/Analyze/StrictState.hs
@@ -0,0 +1,57 @@
+-- | State monad which forces the state to whnf on every step
+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving #-}
+module GHC.RTS.Events.Analyze.StrictState (
+    -- * Transformer
+    StateT
+  , runStateT
+  , evalStateT
+  , execStateT
+    -- * Base monad
+  , State
+  , runState
+  , evalState
+  , execState
+    -- * Re-exports
+  , module Control.Monad.State.Strict
+  ) where
+
+import Control.Monad.IO.Class (MonadIO)
+import Control.Monad.State.Strict (MonadState(..))
+import qualified Control.Monad.State.Strict as St
+import Control.Monad.Trans.Class (MonadTrans)
+import Control.Monad.Identity (Identity(..))
+
+{-------------------------------------------------------------------------------
+  Transformer
+-------------------------------------------------------------------------------}
+
+newtype StateT s m a = StateT { unStateT :: St.StateT s m a  }
+  deriving (Functor, Monad, MonadTrans, MonadIO)
+
+runStateT :: StateT s m a -> s -> m (a, s)
+runStateT = St.runStateT . unStateT
+
+evalStateT :: Monad m => StateT s m a -> s -> m a
+evalStateT = St.evalStateT . unStateT
+
+execStateT :: Monad m => StateT s m a -> s -> m s
+execStateT = St.execStateT . unStateT
+
+instance Monad m => MonadState s (StateT s m) where
+  get   = StateT get
+  put s = s `seq` StateT (put s)
+
+{-------------------------------------------------------------------------------
+  Base monad
+-------------------------------------------------------------------------------}
+
+type State s a = StateT s Identity a
+
+runState :: State s a -> s -> (a, s)
+runState act = runIdentity . runStateT act
+
+evalState :: State s a -> s -> a
+evalState act = runIdentity . evalStateT act
+
+execState :: State s a -> s -> s
+execState act = runIdentity . execStateT act
diff --git a/src/GHC/RTS/Events/Analyze/Types.hs b/src/GHC/RTS/Events/Analyze/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/GHC/RTS/Events/Analyze/Types.hs
@@ -0,0 +1,149 @@
+{-# LANGUAGE TemplateHaskell #-}
+module GHC.RTS.Events.Analyze.Types (
+    EventId(..)
+  , Options(..)
+  , EventAnalysis(..)
+  , events
+  , threadInfo
+  , openEvents
+  , startup
+  , shutdown
+  , numThreads
+  , Quantized(..)
+  , showEventId
+  , isUserEvent
+  , isThreadEvent
+  ) where
+
+import Control.Lens (Lens', makeLenses, at, (^.))
+import Data.Map (Map)
+import GHC.RTS.Events (Timestamp, ThreadId)
+import qualified Data.Map as Map
+
+-- | Event identifiers
+--
+-- The order of the constructors matters because it dictates the default
+-- ordering in the output SVG
+data EventId =
+    -- | Garbage collection
+    EventGC
+
+    -- | User events
+    --
+    -- To use user events, do
+    --
+    -- > traceEventIO "START <label>"
+    -- > ...
+    -- > traceEventIO "STOP <label>"
+  | EventUser String
+
+    -- | Threads
+  | EventThread ThreadId
+  deriving (Eq, Ord, Show)
+
+-- | Command line options
+data Options = Options {
+    optionsGenerateTimedSVG   :: Bool
+  , optionsGenerateTimedText  :: Bool
+  , optionsGenerateTotalsText :: Bool
+  , optionsNumBuckets         :: Int
+  , optionsUserStart          :: String
+  , optionsUserStop           :: String
+  , optionsScriptTotals       :: FilePath  -- "" denotes the standard script
+  , optionsScriptTimed        :: FilePath
+    -- Defined last to make defining the parser easier
+  , optionsInput              :: FilePath
+  }
+  deriving Show
+
+-- The fields that we use as "accumulators" in `analyze` are strict so that we
+-- don't build up chains of EventAnalysis objects when we update it as we
+-- process the eventlog
+data EventAnalysis = EventAnalysis {
+    -- | Start and stop timestamps
+    --
+    -- For events that miss an end marker the @stop@ timestamp will be set to
+    -- be equal to the @start@ timestamp
+    _events :: ![(EventId, Timestamp, Timestamp)]
+
+    -- | Information about each thread
+    --
+    -- When was the thread created, when was it destroyed, and what is the
+    -- thread label (as indicated by ThreadLabel events)
+    --
+    -- The default label for each thread is the thread ID
+  , __threadInfo :: !(Map ThreadId (Timestamp, Timestamp, String))
+
+    -- | Event with a start but with a missing end.
+    --
+    -- Some events may be self-overlapping
+    --
+    -- > Start <event>
+    -- > ..
+    -- > Start <event>
+    -- > ..
+    -- >    End <event>
+    -- > ..
+    -- >    End <event>
+    --
+    -- (this happens in particular for GC events because GC events are listed
+    -- separately for separate HECs). We therefore record for each open event
+    -- how many start events we have seen, and hence how many ends we need to
+    -- see before counting the event as finished.
+  , _openEvents :: !(Map EventId (Timestamp, Int))
+
+    -- | Total amount of time per event (non-strict)
+  , eventTotals :: Map EventId Timestamp
+
+    -- | Timestamp of the Startup event
+  , _startup :: !(Maybe Timestamp)
+
+    -- | Timestamp of the Shutdown event
+  , _shutdown :: !(Maybe Timestamp)
+  }
+  deriving Show
+
+$(makeLenses ''EventAnalysis)
+
+threadInfo :: ThreadId -> Lens' EventAnalysis (Maybe (Timestamp, Timestamp, String))
+threadInfo tid = _threadInfo . at tid
+
+numThreads :: EventAnalysis -> Int
+numThreads analysis = Map.size (analysis ^. _threadInfo)
+
+-- | Quantization splits the total time up into @n@ buckets. We record for each
+-- event and each bucket what percentage of that bucket the event used. A
+-- missing entry denotes 0.
+--
+-- Quantization is essential because each individual event period might be too
+-- small to show
+--
+-- For any given bucket the sum of all threads for that bucket cannot exceed the
+-- number of cores.
+data Quantized = Quantized {
+    -- | For each event and each bucket how much of that bucket the event used up
+    quantTimes      :: Map EventId (Map Int Double)
+    -- | Like threadInfo, but quantized (start and finish bucket)
+  , quantThreadInfo :: Map ThreadId (Int, Int, String)
+    -- | Size of each bucket
+  , quantBucketSize :: Timestamp
+  }
+  deriving Show
+
+-- | Show an event ID given the specified options (for renaming events)
+-- and information about threads (either `__threadInfo` from `EventAnalysis` or
+-- `quantThreadInfo` from `Quantized`).
+showEventId :: Map ThreadId (a, a, String) -> EventId -> String
+showEventId _     EventGC          = "GC"
+showEventId _    (EventUser event) = event
+showEventId info (EventThread tid) = case Map.lookup tid info of
+                                       Just (_, _, l) -> l
+                                       Nothing        -> show tid
+
+isUserEvent :: EventId -> Bool
+isUserEvent (EventUser _) = True
+isUserEvent _             = False
+
+isThreadEvent :: EventId -> Bool
+isThreadEvent (EventThread _) = True
+isThreadEvent _               = False
diff --git a/src/GHC/RTS/Events/Analyze/Utils.hs b/src/GHC/RTS/Events/Analyze/Utils.hs
new file mode 100644
--- /dev/null
+++ b/src/GHC/RTS/Events/Analyze/Utils.hs
@@ -0,0 +1,106 @@
+module GHC.RTS.Events.Analyze.Utils (
+    throwLeft
+  , throwLeftStr
+  , insertWith
+  , prefix
+  , explode
+  , mapEithers
+  , unsparse
+  , Alignment(..)
+  , renderTable
+  ) where
+
+import Control.Exception
+import Data.List (transpose)
+import Data.Either (partitionEithers)
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+throwLeft :: Exception e => IO (Either e a) -> IO a
+throwLeft act = act >>= \ea -> case ea of Left  e -> throwIO e
+                                          Right a -> return a
+
+throwLeftStr :: IO (Either String a) -> IO a
+throwLeftStr = throwLeft . fmap (either (Left . userError) Right)
+
+-- | Like `Map.insertWith`, but for associative lists
+--
+-- > updateAssocs f key val [.. (key, val') ..] == [.. (key, val' `f` val) ..]
+-- > updateAssocs f key val assocs == assocs ++ [(key, val)]
+insertWith :: Eq a => (b -> b -> b) -> a -> b -> [(a, b)] -> [(a, b)]
+insertWith f key val = go
+  where
+    go [] = [(key, val)]
+    go ((key', val') : assocs)
+      | key == key' = (key, val' `f` val) : assocs
+      | otherwise   = (key', val')        : go assocs
+
+-- | Like PHP's explode function
+--
+-- > explode ',' "abc,def,ghi" == ["abc","def","ghi"]
+explode :: Eq a => a -> [a] -> [[a]]
+explode needle = go
+  where
+    go xs = case break (== needle) xs of
+              (before, [])        -> [before]
+              (before, _ : after) -> before : go after
+
+-- | Check if a string has a given prefix
+--
+-- > prefix "abc" "abcdef" == Just "def"
+-- > prefix "abc" "defabc" == Nothing
+prefix :: String -> String -> Maybe String
+prefix []     ys                 = Just ys
+prefix _      []                 = Nothing
+prefix (x:xs) (y:ys) | x == y    = prefix xs ys
+                     | otherwise = Nothing
+
+mapEithers :: forall a b c d.
+              ([a] -> [c])
+           -> ([b] -> [d])
+           -> [Either a b]
+           -> [Either c d]
+mapEithers f g eithers = rebuild eithers (f lefts) (g rights)
+  where
+    (lefts, rights) = partitionEithers eithers
+
+    rebuild :: [Either a b] -> [c] -> [d] -> [Either c d]
+    rebuild []             []       []       = []
+    rebuild (Left  _ : es) (x : xs)      ys  = Left  x : rebuild es xs ys
+    rebuild (Right _ : es)      xs  (y : ys) = Right y : rebuild es xs ys
+    rebuild _ _ _ = error "mapEithers: lengths changed"
+
+-- | Turn a sparse representation of a list into a regular list, using
+-- a default value for the blanks
+unsparse :: forall a. a -> Map Int a -> [a]
+unsparse blank = go 0 . Map.toList
+  where
+    go :: Int -> [(Int, a)] -> [a]
+    go _ []            = []
+    go n ((m, a) : as) = replicate (m - n) blank ++ a : go (m + 1) as
+
+-- | Alignment options for `renderTable`
+data Alignment = AlignLeft | AlignRight
+
+-- | "Typeset" a table
+renderTable :: [Alignment] -> [[String]] -> [[String]]
+renderTable aligns rows = transpose paddedColumns
+  where
+    columns :: [[String]]
+    columns = transpose rows
+
+    columnWidths :: [Int]
+    columnWidths = map (maximum . map length) columns
+
+    paddedColumns :: [[String]]
+    paddedColumns = map padColumn (zip3 aligns columnWidths columns)
+
+    padColumn :: (Alignment, Int, [String]) -> [String]
+    padColumn (align, width, column) = map (padCell align width) column
+
+    padCell :: Alignment -> Int -> String -> String
+    padCell align width cell =
+      let padding = replicate (width - length cell) ' '
+      in case align of
+           AlignLeft  -> cell ++ padding
+           AlignRight -> padding ++ cell