added symbol de-mangling
This commit is contained in:
parent
36d581f08d
commit
504cce3ce3
1 changed files with 32 additions and 3 deletions
|
@ -198,9 +198,38 @@ expandSplice s lls = concat [before, new:splicerest, end]
|
||||||
|
|
||||||
{- Tweaks code output by GHC in splices to actually build. Yipes. -}
|
{- Tweaks code output by GHC in splices to actually build. Yipes. -}
|
||||||
mangleCode :: String -> String
|
mangleCode :: String -> String
|
||||||
mangleCode =
|
mangleCode = fix_bad_escape . remove_package_version
|
||||||
{- ghc mayb incorrectly escape "}" within a multi-line string. -}
|
where
|
||||||
replace " \\}" " }"
|
{- 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
|
main = do
|
||||||
r <- parseFromFile splicesExtractor "log"
|
r <- parseFromFile splicesExtractor "log"
|
||||||
|
|
Loading…
Add table
Reference in a new issue