From 9b2f4dbb8bb4501e18b6f939d2738fb377c5582b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= <dxld@darkboxed.org>
Date: Wed, 20 Jan 2016 23:39:17 +0100
Subject: [PATCH] Fix NotCPP for GHC 8

---
 NotCPP/Declarations.hs    | 28 ++++++++++++++++++++++++++--
 NotCPP/LookupValueName.hs | 11 ++++++++++-
 NotCPP/Utils.hs           | 19 ++++++++++++++++---
 3 files changed, 52 insertions(+), 6 deletions(-)

diff --git a/NotCPP/Declarations.hs b/NotCPP/Declarations.hs
index 1657a68..b57feae 100644
--- a/NotCPP/Declarations.hs
+++ b/NotCPP/Declarations.hs
@@ -104,18 +104,33 @@ boundNames decl =
 
       TySynD n _ _ -> [(TcClsName, n)]
       ClassD _ n _ _ _ -> [(TcClsName, n)]
-      FamilyD _ n _ _ -> [(TcClsName, n)]
 
+#if __GLASGOW_HASKELL__ >= 800
+      DataD _ n _ _ ctors _ ->
+#else
       DataD _ n _ ctors _ ->
+#endif
           [(TcClsName, n)] ++ map ((,) TcClsName) (conNames `concatMap` ctors)
 
+#if __GLASGOW_HASKELL__ >= 800
+      NewtypeD _ n _ _ ctor _ ->
+#else
       NewtypeD _ n _ ctor _ ->
+#endif
           [(TcClsName, n)] ++ map ((,) TcClsName) (conNames ctor)
 
+#if __GLASGOW_HASKELL__ >= 800
+      DataInstD _ _n _ _ ctors _ ->
+#else
       DataInstD _ _n _ ctors _ ->
+#endif
           map ((,) TcClsName) (conNames `concatMap` ctors)
 
+#if __GLASGOW_HASKELL__ >= 800
+      NewtypeInstD _ _n _ _ ctor _ ->
+#else
       NewtypeInstD _ _n _ ctor _ ->
+#endif
           map ((,) TcClsName) (conNames ctor)
 
       InstanceD _ _ty _ ->
@@ -131,10 +146,19 @@ boundNames decl =
 #endif
 
 #if __GLASGOW_HASKELL__ >= 708
-      ClosedTypeFamilyD n _ _ _ -> [(TcClsName, n)]
       RoleAnnotD _n _ -> error "notcpp: RoleAnnotD not supported yet"
 #endif
 
+#if __GLASGOW_HASKELL__ >= 704 && __GLASGOW_HASKELL__ < 800
+      FamilyD _ n _ _ -> [(TcClsName, n)]
+#elif __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 800
+      ClosedTypeFamilyD n _ _ _ -> [(TcClsName, n)]
+#else
+      OpenTypeFamilyD (TypeFamilyHead n _ _ _) -> [(TcClsName, n)]
+      ClosedTypeFamilyD (TypeFamilyHead n _ _ _) _ -> [(TcClsName, n)]
+
+#endif
+
 conNames :: Con -> [Name]
 conNames con =
     case con of
diff --git a/NotCPP/LookupValueName.hs b/NotCPP/LookupValueName.hs
index 72462c2..9132e99 100644
--- a/NotCPP/LookupValueName.hs
+++ b/NotCPP/LookupValueName.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE CPP, TemplateHaskell #-}
 -- | This module uses scope lookup techniques to either export
 -- 'lookupValueName' from @Language.Haskell.TH@, or define
 -- its own 'lookupValueName', which attempts to do the
@@ -25,8 +25,13 @@ bestValueGuess s = do
   case mi of
     Nothing -> no
     Just i -> case i of
+#if __GLASGOW_HASKELL__ >= 800
+      VarI n _ _ -> yes n
+      DataConI n _ _ -> yes n
+#else
       VarI n _ _ _ -> yes n
       DataConI n _ _ _ -> yes n
+#endif
       _ -> err ["unexpected info:", show i]
  where
   no = return Nothing
@@ -34,5 +39,9 @@ bestValueGuess s = do
   err = fail . showString "NotCPP.bestValueGuess: " . unwords
 
 $(recover [d| lookupValueName = bestValueGuess |] $ do
+#if __GLASGOW_HASKELL__ >= 800
+  VarI _ _ _ <- reify (mkName "lookupValueName")
+#else
   VarI _ _ _ _ <- reify (mkName "lookupValueName")
+#endif
   return [])
diff --git a/NotCPP/Utils.hs b/NotCPP/Utils.hs
index 9da7958..8557c4a 100644
--- a/NotCPP/Utils.hs
+++ b/NotCPP/Utils.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE CPP, TemplateHaskell #-}
 module NotCPP.Utils where
 
 import Control.Applicative ((<$>))
@@ -24,6 +24,19 @@ recoverMaybe q = recover (return Nothing) (Just <$> q)
 -- | Returns @'Just' ('VarE' n)@ if the info relates to a value called
 -- @n@, or 'Nothing' if it relates to a different sort of thing.
 infoToExp :: Info -> Maybe Exp
-infoToExp (VarI n _ _ _) = Just (VarE n)
-infoToExp (DataConI n _ _ _) = Just (ConE n)
+
+#if __GLASGOW_HASKELL__ >= 800
+infoToExp (VarI n _ _) =
+#else
+infoToExp (VarI n _ _ _) =
+#endif
+    Just (VarE n)
+
+#if __GLASGOW_HASKELL__ >= 800
+infoToExp (DataConI n _ _) =
+#else
+infoToExp (DataConI n _ _ _) =
+#endif
+    Just (ConE n)
+
 infoToExp _ = Nothing