diff --git a/Build/EvilSplicer.hs b/Build/EvilSplicer.hs
new file mode 100644
index 0000000000..1743a8ed19
--- /dev/null
+++ b/Build/EvilSplicer.hs
@@ -0,0 +1,212 @@
+{- Expands template haskell splices
+ -
+ - First, the code must be built with a ghc that supports TH,
+ - and the splices dumped to a log. For example:
+ - cabal build --ghc-options=-ddump-splices 2>&1 | tee log
+ -
+ - Along with the log, a "headers" file may also be provided, containing
+ - additional imports needed by the template haskell code.
+ -
+ - This program will parse the log, and expand all splices therein,
+ - modifying files in the source tree. They can then be built a second
+ - time, with a ghc that does not support TH.
+ -
+ - Note that template haskell code may refer to symbols that are not
+ - exported by the library that defines the TH code. In this case,
+ - the library has to be modifed to export those symbols.
+ -
+ - There can also be other problems with the generated code; it may
+ - need modifications to compile.
+ -
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+import Text.Parsec
+import Text.Parsec.String
+import Control.Applicative ((<$>))
+import Data.Either
+import Data.List
+import Data.String.Utils
+import Data.Char
+
+import Utility.Monad
+import Utility.Misc
+import Utility.Exception
+
+data Coord = Coord
+ { coordLine :: Int
+ , coordColumn :: Int
+ }
+ deriving (Read, Show)
+
+offsetCoord :: Coord -> Coord -> Coord
+offsetCoord a b = Coord
+ (coordLine a - coordLine b)
+ (coordColumn a - coordColumn b)
+
+data Splice = Splice
+ { splicedFile :: FilePath
+ , spliceStart :: Coord
+ , spliceEnd :: Coord
+ , splicedExpression :: String
+ , splicedResult :: String
+ }
+ deriving (Read, Show)
+
+number :: Parser Int
+number = read <$> many1 digit
+
+{- A pair of Coords is written in one of two ways:
+ - "95:21-73" or "(92,25)-(94,2)"
+ -}
+coordsParser :: Parser (Coord, Coord)
+coordsParser = (singleline <|> multiline) <?> "Coords"
+ where
+ singleline = do
+ line <- number
+ char ':'
+ startcol <- number
+ char '-'
+ endcol <- number
+ return $ (Coord line startcol, Coord line endcol)
+
+ multiline = do
+ start <- fromparens
+ char '-'
+ end <- fromparens
+ return $ (start, end)
+
+ fromparens = between (char '(') (char ')') $ do
+ line <- number
+ char ','
+ col <- number
+ return $ Coord line col
+
+indent :: Parser String
+indent = many1 $ char ' '
+
+restOfLine :: Parser String
+restOfLine = newline `after` many (noneOf "\n")
+
+indentedLine :: Parser String
+indentedLine = indent >> restOfLine
+
+spliceParser :: Parser Splice
+spliceParser = do
+ file <- many1 (noneOf ":\n")
+ char ':'
+ (start, end) <- coordsParser
+ string ": Splicing expression"
+ newline
+
+ expression <- indentedLine
+
+ indent
+ string "======>"
+ newline
+
+ {- All lines of the splice result will start with the same
+ - indent, which is stripped. Any other indentation is preserved. -}
+ i <- lookAhead indent
+ result <- unlines <$> many1 (string i >> restOfLine)
+
+ return $ Splice file start end expression result
+
+{- Extracts the splices, ignoring the rest of the compiler output. -}
+splicesExtractor :: Parser [Splice]
+splicesExtractor = rights <$> many extract
+ where
+ extract = try (Right <$> spliceParser) <|> (Left <$> compilerJunkLine)
+ compilerJunkLine = restOfLine
+
+{- Modifies the source file, expanding the splices, which all must
+ - have the same splicedFile.
+ -
+ - Each splice's Coords refer to the original position in the file,
+ - and not to its position after any previous splices may have inserted
+ - or removed lines.
+ -
+ - To deal with this complication, the file is broken into logical lines
+ - (which can contain any String, including a multiline or empty string).
+ - Each splice is assumed to be on its own block of lines; two
+ - splices on the same line is not currently supported.
+ - This means that a splice can modify the logical lines within its block
+ - as it likes, without interfering with the Coords of other splices.
+ -
+ - As well as expanding splices, this can add a block of imports to the
+ - file. These are put right before the first line in the file that
+ - starts with "import "
+ -}
+applySplices :: Maybe String -> [Splice] -> IO ()
+applySplices imports l@(first:_) = do
+ let f = splicedFile first
+ lls <- map (++ "\n") . lines <$> readFileStrict f
+ writeFile f $ concat $ addimports $ expand lls l
+ where
+ expand lls [] = lls
+ expand lls (s:rest) = expand (expandSplice s lls) rest
+
+ addimports lls = case imports of
+ Nothing -> lls
+ Just v ->
+ let (start, end) = break ("import " `isPrefixOf`) lls
+ in if null end
+ then start
+ else concat
+ [ start
+ , [v]
+ , end
+ ]
+
+expandSplice :: Splice -> [String] -> [String]
+expandSplice s lls = concat [before, new:splicerest, end]
+ where
+ cs = spliceStart s
+ ce = spliceEnd s
+
+ (before, rest) = splitAt (coordLine cs - 1) lls
+ (oldlines, end) = splitAt (1 + coordLine (offsetCoord ce cs)) rest
+ (splicestart, splicerest) = case oldlines of
+ l:r -> (expandtabs l, take (length r) (repeat []))
+ _ -> ([], [])
+ new = concat
+ [ let s = deqqstart $ take (coordColumn cs - 1) splicestart
+ in if all isSpace s
+ then ""
+ else s
+ , addindent (findindent splicestart) (mangleCode $ splicedResult s)
+ , deqqend $ drop (coordColumn ce) splicestart
+ ]
+
+ {- coordinates assume tabs are expanded to 8 spaces -}
+ expandtabs = replace "\t" (take 8 $ repeat ' ')
+
+ {- splicing leaves $() quasiquote behind; remove it -}
+ deqqstart s = case reverse s of
+ ('(':'$':rest) -> reverse rest
+ _ -> s
+ deqqend (')':s) = s
+ deqqend s = s
+
+ findindent = length . takeWhile isSpace
+ addindent n = unlines . map (i ++) . lines
+ where
+ i = take n $ repeat ' '
+
+{- Tweaks code output by GHC in splices to actually build. Yipes. -}
+mangleCode :: String -> String
+mangleCode =
+ {- ghc mayb incorrectly escape "}" within a multi-line string. -}
+ replace " \\}" " }"
+
+main = do
+ r <- parseFromFile splicesExtractor "log"
+ case r of
+ Left e -> error $ show e
+ Right splices -> do
+ let groups = groupBy (\a b -> splicedFile a == splicedFile b) splices
+ imports <- catchMaybeIO $ readFile "imports"
+ mapM_ (applySplices imports) groups