From e9aacb27ffcd1bdf350d59a56178688284cd4f8f Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <hexagoxel@hexagoxel.de>
Date: Wed, 25 Apr 2018 19:54:35 +0200
Subject: [PATCH] Implement hacky workaround for issue 89

---
 src-literatetests/15-regressions.blt      |  5 +++++
 src/Language/Haskell/Brittany/Internal.hs | 14 ++++++++++++++
 2 files changed, 19 insertions(+)

diff --git a/src-literatetests/15-regressions.blt b/src-literatetests/15-regressions.blt
index 3ba6bbf..88f6e6f 100644
--- a/src-literatetests/15-regressions.blt
+++ b/src-literatetests/15-regressions.blt
@@ -606,3 +606,8 @@ go l ((IRType, _a) : eqr) = go l eqr
 go l ((_, IRType) : eqr) = go l eqr
 go _ ((IRTypeError ps t1 t2, _) : _) = Left $ makeError ps t1 t2
 go _ ((_, IRTypeError ps t1 t2) : _) = Left $ makeError ps t1 t2
+
+#test issue 89 - type-family-instance
+
+type instance (XPure StageParse) = ()
+type Pair a = (a, a)
diff --git a/src/Language/Haskell/Brittany/Internal.hs b/src/Language/Haskell/Brittany/Internal.hs
index 9bc144f..b4c59b9 100644
--- a/src/Language/Haskell/Brittany/Internal.hs
+++ b/src/Language/Haskell/Brittany/Internal.hs
@@ -514,6 +514,20 @@ ppDecl d@(L loc decl) = case decl of
         Left  ns -> docLines $ return <$> ns
         Right n  -> return n
     layoutBriDoc briDoc
+  InstD (TyFamInstD{}) -> do
+    -- this is a (temporary (..)) workaround for "type instance" decls
+    -- that do not round-trip through exactprint properly.
+    let fixer s = case List.stripPrefix "type " s of
+          Just rest | not ("instance" `isPrefixOf` rest) ->
+            "type instance " ++ rest
+          _ -> s
+    str <- mAsk <&> \anns ->
+      intercalate "\n" $ fmap fixer $ lines' $ ExactPrint.exactPrint d anns
+    bd <- briDocMToPPM $ allocateNode $ BDFExternal (ExactPrint.mkAnnKey d)
+                                                    (foldedAnnKeys d)
+                                                    False
+                                                    (Text.pack str)
+    layoutBriDoc bd
   _ -> briDocMToPPM (briDocByExactNoComment d) >>= layoutBriDoc
 
 -- Prints the information associated with the module annotation