Merge release-5.5.0.0 into master (using imerge)

2016-01-17 21:03:28 +01:00
parent 5efa123f36 54fe4a0edb
commit 566dbebe29
20 changed files with 195 additions and 160 deletions
--- a/Language/Haskell/GhcMod/Browse.hs
+++ b/Language/Haskell/GhcMod/Browse.hs
@@ -3,6 +3,7 @@ module Language.Haskell.GhcMod.Browse (
    BrowseOpts(..)
  ) where

+import Safe
 import Control.Applicative
 import Control.Exception (SomeException(..))
 import Data.Char
@@ -49,7 +50,7 @@ browse opts pkgmdl = do
    goHomeModule = runGmlT [Right mdlname] $ do
      processExports opts =<< tryModuleInfo =<< G.findModule mdlname Nothing

-    tryModuleInfo m = fromJust <$> G.getModuleInfo m
+    tryModuleInfo m = fromJustNote "browse, tryModuleInfo" <$> G.getModuleInfo m

    (mpkg, mdl) = splitPkgMdl pkgmdl
    mdlname = G.mkModuleName mdl
--- a/Language/Haskell/GhcMod/CabalHelper.hs
+++ b/Language/Haskell/GhcMod/CabalHelper.hs
@@ -113,32 +113,30 @@ getComponents = chCached $ \distdir -> Cached {
                 , (a', c) <- lc
                 , a == a'
                 ]
-runCHQuery :: (IOish m, GmOut m, GmEnv m) => Query m b -> m b
-runCHQuery a = do
+
+getQueryEnv :: (IOish m, GmOut m, GmEnv m) => m QueryEnv
+getQueryEnv = do
  crdl <- cradle
+  progs <- patchStackPrograms crdl =<< (optPrograms <$> options)
+  readProc <- gmReadProcess
  let projdir = cradleRootDir crdl
      distdir = projdir </> cradleDistDir crdl
+  return (defaultQueryEnv projdir distdir) {
+                  qeReadProcess = readProc
+                , qePrograms = helperProgs progs
+                }

-  opts <- options
-  progs <- patchStackPrograms crdl (optPrograms opts)
-
-  readProc <- gmReadProcess
-
-  let qe = (defaultQueryEnv projdir distdir) {
-               qeReadProcess = readProc
-             , qePrograms = helperProgs progs
-             }
+runCHQuery :: (IOish m, GmOut m, GmEnv m) => Query m b -> m b
+runCHQuery a = do
+  qe <- getQueryEnv
  runQuery qe a


 prepareCabalHelper :: (IOish m, GmEnv m, GmOut m, GmLog m) => m ()
 prepareCabalHelper = do
  crdl <- cradle
-  let projdir = cradleRootDir crdl
-      distdir = projdir </> cradleDistDir crdl
-  readProc <- gmReadProcess
  when (isCabalHelperProject $ cradleProject crdl) $
-       withCabal $ liftIO $ prepare readProc projdir distdir
+       withCabal $ prepare' =<< getQueryEnv

 withAutogen :: (IOish m, GmEnv m, GmOut m, GmLog m) => m a -> m a
 withAutogen action = do
@@ -155,15 +153,14 @@ withAutogen action = do

    when (mCabalMacroHeader < mCabalFile || mCabalPathsModule < mCabalFile) $ do
      gmLog GmDebug "" $ strDoc $ "autogen files out of sync"
-      writeAutogen projdir distdir
+      writeAutogen

    action

 where
-   writeAutogen projdir distdir = do
-     readProc <- gmReadProcess
+   writeAutogen = do
     gmLog GmDebug "" $ strDoc $ "writing Cabal autogen files"
-     liftIO $ writeAutogenFiles readProc projdir distdir
+     writeAutogenFiles' =<< getQueryEnv


 withCabal :: (IOish m, GmEnv m, GmOut m, GmLog m) => m a -> m a
--- a/Language/Haskell/GhcMod/Cradle.hs
+++ b/Language/Haskell/GhcMod/Cradle.hs
@@ -17,10 +17,10 @@ import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Utils
 import Language.Haskell.GhcMod.Stack
 import Language.Haskell.GhcMod.Logging
+import Language.Haskell.GhcMod.Error

-
+import Safe
 import Control.Applicative
-import Control.Monad
 import Control.Monad.Trans.Maybe
 import Data.Maybe
 import System.Directory
@@ -28,7 +28,6 @@ import System.FilePath
 import Prelude
 import Control.Monad.Trans.Journal (runJournalT)

-
 ----------------------------------------------------------------

 -- | Finding 'Cradle'.
@@ -40,7 +39,7 @@ findCradle = findCradle' =<< liftIO getCurrentDirectory

 findCradleNoLog  :: forall m. (IOish m, GmOut m) => m Cradle
 findCradleNoLog = fst <$> (runJournalT findCradle :: m (Cradle, GhcModLog))
-    
+
 findCradle' :: (GmLog m, IOish m, GmOut m) => FilePath -> m Cradle
 findCradle' dir = run $
    msum [ stackCradle dir
@@ -48,7 +47,7 @@ findCradle' dir = run $
         , sandboxCradle dir
         , plainCradle dir
         ]
- where run a = fillTempDir =<< (fromJust <$> runMaybeT a)
+ where run a = fillTempDir =<< (fromJustNote "findCradle'" <$> runMaybeT a)

 findSpecCradle :: (GmLog m, IOish m, GmOut m) => FilePath -> m Cradle
 findSpecCradle dir = do
@@ -99,9 +98,9 @@ stackCradle wdir = do

    -- If dist/setup-config already exists the user probably wants to use cabal
    -- rather than stack, or maybe that's just me ;)
-    whenM (liftIO $ doesFileExist $ setupConfigPath "dist") $ do
-                      gmLog GmWarning "" $ text "'dist/setup-config' exists, ignoring Stack and using cabal-install instead."
-                      mzero
+    whenM (liftIO $ doesFileExist $ cabalDir </> setupConfigPath "dist") $ do
+      gmLog GmWarning "" $ text "'dist/setup-config' exists, ignoring Stack and using cabal-install instead."
+      mzero

    senv <- MaybeT $ getStackEnv cabalDir

--- a/Language/Haskell/GhcMod/Find.hs
+++ b/Language/Haskell/GhcMod/Find.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, BangPatterns, DoAndIfThenElse, TupleSections #-}
+{-# LANGUAGE CPP, BangPatterns, TupleSections, DeriveGeneric #-}

 module Language.Haskell.GhcMod.Find
 #ifndef SPEC
@@ -18,47 +18,47 @@ module Language.Haskell.GhcMod.Find
 #endif
  where

-import Control.Applicative
-import Control.Monad
-import Control.Exception
-import Control.Concurrent
-import Data.List
-import Data.Binary
-import Data.IORef
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Lazy as LBS
 import qualified GHC as G
 import FastString
 import Module
 import OccName
 import HscTypes
+import Exception
+
 import Language.Haskell.GhcMod.Convert
 import Language.Haskell.GhcMod.Gap
 import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.Output
-import Language.Haskell.GhcMod.PathsAndFiles
 import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Utils
 import Language.Haskell.GhcMod.World
-import Language.Haskell.GhcMod.Target
 import Language.Haskell.GhcMod.LightGhc

-import Exception
-
+import Control.Applicative
+import Control.DeepSeq
+import Control.Monad
 import Control.Monad.Trans.Control
+import Control.Concurrent
+
+import Data.List
+import Data.Binary
 import Data.Function
-import System.Directory
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import Data.IORef
+
 import System.Directory.ModTime
-import System.FilePath ((</>))
-import System.IO
 import System.IO.Unsafe
-import Prelude
+
+import GHC.Generics (Generic)

 import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Set (Set)
 import qualified Data.Set as S

+import Prelude
+
 ----------------------------------------------------------------

 -- | Type of function and operation names.
@@ -67,22 +67,23 @@ type ModuleNameBS = BS.ByteString

 -- | Database from 'Symbol' to \['ModuleString'\].
 data SymbolDb = SymbolDb
-  { table             :: Map Symbol [ModuleNameBS]
-  , symbolDbCachePath :: FilePath
-  }
+  { sdTable             :: Map Symbol (Set ModuleNameBS)
+  , sdTimestamp         :: ModTime
+  } deriving (Generic)
+
+instance Binary SymbolDb
+instance NFData SymbolDb

 isOutdated :: IOish m => SymbolDb -> GhcModT m Bool
 isOutdated db =
-  (liftIO . isOlderThan (symbolDbCachePath db)) =<< timedPackageCaches
+  isOlderThan (sdTimestamp db) <$> timedPackageCaches

 ----------------------------------------------------------------

 -- | Looking up 'SymbolDb' with 'Symbol' to \['ModuleString'\]
 --   which will be concatenated. 'loadSymbolDb' is called internally.
 findSymbol :: IOish m => String -> GhcModT m String
-findSymbol sym = do
-  tmpdir <- cradleTempDir <$> cradle
-  loadSymbolDb tmpdir >>= lookupSymbol sym
+findSymbol sym = loadSymbolDb >>= lookupSymbol sym

 -- | Looking up 'SymbolDb' with 'Symbol' to \['ModuleString'\]
 --   which will be concatenated.
@@ -90,62 +91,36 @@ lookupSymbol :: IOish m => String -> SymbolDb -> GhcModT m String
 lookupSymbol sym db = convert' $ lookupSym (fastStringToByteString $ mkFastString sym) db

 lookupSym :: Symbol -> SymbolDb -> [ModuleString]
-lookupSym sym db = map (ModuleString . unpackFS . mkFastStringByteString') $ M.findWithDefault [] sym $ table db
+lookupSym sym db = map (ModuleString . unpackFS . mkFastStringByteString') $ S.toList $ M.findWithDefault S.empty sym $ sdTable db

 ---------------------------------------------------------------

 -- | Loading a file and creates 'SymbolDb'.
-loadSymbolDb :: IOish m => FilePath -> GhcModT m SymbolDb
-loadSymbolDb dir = do
+loadSymbolDb :: IOish m => GhcModT m SymbolDb
+loadSymbolDb = do
  ghcMod <- liftIO ghcModExecutable
-  readProc <- gmReadProcess
-  file   <- liftIO $ chop <$> readProc ghcMod ["dumpsym", dir] ""
-  !db    <- M.fromList . decode <$> liftIO (LBS.readFile file)
-  return $ SymbolDb
-    { table             = db
-    , symbolDbCachePath = file
-    }
-  where
-    chop :: String -> String
-    chop "" = ""
-    chop xs = init xs
+  readProc <- gmReadProcess'
+  out <- liftIO $ readProc ghcMod ["--verbose", "error", "dumpsym"] ""
+  return $!! decode out

 ----------------------------------------------------------------
 -- used 'ghc-mod dumpsym'

-- | Dumping a set of ('Symbol',\['ModuleString'\]) to a file
--   if the file does not exist or is invalid.
--   The file name is printed.
-
-dumpSymbol :: IOish m => FilePath -> GhcModT m String
-dumpSymbol dir = do
-  create <- (liftIO . isOlderThan cache) =<< timedPackageCaches
-  pkgOpts <- packageGhcOptions
-  when create $ liftIO $ do
-    withLightHscEnv pkgOpts $ \env -> do
-      writeSymbolCache cache =<< getGlobalSymbolTable env
-
-  return $ unlines [cache]
-  where
-    cache = dir </> symbolCacheFile
-
-writeSymbolCache :: FilePath
-                 -> Map Symbol (Set ModuleNameBS)
-                 -> IO ()
-writeSymbolCache cache sm =
-  void . withFile cache WriteMode $ \hdl ->
-    LBS.hPutStr hdl (encode sm)
+-- | Dumps a 'Binary' representation of 'SymbolDb' to stdout
+dumpSymbol :: IOish m => GhcModT m ()
+dumpSymbol = do
+  ts <- liftIO getCurrentModTime
+  st <- runGmPkgGhc $ (liftIO . getGlobalSymbolTable) =<< G.getSession
+  liftIO . LBS.putStr $ encode SymbolDb {
+      sdTable = st
+    , sdTimestamp = ts
+    }

 -- | Check whether given file is older than any file from the given set.
 -- Returns True if given file does not exist.
-isOlderThan :: FilePath -> [TimedFile] -> IO Bool
-isOlderThan cache files = do
-  exist <- doesFileExist cache
-  if not exist
-  then return True
-  else do
-    tCache <- getModTime cache
-    return $ any (tCache <=) $ map tfTime files -- including equal just in case
+isOlderThan :: ModTime -> [TimedFile] -> Bool
+isOlderThan tCache files =
+  any (tCache <=) $ map tfTime files -- including equal just in case

 -- | Browsing all functions in all system modules.
 getGlobalSymbolTable :: HscEnv -> IO (Map Symbol (Set ModuleNameBS))
@@ -187,30 +162,29 @@ mkFastStringByteString' = mkFastStringByteString

 ----------------------------------------------------------------

-data AsyncSymbolDb = AsyncSymbolDb FilePath (MVar (Either SomeException SymbolDb))
+data AsyncSymbolDb = AsyncSymbolDb (MVar (Either SomeException SymbolDb))

 asyncLoadSymbolDb :: IOish m
-                  => FilePath
-                  -> MVar (Either SomeException SymbolDb)
+                  => MVar (Either SomeException SymbolDb)
                  -> GhcModT m ()
-asyncLoadSymbolDb tmpdir mv = void $
+asyncLoadSymbolDb mv = void $
    liftBaseWith $ \run -> forkIO $ void $ run $ do
-      edb <- gtry $ loadSymbolDb tmpdir
+      edb <- gtry loadSymbolDb
      liftIO $ putMVar mv edb

-newAsyncSymbolDb :: IOish m => FilePath -> GhcModT m AsyncSymbolDb
-newAsyncSymbolDb tmpdir = do
+newAsyncSymbolDb :: IOish m => GhcModT m AsyncSymbolDb
+newAsyncSymbolDb = do
    mv <- liftIO newEmptyMVar
-    asyncLoadSymbolDb tmpdir mv
-    return $ AsyncSymbolDb tmpdir mv
+    asyncLoadSymbolDb mv
+    return $ AsyncSymbolDb mv

 getAsyncSymbolDb :: forall m. IOish m => AsyncSymbolDb -> GhcModT m SymbolDb
-getAsyncSymbolDb (AsyncSymbolDb tmpdir mv) = do
+getAsyncSymbolDb (AsyncSymbolDb mv) = do
  db <- liftIO $ handleEx <$> takeMVar mv
  outdated <- isOutdated db
  if outdated
    then do
-      asyncLoadSymbolDb tmpdir mv
+      asyncLoadSymbolDb mv
      liftIO $ handleEx <$> readMVar mv
    else do
      liftIO $ putMVar mv $ Right db
--- a/Language/Haskell/GhcMod/Gap.hs
+++ b/Language/Haskell/GhcMod/Gap.hs
@@ -101,6 +101,11 @@ import Module
 import qualified Data.IntSet as I (IntSet, empty)
 #endif

+#if __GLASGOW_HASKELL__ < 706
+import Control.DeepSeq (NFData(rnf))
+import Data.ByteString.Lazy.Internal (ByteString(..))
+#endif
+
 import Bag
 import Lexer as L
 import Parser
@@ -564,3 +569,9 @@ mkErrStyle' = Outputable.mkErrStyle
 #else
 mkErrStyle' _ = Outputable.mkErrStyle
 #endif
+
+#if __GLASGOW_HASKELL__ < 706
+instance NFData ByteString where
+  rnf Empty       = ()
+  rnf (Chunk _ b) = rnf b
+#endif
--- a/Language/Haskell/GhcMod/Logging.hs
+++ b/Language/Haskell/GhcMod/Logging.hs
@@ -45,11 +45,11 @@ gmSetLogLevel :: GmLog m => GmLogLevel -> m ()
 gmSetLogLevel level =
    gmlJournal $ GhcModLog (Just level) (Last Nothing) []

-gmGetLogLevel :: forall m. GmLog m => m GmLogLevel 
+gmGetLogLevel :: forall m. GmLog m => m GmLogLevel
 gmGetLogLevel = do
  GhcModLog { gmLogLevel = Just level } <-  gmlHistory
  return level
-               
+
 gmSetDumpLevel :: GmLog m => Bool -> m ()
 gmSetDumpLevel level =
    gmlJournal $ GhcModLog Nothing (Last (Just level)) []
@@ -76,18 +76,19 @@ gmLog level loc' doc = do

  let loc | loc' == "" = empty
          | otherwise = text loc' <+>: empty
-      msgDoc = gmLogLevelDoc level <+>: sep [loc, doc]
-      msg = dropWhileEnd isSpace $ gmRenderDoc msgDoc
+      msgDoc = sep [loc, doc]
+      msg = dropWhileEnd isSpace $ gmRenderDoc $ gmLogLevelDoc level <+>: msgDoc

  when (level <= level') $ gmErrStrLn msg
+  gmLogQuiet level loc' doc

-  gmlJournal (GhcModLog Nothing (Last Nothing) [(level, loc', msgDoc)])
+gmLogQuiet :: GmLog m => GmLogLevel -> String -> Doc -> m ()
+gmLogQuiet level loc doc =
+  gmlJournal (GhcModLog Nothing (Last Nothing) [(level, loc, doc)])

-- | Appends a collection of logs to the logging environment, with effects
-- | if their log level specifies it should
-gmAppendLog ::  (MonadIO m, GmLog m, GmOut m) => GhcModLog -> m ()
-gmAppendLog  GhcModLog { gmLogMessages } = (\(level, loc, msgDoc) -> gmLog level loc msgDoc) `mapM_` gmLogMessages
-    
+gmAppendLogQuiet :: GmLog m => GhcModLog -> m ()
+gmAppendLogQuiet GhcModLog { gmLogMessages } =
+    forM_ gmLogMessages $ \(level, loc, doc) -> gmLogQuiet level loc doc

 gmVomit :: (MonadIO m, GmLog m, GmOut m, GmEnv m) => String -> Doc -> String -> m ()
 gmVomit filename doc content = do
--- a/Language/Haskell/GhcMod/Monad.hs
+++ b/Language/Haskell/GhcMod/Monad.hs
@@ -108,10 +108,10 @@ runGhcModT :: IOish m
 runGhcModT opt action = liftIO (getCurrentDirectory >>= canonicalizePath) >>= \dir' -> do
    runGmOutT opt $
      withGhcModEnv dir' opt $ \(env,lg) ->
-        first (fst <$>) <$> runGhcModT' env defaultGhcModState
-          (gmSetLogLevel (ooptLogLevel $ optOutput opt) >>
-           gmAppendLog lg >>
-           action)
+        first (fst <$>) <$> runGhcModT' env defaultGhcModState (do
+          gmSetLogLevel (ooptLogLevel $ optOutput opt)
+          gmAppendLogQuiet lg
+          action)

 -- | @hoistGhcModT result@. Embed a GhcModT computation's result into a GhcModT
 -- computation. Note that if the computation that returned @result@ modified the
--- a/Language/Haskell/GhcMod/Monad/Log.hs
+++ b/Language/Haskell/GhcMod/Monad/Log.hs
@@ -62,7 +62,7 @@ instance (Monad m, GmLog m, Error e) => GmLog (ErrorT e m) where
    gmlHistory = lift gmlHistory
    gmlClear = lift gmlClear

-instance (Monad m, GmLog m) => GmLog (MaybeT  m) where
+instance (Monad m, GmLog m) => GmLog (MaybeT m) where
    gmlJournal = lift . gmlJournal
    gmlHistory = lift gmlHistory
    gmlClear = lift gmlClear
--- a/Language/Haskell/GhcMod/Monad/Types.hs
+++ b/Language/Haskell/GhcMod/Monad/Types.hs
@@ -73,6 +73,8 @@ import Language.Haskell.GhcMod.Monad.Out
 import Language.Haskell.GhcMod.Monad.Newtypes
 import Language.Haskell.GhcMod.Monad.Orphans ()

+import Safe
+
 import GHC
 import DynFlags
 import Exception
@@ -84,6 +86,7 @@ import Control.Monad
 import Control.Monad.Reader (ReaderT(..))
 import Control.Monad.State.Strict (StateT(..))
 import Control.Monad.Trans.Journal (JournalT)
+import Control.Monad.Trans.Maybe (MaybeT)

 import Control.Monad.Trans.Control

@@ -112,14 +115,16 @@ instance (MonadIO m, MonadBaseControl IO m) => GhcMonad (GmlT m) where
    getSession = gmlGetSession
    setSession = gmlSetSession

+-- | Get the underlying GHC session
 gmlGetSession :: (MonadIO m, MonadBaseControl IO m) => GmlT m HscEnv
 gmlGetSession = do
-        ref <- gmgsSession . fromJust . gmGhcSession <$> gmsGet
+        ref <- gmgsSession . fromJustNote "gmlGetSession" . gmGhcSession <$> gmsGet
        liftIO $ readIORef ref

+-- | Set the underlying GHC session
 gmlSetSession :: (MonadIO m, MonadBaseControl IO m) => HscEnv -> GmlT m ()
 gmlSetSession a = do
-        ref <- gmgsSession . fromJust . gmGhcSession <$> gmsGet
+        ref <- gmgsSession . fromJustNote "gmlSetSession" . gmGhcSession <$> gmsGet
        liftIO $ flip writeIORef a ref

 instance GhcMonad LightGhc where
@@ -186,6 +191,13 @@ instance (Monoid w, MonadIO m, MonadBaseControl IO m) => ExceptionMonad (Journal
    gmask = liftBaseOp gmask . liftRestore
     where liftRestore f r = f $ liftBaseOp_ r

+instance (MonadIO m, MonadBaseControl IO m) => ExceptionMonad (MaybeT m) where
+    gcatch act handler = control $ \run ->
+        run act `gcatch` (run . handler)
+
+    gmask = liftBaseOp gmask . liftRestore
+     where liftRestore f r = f $ liftBaseOp_ r
+

 ----------------------------------------------------------------

--- a/Language/Haskell/GhcMod/Output.hs
+++ b/Language/Haskell/GhcMod/Output.hs
@@ -17,6 +17,7 @@
 -- Derived from process:System.Process
 -- Copyright (c) The University of Glasgow 2004-2008

+{-# LANGUAGE FlexibleInstances #-}
 module Language.Haskell.GhcMod.Output (
    gmPutStr
  , gmErrStr
@@ -27,12 +28,15 @@ module Language.Haskell.GhcMod.Output (
  , gmErrStrIO

  , gmReadProcess
+  , gmReadProcess'

  , stdoutGateway
  , flushStdoutGateway
  ) where

 import Data.List
+import Data.ByteString.Lazy (ByteString)
+import qualified Data.ByteString.Lazy as BS
 import qualified Data.Label as L
 import qualified Data.Label.Base as LB
 import System.IO
@@ -51,6 +55,16 @@ import Prelude

 import Language.Haskell.GhcMod.Types hiding (LineSeparator, MonadIO(..))
 import Language.Haskell.GhcMod.Monad.Types hiding (MonadIO(..))
+import Language.Haskell.GhcMod.Gap ()
+
+class ProcessOutput a where
+  hGetContents' :: Handle -> IO a
+
+instance ProcessOutput String where
+  hGetContents' = hGetContents
+
+instance ProcessOutput ByteString where
+  hGetContents' = BS.hGetContents

 outputFns :: (GmOut m, MonadIO m')
          => m (String -> m' (), String -> m' ())
@@ -108,6 +122,9 @@ gmReadProcess = do
    Nothing ->
        return $ readProcess

+gmReadProcess' :: GmOut m => m (FilePath -> [String] -> String -> IO ByteString)
+gmReadProcess' = readProcessStderrChan
+
 flushStdoutGateway :: Chan (Either (MVar ()) (GmStream, String)) -> IO ()
 flushStdoutGateway c = do
  mv <- newEmptyMVar
@@ -175,17 +192,14 @@ zoom l (StateT a) =
      return (a', L.set l s' f)

 readProcessStderrChan ::
-    GmOut m => m (FilePath -> [String] -> String -> IO String)
+    (GmOut m, ProcessOutput a, NFData a) => m (FilePath -> [String] -> String -> IO a)
 readProcessStderrChan = do
  (_, e :: String -> IO ()) <- outputFns
  return $ readProcessStderrChan' e

-readProcessStderrChan' ::
-    (String -> IO ()) -> FilePath -> [String] -> String -> IO String
-readProcessStderrChan' pute = go pute
- where
-   go :: (String -> IO ()) -> FilePath -> [String] -> String -> IO String
-   go putErr exe args input = do
+readProcessStderrChan' :: (ProcessOutput a, NFData a) =>
+    (String -> IO ()) -> FilePath -> [String] -> String -> IO a
+readProcessStderrChan' putErr exe args input = do
     let cp = (proc exe args) {
                std_out = CreatePipe
              , std_err = CreatePipe
@@ -195,7 +209,7 @@ readProcessStderrChan' pute = go pute

     _ <- forkIO $ reader e

-     output  <- hGetContents o
+     output  <- hGetContents' o
     withForkWait (evaluate $ rnf output) $ \waitOut -> do

       -- now write any input
--- a/Language/Haskell/GhcMod/Stack.hs
+++ b/Language/Haskell/GhcMod/Stack.hs
@@ -16,7 +16,7 @@

 module Language.Haskell.GhcMod.Stack where

-
+import Safe
 import Control.Applicative
 import Control.Exception as E
 import Control.Monad
@@ -33,6 +33,8 @@ import Exception
 import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Monad.Types
 import Language.Haskell.GhcMod.Output
+import Language.Haskell.GhcMod.Logging
+import Language.Haskell.GhcMod.Error
 import qualified Language.Haskell.GhcMod.Utils as U
 import Prelude

@@ -46,10 +48,10 @@ patchStackPrograms Cradle { cradleProject = (StackProject senv) } progs = do
    }
 patchStackPrograms _crdl progs = return progs

-getStackEnv :: (IOish m, GmOut m) => FilePath -> m (Maybe StackEnv)
+getStackEnv :: (IOish m, GmOut m, GmLog m) => FilePath -> m (Maybe StackEnv)
 getStackEnv projdir = U.withDirectory_ projdir $ runMaybeT $ do
    env <- map (liToTup . splitOn ": ") . lines <$> readStack ["path"]
-    let look k = fromJust $ lookup k env
+    let look k = fromJustNote "getStackEnv" $ lookup k env
    return StackEnv {
        seDistDir       = look "dist-dir"
      , seBinPath       = splitSearchPath $ look "bin-path"
@@ -80,11 +82,14 @@ findExecutablesInDirectories' path binary =

         exeExtension = if isWindows then "exe" else ""

-readStack :: (IOish m, GmOut m) => [String] -> MaybeT m String
+readStack :: (IOish m, GmOut m, GmLog m) => [String] -> MaybeT m String
 readStack args = do
  stack <- MaybeT $ liftIO $ findExecutable "stack"
  readProc <- lift gmReadProcess
-  lift $ flip gcatch (\(e :: IOError) -> exToErr e) $ do
+  flip gcatch handler $ do
    liftIO $ evaluate =<< readProc stack args ""
 where
-   exToErr = throw . GMEStackBootstrap . GMEString . show
+   handler (e :: IOError) = do
+     gmLog GmWarning "readStack" $ gmeDoc $ exToErr e
+     mzero
+   exToErr = GMEStackBootstrap . GMEString . show
--- a/Language/Haskell/GhcMod/Target.hs
+++ b/Language/Haskell/GhcMod/Target.hs
@@ -40,6 +40,7 @@ import Language.Haskell.GhcMod.LightGhc
 import Language.Haskell.GhcMod.CustomPackageDb
 import Language.Haskell.GhcMod.Output

+import Safe
 import Data.Maybe
 import Data.Monoid as Monoid
 import Data.Either
@@ -104,10 +105,13 @@ dropSession = do

    Nothing -> return ()

-
+-- | Run a GmlT action (i.e. a function in the GhcMonad) in the context
+-- of certain files or modules
 runGmlT :: IOish m => [Either FilePath ModuleName] -> GmlT m a -> GhcModT m a
 runGmlT fns action = runGmlT' fns return action

+-- | Run a GmlT action (i.e. a function in the GhcMonad) in the context
+-- of certain files or modules, with updated GHC flags
 runGmlT' :: IOish m
              => [Either FilePath ModuleName]
              -> (DynFlags -> Ghc DynFlags)
@@ -115,6 +119,9 @@ runGmlT' :: IOish m
              -> GhcModT m a
 runGmlT' fns mdf action = runGmlTWith fns mdf id action

+-- | Run a GmlT action (i.e. a function in the GhcMonad) in the context
+-- of certain files or modules, with updated GHC flags and a final
+-- transformation
 runGmlTWith :: IOish m
                 => [Either FilePath ModuleName]
                 -> (DynFlags -> Ghc DynFlags)
@@ -182,13 +189,13 @@ targetGhcOptions crdl sefnmn = do
            let cns = filter (/= ChSetupHsName) $ Map.keys mcs

            gmLog GmDebug "" $ strDoc $ "Could not find a component assignment, falling back to picking library component in cabal file."
-            return $ gmcGhcOpts $ fromJust $ Map.lookup (head cns) mcs
+            return $ gmcGhcOpts $ fromJustNote "targetGhcOptions, no-assignment" $ Map.lookup (head cns) mcs
          else do
            when noCandidates $
              throwError $ GMECabalCompAssignment mdlcs

            let cn = pickComponent candidates
-            return $ gmcGhcOpts $ fromJust $ Map.lookup cn mcs
+            return $ gmcGhcOpts $ fromJustNote "targetGhcOptions" $ Map.lookup cn mcs

 resolvedComponentsCache :: IOish m => FilePath ->
    Cached (GhcModT m) GhcModState
--- a/Language/Haskell/GhcMod/Types.hs
+++ b/Language/Haskell/GhcMod/Types.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, RankNTypes,
-  StandaloneDeriving, DefaultSignatures, FlexibleInstances, TemplateHaskell #-}
+  StandaloneDeriving, DefaultSignatures, FlexibleInstances, TemplateHaskell,
+  GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-deprecations #-}
 module Language.Haskell.GhcMod.Types (
    module Language.Haskell.GhcMod.Types
@@ -15,6 +16,7 @@ import Control.Exception (Exception)
 import Control.Applicative
 import Control.Concurrent
 import Control.Monad
+import Control.DeepSeq
 import Data.Binary
 import Data.Binary.Generic
 import Data.Map (Map)
@@ -232,7 +234,7 @@ newtype Expression = Expression { getExpression :: String }

 -- | Module name.
 newtype ModuleString = ModuleString { getModuleString :: String }
-  deriving (Show, Read, Eq, Ord)
+  deriving (Show, Eq, Ord, Binary, NFData)

 data GmLogLevel =
    GmSilent