Eliminate warnings and errors on GHC 7.2

src-execs/Worker.hs

@@ -2,5 +2,6 @@ module Main where
 
 import Scion.Worker.Main ( workerMain )
 
+main :: IO ()
 main = workerMain 42
 --main = soloWorkerMain

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 =

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)

src/Scion/Session.hs

@@ -28,28 +28,24 @@ 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
 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)

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"

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

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

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
 

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"

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)

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

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

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