diff --git a/CHANGES.txt b/CHANGES.txt
new file mode 100644
--- /dev/null
+++ b/CHANGES.txt
@@ -0,0 +1,4 @@
+Changelog for Profiterole
+
+0.1
+    Initial version
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Neil Mitchell 2017.
+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 Neil Mitchell 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/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,25 @@
+# Profiterole [![Hackage version](https://img.shields.io/hackage/v/profiterole.svg?label=Hackage)](https://hackage.haskell.org/package/profiterole) [![Stackage version](https://www.stackage.org/package/profiterole/badge/lts?label=Stackage)](https://www.stackage.org/package/profiterole) [![Linux Build Status](https://img.shields.io/travis/ndmitchell/profiterole.svg?label=Linux%20build)](https://travis-ci.org/ndmitchell/profiterole) [![Windows Build Status](https://img.shields.io/appveyor/ci/ndmitchell/profiterole.svg?label=Windows%20build)](https://ci.appveyor.com/project/ndmitchell/profiterole)
+
+Script for reading and restructring a GHC profile script.
+
+## The Goal
+
+Given profile data, different ways of looking at it reveal different insights. This tool provides one of those insights - in addition to reading the standard profile output and using other tools such as [Profiteur](https://hackage.haskell.org/package/profiteur).
+
+Profiterole aims to make the profile shorter by combining common subtrees and lifting them to the root - e.g. if you call `parseFile` from 7 places in the code, instead of having 7 pieces of `parseFile` profiling, Profiterole will give you one.
+
+As an example compare [HLint profile input](https://gist.github.com/ndmitchell/308cd9a2774873c9a74ee613ae203b65#file-hlint-prof) to [HLint Profiterole output](https://gist.github.com/ndmitchell/ab790bbfa482a70fa2db020fda623309#file-hlint-profiterole-txt).
+
+## Usage
+
+To run, first install (`cabal update && cabal install profiterole`), generate a GHC profile the [normal way](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/profiling.html), then run:
+
+    profiterole myprogram.prof
+
+Profiterole will generate `myprogram.profiterole.txt` and `myprogram.profiterole.html` - both contain the same information, but the HTML has hyperlinks. There are three columns of numbers:
+
+* `TOT` is the total time spent in any item under this code, what GHC calls inherited time.
+* `INH` is the total time spent in the items that Profiterole did not move out to the top level.
+* `IND` is the individual time, just like GHC profiles.
+
+For large programs, using `+RTS -P` (instead of the common `-p`) will give more accurate results.
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/profiterole.cabal b/profiterole.cabal
new file mode 100644
--- /dev/null
+++ b/profiterole.cabal
@@ -0,0 +1,44 @@
+cabal-version:      >= 1.18
+build-type:         Simple
+name:               profiterole
+version:            0.1
+license:            BSD3
+license-file:       LICENSE
+category:           Development
+author:             Neil Mitchell <ndmitchell@gmail.com>
+maintainer:         Neil Mitchell <ndmitchell@gmail.com>
+copyright:          Neil Mitchell 2017
+synopsis:           Restructure GHC profile reports
+description:
+    Given a GHC profile output, this tool generates alternative views on the data,
+    which are typically more concise and may reveal new insights.
+homepage:           https://github.com/ndmitchell/profiterole#readme
+bug-reports:        https://github.com/ndmitchell/profiterole/issues
+extra-doc-files:
+    README.md
+    CHANGES.txt
+tested-with:        GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3
+
+source-repository head
+    type:     git
+    location: https://github.com/ndmitchell/profiterole.git
+
+executable profiterole
+    default-language:   Haskell2010
+    main-is:            Main.hs
+    hs-source-dirs:     src
+    build-depends:
+        base >= 4.6 && < 5,
+        containers,
+        directory,
+        extra,
+        filepath,
+        ghc-prof,
+        hashable,
+        scientific,
+        text
+    other-modules:
+        Config
+        Report
+        Type
+        Util
diff --git a/src/Config.hs b/src/Config.hs
new file mode 100644
--- /dev/null
+++ b/src/Config.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE ViewPatterns #-}
+
+module Config(emptyConfig, readConfig, Config(..)) where
+
+import Data.List.Extra
+import qualified Data.Map as Map
+import System.IO.Extra
+import Data.Functor
+import Prelude
+
+
+data Config = Root | Bury deriving Eq
+
+readConfig :: FilePath -> IO (String -> Maybe Config)
+readConfig file = do
+    let f (stripPrefix "root: " -> Just x) = (x, Root)
+        f (stripPrefix "bury: " -> Just x) = (x, Bury)
+        f x = error $ "Bad config, got " ++ show x
+    mp <- Map.fromList . map f .  lines <$> readFile' file
+    return $ flip Map.lookup mp
+
+emptyConfig :: String -> Maybe Config
+emptyConfig _ = Nothing
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,80 @@
+{-# LANGUAGE RecordWildCards, ViewPatterns #-}
+
+module Main(main) where
+
+import GHC.Prof
+import Control.Monad
+import Data.List.Extra
+import Data.Char
+import Data.Monoid
+import Data.Tree
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+import qualified Data.Text.Lazy.IO as T
+import System.Environment
+import System.FilePath
+import System.Directory
+import Type
+import Config
+import Report
+import Data.Functor
+import Prelude
+
+
+main :: IO ()
+main = do
+    [arg] <- getArgs
+    Right vals <- fmap (removeZero . valFromProfile) . decode <$> T.readFile arg
+    b <- doesFileExist ".profiterole.yaml"
+    config <- if b then readConfig ".profiterole.yaml" else return emptyConfig
+    let roots = findRoots config vals
+    let vals2 =  mergeRoots $ liftRoots roots vals
+    let arg0 = if takeExtension arg == ".prof" then dropExtension arg else arg
+    let writeTo file x = do
+            putStrLn $ "Writing to " ++ file ++ " ..."
+            writeFile file x
+    writeTo (arg0 <.> "profiterole.txt") $ unlines $ reportText vals2
+    writeTo (arg0 <.> "profiterole.html") $ unlines $ reportHTML vals2
+    putStrLn "Done"
+    when False $ do
+        -- Should check the time is not lost, if it is, suggest -P
+        print $ sum $ map timeInd $ concatMap flatten vals2
+        print $ sum $ map (timeInh . rootLabel) vals2
+
+
+---------------------------------------------------------------------
+-- TRANSFORMATIONS
+
+removeZero :: Tree Val -> Tree Val
+removeZero (Node x xs) = Node x $ map removeZero $ filter (not . isZero . rootLabel) xs
+    where isZero Val{..} = timeTot == 0
+
+
+-- | A root has at least two distinct parents and isn't a local binding
+findRoots :: (String -> Maybe Config) -> Tree Val -> Set.Set String
+findRoots config x = Map.keysSet $
+    Map.filterWithKey (\k v -> case config k of
+        Just Root -> True
+        Just Bury -> False
+        Nothing -> not (isLocal k) && Set.size v > 1) $
+    Map.fromListWith (<>) $ f x
+    where
+        f (Node v xs) = [(name $ rootLabel x, Set.singleton $ name v) | x <- xs] ++
+                        concatMap f xs
+        isLocal (word1 -> (_, x)) =  any isAlpha x && '.' `elem` x
+
+liftRoots :: Set.Set String -> Tree Val -> [Tree Val]
+liftRoots = fs
+    where
+        fs set x = let (y,_,ys) = f set x in y:ys
+
+        -- return (this tree, discount to apply up, new roots)
+        f :: Set.Set String -> Tree Val -> (Tree Val, Double, [Tree Val])
+        f set (Node x ys)
+            | name x `Set.member` set = (Node x{timeInh=0,timeInd=0} [], timeInh x, fs (Set.delete (name x) set) $ Node x ys)
+            | otherwise = (Node x{timeInh = timeInh x - disc} child, disc, root)
+                where (child, sum -> disc, concat -> root) = unzip3 $ map (f set) ys
+
+mergeRoots :: [Tree Val] -> [Tree Val]
+mergeRoots xs = Map.elems $ Map.fromListWith f [(name $ rootLabel x, x) | x <- xs]
+    where f (Node x xs) (Node y ys) = Node (mergeVal x y) $ mergeRoots $ xs ++ ys
diff --git a/src/Report.hs b/src/Report.hs
new file mode 100644
--- /dev/null
+++ b/src/Report.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Report(
+    reportText,
+    reportHTML
+    ) where
+
+import Data.List.Extra
+import Data.Tree
+import Data.Char
+import Data.Hashable
+import qualified Data.Set as Set
+import Numeric.Extra
+import Util
+import Type
+
+
+presort :: [Tree Val] -> [Tree Val]
+presort =
+    sortOn (negate . timeInh . rootLabel) .
+    fmapForest (sortOn (negate . timeTot . rootLabel))
+
+
+reportHTML :: [Tree Val] -> [String]
+reportHTML vals =
+    let vals2 = presort vals
+        indent i x = x{name = replicate (i*2) ' ' ++ name x}
+        links = Set.fromList $ map (name . rootLabel) vals2
+        anchor x = "<a id='" ++ show (hash x) ++ "'></a>"
+    in (["<pre>"] ++) $ (++ ["</pre>"]) $ intercalate [""] $
+        (" TOT   INH   IND" : map (showHTML links . rootLabel) (take 25 vals2)) :
+        [ anchor (name $ rootLabel x) :
+          map (showHTML $ Set.delete (name $ rootLabel x) links) (flatten $ fmapTreeDepth indent x)
+        | x <- vals2]
+
+showHTML :: Set.Set String -> Val -> String
+showHTML xs Val{..} = intercalate "  "
+    [showDouble timeTot, showDouble timeInh, showDouble timeInd
+    ,spc ++ (if nam `Set.member` xs then link else nam) ++ " (" ++ show entries ++ ")"]
+    where
+        link = "<a href='#" ++ show (hash nam) ++ "'>" ++ nam ++ "</a>"
+        (spc,nam) = span isSpace name
+
+
+reportText :: [Tree Val] -> [String]
+reportText vals =
+    let vals2 = presort vals
+        indent i x = x{name = replicate (i*2) ' ' ++ name x}
+    in intercalate ["",""] $
+        (" TOT   INH   IND" : map (showText . rootLabel) (take 25 vals2)) :
+        [map showText $ flatten $ fmapTreeDepth indent x | x <- vals2]
+
+showText :: Val -> String
+showText Val{..} = intercalate "  "
+    [showDouble timeTot, showDouble timeInh, showDouble timeInd, name ++ " (" ++ show entries ++ ")"]
+
+showDouble :: Double -> String
+showDouble x = case showDP 1 x of
+    "0.0" -> "   -"
+    "100.0" -> "99.9" -- avoid making the column bigger for a corner case
+    ['0','.',x] -> [' ',' ','.',x]
+    x -> replicate (4 - length x) ' ' ++ x
diff --git a/src/Type.hs b/src/Type.hs
new file mode 100644
--- /dev/null
+++ b/src/Type.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Type(
+    Val(..),
+    mergeVal,
+    valFromProfile
+    ) where
+
+import GHC.Prof
+import Data.Maybe
+import Data.Scientific
+import Data.Tree
+import qualified Data.Text as T
+
+
+data Val = Val
+    {name :: String -- Name of this node
+    ,timeTot :: Double -- Time spent under this node
+    ,timeInh :: Double -- Time spent under this node excluding rerooted
+    ,timeInd :: Double -- Time spent in this code
+    ,entries :: Integer -- Number of times this node was called
+    } deriving Show
+
+
+mergeVal :: Val -> Val -> Val
+mergeVal x y
+    | name x /= name y = error "mergeRoots, invariant violated"
+    | otherwise = Val
+        {name = name x
+        ,timeTot = timeTot x + timeTot y
+        ,timeInh = timeInh x + timeInh y
+        ,timeInd = timeInd x + timeInd y
+        ,entries = entries x + entries y}
+
+
+valFromProfile :: Profile -> Tree Val
+valFromProfile prf = case costCentres prf of
+    Nothing -> error "Failed to generate value tree from profile (no idea why - corrupt profile?)"
+    Just x
+        | isNothing $ costCentreTicks $ rootLabel x -> fmap toValTime x
+        | otherwise -> fixTotInh $ fmap (toValTick $ (* 0.01) $ fromInteger $ totalTimeTicks $ profileTotalTime prf) x
+
+toValTime :: CostCentre -> Val
+toValTime CostCentre{..} = Val
+    (T.unpack costCentreModule ++ " " ++ T.unpack costCentreName)
+    inh inh (toRealFloat costCentreIndTime)
+    costCentreEntries
+    where inh = toRealFloat costCentreInhTime
+
+toValTick :: Double -> CostCentre -> Val
+toValTick tot cc = (toValTime cc){timeInd = fromInteger (fromJust $ costCentreTicks cc) / tot}
+
+fixTotInh :: Tree Val -> Tree Val
+fixTotInh (Node x xs) = Node x{timeTot=t, timeInh=t} ys
+    where
+        ys = map fixTotInh xs
+        t = timeInd x + sum (map (timeInh . rootLabel) ys)
diff --git a/src/Util.hs b/src/Util.hs
new file mode 100644
--- /dev/null
+++ b/src/Util.hs
@@ -0,0 +1,15 @@
+
+module Util(fmapForest, fmapTreeDepth) where
+
+import Data.Tree
+
+
+-- | 'fmap' over a 'Tree', but passing the depth as well
+fmapTreeDepth :: (Int -> a -> b) -> Tree a -> Tree b
+fmapTreeDepth op = f 0
+    where f i (Node x xs) = Node (op i x) $ map (f $! i+1) xs
+
+-- | 'fmap' over a forest, bottom-up
+fmapForest :: ([Tree a] -> [Tree a]) -> [Tree a] -> [Tree a]
+fmapForest op = f
+    where f xs = op [Node y $ f ys | Node y ys <- xs]