From 504cce3ce3f425442c1736d00325b21a025213fa Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 13 Apr 2013 17:15:05 -0400
Subject: [PATCH] added symbol de-mangling

---
 Build/EvilSplicer.hs | 35 ++++++++++++++++++++++++++++++++---
 1 file changed, 32 insertions(+), 3 deletions(-)

diff --git a/Build/EvilSplicer.hs b/Build/EvilSplicer.hs
index 1743a8ed19..ad3fb3b927 100644
--- a/Build/EvilSplicer.hs
+++ b/Build/EvilSplicer.hs
@@ -198,9 +198,38 @@ expandSplice s lls = concat [before, new:splicerest, end]
 
 {- 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 " \\}" " }"
+mangleCode = fix_bad_escape . remove_package_version
+  where
+	{- GHC may incorrectly escape "}" within a multi-line string. -}
+	fix_bad_escape = replace " \\}" " }"
+
+	{- GHC may add full package and version qualifications for
+	 - symbols from unimported modules. We don't want these.
+	 -
+	 - Examples:
+	 -   "blaze-html-0.4.3.1:Text.Blaze.Internal.preEscapedText" 
+	 -   "ghc-prim:GHC.Types.:"
+	 -}
+	remove_package_version s = case parse findQualifiedSymbols "" s of
+		Left e -> s
+		Right symbols -> concat $ 
+			map (either (\c -> [c]) mangleSymbol) symbols
+
+	findQualifiedSymbols :: Parser [Either Char String]
+	findQualifiedSymbols = many $
+		try (Right <$> qualifiedSymbol) <|> (Left <$> anyChar)
+
+	qualifiedSymbol :: Parser String
+	qualifiedSymbol = do
+		token
+		char ':'
+		token
+
+	token :: Parser String
+	token = many1 $ satisfy isAlphaNum <|> oneOf "-.'"
+
+	mangleSymbol "GHC.Types." = ""
+	mangleSymbol s = s
 
 main = do
 	r <- parseFromFile splicesExtractor "log"