Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

7.6.1 and Cabal 1.16 compatibility

  • Loading branch information...
commit 3693e0df8ce8226fdd1fbb1b3c6f924847660f3a 1 parent cc24132
@JPMoresmau authored
View
4 src/Language/Haskell/BuildWrapper/API.hs
@@ -317,7 +317,7 @@ getBuildFlags fp mccn=do
Just bf-> return bf
Nothing -> do
(mcbi,bwns)<-getBuildInfo fp mccn
- -- liftIO $ print mcbi
+ --liftIO $ print mcbi
ret<-case mcbi of
Just cbi->do
opts2<-fileGhcOptions cbi
@@ -384,7 +384,7 @@ withGHCAST' :: FilePath -- ^ the source file
-> IO (OpResult (Maybe a))) -> BuildWrapper (OpResult (Maybe a))
withGHCAST' fp mccn f= do
(bf,ns)<-getBuildFlags fp mccn
- liftIO $ print bf
+ -- liftIO $ print bf
case bf of
(BuildFlags opts _ (Just modS) _)-> do
tgt<-getTargetPath fp
View
12 src/Language/Haskell/BuildWrapper/Base.hs
@@ -54,9 +54,15 @@ instance ToJSON BWNoteStatus where
toJSON = toJSON . drop 2 . show
instance FromJSON BWNoteStatus where
- parseJSON (String t) =return $ read $ T.unpack $ T.append "BW" t
+ parseJSON (String t) =return $ readObj "BWNoteStatus" $ T.unpack $ T.append "BW" t
parseJSON _= mzero
+readObj :: Read a=> String -> String -> a
+readObj msg s=let parses=reads s -- :: [(a,String)]
+ in if null parses
+ then error (msg ++ ": " ++ s ++ ".")
+ else fst $ head parses
+
-- | location of a note/error (lines and columns start at 1)
data BWLocation=BWLocation {
bwlSrc::FilePath -- ^ source file
@@ -158,7 +164,7 @@ instance ToJSON OutlineDefType where
toJSON = toJSON . show
instance FromJSON OutlineDefType where
- parseJSON (String s) =return $ read $ T.unpack s
+ parseJSON (String s) =return $ readObj "OutlineDefType" $ T.unpack s
parseJSON _= mzero
-- | Location inside a file, the file is known and doesn't need to be repeated
@@ -313,7 +319,7 @@ instance ToJSON ImportExportType where
toJSON = toJSON . show
instance FromJSON ImportExportType where
- parseJSON (String s) =return $ read $ T.unpack s
+ parseJSON (String s) =return $ readObj "ImportExportType" $ T.unpack s
parseJSON _= mzero
-- | definition of export
View
10 src/Language/Haskell/BuildWrapper/Cabal.hs
@@ -22,6 +22,12 @@ import Data.Char
import Data.Ord (comparing)
import Data.List
import Data.Maybe
+
+#if MIN_VERSION_Cabal(1,15,0)
+import Data.Version (parseVersion)
+import Text.ParserCombinators.ReadP(readP_to_S)
+#endif
+
import qualified Data.Map as DM
import Exception (ghandle)
@@ -312,7 +318,7 @@ parseBuildMessages cf cabalExe distDir s=let
extractLocation el=let
(_,_,aft,ls)=el =~ "(.+):([0-9]+):([0-9]+):" :: (String,String,String,[String])
in case ls of
- (loc:line:col:[])-> Just $ BWNote BWError (dropWhile isSpace aft) (mkEmptySpan loc (readInt line 1) (read col))
+ (loc:line:col:[])-> Just $ BWNote BWError (dropWhile isSpace aft) (mkEmptySpan loc (readInt line 1) (readInt col 1))
_ -> let
(_,_,_,ls2)=el =~ "(.+)(\\(.+\\)):(.+):(.+):" :: (String,String,String,[String])
in case ls2 of
@@ -432,7 +438,7 @@ fileGhcOptions (lbi,CabalBuildInfo bi clbi fp isLib _ _)=do
inplaceExist<-liftIO $ doesFileExist inplace
#if MIN_VERSION_Cabal(1,15,0)
v<-cabalV
- let opts l b c f=renderGhcOptions (read VERSION_ghc) $ componentGhcOptions v l b c f
+ let opts l b c f=renderGhcOptions ((fst $ head $ readP_to_S parseVersion VERSION_ghc) :: Version) $ componentGhcOptions v l b c f
#else
let opts=ghcOptions
#endif
View
7 src/Language/Haskell/BuildWrapper/GHC.hs
@@ -809,6 +809,13 @@ tokenType ITtildehsh= "S"
tokenType ITsimpleQuote="SS"
#endif
+-- 7.6 new token types
+#if __GLASGOW_HASKELL__ >= 706
+tokenType ITctype= "P"
+tokenType ITlcase= "S"
+tokenType (ITqQuasiQuote {}) = "TH" -- [Qual.quoter| quote |]
+#endif
+
dotFS :: FastString
dotFS = fsLit "."
View
3  src/Language/Haskell/BuildWrapper/Packages.hs
@@ -13,6 +13,7 @@
-- Packages from packages databases (global, user).
module Language.Haskell.BuildWrapper.Packages ( getPkgInfos ) where
+import Language.Haskell.BuildWrapper.Base
import Prelude hiding (Maybe)
import qualified Config
@@ -188,7 +189,7 @@ readContents pkgdb =
(PkgFile dbFile) -> do
pkgStr <- readUTF8File dbFile
- let pkgs = map convertPackageInfoIn $ read pkgStr
+ let pkgs = map convertPackageInfoIn $ readObj "InstalledPackageInfo" pkgStr
pkgInfoList <-
Exception.evaluate pkgs
`catchError`
View
8 test/Language/Haskell/BuildWrapper/Tests.hs
@@ -53,7 +53,7 @@ tests= [
testOutlineOptions,
testPreviewTokenTypes,
testThingAtPoint,
- testThingAtPointTypeReduction,
+ testThingAtPointTypeReduction,
testThingAtPointNotInCabal,
testThingAtPointMain,
testThingAtPointMainSubFolder,
@@ -1029,9 +1029,15 @@ testThingAtPointTypeReduction api= TestLabel "testThingAtPointTypeReduction" (Te
assertBool ("errors or warnings on getThingAtPointM:"++show nsErrorsM) (null nsErrorsM)
assertBool "not just tapM" (isJust tapM)
assertEqual "not insert" "insert" (tapName $ fromJust tapM)
+#if __GLASGOW_HASKELL__ >= 706
+ assertEqual "not Data.Map.Base module" (Just "Data.Map.Base") (tapModule $ fromJust tapM)
+ assertEqual "not htypeM" (Just "v") (tapHType $ fromJust tapM)
+ assertEqual "qtype insert" (Just "GHC.Base.String -> GHC.Types.Int -> Data.Map.Base.Map GHC.Base.String GHC.Types.Int -> Data.Map.Base.Map GHC.Base.String GHC.Types.Int") (tapQType $ fromJust tapM)
+#else
assertEqual "not Data.Map module" (Just "Data.Map") (tapModule $ fromJust tapM)
assertEqual "not htypeM" (Just "v") (tapHType $ fromJust tapM)
assertEqual "qtype insert" (Just "GHC.Base.String -> GHC.Types.Int -> Data.Map.Map GHC.Base.String GHC.Types.Int -> Data.Map.Map GHC.Base.String GHC.Types.Int") (tapQType $ fromJust tapM)
+#endif
))
testThingAtPointNotInCabal :: (APIFacade a)=> a -> Test
Please sign in to comment.
Something went wrong with that request. Please try again.