Fix NotCPP for GHC 8

This commit is contained in:
Daniel Gröber 2016-01-20 23:39:17 +01:00
parent 3ca408ec6a
commit 9b2f4dbb8b
3 changed files with 52 additions and 6 deletions

View File

@ -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

View File

@ -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 [])

View File

@ -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