packages feed

buildwrapper 0.8.0 → 0.8.1

raw patch · 3 files changed

+52/−9 lines, 3 files

Files

buildwrapper.cabal view
@@ -1,5 +1,5 @@ name:           buildwrapper-version:        0.8.0+version:        0.8.1 cabal-version:  >= 1.8 build-type:     Simple license:        BSD3
src/Language/Haskell/BuildWrapper/GHC.hs view
@@ -51,6 +51,10 @@ import Bag import Linker import RtClosureInspect+#if __GLASGOW_HASKELL__ >= 707+import ConLike+import PatSyn (patSynType)+#endif  import GhcMonad import Id@@ -490,7 +494,11 @@                                                       mty<-lookupName n                                                       case mty of                                                               Just (AnId aid)->do+#if __GLASGOW_HASKELL__ >= 707+                                                                      let pprTyp    = (pprTypeForUser . idType) aid+#else                                                                                                                                     let pprTyp    = (pprTypeForUser True . idType) aid+#endif                                                                       t<-gtry $ GHC.obtainTermFromId maxBound True aid                                                                       evalDoc<-case t of                                                                           Right term -> showTerm term@@ -555,9 +563,15 @@ -- | convert a Name int a NameDef                     name2nd :: GhcMonad m=> DynFlags -> Name -> m NameDef name2nd df n=do+#if __GLASGOW_HASKELL__ >= 707+        m<- getInfo False n  -- filters like the old function if False, all info if True+        let ty=case m of+                Just (tyt,_,_,_)->ty2t tyt+#else         m<- getInfo n         let ty=case m of                 Just (tyt,_,_)->ty2t tyt+#endif                                 Nothing->Nothing         return $ NameDef (T.pack $ showSDDump df $ ppr n) (name2t n) ty         where         @@ -569,8 +583,14 @@                         | isVarName n2 = [Function]                         | otherwise =[]               ty2t :: TyThing -> Maybe T.Text+#if __GLASGOW_HASKELL__ >= 707+              ty2t (AnId aid)=Just $ T.pack $ showSD False df $ pprTypeForUser $ varType aid+              ty2t (AConLike(RealDataCon dc))=Just $ T.pack $ showSD False df $ pprTypeForUser $ dataConUserType dc+              ty2t (AConLike(PatSynCon ps))=Just $ T.pack $ showSD False df $ pprTypeForUser $ patSynType ps+#else               ty2t (AnId aid)=Just $ T.pack $ showSD False df $ pprTypeForUser True $ varType aid               ty2t (ADataCon dc)=Just $ T.pack $ showSD False df $ pprTypeForUser True $ dataConUserType dc+#endif               ty2t _ = Nothing  @@ -747,7 +767,11 @@ -- | like lexTokenStream, but keep Haddock flag lexTokenStreamH :: StringBuffer -> RealSrcLoc -> DynFlags -> ParseResult [Located Token] lexTokenStreamH buf loc dflags = unP go initState+#if __GLASGOW_HASKELL__ >= 707+    where dflags' = gopt_set (gopt_set dflags Opt_KeepRawTokenStream) Opt_Haddock+#else     where dflags' = dopt_set (dopt_set dflags Opt_KeepRawTokenStream) Opt_Haddock+#endif             initState = mkPState dflags' buf loc           go = do             ltok <- lexer return@@ -964,7 +988,11 @@          , bwnTitle = removeBaseDir base_dir $ removeStatus note_kind $ show_msg (errMsgShortDoc msg)          }   where+#if __GLASGOW_HASKELL__ >= 707+    loc | s <- errMsgSpan msg = s+#else     loc | (s:_) <- errMsgSpans msg = s+#endif           | otherwise                    = GHC.noSrcSpan     unqual = errMsgContext msg     show_msg = showSDUser unqual df@@ -1033,7 +1061,9 @@ tokenType  ITthen = "K" tokenType  ITtype = "K" tokenType  ITwhere = "K"+#if __GLASGOW_HASKELL__ < 707 tokenType  ITscc = "K"                       -- ToDo: remove (we use {-# SCC "..." #-} now)+#endif  tokenType  ITforall = "EK"                    -- GHC extension keywords tokenType  ITforeign = "EK"
src/Language/Haskell/BuildWrapper/GHCStorage.hs view
@@ -50,12 +50,12 @@ import Unique (getUnique)
 import Data.List (sortBy)
 --import GHC.SYB.Utils (Stage(..), showData)
-import qualified MonadUtils as GMU-import TcRnTypes (tcg_type_env,tcg_rdr_env)-import qualified CoreUtils (exprType)-import Desugar (deSugarExpr)-import Control.Monad (liftM)-import Data.Aeson.Types (Pair)+import qualified MonadUtils as GMU
+import TcRnTypes (tcg_type_env,tcg_rdr_env)
+import qualified CoreUtils (exprType)
+import Desugar (deSugarExpr)
+import Control.Monad (liftM)
+import Data.Aeson.Types (Pair)
 
 -- | get the file storing the information for the given source file
 getInfoFile :: FilePath -- ^ the source file
@@ -303,11 +303,20 @@         fixity  = const Null :: GHC.Fixity -> Value --simple "Fixity" . showSDoc . ppr 
 
         typeToJSON :: Type -> [(T.Text,Value)]
-        typeToJSON t =  
+        typeToJSON t =
+#if __GLASGOW_HASKELL__ >= 707         
+                ["Type" .= string (showSD False df $ pprTypeForUser t),
+                "QType" .= string (showSD True df $ pprTypeForUser t)]
+#else
                 ["Type" .= string (showSD False df $ pprTypeForUser True t),
-                "QType" .= string (showSD True df $ pprTypeForUser True t)]
+                "QType" .= string (showSD True df $ pprTypeForUser True t)]                
+#endif                 
         hsBind :: HsBindLR Name Name -> IO Value
+#if __GLASGOW_HASKELL__ >= 707
+        hsBind (FunBind fid _ (MG matches _ _) _ _ _) =do
+#else
         hsBind (FunBind fid _ (MatchGroup matches _) _ _ _) =do
+#endif        
                 d2<-dataToJSON df env tcm $ unLoc fid
                 liftM arr $ mapM (\m->do
                         d1<-dataToJSON df env tcm $ getLoc m
@@ -327,7 +336,11 @@ --getType _ _ (L _ (HsDo ArrowExpr _ _))=return Nothing
 --getType _ _ (L _ (HsArrApp {}))=return Nothing
 getType hs_env tcm e = do
+#if __GLASGOW_HASKELL__ >= 707
+      (_, mbe) <- GMU.liftIO $ deSugarExpr hs_env e
+#else
       (_, mbe) <- GMU.liftIO $ deSugarExpr hs_env modu rn_env ty_env e
+#endif      
       return $ fmap CoreUtils.exprType mbe
       where
         modu = ms_mod $ pm_mod_summary $ tm_parsed_module tcm