Fix NotCPP for GHC 8
This commit is contained in:
parent
3ca408ec6a
commit
9b2f4dbb8b
@ -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
|
||||
|
@ -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 [])
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user