Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Eliminate warnings and errors on GHC 7.2

  • Loading branch information...
commit 538d28af0f39a4061d524b06456e0051efa7b9ee 1 parent 98bc21b
@maoe maoe authored
View
1  src-execs/Worker.hs
@@ -2,5 +2,6 @@ module Main where
import Scion.Worker.Main ( workerMain )
+main :: IO ()
main = workerMain 42
--main = soloWorkerMain
View
5 src/Scion/Cabal.hs
@@ -20,11 +20,10 @@ import Control.Monad ( when )
import Distribution.PackageDescription.Parse
import Distribution.Simple.Build ( initialBuildSteps )
import Distribution.Simple.Configure
-import Distribution.Simple.LocalBuildInfo hiding ( libdir )
+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
-import Distribution.Simple.PreProcess ( knownSuffixHandlers )
import Distribution.Simple.Program
import Distribution.Simple.Setup ( defaultConfigFlags,
ConfigFlags(..), Flag(..) )
@@ -115,8 +114,8 @@ configureCabalProject conf@CabalConfig{} build_dir = do
config_flags
writePersistBuildConfig build_dir lbi
initialBuildSteps build_dir (localPkgDescr lbi) lbi V.normal
- knownSuffixHandlers
return lbi
+configureCabalProject _ _ = fail "configureCabalProject: invalid config type"
availableComponents :: PD.PackageDescription -> [Component]
availableComponents pd =
View
23 src/Scion/Ghc.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP, MultiParamTypeClasses #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
module Scion.Ghc
( -- * Converting from GHC error messages
ghcSpanToLocation, ghcErrMsgToNote, ghcWarnMsgToNote,
@@ -33,20 +34,20 @@ import System.FilePath.Canonical
ghcSpanToLocation :: FilePath -- ^ Base directory
-> Ghc.SrcSpan
-> Location
-ghcSpanToLocation baseDir sp
+ghcSpanToLocation baseDir sp@(Ghc.RealSrcSpan rsp)
| 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))
+ (Ghc.srcSpanStartLine rsp)
+ (ghcColToScionCol $ Ghc.srcSpanStartCol rsp)
+ (Ghc.srcSpanEndLine rsp)
+ (ghcColToScionCol $ Ghc.srcSpanEndCol rsp)
where
mkLocFile =
- case Ghc.unpackFS (Ghc.srcSpanFile sp) of
+ case Ghc.unpackFS (Ghc.srcSpanFile rsp) of
s@('<':_) -> OtherSrc s
p -> FileSrc $ mkAbsFilePath baseDir p
+ghcSpanToLocation _baseDir sp =
+ mkNoLoc (Ghc.showSDoc (Ghc.ppr sp))
ghcErrMsgToNote :: FilePath -> Ghc.ErrMsg -> Note
ghcErrMsgToNote = ghcMsgToNote ErrorNote
@@ -92,6 +93,7 @@ fromGhcModSummary ms = do
, ms_fileType = case Ghc.ms_hsc_src ms of
Ghc.HsSrcFile -> HaskellFile
Ghc.HsBootFile -> HaskellBootFile
+ Ghc.ExtCoreFile -> ExternalCoreFile
, ms_imports =
map (convert . Ghc.unLoc
. Ghc.ideclName . Ghc.unLoc) (Ghc.ms_imps ms)
@@ -117,6 +119,11 @@ targetToGhcTarget (FileTarget path) =
, Ghc.targetAllowObjCode = True
, Ghc.targetContents = Nothing
}
+targetToGhcTarget (CabalTarget path) =
+ Ghc.Target { Ghc.targetId = Ghc.TargetFile path Nothing
+ , Ghc.targetAllowObjCode = False
+ , Ghc.targetContents = Nothing
+ }
instance Convert ModuleName Ghc.ModuleName where
convert (ModuleName s) = Ghc.mkModuleName (T.unpack s)
View
24 src/Scion/Session.hs
@@ -28,7 +28,6 @@ import Scion.Cabal ( CabalException )
import Control.Applicative
import Control.Concurrent
-import Control.Exception ( throwIO )
import Control.Monad ( when, unless, forever, filterM )
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
@@ -36,20 +35,17 @@ import qualified Data.Map as M
import Data.Char ( ord )
import Data.Maybe
import Data.Time.Clock ( getCurrentTime )
-import Data.Time.Clock.POSIX ( posixSecondsToUTCTime )
import System.Directory ( doesFileExist, getTemporaryDirectory,
removeDirectoryRecursive )
import System.Exit ( ExitCode(..) )
import System.FilePath ( dropFileName, (</>), takeFileName,
- makeRelative, takeDirectory )
+ takeDirectory )
import System.FilePath.Canonical
import System.IO
import System.IO.Temp ( createTempDirectory )
import System.PosixCompat.Files ( getFileStatus, modificationTime )
import System.Process ( getProcessExitCode, terminateProcess )
-import Debug.Trace
-
-- -------------------------------------------------------------------
-- | Throw a 'ScionException' if the file does not exist.
@@ -187,14 +183,15 @@ supportedLanguagesAndExtensions = do
wh <- sessionWorker <$> getSessionState sid
(ans, _) <- io $ callWorker wh Extensions
case ans of
- AvailExtensions exts -> do
- setExtensions exts
- return exts
+ AvailExtensions exts' -> do
+ setExtensions exts'
+ return exts'
+ _ -> fail "supportedLanguagesAndExtensions: illegal answer"
-- | Notify the worker that a file has changed. The worker will then
-- update its internal state.
fileModified :: SessionId -> FilePath -> ScionM ()
-fileModified sid path = do
+fileModified sid _path = do
-- TODO: check whether file is actually part of module graph
-- TODO: properly merge compilation results
st <- getSessionState sid
@@ -205,6 +202,7 @@ fileModified sid path = do
modifySessionState sid $ \ss ->
(ss{ sessionModuleGraph = graph
, sessionLastCompilation = rslt }, ())
+ _ -> fail "fileModified: illegal answer"
@@ -230,7 +228,7 @@ setTargets sid _targets = do
sessionTargets :: SessionConfig -> [Target]
sessionTargets FileConfig{ sc_fileName = f} = [FileTarget f]
-sessionTargets CabalConfig{} = []
+sessionTargets _ = []
-- -------------------------------------------------------------------
@@ -249,7 +247,7 @@ startWorker start_worker homedir conf = do
\(inp, out, err, proc) -> do
hSetBinaryMode inp True
hSetBinaryMode out True
- if verb >= deafening then forkIO (printFromHandle err) else return undefined
+ _ <- if verb >= deafening then forkIO (printFromHandle err) else return undefined
-- Wait for worker to start up.
wait_for_READY out
@@ -286,7 +284,7 @@ startWorker start_worker homedir conf = do
printFromHandle hdl =
handle (\(_e :: IOError) -> return ()) $ do
forever $ do
- hWaitForInput hdl (-1)
+ _ <- hWaitForInput hdl (-1)
s <- S.hGetNonBlocking hdl 256
hPutStr stderr (show hdl ++ ": ")
S.hPutStr stderr s
@@ -349,7 +347,7 @@ collectLines h act = do
where
loop var =
handle (\(_e :: IOError) -> return ()) $ do
- hWaitForInput h (-1)
+ _ <- hWaitForInput h (-1)
modifyMVar_ var $ \cs -> do
chunk <- S.hGetNonBlocking h (2*4096)
return (chunk:cs)
View
2  src/Scion/Types/Commands.hs
@@ -39,6 +39,7 @@ instance Binary Command where
3 -> pure Quit
4 -> pure Reload
5 -> pure Extensions
+ _ -> fail "Binary Command get: tag error"
instance Binary Answer where
put Pong = putWord16le 1
@@ -55,3 +56,4 @@ instance Binary Answer where
3 -> Error <$> get
4 -> pure Quitting
5 -> AvailExtensions <$> get
+ _ -> fail "Binary Answer get: tag error"
View
1  src/Scion/Types/Compiler.hs
@@ -3,7 +3,6 @@ module Scion.Types.Compiler where
import Control.Applicative
import Data.Binary
import Data.Binary.Get()
-import Data.Binary.Put
import Data.String ( IsString(fromString) )
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
View
3  src/Scion/Types/Monad.hs
@@ -13,10 +13,7 @@ import Scion.Types.Core
import Control.Applicative
import Control.Monad ( when )
import qualified Data.Map as M
-import qualified Data.Text as T
import Data.IORef
-import MonadUtils -- from GHC
-import Exception -- from GHC
import System.IO ( hFlush, stdout )
-- * The Scion Monad and Session State
View
2  src/Scion/Types/Note.hs
@@ -120,6 +120,7 @@ instance Binary Location where
case tag of
1 -> LocNone <$> get
2 -> mkLocation <$> get <*> get <*> get <*> get <*> get
+ _ -> fail "Binary Location get: tag error"
-- | The \"source\" of a location.
data LocSource
@@ -137,6 +138,7 @@ instance Binary LocSource where
case tag of
1 -> FileSrc <$> get
2 -> OtherSrc <$> get
+ _ -> fail "Binary LocSource get: tag error"
instance Ord Location where compare = cmpLoc
View
5 src/Scion/Types/Session.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE GeneralizedNewtypeDeriving, BangPatterns, DeriveDataTypeable,
MultiParamTypeClasses #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
module Scion.Types.Session
( module Scion.Types.Session
, module Scion.Types.Core
@@ -57,6 +58,7 @@ instance Binary Component where
case tag of
1 -> return Library
2 -> Executable <$> get
+ _ -> fail "Binary Component get: tag error"
-- | A @WorkerHandle@ contains the state and data structures for
-- communicating with a worker process.
@@ -152,6 +154,7 @@ instance Binary SessionConfig where
1 -> FileConfig <$> get <*> get
2 -> CabalConfig <$> get <*> get <*> get <*> get <*> get
3 -> EmptyConfig <$> get
+ _ -> fail "Binary SessionConfig get: tag error"
-- | The concept of \"a point in time\" that we use throughout Scion.
@@ -249,6 +252,7 @@ instance Binary CanonicalFilePath where
data HsFileType
= HaskellFile
| HaskellBootFile
+ | ExternalCoreFile
deriving (Eq, Ord, Show, Enum)
instance Binary HsFileType where
@@ -302,3 +306,4 @@ instance Binary Target where
1 -> ModuleTarget <$> get
2 -> FileTarget <$> get
3 -> CabalTarget <$> get
+ _ -> fail "Binary Target get: tag error"
View
7 src/Scion/Types/Worker.hs
@@ -14,9 +14,6 @@ import Data.IORef
import System.IO
import Distribution.Simple.LocalBuildInfo
import GHC ( Ghc, GhcMonad(..) )
-import HscTypes ( WarnLogMonad(..) )
-import MonadUtils ( MonadIO, liftIO )
-import Exception ( ExceptionMonad(..) )
newtype Worker a
= Worker { unWorker :: IORef WorkerState -> Ghc a }
@@ -58,10 +55,6 @@ instance ExceptionMonad Worker where
gblock (Worker act) = Worker $ \r -> gblock (act r)
gunblock (Worker act) = Worker $ \r -> gunblock (act r)
-instance WarnLogMonad Worker where
- setWarnings ws = Worker $ \_ -> setWarnings ws
- getWarnings = Worker $ \_ -> getWarnings
-
instance GhcMonad Worker where
getSession = Worker (\_ -> getSession)
setSession s = Worker (\_ -> setSession s)
View
3  src/Scion/Utils/IO.hs
@@ -6,7 +6,6 @@ import System.IO
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import Control.Applicative
-import Data.Binary
import Data.Binary.Get ( getWord32le, runGet )
import Data.Binary.Put ( putWord32le, runPut )
import Network.Socket hiding (send, sendTo, recv, recvFrom)
@@ -94,7 +93,7 @@ hRecv h size = do
return S.empty) $ do
-- Note: hWaitForInput tries to decode its input, so we must make
-- sure the handle is in binary mode.
- hWaitForInput h (-1)
+ _ <- hWaitForInput h (-1)
S.hGetNonBlocking h size
die :: String -> a
View
4 src/Scion/Worker/Commands.hs
@@ -95,7 +95,7 @@ load how_much = do
<- withMeasuredTime $ \_stop_timer -> do
Ghc.load how_much --WithLogger (my_logger msgs) how_much
`gcatch` (\(e :: Ghc.SourceError) -> do
- Ghc.printExceptionAndWarnings e
+ Ghc.printException e
return Ghc.Failed
) --handle_error msgs e)
@@ -116,6 +116,7 @@ load how_much = do
where
--my_logger :: IORef Messages -> Maybe Ghc.SourceError -> Worker ()
+ {-
my_logger msgs err = do
let errs = case err of
Nothing -> emptyBag
@@ -125,6 +126,7 @@ load how_much = do
liftIO $ modifyIORef msgs (`mappend` Messages warns errs)
-- return Ghc.Failed
return ()
+ -}
moduleGraph :: Worker [ModuleSummary]
moduleGraph = do
View
5 src/Scion/Worker/Main.hs
@@ -22,7 +22,6 @@ import qualified Outputable as O
import qualified Distribution.Compiler as C
import qualified Distribution.Simple.Configure as C
import qualified Distribution.Simple.Build as C
-import qualified Distribution.Simple.PreProcess as C
import qualified Distribution.PackageDescription as C
import qualified Distribution.PackageDescription.Parse as C
import qualified Distribution.Verbosity as C
@@ -225,7 +224,7 @@ initGhcSession targets args1 _debugMsg kont = do
debugMsg $ "GHC Args: " ++ show (map Ghc.unLoc args1)
-- handles Ctrl-C and GHC panics and suchlike
- Ghc.defaultErrorHandler Ghc.defaultDynFlags $ do
+ Ghc.defaultErrorHandler Ghc.defaultLogAction $ do
-- 1. Initialise all the static flags
debugMsg "Parsing static flags"
@@ -381,7 +380,7 @@ configureCabal cabal_file0 config_flags odir = do
C.writePersistBuildConfig odir lcl_build_info
C.initialBuildSteps odir (C.localPkgDescr lcl_build_info) lcl_build_info
- C.normal C.knownSuffixHandlers
+ C.normal
-- Create timestamp *after* writing the file. Thus if we later
-- check if the file is up to date using this timestamp, it is
Please sign in to comment.
Something went wrong with that request. Please try again.