Fix NotCPP for GHC 8
This commit is contained in:
parent
3ca408ec6a
commit
9b2f4dbb8b
@ -104,18 +104,33 @@ boundNames decl =
|
|||||||
|
|
||||||
TySynD n _ _ -> [(TcClsName, n)]
|
TySynD n _ _ -> [(TcClsName, n)]
|
||||||
ClassD _ n _ _ _ -> [(TcClsName, n)]
|
ClassD _ n _ _ _ -> [(TcClsName, n)]
|
||||||
FamilyD _ n _ _ -> [(TcClsName, n)]
|
|
||||||
|
|
||||||
|
#if __GLASGOW_HASKELL__ >= 800
|
||||||
|
DataD _ n _ _ ctors _ ->
|
||||||
|
#else
|
||||||
DataD _ n _ ctors _ ->
|
DataD _ n _ ctors _ ->
|
||||||
|
#endif
|
||||||
[(TcClsName, n)] ++ map ((,) TcClsName) (conNames `concatMap` ctors)
|
[(TcClsName, n)] ++ map ((,) TcClsName) (conNames `concatMap` ctors)
|
||||||
|
|
||||||
|
#if __GLASGOW_HASKELL__ >= 800
|
||||||
|
NewtypeD _ n _ _ ctor _ ->
|
||||||
|
#else
|
||||||
NewtypeD _ n _ ctor _ ->
|
NewtypeD _ n _ ctor _ ->
|
||||||
|
#endif
|
||||||
[(TcClsName, n)] ++ map ((,) TcClsName) (conNames ctor)
|
[(TcClsName, n)] ++ map ((,) TcClsName) (conNames ctor)
|
||||||
|
|
||||||
|
#if __GLASGOW_HASKELL__ >= 800
|
||||||
|
DataInstD _ _n _ _ ctors _ ->
|
||||||
|
#else
|
||||||
DataInstD _ _n _ ctors _ ->
|
DataInstD _ _n _ ctors _ ->
|
||||||
|
#endif
|
||||||
map ((,) TcClsName) (conNames `concatMap` ctors)
|
map ((,) TcClsName) (conNames `concatMap` ctors)
|
||||||
|
|
||||||
|
#if __GLASGOW_HASKELL__ >= 800
|
||||||
|
NewtypeInstD _ _n _ _ ctor _ ->
|
||||||
|
#else
|
||||||
NewtypeInstD _ _n _ ctor _ ->
|
NewtypeInstD _ _n _ ctor _ ->
|
||||||
|
#endif
|
||||||
map ((,) TcClsName) (conNames ctor)
|
map ((,) TcClsName) (conNames ctor)
|
||||||
|
|
||||||
InstanceD _ _ty _ ->
|
InstanceD _ _ty _ ->
|
||||||
@ -131,10 +146,19 @@ boundNames decl =
|
|||||||
#endif
|
#endif
|
||||||
|
|
||||||
#if __GLASGOW_HASKELL__ >= 708
|
#if __GLASGOW_HASKELL__ >= 708
|
||||||
ClosedTypeFamilyD n _ _ _ -> [(TcClsName, n)]
|
|
||||||
RoleAnnotD _n _ -> error "notcpp: RoleAnnotD not supported yet"
|
RoleAnnotD _n _ -> error "notcpp: RoleAnnotD not supported yet"
|
||||||
#endif
|
#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 -> [Name]
|
||||||
conNames con =
|
conNames con =
|
||||||
case con of
|
case con of
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE CPP, TemplateHaskell #-}
|
||||||
-- | This module uses scope lookup techniques to either export
|
-- | This module uses scope lookup techniques to either export
|
||||||
-- 'lookupValueName' from @Language.Haskell.TH@, or define
|
-- 'lookupValueName' from @Language.Haskell.TH@, or define
|
||||||
-- its own 'lookupValueName', which attempts to do the
|
-- its own 'lookupValueName', which attempts to do the
|
||||||
@ -25,8 +25,13 @@ bestValueGuess s = do
|
|||||||
case mi of
|
case mi of
|
||||||
Nothing -> no
|
Nothing -> no
|
||||||
Just i -> case i of
|
Just i -> case i of
|
||||||
|
#if __GLASGOW_HASKELL__ >= 800
|
||||||
|
VarI n _ _ -> yes n
|
||||||
|
DataConI n _ _ -> yes n
|
||||||
|
#else
|
||||||
VarI n _ _ _ -> yes n
|
VarI n _ _ _ -> yes n
|
||||||
DataConI n _ _ _ -> yes n
|
DataConI n _ _ _ -> yes n
|
||||||
|
#endif
|
||||||
_ -> err ["unexpected info:", show i]
|
_ -> err ["unexpected info:", show i]
|
||||||
where
|
where
|
||||||
no = return Nothing
|
no = return Nothing
|
||||||
@ -34,5 +39,9 @@ bestValueGuess s = do
|
|||||||
err = fail . showString "NotCPP.bestValueGuess: " . unwords
|
err = fail . showString "NotCPP.bestValueGuess: " . unwords
|
||||||
|
|
||||||
$(recover [d| lookupValueName = bestValueGuess |] $ do
|
$(recover [d| lookupValueName = bestValueGuess |] $ do
|
||||||
|
#if __GLASGOW_HASKELL__ >= 800
|
||||||
|
VarI _ _ _ <- reify (mkName "lookupValueName")
|
||||||
|
#else
|
||||||
VarI _ _ _ _ <- reify (mkName "lookupValueName")
|
VarI _ _ _ _ <- reify (mkName "lookupValueName")
|
||||||
|
#endif
|
||||||
return [])
|
return [])
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE CPP, TemplateHaskell #-}
|
||||||
module NotCPP.Utils where
|
module NotCPP.Utils where
|
||||||
|
|
||||||
import Control.Applicative ((<$>))
|
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
|
-- | Returns @'Just' ('VarE' n)@ if the info relates to a value called
|
||||||
-- @n@, or 'Nothing' if it relates to a different sort of thing.
|
-- @n@, or 'Nothing' if it relates to a different sort of thing.
|
||||||
infoToExp :: Info -> Maybe Exp
|
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
|
infoToExp _ = Nothing
|
||||||
|
Loading…
Reference in New Issue
Block a user