From fd4866b8c71e2502234f2fefa3f043603333be40 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Sun, 22 Feb 2015 19:24:47 -0400
Subject: add another lambdaparams hack, sigh

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

(limited to 'Build')

diff --git a/Build/EvilSplicer.hs b/Build/EvilSplicer.hs
index e917dcc7a..2b9084a52 100644
--- a/Build/EvilSplicer.hs
+++ b/Build/EvilSplicer.hs
@@ -304,7 +304,8 @@ mangleCode = flip_colon
 	. persist_dequalify_hack
 	. let_do
 	. remove_unnecessary_type_signatures
-	. lambdaparenhack
+	. lambdaparenhackyesod
+	. lambdaparenhackpersistent
 	. lambdaparens
 	. declaration_parens
 	. case_layout
@@ -385,7 +386,7 @@ mangleCode = flip_colon
 	 - FIXME: This is a hack. lambdaparens could just always add a
 	 - layer of parens even when a lambda seems to be in parent.
 	 -}
-	lambdaparenhack = parsecAndReplace $ do
+	lambdaparenhackyesod = parsecAndReplace $ do
 		indent1 <- many1 $ char ' '
 		staticr <- string "StaticR"
 		void newline
@@ -409,6 +410,44 @@ mangleCode = flip_colon
 			, indent1 ++ lambdaarrow ++ l2 ++ l3 ++ ")"
 			]
 
+	{- Hack to reorder misplaced paren in persistent code.
+	 -
+	 - = ((Right Fscked)
+         -    (\ persistValue_a36iM
+         -       -> case fromPersistValue persistValue_a36iM of {
+         -            Right r_a36iN -> Right r_a36iN
+         -            Left err_a36iO
+         -              -> (Left
+         -                  $ ((("field " `Data.Monoid.mappend` (packPTH "key"))
+         -                      `Data.Monoid.mappend` ": ")
+         -                     `Data.Monoid.mappend` err_a36iO)) }
+         -       x_a36iL))
+	 -
+	 - Fixed by adding another level of params around the lambda
+	 - (lambdaparams should be generalized to cover this case).
+	 -}
+	lambdaparenhackpersistent = parsecAndReplace $ do
+		indent1 <- many1 $ char ' '
+		start <- do
+			s1 <- string "(\\ "
+			s2 <- string "persistValue_"
+			s3 <- restofline
+			return $ s1 ++ s2 ++ s3
+		void $ string indent1
+		indent2 <- many1 $ char ' '
+		void $ string "-> "
+		l1 <- restofline
+		lambdalines <- many $ try $ do
+			void $ string $ indent1 ++ indent2 ++ " "
+			l <- restofline
+			return $ indent1 ++ indent2 ++ " " ++ l
+		return $ concat
+			[ indent1 ++ "(" ++ start ++ "\n"
+			, indent1 ++ indent2 ++ "-> " ++ l1 ++ "\n"
+			, intercalate "\n" lambdalines
+			, ")\n"
+			]
+
 	restofline = manyTill (noneOf "\n") newline
 
 	{- For some reason, GHC sometimes doesn't like the multiline
@@ -572,11 +611,13 @@ mangleCode = flip_colon
 	 - foo = do { let x = foo;
 	 -            use foo }
 	 -
-	 - Fix by converting the "let x" to "x <- return $"
+	 - Fix by converting the "let x = " to "x <- return $"
 	 -}
 	let_do = parsecAndReplace $ do
 		void $ string "= do { let "
 		x <- hstoken
+		ws <- many $ oneOf " \t\r\n"
+		void $ string "= "
 		return $ "= do { " ++ x ++ " <- return $ "
 
 {- Embedded files use unsafe packing, which is problimatic
-- 
cgit v1.2.3