Permalink
Browse files

Add backward compatibility for GHC < 7.2

  • Loading branch information...
maoe committed Nov 20, 2011
1 parent 4cf1e7e commit 146eb5946fd90a49918a863e5755e62e839fa652
Showing with 56 additions and 2 deletions.
  1. +1 −1 scion.cabal
  2. +10 −1 src/Scion/Cabal.hs
  3. +17 −0 src/Scion/Ghc.hs
  4. +12 −0 src/Scion/Types/Worker.hs
  5. +4 −0 src/Scion/Worker/Commands.hs
  6. +12 −0 src/Scion/Worker/Main.hs
View
@@ -112,4 +112,4 @@ executable scion-server
network >= 2.3 && < 2.4,
text >= 0.11 && < 0.12,
canonical-filepath == 1.0.*
- ghc-options: -fcontext-stack=30
+ ghc-options: -fcontext-stack=30
View
@@ -20,7 +20,6 @@ import Control.Monad ( when )
import Distribution.PackageDescription.Parse
import Distribution.Simple.Build ( initialBuildSteps )
import Distribution.Simple.Configure
-import Distribution.Simple.LocalBuildInfo hiding ( Component, libdir )
import qualified Distribution.PackageDescription as PD
import qualified Distribution.PackageDescription.Parse as PD
import qualified Distribution.PackageDescription.Configuration as PD
@@ -33,6 +32,13 @@ import System.Directory
import System.Exit ( ExitCode(..) )
import System.FilePath ( dropFileName, takeBaseName )
+#if __GLASGOW_HASKELL__ >= 702
+import Distribution.Simple.LocalBuildInfo hiding ( Component, libdir )
+#else
+import Distribution.Simple.LocalBuildInfo hiding ( libdir )
+import Distribution.Simple.PreProcess ( knownSuffixHandlers )
+#endif
+
-- | Something went wrong inside Cabal.
data CabalException = CabalException String
deriving (Typeable)
@@ -114,6 +120,9 @@ configureCabalProject conf@CabalConfig{} build_dir = do
config_flags
writePersistBuildConfig build_dir lbi
initialBuildSteps build_dir (localPkgDescr lbi) lbi V.normal
+#if __GLASGOW_HASKELL__ < 702
+ knownSuffixHandlers
+#endif
return lbi
configureCabalProject _ _ = fail "configureCabalProject: invalid config type"
View
@@ -34,6 +34,7 @@ import System.FilePath.Canonical
ghcSpanToLocation :: FilePath -- ^ Base directory
-> Ghc.SrcSpan
-> Location
+#if __GLASGOW_HASKELL__ >= 702
ghcSpanToLocation baseDir sp@(Ghc.RealSrcSpan rsp)
| Ghc.isGoodSrcSpan sp =
mkLocation mkLocFile
@@ -48,6 +49,22 @@ ghcSpanToLocation baseDir sp@(Ghc.RealSrcSpan rsp)
p -> FileSrc $ mkAbsFilePath baseDir p
ghcSpanToLocation _baseDir sp =
mkNoLoc (Ghc.showSDoc (Ghc.ppr sp))
+#else
+ghcSpanToLocation baseDir sp
+ | Ghc.isGoodSrcSpan sp =
+ mkLocation mkLocFile
+ (Ghc.srcSpanStartLine sp)
+ (ghcColToScionCol $ Ghc.srcSpanStartCol sp)
+ (Ghc.srcSpanEndLine sp)
+ (ghcColToScionCol $ Ghc.srcSpanEndCol sp)
+ | otherwise =
+ mkNoLoc (Ghc.showSDoc (Ghc.ppr sp))
+ where
+ mkLocFile =
+ case Ghc.unpackFS (Ghc.srcSpanFile sp) of
+ s@('<':_) -> OtherSrc s
+ p -> FileSrc $ mkAbsFilePath baseDir p
+#endif
ghcErrMsgToNote :: FilePath -> Ghc.ErrMsg -> Note
ghcErrMsgToNote = ghcMsgToNote ErrorNote
View
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
-- | The types used by the worker (which talks to the GHC API.)
module Scion.Types.Worker
( module Scion.Types.Worker
@@ -14,6 +15,11 @@ import Data.IORef
import System.IO
import Distribution.Simple.LocalBuildInfo
import GHC ( Ghc, GhcMonad(..) )
+#if __GLASGOW_HASKELL__ < 702
+import HscTypes ( WarnLogMonad(..) )
+import MonadUtils ( MonadIO, liftIO )
+import Exception ( ExceptionMonad(..) )
+#endif
newtype Worker a
= Worker { unWorker :: IORef WorkerState -> Ghc a }
@@ -55,6 +61,12 @@ instance ExceptionMonad Worker where
gblock (Worker act) = Worker $ \r -> gblock (act r)
gunblock (Worker act) = Worker $ \r -> gunblock (act r)
+#if __GLASGOW_HASKELL__ < 702
+instance WarnLogMonad Worker where
+ setWarnings ws = Worker $ \_ -> setWarnings ws
+ getWarnings = Worker $ \_ -> getWarnings
+#endif
+
instance GhcMonad Worker where
getSession = Worker (\_ -> getSession)
setSession s = Worker (\_ -> setSession s)
@@ -95,7 +95,11 @@ load how_much = do
<- withMeasuredTime $ \_stop_timer -> do
Ghc.load how_much --WithLogger (my_logger msgs) how_much
`gcatch` (\(e :: Ghc.SourceError) -> do
+#if __GLASGOW_HASKELL__ >= 702
Ghc.printException e
+#else
+ Ghc.printExceptionAndWarnings e
+#endif
return Ghc.Failed
) --handle_error msgs e)
View
@@ -47,6 +47,10 @@ import System.Directory hiding ( getModificationTime )
import System.PosixCompat.Files ( getFileStatus, modificationTime )
import System.FilePath.Canonical
+#if __GLASGOW_HASKELL__ < 702
+import qualified Distribution.Simple.PreProcess as C ( knownSuffixHandlers )
+#endif
+
------------------------------------------------------------------------
--
-- Compilation worker initialisation sequence:
@@ -224,7 +228,11 @@ initGhcSession targets args1 _debugMsg kont = do
debugMsg $ "GHC Args: " ++ show (map Ghc.unLoc args1)
-- handles Ctrl-C and GHC panics and suchlike
+#if __GLASGOW_HASKELL__ >= 702
Ghc.defaultErrorHandler Ghc.defaultLogAction $ do
+#else
+ Ghc.defaultErrorHandler Ghc.defaultDynFlags $ do
+#endif
-- 1. Initialise all the static flags
debugMsg "Parsing static flags"
@@ -380,7 +388,11 @@ configureCabal cabal_file0 config_flags odir = do
C.writePersistBuildConfig odir lcl_build_info
C.initialBuildSteps odir (C.localPkgDescr lcl_build_info) lcl_build_info
+#if __GLASGOW_HASKELL__ >= 702
C.normal
+#else
+ C.normal C.knownSuffixHandlers
+#endif
-- Create timestamp *after* writing the file. Thus if we later
-- check if the file is up to date using this timestamp, it is

0 comments on commit 146eb59

Please sign in to comment.