diff options
Diffstat (limited to 'Build/EvilSplicer.hs')
-rw-r--r-- | Build/EvilSplicer.hs | 94 |
1 files changed, 52 insertions, 42 deletions
diff --git a/Build/EvilSplicer.hs b/Build/EvilSplicer.hs index 08b54226c..a43a971fd 100644 --- a/Build/EvilSplicer.hs +++ b/Build/EvilSplicer.hs @@ -290,17 +290,61 @@ expandExpressionSplice s lls = concat [before, spliced:padding, end] {- Tweaks code output by GHC in splices to actually build. Yipes. -} mangleCode :: String -> String -mangleCode = declaration_parens +mangleCode = flip_colon + . lambdaparens + . declaration_parens . case_layout . case_layout_multiline - . remove_declaration_splices . yesod_url_render_hack - . yesod_static_route_render_hack . nested_instances . collapse_multiline_strings . remove_package_version . emptylambda where + {- Lambdas are often output without parens around them. + - This breaks when the lambda is immediately applied to a + - parameter. + - + - For example: + - + - renderRoute (StaticR sub_a1nUH) + - = \ (a_a1nUI, b_a1nUJ) + - -> (((pack "static") : a_a1nUI), + - b_a1nUJ) + - (renderRoute sub_a1nUH) + - + - There are sometimes many lines of lambda code that need to be + - parenthesised. Approach: find the "->" and scan down the + - column to the first non-whitespace. This is assumed + - to be the expression after the lambda. + - + - Runs recursively on the body of the lambda, to handle nested + - lambdas. + -} + lambdaparens = parsecAndReplace $ do + -- skip lambdas inside tuples or parens + prefix <- noneOf "(, \n" + preindent <- many1 $ oneOf " \n" + string "\\ " + lambdaparams <- restofline + indent <- many1 $ char ' ' + string "-> " + firstline <- restofline + lambdalines <- many $ try $ do + string indent + char ' ' + l <- restofline + return $ indent ++ " " ++ l + return $ concat + [ prefix:preindent + , "(\\ " ++ lambdaparams ++ "\n" + , indent ++ "-> " + , lambdaparens $ intercalate "\n" (firstline:lambdalines) + , ")\n" + ] + + restofline = manyTill (noneOf "\n") newline + {- For some reason, GHC sometimes doesn't like the multiline - strings it creates. It seems to get hung up on \{ at the - start of a new line sometimes, wanting it to not be escaped. @@ -357,7 +401,7 @@ mangleCode = declaration_parens case_layout_multiline = parsecAndReplace $ do newline indent <- many1 $ char ' ' - firstline <- manyTill (noneOf "\n") newline + firstline <- restofline string indent indent2 <- many1 $ char ' ' @@ -420,44 +464,10 @@ mangleCode = declaration_parens oken <- many $ satisfy isAlphaNum <|> oneOf "-.'" return $ t:oken -{- This works around a problem in the expanded template haskell for Yesod's - - static site route rendering. - - - - renderRoute (StaticR sub_a1nUH) - - = \ (a_a1nUI, b_a1nUJ) - - -> (((pack "static") : a_a1nUI), b_a1nUJ) - - (renderRoute sub_a1nUH) - - - - That is missing parens around the lambda expression (which - - is supposed to be applied to renderRoute). Add those parens. - -} -yesod_static_route_render_hack :: String -> String -yesod_static_route_render_hack = parsecAndReplace $ do - def <- string "renderRoute (StaticR sub_a1nUH)" - whitespace - string "= \\ (" - t1 <- token - string ", " - t2 <- token - string ")" - whitespace - f <- string "-> (((pack \"static\") : " - string t1 - string "), " - string t2 - string ")" - return $ concat - [ def - , " = (\\ (", t1, ",", t2, ") " - , f, t1, "), ", t2, "))" - ] - where - whitespace :: Parser String - whitespace = many $ oneOf " \t\r\n" - - token :: Parser String - token = many1 $ satisfy isAlphaNum <|> oneOf "_" - + {- This works when it's "GHC.Types.:", but we strip + - that above, so have to fix up after it here. + - The ; is added by case_layout. -} + flip_colon = replace "; : _ " "; _ : " {- This works around a problem in the expanded template haskell for Yesod - type-safe url rendering. |