diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 --- /dev/null +++ b/CHANGELOG @@ -0,0 +1,2 @@ +0.8.7 + - support GHC 7.8: ConLike structure, different error messages, requirement for -dynamic diff --git a/buildwrapper.cabal b/buildwrapper.cabal --- a/buildwrapper.cabal +++ b/buildwrapper.cabal @@ -1,5 +1,5 @@ name: buildwrapper -version: 0.8.6 +version: 0.8.7 cabal-version: >= 1.8 build-type: Simple license: BSD3 @@ -15,6 +15,7 @@ author: JP Moresmau , based on the work of Thomas Schilling and others homepage: https://github.com/JPMoresmau/BuildWrapper extra-source-files: README.md + CHANGELOG library hs-source-dirs: src @@ -24,7 +25,7 @@ mtl, directory, Cabal, - dynamic-cabal >=0.3 && <0.4, + dynamic-cabal >=0.3.1 && <0.4, process, regex-tdfa, ghc, @@ -33,14 +34,14 @@ text, containers, vector >= 0.8, - haskell-src-exts >= 1.12 && <1.15, + haskell-src-exts >= 1.12 && <1.16, cpphs, old-time, aeson >=0.7 && <0.8, unordered-containers, utf8-string, bytestring, - attoparsec>=0.11 && <0.12, + attoparsec>=0.11 && <0.13, transformers, deepseq ghc-options: -Wall -fno-warn-unused-do-bind @@ -73,7 +74,7 @@ mtl, ghc, cpphs, - haskell-src-exts >= 1.12 && <1.15, + haskell-src-exts >= 1.12 && <1.16, old-time, ghc-paths, vector >= 0.8, @@ -86,6 +87,10 @@ bytestring, transformers ghc-options: -Wall -fno-warn-unused-do-bind -optl -s + -- see https://ghc.haskell.org/trac/ghc/ticket/8376 + -- if impl(ghc >= 7.8) && impl(ghc < 7.8.3) + -- ghc-options: + -- -dynamic other-modules: Language.Haskell.BuildWrapper.CMD if impl(ghc >= 7.6) build-depends: diff --git a/src/Language/Haskell/BuildWrapper/GHCStorage.hs b/src/Language/Haskell/BuildWrapper/GHCStorage.hs --- a/src/Language/Haskell/BuildWrapper/GHCStorage.hs +++ b/src/Language/Haskell/BuildWrapper/GHCStorage.hs @@ -32,7 +32,7 @@ #endif import qualified Data.ByteString.Lazy as BS --- import qualified Data.ByteString.Lazy.Char8 as BSC (putStrLn) +--import qualified Data.ByteString.Lazy.Char8 as BSC (putStrLn) import qualified Data.ByteString as BSS import Data.Aeson import Data.Maybe @@ -46,6 +46,9 @@ #else import Data.Time.Clock (UTCTime) #endif +#if __GLASGOW_HASKELL__ >= 708 +import ConLike +#endif import Type (splitFunTys) import Unique (getUnique) import Data.List (sortBy) @@ -90,7 +93,7 @@ generateGHCInfo df env tcm=do -- extract usages from typechecked source tcvals<-liftM extractUsages $ dataToJSON df env tcm $ typecheckedSource tcm - -- print tcvals + print tcvals -- store objects with type annotations in a map keyed by module, name, line and column let tcByNameLoc=foldr buildMap DM.empty tcvals -- print tcByNameLoc @@ -238,6 +241,9 @@ dataToJSON df env tcm= generic `ext1Q` list `extQ` (return . string) `extQ` (return . fastString) `extQ` (return . srcSpanToJSON) `extQ` (return . name) `extQ` (return . ocName) `extQ` (return . modName) `extQ` var `extQ` exprVar `extQ` (return . dataCon) +#if __GLASGOW_HASKELL__ >= 708 + `extQ` (return . rDataCon) +#endif `extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` (return . nameSet) `extQ` (return . postTcType) `extQ` (return . fixity) `extQ` hsBind where generic :: Data a => a -> IO Value @@ -265,6 +271,10 @@ var :: Var -> IO Value var v = return $ typedVar v (varType v) +#if __GLASGOW_HASKELL__ >= 708 + rDataCon (RealDataCon dc)=dataCon dc + rDataCon_ = Null +#endif dataCon :: DataCon -> Value dataCon d = let t=dataConUserType d @@ -313,7 +323,8 @@ #endif hsBind :: HsBindLR Name Name -> IO Value #if __GLASGOW_HASKELL__ >= 707 - hsBind (FunBind fid _ (MG matches _ _) _ _ _) =do + hsBind (FunBind fid _ mg _ _ _) =do + let matches = mg_alts mg #else hsBind (FunBind fid _ (MatchGroup matches _) _ _ _) =do #endif diff --git a/test/Language/Haskell/BuildWrapper/CMDLongRunningTests.hs b/test/Language/Haskell/BuildWrapper/CMDLongRunningTests.hs --- a/test/Language/Haskell/BuildWrapper/CMDLongRunningTests.hs +++ b/test/Language/Haskell/BuildWrapper/CMDLongRunningTests.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP, OverloadedStrings #-} {-# OPTIONS_GHC -F -pgmF htfpp #-} -- | -- Module : Language.Haskell.BuildWrapper.CMDTests @@ -49,8 +49,14 @@ assertBool (isJust mtts) assertBool (not $ notesInError ns) let tts=fromJust mtts +#if __GLASGOW_HASKELL__ >=708 + let functype="t" +#else + let functype="forall a. a" +#endif + print $ NameDef "B.D.fD" [Function] (Just functype) assertBool (NameDef "Main.main" [Function] (Just "IO [Char]") `elem` tts) - assertBool (NameDef "B.D.fD" [Function] (Just "forall a. a") `elem` tts) + assertBool (NameDef "B.D.fD" [Function] (Just functype) `elem` tts) assertBool (NameDef "Main.Type1" [Type] Nothing `elem` tts) assertBool (NameDef "Main.MkType1_1" [Constructor] (Just "Int -> Type1") `elem` tts) assertBool (NameDef "GHC.Types.Char" [Type] Nothing `elem` tts) diff --git a/test/Language/Haskell/BuildWrapper/CMDTests.hs b/test/Language/Haskell/BuildWrapper/CMDTests.hs --- a/test/Language/Haskell/BuildWrapper/CMDTests.hs +++ b/test/Language/Haskell/BuildWrapper/CMDTests.hs @@ -291,7 +291,7 @@ assertBool bool1 assertEqual 1 (length ns1) let (nsWarning1:[])=ns1 - assertEqual (BWNote BWWarning "Unknown fields: field1 (line 5)\nFields allowed in this section:\nname, version, cabal-version, build-type, license, license-file,\ncopyright, maintainer, build-depends, stability, homepage,\npackage-url, bug-reports, synopsis, description, category, author,\ntested-with, data-files, data-dir, extra-source-files,\nextra-tmp-files, extra-doc-files\n" (mkEmptySpan cfn 5 1)) nsWarning1 + assertEqualNotesStart (BWNote BWWarning "Unknown fields: field1 (line 5)" (mkEmptySpan cfn 5 1)) nsWarning1 writeFile cf $ unlines ["name: "++testProjectName, "version:0.1", "build-type: Simple", @@ -407,8 +407,13 @@ assertBool (not $ null nsErrors1) assertBool (rel `elem` fps1) let (nsError1:nsError2:[])=nsErrors1 +#if __GLASGOW_HASKELL__ >=708 + let notype="Top-level binding with no type signature:\n fA :: forall t. t" +#else + let notype="Top-level binding with no type signature:\n fA :: forall a. a" +#endif assertEqualNotesWithoutSpaces "not proper error 1" (BWNote BWWarning "The import of `Data.List' is redundant\n except perhaps to import instances from `Data.List'\n To import instances alone, use: import Data.List()\n" (mkEmptySpan rel 2 1)) nsError1 - assertEqualNotesWithoutSpaces "not proper error 2" (BWNote BWWarning "Top-level binding with no type signature:\n fA :: forall a. a\n" (mkEmptySpan rel 3 1)) nsError2 + assertEqualNotesWithoutSpaces "not proper error 2" (BWNote BWWarning notype (mkEmptySpan rel 3 1)) nsError2 (_,nsErrors3f)<-getBuildFlags api root rel assertBool (null nsErrors3f) (bool3,nsErrors3)<-build1 api root rel @@ -416,7 +421,7 @@ assertEqual 2 (length nsErrors3) let (nsError3:nsError4:[])=nsErrors3 assertEqualNotesWithoutSpaces "not proper error 3" (BWNote BWWarning "The import of `Data.List' is redundant\n except perhaps to import instances from `Data.List'\n To import instances alone, use: import Data.List()" (mkEmptySpan rel 2 1)) nsError3 - assertEqualNotesWithoutSpaces "not proper error 4" (BWNote BWWarning "Top-level binding with no type signature:\n fA :: forall a. a" (mkEmptySpan rel 3 1)) nsError4 + assertEqualNotesWithoutSpaces "not proper error 4" (BWNote BWWarning notype (mkEmptySpan rel 3 1)) nsError4 writeFile (root rel) $ unlines ["module A where","pats:: String -> String","pats a=reverse a","fB:: String -> Char","fB pats=head pats"] mf3<-synchronize1 api root True rel assertBool (isJust mf3) @@ -1512,8 +1517,13 @@ (mtts,_)<-build1 api root rel assertBool (isJust mtts) let tts=fromJust mtts +#if __GLASGOW_HASKELL__ >=708 + let functype="t" +#else + let functype="forall a. a" +#endif assertBool (NameDef "Main.main" [Function] (Just "IO [Char]") `elem` tts) - assertBool (NameDef "B.D.fD" [Function] (Just "forall a. a") `elem` tts) + assertBool (NameDef "B.D.fD" [Function] (Just functype) `elem` tts) assertBool (NameDef "Main.Type1" [Type] Nothing `elem` tts) assertBool (NameDef "Main.MkType1_1" [Constructor] (Just "Int -> Type1") `elem` tts) assertBool (NameDef "GHC.Types.Char" [Type] Nothing `elem` tts) @@ -1994,6 +2004,7 @@ " main-is: Main.hs", " other-modules: B.D", " build-depends: base", + " ghc-options: -dynamic", "", "test-suite BWTest-test", " type: exitcode-stdio-1.0", @@ -2050,7 +2061,12 @@ return root removeSpaces :: String -> String -removeSpaces = filter (/= ':') . filter (not . isSpace) +removeSpaces = filter (not . flip elem [':','\'','`','\CAN','\EM']) . filter (not . isSpace) + +assertEqualNotesStart :: BWNote -> BWNote -> IO() +assertEqualNotesStart n1 n2=do + let n2'=n1{bwnTitle=Data.List.take (length $ bwnTitle n1) $ bwnTitle n2} + assertEqual n1 n2' assertEqualNotesWithoutSpaces :: String -> BWNote -> BWNote -> IO() assertEqualNotesWithoutSpaces msg n1 n2=do diff --git a/test/Language/Haskell/BuildWrapper/ImportsTests.hs b/test/Language/Haskell/BuildWrapper/ImportsTests.hs --- a/test/Language/Haskell/BuildWrapper/ImportsTests.hs +++ b/test/Language/Haskell/BuildWrapper/ImportsTests.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP,OverloadedStrings #-} {-# OPTIONS_GHC -F -pgmF htfpp #-} -- | -- Module : Language.Haskell.BuildWrapper.ImportsTests @@ -128,21 +128,23 @@ " hs-source-dirs: src", " exposed-modules: A", " other-modules: B.C", - " build-depends: base, attoparsec"] + " build-depends: base"] synchronize api root False configure api root Target let rel2="src""B""C.hs" write api root rel2 $ unlines [ "module B.C where", "", - "import Data.Attoparsec", + "import System.Exit", "f r= case r of", - " Done _ js->True", + " ExitFailure _ ->True", " _->False" ] (ics,ns)<-cleanImports api root rel2 False assertBool $ null ns - assertEqual [ImportClean (InFileSpan (InFileLoc 3 1) (InFileLoc 3 23)) "import Data.Attoparsec (IResult (Done))"] ics +#if __GLASGOW_HASKELL__ != 704 + assertEqual [ImportClean (InFileSpan (InFileLoc 3 1) (InFileLoc 3 19)) "import System.Exit (ExitCode (ExitFailure))"] ics +#endif test_CleanImportsFunctionInExport :: Assertion test_CleanImportsFunctionInExport = do