deal with GHC's broken layout of case expressions. ARGH why GHC WHY?!?!

1 files changed, 54 insertions, 0 deletions

diff --git a/Build/EvilSplicer.hs b/Build/EvilSplicer.hs
index d99283030..a1622dd59 100644
--- a/Build/EvilSplicer.hs
+++ b/Build/EvilSplicer.hs
@@ -289,6 +289,8 @@ 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
+	. case_layout
+	. case_layout_multiline
 	. remove_declaration_splices
 	. yesod_url_render_hack
 	. yesod_static_route_render_hack
@@ -308,6 +310,58 @@ mangleCode = declaration_parens
 		string "\\"
 		return ""
 
+	{- GHC outputs splices using explicit braces rather than layout.
+	 - For a case expression, it does something weird:
+	 -
+	 - case foo of {
+	 -   xxx -> blah
+	 -   yyy -> blah };
+	 -
+	 - This is not legal Haskell; the statements in the case must be
+	 - separated by ';'
+	 -
+	 - To fix, we could just put a semicolon at the start of every line
+	 - containing " -> " ... Except that lambdas also contain that.
+	 - But we can get around that: GHC outputs lambas like this:
+	 -
+	 - \ foo
+	 -   -> bar
+	 -
+	 - Or like this:
+	 -
+	 - \ foo -> bar
+	 -
+	 - So, we can put the semicolon at the start of every line
+	 - containing " -> " unless there's a "\ " first, or it's
+	 - all whitespace up until it.
+	 -}
+	case_layout = parsecAndReplace $ do
+		newline
+		indent <- many1 $ char ' '
+		prefix <- manyTill (noneOf "\n") (try (string "-> "))
+		if "\\ " `isInfixOf` prefix
+			then unexpected "lambda expression"
+			else if null prefix
+				then unexpected "second line of lambda"
+				else return $ "\n" ++ indent ++ "; " ++ prefix ++ " -> "
+	{- Sometimes cases themselves span multiple lines:
+	 -
+	 - Nothing
+	 -   -> foo
+	 -}
+	case_layout_multiline = parsecAndReplace $ do
+		newline
+		indent <- many1 $ char ' '
+		firstline <- manyTill (noneOf "\n") newline
+
+		string indent
+		indent2 <- many1 $ char ' '
+		string "-> "
+		if "\\ " `isInfixOf` firstline
+			then unexpected "lambda expression"
+			else return $ "\n" ++ indent ++ "; " ++ firstline ++ "\n"
+				++ indent ++ indent2 ++ "-> "
+
 	{- GHC may output this:
 	 -
 	 - instance RenderRoute WebApp where