content: {-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, ScopedTypeVariables, TemplateHaskell, OverloadedStrings #-}
  -- | IDE session updates
  --
  -- We should only be using internal types here (explicit strictness/sharing)
  module IdeSession.Update (
      -- * Starting and stopping
      initSession
    , initSessionWithCallbacks
    , SessionInitParams(..)
    , defaultSessionInitParams
    , shutdownSession
    , forceShutdownSession
    , restartSession
      -- * Session updates
    , IdeSessionUpdate -- Abstract
    , updateSession
    , updateSourceFile
    , updateSourceFileFromFile
    , updateSourceFileDelete
    , updateGhcOpts
    , updateRtsOpts
    , updateRelativeIncludes
    , updateCodeGeneration
    , updateDataFile
    , updateDataFileFromFile
    , updateDataFileDelete
    , updateDeleteManagedFiles
    , updateEnv
    , updateArgs
    , updateStdoutBufferMode
    , updateStderrBufferMode
    , updateTargets
    , buildExe
    , buildDoc
    , buildLicenses
      -- * Running code
    , runStmt
    , runStmtPty
    , runExe
    , resume
    , setBreakpoint
    , printVar
      -- * Debugging
    , crashGhcServer
    , buildLicsFromPkgs
    , LicenseArgs(..)
    )
    where
  
  import Prelude hiding (mod, span)
  import Control.Concurrent (threadDelay)
  import Control.Monad (when, unless)
  import Control.Monad.IO.Class (liftIO)
  import Data.Accessor (Accessor, (^.))
  import Data.List (elemIndices, isPrefixOf)
  import Data.Maybe (fromMaybe, isJust)
  import Data.Monoid (Monoid(..), (<>))
  import Distribution.Simple (PackageDBStack, PackageDB(..))
  import System.Environment (getEnvironment, unsetEnv, lookupEnv)
  import System.Exit (ExitCode(..))
  import System.FilePath ((</>))
  import System.IO.Temp (createTempDirectory)
  import System.IO (IOMode(..))
  import System.Process (proc, CreateProcess(..), StdStream(..), createProcess, waitForProcess, interruptProcessGroupOf, terminateProcess)
  import qualified Control.Exception         as Ex
  import qualified Data.ByteString           as BSS
  import qualified Data.ByteString.Lazy      as BSL
  import qualified Data.ByteString.Lazy.UTF8 as BSL.UTF8
  import qualified Data.Set                  as Set
  import qualified Data.Text                 as Text
  import qualified System.Directory          as Dir
  import qualified System.IO                 as IO
  
  import IdeSession.Cabal
  import IdeSession.Config
  import IdeSession.GHC.API
  import IdeSession.GHC.Client
  import IdeSession.RPC.API (ExternalException(..))
  import IdeSession.State
  import IdeSession.Strict.Container
  import IdeSession.Strict.MVar (newMVar, newEmptyMVar, StrictMVar)
  import IdeSession.Types.Private hiding (RunResult(..))
  import IdeSession.Types.Progress
  import IdeSession.Types.Public (RunBufferMode(..))
  import IdeSession.Update.ExecuteSessionUpdate
  import IdeSession.Update.IdeSessionUpdate
  import IdeSession.Util
  import IdeSession.Util.BlockingOps
  import IdeSession.Util.Logger
  import IdeSession.Util.PortableIO
  import IdeSession.Util.PortableFiles (moduleNameToExeName)
  import qualified IdeSession.Query         as Query
  import qualified IdeSession.Strict.List   as List
  import qualified IdeSession.Strict.Map    as Map
  import qualified IdeSession.Strict.Maybe  as Maybe
  import qualified IdeSession.Types.Private as Private
  import qualified IdeSession.Types.Public  as Public
  
  {-------------------------------------------------------------------------------
    Session initialization
  -------------------------------------------------------------------------------}
  
  -- | How should the session be initialized?
  --
  -- Client code should use 'defaultSessionInitParams' to protect itself against
  -- future extensions of this record.
  data SessionInitParams = SessionInitParams {
      -- | Previously computed cabal macros,
      -- or 'Nothing' to compute them on startup
      sessionInitCabalMacros :: Maybe BSL.ByteString
  
      -- | Initial ghc options
    , sessionInitGhcOptions :: [String]
  
      -- | Include paths (equivalent of GHC's @-i@ parameter) relative to the
      -- temporary directory where we store the session's source files.
      --
      -- By default this is the singleton list @[""]@ -- i.e., we include the
      -- sources dir but nothing else.
    , sessionInitRelativeIncludes :: [FilePath]
  
      -- | Targets for compilation
      --
      -- Defaults to @TargetsExclude []@ -- i.e., compile all modules in the
      -- project.
    , sessionInitTargets :: Public.Targets
  
      -- | RTS options
      --
      -- Defaults to @-K8M@
    , sessionInitRtsOpts :: [String]
  
      -- | dist/ directory.
    , sessionInitDistDir :: !(Maybe FilePath)
    }
    deriving Show
  
  defaultSessionInitParams :: SessionInitParams
  defaultSessionInitParams = SessionInitParams {
      sessionInitCabalMacros      = Nothing
    , sessionInitGhcOptions       = []
    , sessionInitRelativeIncludes = [""]
    , sessionInitTargets          = Public.TargetsExclude []
    , sessionInitRtsOpts          = ["-K8M"]
    , sessionInitDistDir          = Nothing
    }
  
  -- | Session initialization parameters for an existing session.
  --
  -- For internal use only (used in 'updateSession' when restarting the session).
  --
  -- We set 'sessionInitCabalMacros' to 'Nothing' because the cabal macros file
  -- has already been written to disk, and we don't remove the project directory
  -- on a session restart.
  sessionRestartParams :: IdeIdleState -> IdeSessionUpdate -> SessionInitParams
  sessionRestartParams st IdeSessionUpdate{..} = SessionInitParams {
      sessionInitCabalMacros      = Nothing
    , sessionInitGhcOptions       = fromMaybe (st ^. ideGhcOpts)          ideUpdateGhcOpts
    , sessionInitRelativeIncludes = fromMaybe (st ^. ideRelativeIncludes) ideUpdateRelIncls
    , sessionInitTargets          = fromMaybe (st ^. ideTargets)          ideUpdateTargets
    , sessionInitRtsOpts          = fromMaybe (st ^. ideRtsOpts)          ideUpdateRtsOpts
    , sessionInitDistDir          = Nothing
    }
  
  -- | Set up the initial state of the session according to the given parameters
  execInitParams :: IdeStaticInfo -> SessionInitParams -> IO ()
  execInitParams staticInfo SessionInitParams{..} = do
    writeMacros staticInfo sessionInitCabalMacros
  
  -- | Write per-package CPP macros.
  writeMacros :: IdeStaticInfo -> Maybe BSL.ByteString -> IO ()
  writeMacros IdeStaticInfo{ideConfig = SessionConfig {..}, ..}
              configCabalMacros = do
    macros <- case configCabalMacros of
                Nothing     -> generateMacros configPackageDBStack configExtraPathDirs
                Just macros -> return (BSL.UTF8.toString macros)
    writeFile (cabalMacrosLocation ideDistDir) macros
  
  {-------------------------------------------------------------------------------
    Session startup
  -------------------------------------------------------------------------------}
  
  -- | Create a fresh session, using some initial configuration.
  --
  -- Throws an exception if the configuration is invalid, or if GHC_PACKAGE_PATH
  -- is set.
  initSession :: SessionInitParams -> SessionConfig -> IO IdeSession
  initSession = initSessionWithCallbacks defaultIdeCallbacks
  
  -- | Like 'initSession', but also takes a 'IdeCallbacks'.
  --
  -- Since 0.10.0
  initSessionWithCallbacks :: IdeCallbacks -> SessionInitParams -> SessionConfig -> IO IdeSession
  initSessionWithCallbacks ideCallbacks initParams@SessionInitParams{..} ideConfig@SessionConfig{..} = do
    let logFunc = ideCallbacksLogFunc ideCallbacks
    --FIXME: add version info here.
    $logInfo "Initializing ide-backend session"
    -- verifyConfig used to bail if GHC_PACKAGE_PATH was set.  Instead,
    -- we just unset it so that cabal invocations are happy.  It's up to
    -- the user of ide-backend to set 'configPackageDBStack' based on
    -- this environment variable.
    mpath <- lookupEnv "GHC_PACKAGE_PATH"
    when (isJust mpath) $ do
      $logWarn "ide-backend doesn't pay attention to GHC_PACKAGE_PATH, but it is set in the environment"
      unsetEnv "GHC_PACKAGE_PATH"
    verifyConfig ideConfig
  
    configDirCanon <- Dir.canonicalizePath configDir
    ideSessionDir  <- createTempDirectory configDirCanon "session."
    $logDebug $ "Session dir = " <> Text.pack ideSessionDir
    let ideDistDir = fromMaybe (ideSessionDir </> "dist/") sessionInitDistDir
    $logDebug $ "Dist dir = " <> Text.pack ideDistDir
  
    let ideStaticInfo = IdeStaticInfo{..}
  
    -- Create the common subdirectories of session.nnnn so that we don't have to
    -- worry about creating these elsewhere
    case configLocalWorkingDir of
      Just dir -> $logDebug $ "Local working dir = " <> Text.pack dir
      Nothing -> do
        Dir.createDirectoryIfMissing True (ideSourceDir  ideStaticInfo)
        Dir.createDirectoryIfMissing True (ideDataDir    ideStaticInfo)
    Dir.createDirectoryIfMissing True ideDistDir
    Dir.createDirectoryIfMissing True (ideSessionObjDir  ideSessionDir)
    -- Local initialization
    execInitParams ideStaticInfo initParams
  
    -- Start the GHC server (as a separate process)
    mServer <- forkGhcServer sessionInitGhcOptions
                             sessionInitRelativeIncludes
                             sessionInitRtsOpts
                             ideStaticInfo
                             ideCallbacks
    let (state, server, version) = case mServer of
           Right (s, v) -> (IdeSessionIdle,         s,          v)
           Left e       -> (IdeSessionServerDied e, Ex.throw e, Ex.throw e)
  
    -- The value of _ideLogicalTimestamp field is a workaround for
    -- the problems with 'invalidateModSummaryCache', which itself is
    -- a workaround for http://hackage.haskell.org/trac/ghc/ticket/7478.
    -- We have to make sure that file times never reach 0, because this will
    -- trigger an exception (http://hackage.haskell.org/trac/ghc/ticket/7567).
    -- We rather arbitrary start at Jan 2, 1970.
    let idleState = IdeIdleState {
            _ideLogicalTimestamp    = 86400
          , _ideComputed            = Maybe.nothing
          , _ideGenerateCode        = False
          , _ideManagedFiles        = ManagedFilesInternal [] []
          , _ideObjectFiles         = []
          , _ideBuildExeStatus      = Nothing
          , _ideBuildDocStatus      = Nothing
          , _ideBuildLicensesStatus = Nothing
          , _ideEnv                 = []
          , _ideArgs                = []
          , _ideStdoutBufferMode    = RunNoBuffering
          , _ideStderrBufferMode    = RunNoBuffering
          , _ideBreakInfo           = Maybe.nothing
          , _ideGhcServer           = server
          , _ideGhcVersion          = version
          , _ideGhcOpts             = sessionInitGhcOptions
          , _ideRelativeIncludes    = sessionInitRelativeIncludes
          , _ideTargets             = sessionInitTargets
          , _ideRtsOpts             = sessionInitRtsOpts
          }
  
    ideState <- newMVar (state idleState)
    return IdeSession{..}
  
  -- | Verify configuration, and throw an exception if configuration is invalid
  verifyConfig :: SessionConfig -> IO ()
  verifyConfig SessionConfig{..} = do
      unless (isValidPackageDB configPackageDBStack) $
        Ex.throw . userError $ "Invalid package DB stack: "
                               ++ show configPackageDBStack
    where
      isValidPackageDB :: PackageDBStack -> Bool
      isValidPackageDB stack =
            elemIndices GlobalPackageDB stack == [0]
         && elemIndices UserPackageDB stack `elem` [[], [1]]
  
  {-------------------------------------------------------------------------------
    Session shutdown
  -------------------------------------------------------------------------------}
  
  -- | Close a session down, releasing the resources.
  --
  -- This operation is the only one that can be run after a shutdown was already
  -- performed. This lets the API user execute an early shutdown, e.g., before
  -- the @shutdownSession@ placed inside 'bracket' is triggered by a normal
  -- program control flow.
  --
  -- If code is still running, it will be interrupted.
  shutdownSession :: IdeSession -> IO ()
  shutdownSession = shutdownSession' False
  
  -- | Like shutdownSession, but don't be nice about it (SIGKILL)
  forceShutdownSession :: IdeSession -> IO ()
  forceShutdownSession = shutdownSession' True
  
  -- | Internal generalization of 'shutdownSession' and 'forceShutdownSession'
  shutdownSession' :: Bool -> IdeSession -> IO ()
  shutdownSession' forceTerminate IdeSession{ideState, ideStaticInfo} = do
    $modifyStrictMVar_ ideState $ \state ->
      case state of
        IdeSessionIdle idleState -> do
          if forceTerminate
            then forceShutdownGhcServer $ _ideGhcServer idleState
            else shutdownGhcServer      $ _ideGhcServer idleState
          cleanupDirs
          return IdeSessionShutdown
        IdeSessionShutdown ->
          return IdeSessionShutdown
        IdeSessionServerDied _ _ -> do
          cleanupDirs
          return IdeSessionShutdown
    where
      cleanupDirs :: IO ()
      cleanupDirs =
        when (configDeleteTempFiles . ideConfig $ ideStaticInfo) $
          ignoreDoesNotExist $
            Dir.removeDirectoryRecursive (ideSessionDir ideStaticInfo)
  
  {-------------------------------------------------------------------------------
    Session restart
  -------------------------------------------------------------------------------}
  
  -- | Restart a session
  --
  -- This puts the session in a "dead" state; it won't _actually_ be restarted
  -- until the next call to 'updateSession'.
  restartSession :: IdeSession -> IO ()
  restartSession IdeSession{ideState} =
    $modifyStrictMVar_ ideState $ \state ->
      case state of
        IdeSessionIdle idleState ->
          return $ IdeSessionServerDied forcedRestart idleState
        IdeSessionServerDied _ _ ->
          return state -- Leave Died state as is
        IdeSessionShutdown ->
          fail "Shutdown session cannot be restarted."
  
  data RestartResult =
      ServerRestarted IdeIdleState IdeSessionUpdate
    | ServerRestartFailed IdeIdleState
  
  executeRestart :: SessionInitParams
                 -> IdeStaticInfo
                 -> IdeCallbacks
                 -> IdeIdleState
                 -> IO RestartResult
  executeRestart initParams@SessionInitParams{..} staticInfo ideCallbacks idleState = do
    let logFunc = ideCallbacksLogFunc ideCallbacks
    $logInfo "Restarting ide-backend-server"
    forceShutdownGhcServer $ _ideGhcServer idleState
    mServer <- forkGhcServer sessionInitGhcOptions
                             sessionInitRelativeIncludes
                             sessionInitRtsOpts
                             staticInfo
                             ideCallbacks
  
    case mServer of
      Right (server, version) -> do
        execInitParams staticInfo initParams
  
        -- Reset back to initial values ..
        let idleState' = idleState {
                _ideComputed         = Maybe.nothing
              , _ideGhcOpts          = sessionInitGhcOptions
              , _ideRelativeIncludes = sessionInitRelativeIncludes
              , _ideRtsOpts          = sessionInitRtsOpts
              , _ideGenerateCode     = False
              , _ideObjectFiles      = []
              , _ideEnv              = []
              , _ideArgs             = []
              , _ideGhcServer        = server
              , _ideGhcVersion       = version
              , _ideTargets          = sessionInitTargets
              }
        -- .. and let an update make sure we bring the state back to where it was
        let upd = mconcat [
                updateEnv            (idleState ^. ideEnv)
              , updateArgs           (idleState ^. ideArgs)
              , updateCodeGeneration (idleState ^. ideGenerateCode)
              ]
        return (ServerRestarted idleState' upd)
      Left e -> do
        let idleState' = idleState {
                _ideGhcServer  = Ex.throw e
              , _ideGhcVersion = Ex.throw e
              }
        return (ServerRestartFailed idleState')
  
  {-------------------------------------------------------------------------------
    Session update
  
    Here we deal only with the top-level logic: restart the session and then run
    the session update. The specifics of how to execute the individual parts
    of the session update are defined in IdeSession.Update.ExecuteSessionUpdate.
  -------------------------------------------------------------------------------}
  
  -- | Given the current IDE session state, go ahead and update the session,
  -- eventually resulting in a new session state, with fully updated computed
  -- information (typing, etc.).
  --
  -- The update can be a long running operation, so we support a callback which
  -- can be used to monitor progress of the operation.
  updateSession :: IdeSession -> IdeSessionUpdate -> (Public.UpdateStatus -> IO ()) -> IO ()
  updateSession = flip . updateSession'
  
  updateSession' :: IdeSession -> (Public.UpdateStatus -> IO ()) -> IdeSessionUpdate -> IO ()
  updateSession' IdeSession{ideStaticInfo, ideState, ideCallbacks} updateStatus = \update ->
      $modifyStrictMVar_ ideState $ go False update
    where
      logFunc = ideCallbacksLogFunc ideCallbacks
      go :: Bool -> IdeSessionUpdate -> IdeSessionState -> IO IdeSessionState
      go justRestarted update (IdeSessionIdle idleState) =
        if not (requiresSessionRestart idleState update)
          then do
            (idleState', mex) <- runSessionUpdate justRestarted update ideStaticInfo updateStatus ideCallbacks idleState
            case mex of
              Nothing -> do
                updateStatus Public.UpdateStatusDone
                return $ IdeSessionIdle idleState'
              Just ex -> do
                updateStatus $ Public.UpdateStatusFailed (Text.pack (show ex))
                return $ IdeSessionServerDied ex idleState'
          else do
            $logInfo $ "Restarting session due to update requiring it."
            unless justRestarted $ updateStatus Public.UpdateStatusRequiredRestart
            let restartParams = sessionRestartParams idleState update
            restart justRestarted update restartParams idleState
      go justRestarted update (IdeSessionServerDied ex idleState) = do
        let msg = Text.pack (show ex)
        $logInfo $ "Restarting session due to server dieing: " <> msg
        unless justRestarted $ updateStatus (Public.UpdateStatusErrorRestart msg)
        let restartParams = sessionRestartParams idleState update
        restart justRestarted update restartParams idleState
      go _ _ IdeSessionShutdown =
        Ex.throwIO (userError "Session already shut down.")
  
      restart :: Bool -> IdeSessionUpdate -> SessionInitParams -> IdeIdleState -> IO IdeSessionState
      restart True _ _ idleState =
        return $ IdeSessionServerDied serverRestartLoop idleState
      restart False update restartParams idleState = do
        -- To avoid "<stdout> hPutChar: resource vanished (Broken pipe)":
        -- TODO: I wish I knew why this is necessary :(
        threadDelay 100000
  
        restartResult <- executeRestart restartParams ideStaticInfo ideCallbacks idleState
        case restartResult of
          ServerRestarted idleState' resetSession ->
            go True (resetSession <> update) (IdeSessionIdle idleState')
          ServerRestartFailed idleState' -> do
            updateStatus Public.UpdateStatusFailedToRestart
            return $ IdeSessionServerDied failedToRestart idleState'
  
  -- | @requiresSessionRestart st upd@ returns true if update @upd@ requires a
  -- session restart given current state @st@.
  --
  -- See 'sessionRestartParams' to compute the session initialization parameters
  -- for the new session.
  requiresSessionRestart :: IdeIdleState -> IdeSessionUpdate -> Bool
  requiresSessionRestart st IdeSessionUpdate{..} =
           (ideUpdateRelIncls `changes` ideRelativeIncludes)
        || (ideUpdateTargets  `changes` ideTargets)
        || (ideUpdateRtsOpts  `changes` ideRtsOpts)
        || (any optRequiresRestart (listChanges' ideUpdateGhcOpts ideGhcOpts))
    where
      optRequiresRestart :: String -> Bool
      optRequiresRestart str =
           -- Library flags cannot be changed dynamically (#214)
           "-l" `isPrefixOf` str
  
      changes :: Eq a => Maybe a -> Accessor IdeIdleState a -> Bool
      changes Nothing  _ = False
      changes (Just x) y = x /= st ^. y
  
      listChanges' :: Ord a => Maybe [a] -> Accessor IdeIdleState [a] -> [a]
      listChanges' Nothing   _  = []
      listChanges' (Just xs) ys = listChanges xs (st ^. ys)
  
  -- | @listChanges xs ys@ is the list of elements that appear in @xs@ but not
  -- in @ys@ and the set of elements that appear in @ys@ but not in @xs@.
  --
  -- Considering the lists as sets, it is the complement of the intersection
  -- between the two sets.
  listChanges :: Ord a => [a] -> [a] -> [a]
  listChanges xs ys =
      Set.toList $ (a `Set.union` b) `Set.difference` (a `Set.intersection` b)
    where
      a = Set.fromList xs
      b = Set.fromList ys
  
  {-------------------------------------------------------------------------------
    Running code
  -------------------------------------------------------------------------------}
  
  -- | Run a given function in a given module (the name of the module
  -- is the one between @module ... end@, which may differ from the file name).
  -- The function resembles a query, but it's not instantaneous
  -- and the running code can be interrupted or interacted with.
  --
  -- 'runStmt' will throw an exception if the code has not been compiled yet,
  -- or when the server is in a dead state (i.e., when ghc has crashed). In the
  -- latter case 'getSourceErrors' will report the ghc exception; it is the
  -- responsibility of the client code to check for this.
  runStmt :: IdeSession -> String -> String -> IO (RunActions Public.RunResult)
  runStmt ideSession m fun = runCmd ideSession $ \idleState -> RunStmt {
      runCmdModule   = m
    , runCmdFunction = fun
    , runCmdStdout   = idleState ^. ideStdoutBufferMode
    , runCmdStderr   = idleState ^. ideStderrBufferMode
    , runCmdPty      = False
    }
  
  -- | Like 'runStmt', but runs the statement in a pseudoterminal.
  runStmtPty :: IdeSession -> String -> String -> IO (RunActions Public.RunResult)
  runStmtPty ideSession m fun = runCmd ideSession $ \idleState -> RunStmt {
      runCmdModule   = m
    , runCmdFunction = fun
    , runCmdStdout   = idleState ^. ideStdoutBufferMode
    , runCmdStderr   = idleState ^. ideStderrBufferMode
    , runCmdPty      = True
    }
  
  -- | Run the main function from the last compiled executable.
  --
  -- 'runExe' will throw an exception if there were no executables
  -- compiled since session init, or if the last compilation was not
  -- successful (checked as in @getBuildExeStatus@)
  -- or if none of the executables last compiled have the supplied name
  -- or when the server is in a dead state (i.e., when ghc has crashed). In the
  -- last case 'getSourceErrors' will report the ghc exception; it is the
  -- responsibility of the client code to check for this.
  runExe :: IdeSession -> String -> IO (RunActions ExitCode)
  runExe session m = do
   let handleQueriesExc (_ :: Query.InvalidSessionStateQueries) =
         fail $ "Wrong session state when trying to run an executable."
   Ex.handle handleQueriesExc $ do
    mstatus <- Query.getBuildExeStatus session
    case mstatus of
      Nothing ->
        fail $ "No executable compilation initiated since session init."
      (Just status@ExitFailure{}) ->
        fail $ "Last executable compilation failed with status "
               ++ show status ++ "."
      Just ExitSuccess -> do
        distDir <- Query.getDistDir session
        dataDir <- Query.getDataDir session
        args <- Query.getArgs session
        envInherited <- getEnvironment
        envOverride <- Query.getEnv session
        let overrideVar :: (String, Maybe String) -> Strict (Map String) String
                        -> Strict (Map String) String
            overrideVar (var, Just val) env = Map.insert var val env
            overrideVar (var, Nothing) env = Map.delete var env
            envMap = foldr overrideVar (Map.fromList envInherited) envOverride
        let exePath = distDir </> "build" </> m </> moduleNameToExeName m
        exeExists <- Dir.doesFileExist exePath
        unless exeExists $
          fail $ "No compiled executable file "
                 ++ m ++ " exists at path "
                 ++ exePath ++ "."
        (stdRd, stdWr) <- liftIO createPipe
        std_rd_hdl <- fdToHandle stdRd ReadMode
        std_wr_hdl <- fdToHandle stdWr WriteMode
        let cproc = (proc exePath args) { cwd = Just dataDir
                                        , env = Just $ Map.toList envMap
                                        , create_group = True
                                            -- for interruptProcessGroupOf
                                        , std_in = CreatePipe
                                        , std_out = UseHandle std_wr_hdl
                                        , std_err = UseHandle std_wr_hdl
                                        }
        (Just stdin_hdl, Nothing, Nothing, ph) <- createProcess cproc
  
        -- The runActionState holds 'Just' the result of the snippet, or 'Nothing' if
        -- it has not yet terminated.
        runActionsState <- newMVar Nothing
  
        return $ RunActions
          { runWait = $modifyStrictMVar runActionsState $ \st -> case st of
              Just outcome ->
                return (Just outcome, Right outcome)
              Nothing -> do
                bs <- BSS.hGetSome std_rd_hdl blockSize
                if BSS.null bs
                  then do
                    res <- waitForProcess ph
                    return (Just res, Right res)
                  else
                    return (Nothing, Left bs)
          , interrupt = interruptProcessGroupOf ph
          , supplyStdin = \bs -> BSS.hPut stdin_hdl bs >> IO.hFlush stdin_hdl
          , forceCancel = terminateProcess ph
          }
        -- We don't need to close any handles. At the latest GC closes them.
   where
    -- TODO: What is a good value here?
    blockSize :: Int
    blockSize = 4096
  
  -- | Resume a previously interrupted statement
  resume :: IdeSession -> IO (RunActions Public.RunResult)
  resume ideSession = runCmd ideSession (const Resume)
  
  -- | Internal geneneralization used in 'runStmt' and 'resume'
  runCmd :: IdeSession -> (IdeIdleState -> RunCmd) -> IO (RunActions Public.RunResult)
  runCmd session mkCmd = modifyIdleState session $ \idleState ->
    case (toLazyMaybe (idleState ^. ideComputed), idleState ^. ideGenerateCode) of
      (Just comp, True) -> do
        let cmd = mkCmd idleState
  
        checkStateOk comp cmd
        isBreak    <- newEmptyMVar
        runActions <- rpcRun (idleState ^. ideGhcServer)
                             cmd
                             (translateRunResult isBreak)
  
        -- TODO: We should register the runActions somewhere so we can do a
        -- clean session shutdown?
        return (IdeSessionIdle idleState, runActions)
      _ ->
        -- This 'fail' invocation is, in part, a workaround for
        -- http://hackage.haskell.org/trac/ghc/ticket/7539
        -- which would otherwise lead to a hard GHC crash,
        -- instead of providing a sensible error message
        -- that we could show to the user.
        fail "Cannot run before the code is generated."
    where
      checkStateOk :: Computed -> RunCmd -> IO ()
      checkStateOk comp RunStmt{..} =
        -- ideManagedFiles is irrelevant, because only the module name inside
        -- 'module .. where' counts.
        unless (Text.pack runCmdModule `List.elem` computedLoadedModules comp) $
          fail $ "Module " ++ show runCmdModule
                           ++ " not successfully loaded, when trying to run code."
      checkStateOk _comp Resume =
        -- TODO: should we check that there is anything to resume here?
        return ()
  
      translateRunResult :: StrictMVar (Strict Maybe BreakInfo)
                         -> Maybe Private.RunResult
                         -> IO Public.RunResult
      translateRunResult isBreak (Just Private.RunOk) = do
        $putStrictMVar isBreak Maybe.nothing
        return $ Public.RunOk
      translateRunResult isBreak (Just (Private.RunProgException str)) = do
        $putStrictMVar isBreak Maybe.nothing
        return $ Public.RunProgException str
      translateRunResult isBreak (Just (Private.RunGhcException str)) = do
        $putStrictMVar isBreak Maybe.nothing
        return $ Public.RunGhcException str
      translateRunResult isBreak (Just (Private.RunBreak breakInfo)) = do
        $putStrictMVar isBreak (Maybe.just breakInfo)
        return $ Public.RunBreak
      translateRunResult isBreak Nothing = do
        -- On a force cancellation we definitely didn't hit a breakpoint
        $putStrictMVar isBreak Maybe.nothing
        return $ Public.RunForceCancelled
  
  -- | Breakpoint
  --
  -- Set a breakpoint at the specified location. Returns @Just@ the old value of the
  -- breakpoint if successful, or @Nothing@ otherwise.
  setBreakpoint :: IdeSession
                -> ModuleName        -- ^ Module where the breakshould should be set
                -> Public.SourceSpan -- ^ Location of the breakpoint
                -> Bool              -- ^ New value for the breakpoint
                -> IO (Maybe Bool)   -- ^ Old value of the breakpoint (if valid)
  setBreakpoint session mod span value = withIdleState session $ \idleState ->
    rpcBreakpoint (idleState ^. ideGhcServer) mod span value
  
  -- | Print and/or force values during debugging
  --
  -- Only valid in breakpoint state.
  printVar :: IdeSession
           -> Public.Name -- ^ Variable to print
           -> Bool        -- ^ Should printing bind new vars? (@:print@ vs. @:sprint@)
           -> Bool        -- ^ Should the value be forced? (@:print@ vs. @:force@)
           -> IO Public.VariableEnv
  printVar session var bind forceEval = withBreakInfo session $ \idleState _ ->
    rpcPrint (idleState ^. ideGhcServer) var bind forceEval
  
  -- TODO: We should do this translation only when we talk to ghc, and keep
  -- the original Targets in the session state
  -- **  IdeStaticInfo{..} <- asks ideSessionUpdateStaticInfo
  -- **  let sourceDir = ideSessionSourceDir ideSessionDir
  -- **      newTargets = case targets of
  -- **        Public.TargetsInclude l ->
  -- **          Public.TargetsInclude $ map (sourceDir </>) l
  -- **        Public.TargetsExclude l ->
  -- **          Public.TargetsExclude $ map (sourceDir </>) l
  -- **
  -- **  oldTargets <- get ideTargets
  -- **  when (oldTargets /= newTargets) $ do
  -- **    set ideTargets newTargets
  -- **    restartSession'
  
  {------------------------------------------------------------------------------
    Debugging of ide-backend itself
  ------------------------------------------------------------------------------}
  
  -- | Crash the GHC server. For debugging only. If the specified delay is
  -- @Nothing@, crash immediately; otherwise, set up a thread that throws
  -- an exception to the main thread after the delay.
  crashGhcServer :: IdeSession -> Maybe Int -> IO ()
  crashGhcServer IdeSession{..} delay = $withStrictMVar ideState $ \state ->
    case state of
      IdeSessionIdle idleState ->
        rpcCrash (idleState ^. ideGhcServer) delay
      _ ->
        Ex.throwIO $ userError "State not idle"
  
  {-------------------------------------------------------------------------------
    Auxiliary (ide-backend specific)
  -------------------------------------------------------------------------------}
  
  withBreakInfo :: IdeSession -> (IdeIdleState -> Public.BreakInfo -> IO a) -> IO a
  withBreakInfo session act = withIdleState session $ \idleState ->
    case toLazyMaybe (idleState ^. ideBreakInfo) of
      Just breakInfo -> act idleState breakInfo
      Nothing        -> Ex.throwIO (userError "Not in breakpoint state")
  
  withIdleState :: IdeSession -> (IdeIdleState -> IO a) -> IO a
  withIdleState session act = modifyIdleState session $ \idleState -> do
    result <- act idleState
    return (IdeSessionIdle idleState, result)
  
  modifyIdleState :: IdeSession -> (IdeIdleState -> IO (IdeSessionState, a)) -> IO a
  modifyIdleState IdeSession{..} act = $modifyStrictMVar ideState $ \state -> case state of
    IdeSessionIdle idleState -> act idleState
    _ -> Ex.throwIO $ userError "State not idle"
  
  failedToRestart :: ExternalException
  failedToRestart = ExternalException {
      externalStdErr    = "Failed to restart server"
    , externalException = Nothing
    }
  
  forcedRestart :: ExternalException
  forcedRestart = ExternalException {
      externalStdErr    = "Session manually restarted"
    , externalException = Nothing
    }
  
  serverRestartLoop :: ExternalException
  serverRestartLoop = ExternalException {
      externalStdErr    = "Server restart loop"
    , externalException = Nothing
    }
  