ide-backend 0.9.0.1 → 0.9.0.2

raw patch · 24 files changed

+10/−3471 lines, 24 filesdep +ide-backend-commonPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: ide-backend-common

API changes (from Hackage documentation)

Files

• IdeSession/GHC/API.hs +0/−90
• IdeSession/GHC/Requests.hs +0/−192
• IdeSession/GHC/Responses.hs +0/−127
• IdeSession/RPC/API.hs +0/−188
• IdeSession/RPC/Server.hs +0/−230
• IdeSession/RPC/Stream.hs +0/−47
• IdeSession/Strict/Container.hs +0/−130
• IdeSession/Strict/IORef.hs +0/−28
• IdeSession/Strict/IntMap.hs +0/−68
• IdeSession/Strict/IntervalMap.hs +0/−62
• IdeSession/Strict/List.hs +0/−49
• IdeSession/Strict/MVar.hs +0/−66
• IdeSession/Strict/Map.hs +0/−122
• IdeSession/Strict/Maybe.hs +0/−24
• IdeSession/Strict/StateT.hs +0/−65
• IdeSession/Strict/Trie.hs +0/−27
• IdeSession/Types/Private.hs +0/−411
• IdeSession/Types/Progress.hs +0/−61
• IdeSession/Types/Public.hs +0/−571
• IdeSession/Types/Translation.hs +0/−255
• IdeSession/Util.hs +0/−325
• IdeSession/Util/BlockingOps.hs +0/−253
• IdeSession/Util/PrettyVal.hs +0/−42
• ide-backend.cabal +10/−38

@@ -1,90 +0,0 @@--- | Types for the messages to and fro the GHC server------ It is important that none of the types here rely on the GHC library.-{-# LANGUAGE DeriveDataTypeable #-}-module IdeSession.GHC.API (-    -- * Requests-    module IdeSession.GHC.Requests-    -- * Responses-  , module IdeSession.GHC.Responses-    -- * Configuration-  , ideBackendApiVersion-  , hsExtensions-  , hsBootExtensions-  , cExtensions-  , cHeaderExtensions-  , sourceExtensions-  , cabalMacrosLocation-    -- * Paths-  , ideSessionSourceDir-  , ideSessionDataDir-  , ideSessionDistDir-  , ideSessionObjDir-  ) where--import System.FilePath ((</>))--import IdeSession.GHC.Requests-import IdeSession.GHC.Responses---- | For detecting runtime version mismatch between the server and the library------ We use a Unix timestamp for this so that these API versions have some--- semantics (http://www.epochconverter.com/, GMT).-ideBackendApiVersion :: Int-ideBackendApiVersion = 1426765899--{-------------------------------------------------------------------------------  Configuration-------------------------------------------------------------------------------}---- | Haskell source files-hsExtensions :: [FilePath]-hsExtensions = [".hs", ".lhs"]---- | Haskell @.boot@ files-hsBootExtensions :: [FilePath]-hsBootExtensions = [".hs-boot", ".lhs-boot"]---- | C source files-cExtensions :: [FilePath]-cExtensions = [".c"]---- | C header files-cHeaderExtensions :: [FilePath]-cHeaderExtensions = [".h"]---- | Extensions of all source files we keep in our source directory.-sourceExtensions :: [FilePath]-sourceExtensions = hsExtensions-                ++ hsBootExtensions-                ++ cExtensions-                ++ cHeaderExtensions---- TODO: perhaps create dist/build/autogen and put macros there so that--- Cabal.autogenModulesDir can use it for compilation of C files?-cabalMacrosLocation :: FilePath -> FilePath-cabalMacrosLocation ideDistDir = ideDistDir </> "cabal_macros.h"--{--------------------------------------------------------------------------------  Paths--  These are all meant to be relative to the session dir--------------------------------------------------------------------------------}---- | The directory to use for managing source files.-ideSessionSourceDir :: FilePath -> FilePath-ideSessionSourceDir sessionDir = sessionDir </> "src"---- | The directory to use for data files that may be accessed by the--- running program. The running program will have this as its CWD.-ideSessionDataDir :: FilePath -> FilePath-ideSessionDataDir sessionDir = sessionDir </> "data"---- | Cabal "dist" prefix.-ideSessionDistDir :: FilePath -> FilePath-ideSessionDistDir sessionDir = sessionDir </> "dist"---- | Directory where we store compiled C files (objects)-ideSessionObjDir :: FilePath -> FilePath-ideSessionObjDir sessionDir = sessionDir </> "ffi"

@@ -1,192 +0,0 @@--- | GHC requests------ GHC requests use "IdeSession.Types.Public" types.-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}-module IdeSession.GHC.Requests (-    GhcInitRequest(..)-  , GhcRequest(..)-  , GhcRunRequest(..)-  , RunCmd(..)-  ) where--import Data.Binary-import Data.ByteString (ByteString)-import Data.Typeable (Typeable)-import Control.Applicative ((<$>), (<*>))--import Text.Show.Pretty (PrettyVal(..))-import GHC.Generics--import IdeSession.Types.Public---- | Initial handshake with the ghc server------ Ideally we'd send over the entire IdeStaticInfo but this includes some--- Cabal fields, and the ghc server does -not- compile against Cabal--- (although this isn't so important anymore now that we use Cabal-ide-backend)-data GhcInitRequest = GhcInitRequest {-    ghcInitClientApiVersion   :: Int-  , ghcInitGenerateModInfo    :: Bool-  , ghcInitOpts               :: [String]-  , ghcInitUserPackageDB      :: Bool-  , ghcInitSpecificPackageDBs :: [String]-  , ghcInitSessionDir         :: FilePath-  }-  deriving (Typeable, Generic)--data GhcRequest-  = ReqCompile {-        reqCompileGenCode   :: Bool-      , reqCompileTargets   :: Targets-      }-  | ReqRun {-        reqRunCmd :: RunCmd-      }-  | ReqSetEnv {-        reqSetEnv :: [(String, Maybe String)]-      }-  | ReqSetArgs {-        reqSetArgs :: [String]-      }-  | ReqBreakpoint {-        reqBreakpointModule :: ModuleName-      , reqBreakpointSpan   :: SourceSpan-      , reqBreakpointValue  :: Bool-      }-  | ReqPrint {-        reqPrintVars  :: Name-      , reqPrintBind  :: Bool-      , reqPrintForce :: Bool-      }-  | ReqLoad {-        reqLoad :: [FilePath]-      }-  | ReqUnload {-        reqUnload :: [FilePath]-      }-  | ReqSetGhcOpts {-        reqSetGhcOpts :: [String]-      }-    -- | For debugging only! :)-  | ReqCrash {-        reqCrashDelay :: Maybe Int-      }-  deriving (Typeable, Generic, Show)--data RunCmd =-    RunStmt {-        runCmdModule   :: String-      , runCmdFunction :: String-      , runCmdStdout   :: RunBufferMode-      , runCmdStderr   :: RunBufferMode-      }-  | Resume-  deriving (Typeable, Generic, Show)--instance PrettyVal GhcInitRequest-instance PrettyVal GhcRequest-instance PrettyVal RunCmd--data GhcRunRequest =-    GhcRunInput ByteString-  | GhcRunInterrupt-  deriving Typeable--instance Binary GhcInitRequest where-  put (GhcInitRequest{..}) = do-    -- Note: we intentionally write the API version first. This makes it-    -- possible (in theory at least) to have some form of backwards API-    -- compatibility.-    put ghcInitClientApiVersion-    put ghcInitGenerateModInfo-    put ghcInitOpts-    put ghcInitUserPackageDB-    put ghcInitSpecificPackageDBs-    put ghcInitSessionDir--  get = GhcInitRequest <$> get-                       <*> get-                       <*> get-                       <*> get-                       <*> get-                       <*> get--instance Binary GhcRequest where-  put ReqCompile{..} = do-    putWord8 0-    put reqCompileGenCode-    put reqCompileTargets-  put ReqRun{..} = do-    putWord8 1-    put reqRunCmd-  put ReqSetEnv{..} = do-    putWord8 2-    put reqSetEnv-  put ReqSetArgs{..} = do-    putWord8 3-    put reqSetArgs-  put ReqBreakpoint{..} = do-    putWord8 4-    put reqBreakpointModule-    put reqBreakpointSpan-    put reqBreakpointValue-  put ReqPrint{..} = do-    putWord8 5-    put reqPrintVars-    put reqPrintBind-    put reqPrintForce-  put ReqLoad{..} = do-    putWord8 6-    put reqLoad-  put ReqUnload{..} = do-    putWord8 7-    put reqUnload-  put ReqSetGhcOpts{..} = do-    putWord8 8-    put reqSetGhcOpts-  put ReqCrash{..} = do-    putWord8 255-    put reqCrashDelay--  get = do-    header <- getWord8-    case header of-      0   -> ReqCompile     <$> get <*> get-      1   -> ReqRun         <$> get-      2   -> ReqSetEnv      <$> get-      3   -> ReqSetArgs     <$> get-      4   -> ReqBreakpoint  <$> get <*> get <*> get-      5   -> ReqPrint       <$> get <*> get <*> get-      6   -> ReqLoad        <$> get-      7   -> ReqUnload      <$> get-      8   -> ReqSetGhcOpts  <$> get-      255 -> ReqCrash       <$> get-      _   -> fail "GhcRequest.get: invalid header"--instance Binary RunCmd where-  put (RunStmt {..}) = do-    putWord8 0-    put runCmdModule-    put runCmdFunction-    put runCmdStdout-    put runCmdStderr-  put Resume = do-    putWord8 1--  get = do-    header <- getWord8-    case header of-      0 -> RunStmt <$> get <*> get <*> get <*> get-      1 -> return Resume-      _ -> fail "RunCmd.get: invalid header"--instance Binary GhcRunRequest where-  put (GhcRunInput bs) = putWord8 0 >> put bs-  put GhcRunInterrupt  = putWord8 1--  get = do-    header <- getWord8-    case header of-      0 -> GhcRunInput <$> get-      1 -> return GhcRunInterrupt-      _ -> fail "GhcRunRequest.get: invalid header"

@@ -1,127 +0,0 @@--- | Responses from the GHC server------ The server responds with "IdeSession.Types.Private" types-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}-module IdeSession.GHC.Responses (-    GhcInitResponse(..)-  , GhcCompileResponse(..)-  , GhcCompileResult(..)-  , GhcRunResponse(..)-  , GhcVersion(..)-  ) where--import Data.Binary-import Data.ByteString (ByteString)-import Data.Text (Text)-import Data.Typeable (Typeable)-import Control.Applicative ((<$>), (<*>))--import IdeSession.Types.Private-import IdeSession.Types.Progress-import IdeSession.Strict.Container-import IdeSession.Util (Diff)--import Text.Show.Pretty-import GHC.Generics--data GhcInitResponse = GhcInitResponse {-    ghcInitVersion :: GhcVersion-  }-  deriving (Typeable, Generic)--data GhcCompileResponse =-    GhcCompileProgress Progress-  | GhcCompileDone GhcCompileResult-  deriving (Typeable, Generic)---- NOTE: These fields cannot be made strict (at least, not easily)-data GhcCompileResult = GhcCompileResult {-    ghcCompileErrors   :: Strict [] SourceError-  , ghcCompileLoaded   :: Strict [] ModuleName-  , ghcCompileCache    :: ExplicitSharingCache-  -- Computed from the GhcSummary (independent of the plugin, and hence-  -- available even when the plugin does not run)-  , ghcCompileFileMap  :: Strict (Map FilePath) ModuleId-  , ghcCompileImports  :: Strict (Map ModuleName) (Diff (Strict [] Import))-  , ghcCompileAuto     :: Strict (Map ModuleName) (Diff (Strict [] IdInfo))-  -- Computed by the plugin-  , ghcCompileSpanInfo :: Strict (Map ModuleName) (Diff IdList)-  , ghcCompilePkgDeps  :: Strict (Map ModuleName) (Diff (Strict [] PackageId))-  , ghcCompileExpTypes :: Strict (Map ModuleName) (Diff [(SourceSpan, Text)])-  , ghcCompileUseSites :: Strict (Map ModuleName) (Diff UseSites)-  }-  deriving (Typeable, Generic)--data GhcRunResponse =-    GhcRunOutp ByteString-  | GhcRunDone RunResult-  deriving (Typeable, Generic)---- | GHC version------ NOTE: Defined in such a way that the Ord instance makes sense.-data GhcVersion = GHC_7_4 | GHC_7_8 | GHC_7_10-  deriving (Typeable, Show, Eq, Ord, Generic)--instance PrettyVal GhcInitResponse-instance PrettyVal GhcCompileResponse-instance PrettyVal GhcCompileResult-instance PrettyVal GhcRunResponse-instance PrettyVal GhcVersion--instance Binary GhcInitResponse where-  put (GhcInitResponse{..}) = do-    put ghcInitVersion-  get = GhcInitResponse <$> get--instance Binary GhcCompileResponse where-  put (GhcCompileProgress progress) = putWord8 0 >> put progress-  put (GhcCompileDone result)       = putWord8 1 >> put result--  get = do-    header <- getWord8-    case header of-      0 -> GhcCompileProgress <$> get-      1 -> GhcCompileDone     <$> get-      _ -> fail "GhcCompileRespone.get: invalid header"--instance Binary GhcCompileResult where-  put GhcCompileResult{..} = do-    put ghcCompileErrors-    put ghcCompileLoaded-    put ghcCompileCache-    put ghcCompileFileMap-    put ghcCompileImports-    put ghcCompileAuto-    put ghcCompileSpanInfo-    put ghcCompilePkgDeps-    put ghcCompileExpTypes-    put ghcCompileUseSites--  get = GhcCompileResult <$> get <*> get <*> get-                         <*> get <*> get <*> get-                         <*> get <*> get <*> get <*> get--instance Binary GhcRunResponse where-  put (GhcRunOutp bs) = putWord8 0 >> put bs-  put (GhcRunDone r)  = putWord8 1 >> put r--  get = do-    header <- getWord8-    case header of-      0 -> GhcRunOutp <$> get-      1 -> GhcRunDone <$> get-      _ -> fail "GhcRunResponse.get: invalid header"--instance Binary GhcVersion where-  put GHC_7_4  = putWord8 0-  put GHC_7_8  = putWord8 1-  put GHC_7_10 = putWord8 2--  get = do-    header <- getWord8-    case header of-      0 -> return GHC_7_4-      1 -> return GHC_7_8-      2 -> return GHC_7_10-      _ -> fail "GhcVersion.get: invalid header"

@@ -1,188 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, RankNTypes #-}-module IdeSession.RPC.API (-    -- * External exceptions-    ExternalException(..)-  , serverKilledException-    -- * Client-server communication-  , RpcConversation(..)-  , Request(..)-  , Response(..)-    -- * Lazy bytestring with incremental Binary instance-  , IncBS(..)-    -- * IO utils-  , hPutFlush-  , ignoreIOExceptions-  , openPipeForWriting-  , openPipeForReading-  ) where--import Prelude hiding (take)-import Control.Applicative ((<$>))-import Control.Concurrent (threadDelay)-import Data.Binary (Binary)-import Data.Typeable (Typeable)-import System.IO (Handle, hFlush, openFile, IOMode(..), hPutChar, hGetChar)-import qualified Control.Exception as Ex-import qualified Data.Binary as Binary-import qualified Data.ByteString as BSS-import qualified Data.ByteString.Lazy.Char8 as BSL-import qualified Data.ByteString.Lazy.Internal as BSL------------------------------------------------------------------------------------- Exceptions thrown by the RPC server are retrown locally as                 ----- 'ExternalException's                                                       --------------------------------------------------------------------------------------- | Exceptions thrown by the remote server-data ExternalException = ExternalException {-     -- | The output from the server on stderr-     externalStdErr    :: String-     -- | The local exception that was thrown and alerted us to the problem-   , externalException :: Maybe Ex.IOException-   }-  deriving (Eq, Typeable)--instance Show ExternalException where-  show (ExternalException err Nothing) =-    "External exception: " ++ err-  show (ExternalException err (Just ex)) =-    "External exception: " ++ err ++ ". Local exception: " ++ show ex--instance Ex.Exception ExternalException---- | Generic exception thrown if the server gets killed for unknown reason-serverKilledException :: Maybe Ex.IOException -> ExternalException-serverKilledException ex = ExternalException "Server killed" ex--{-------------------------------------------------------------------------------  Client-server communication-------------------------------------------------------------------------------}--data RpcConversation = RpcConversation {-    get :: forall a. (Typeable a, Binary a) => IO a-  , put :: forall a. (Typeable a, Binary a) => a -> IO ()-  }--data Request = Request IncBS | RequestShutdown-  deriving Show--newtype Response = Response IncBS--instance Binary Request where-  put (Request bs)         = Binary.putWord8 0 >> Binary.put bs-  put RequestShutdown      = Binary.putWord8 1--  get = do-    header <- Binary.getWord8-    case header of-      0 -> Request <$> Binary.get-      1 -> return RequestShutdown-      _ -> fail "Request.get: invalid header"--instance Binary Response where-  put (Response bs) = Binary.put bs-  get = Response <$> Binary.get--{-------------------------------------------------------------------------------  Lazy bytestring with an incremental Binary instance--  Note only does this avoid loading the entire ByteString into memory when-  serializing stuff, the standard Binary instance for Lazy bytestring is-  actually broken in 0.5 (http://hpaste.org/87401; fixed in 0.7, but even there-  still requires the length of the bytestring upfront).-------------------------------------------------------------------------------}--newtype IncBS = IncBS { unIncBS :: BSL.ByteString }--instance Binary IncBS where-  put (IncBS BSL.Empty)        = Binary.putWord8 0-  put (IncBS (BSL.Chunk b bs)) = do Binary.putWord8 1-                                    Binary.put b-                                    Binary.put (IncBS bs)--  get = go []-    where-      go :: [BSS.ByteString] -> Binary.Get IncBS-      go acc = do-        header <- Binary.getWord8-        case header of-          0 -> return . IncBS . BSL.fromChunks . reverse $ acc-          1 -> do b <- Binary.get ; go (b : acc)-          _ -> fail "IncBS.get: invalid header"--instance Show IncBS where-  show = show . unIncBS--{-------------------------------------------------------------------------------  Some IO utils-------------------------------------------------------------------------------}---- | Write a bytestring to a buffer and flush-hPutFlush :: Handle -> BSL.ByteString -> IO ()-hPutFlush h bs = BSL.hPut h bs >> ignoreIOExceptions (hFlush h)---- | Ignore IO exceptions-ignoreIOExceptions :: IO () -> IO ()-ignoreIOExceptions = Ex.handle ignore-  where-    ignore :: Ex.IOException -> IO ()-    ignore _ = return ()---- | Open a pipe for writing------ This is meant to be used together with 'openPipeForReading'-openPipeForWriting :: FilePath -> Int -> IO Handle-openPipeForWriting fp = go-  where-    go :: Int -> IO Handle-    go timeout = do-      -- We cannot open a pipe for writing without a corresponding reader-      mh <- Ex.try $ openFile fp WriteMode-      case mh of-        Left ex ->-          if timeout > delay-            then do threadDelay delay-                    go (timeout - delay)-            else Ex.throwIO (RPCPipeNotCreated ex)-        Right h -> do-          hPutChar h '!'-          hFlush h-          return h--    delay :: Int-    delay = 10000 -- 10 ms--data RPCPipeNotCreated = RPCPipeNotCreated Ex.IOException-    deriving Typeable-instance Ex.Exception RPCPipeNotCreated-instance Show RPCPipeNotCreated where-    show (RPCPipeNotCreated e) = "The bidirectional RPC pipe could not be opened. Exception was: " ++ show e---- | Open a pipe for reading------ This is meant to be used together with 'openPipeForWriting'-openPipeForReading :: FilePath -> Int -> IO Handle-openPipeForReading fp = \timeout -> do-    -- We _can_ open a pipe for reading without a corresponding writer-    h <- openFile fp ReadMode-    -- But if there is no corresponding writer, then trying to read from the-    -- pipe will report EOF. So we wait.-    go h timeout-    return h-  where-    go :: Handle -> Int -> IO ()-    go h timeout = do-      mc <- Ex.try $ hGetChar h-      case mc of-        Left ex ->-          if timeout > delay-            then do threadDelay delay-                    go h (timeout - delay)-            else Ex.throwIO (RPCPipeNotCreated ex)-        Right '!' ->-          return ()-        Right c ->-          Ex.throwIO (userError $ "openPipeForReading: Unexpected " ++ show c)--    delay :: Int-    delay = 10000 -- 10 ms

@@ -1,230 +0,0 @@-{-# LANGUAGE ScopedTypeVariables, TemplateHaskell, DeriveDataTypeable, RankNTypes, GADTs #-}-{-# OPTIONS_GHC -Wall #-}-module IdeSession.RPC.Server-  ( rpcServer-  , concurrentConversation-  , RpcConversation(..)-  ) where--import Prelude hiding (take)-import System.IO-  ( Handle-  , hSetBinaryMode-  , hSetBuffering-  , BufferMode(BlockBuffering)-  )-import System.Posix.Types (Fd)-import System.Posix.IO (closeFd, fdToHandle)-import Control.Monad (void)-import qualified Control.Exception as Ex-import Control.Concurrent (threadDelay)-import Control.Concurrent.Chan (Chan, newChan, writeChan)-import qualified Data.ByteString.Lazy.Char8 as BSL-import Control.Concurrent.Async (Async, async)-import Data.Binary (encode, decode)--import IdeSession.Util.BlockingOps (readChan, wait, waitAny)-import IdeSession.RPC.API-import IdeSession.RPC.Stream------------------------------------------------------------------------------------- Server-side API                                                            --------------------------------------------------------------------------------------- Start the RPC server. For an explanation of the command line arguments, see--- 'forkRpcServer'. This function does not return until the client requests--- termination of the RPC conversation (or there is an error).------ The server is passed the RpcConversation to communicate with the client,--- as well as the path to the exception log (rarely needed -- only needed--- if the server thread kills the whole process unconditionally, without--- throwing an exception).-rpcServer :: (FilePath -> RpcConversation -> IO ()) -- ^ Request server-          -> [String]                               -- ^ Command line args-          -> IO ()-rpcServer handler args = do-  let readFd :: String -> Fd-      readFd fd = fromIntegral (read fd :: Int)--  let errorLog : fds = args-      [requestR, requestW, responseR, responseW] = map readFd fds--  closeFd requestW-  closeFd responseR-  requestR'  <- fdToHandle requestR-  responseW' <- fdToHandle responseW--  rpcServer' requestR' responseW' errorLog handler---- | Start a concurrent conversation.-concurrentConversation :: FilePath -- ^ stdin named pipe-                       -> FilePath -- ^ stdout named pipe-                       -> FilePath -- ^ log file for exceptions-                       -> (FilePath -> RpcConversation -> IO ())-                       -> IO ()-concurrentConversation requestR responseW errorLog server = do-    hin  <- openPipeForReading requestR  timeout-    hout <- openPipeForWriting responseW timeout-    rpcServer' hin hout errorLog server-  where-    timeout :: Int-    timeout = maxBound---- | Start the RPC server-rpcServer' :: Handle                     -- ^ Input-           -> Handle                     -- ^ Output-           -> FilePath                   -- ^ Log file for exceptions-           -> (FilePath -> RpcConversation -> IO ()) -- ^ The request server-           -> IO ()-rpcServer' hin hout errorLog server = do-    requests  <- newChan :: IO (Chan BSL.ByteString)-    responses <- newChan :: IO (Chan (Maybe BSL.ByteString))--    setBinaryBlockBuffered [hin, hout]--    -- Each thread installs it own exception handler before unmasking-    -- asynchronous exceptions. This way when an exception occurs we can-    -- identify it (by looking at which ServerEvent was returned).-    (reader, writer, handler) <- Ex.mask $ \restore -> do-      reader  <- async $ readRequests   restore hin requests-      writer  <- async $ writeResponses restore responses hout-      handler <- async $ channelHandler restore requests responses (server errorLog)-      return (reader, writer, handler)--    (_thread, ev) <- $waitAny [reader, writer, handler]-    case ev of-      -- If we lose connection with the client, just terminate.-      -- See #194 (in particular, https://github.com/fpco/ide-backend/issues/194#issuecomment-44210412)-      LostConnection ex ->-        tryShowException (Just ex)--      -- If the client requests termination, we simply terminate immediately.-      -- It is the client's responsibility to have a proper shutdown protocol-      -- with the server thread-      ReaderThreadTerminated ->-        return ()--      -- The writer thread should never terminate normally unless we request-      -- it; this is a logical impossibility :)-      WriterThreadTerminated ->-        error "The impossible happened"--      -- When the main server thread terminates we ask the writer thread to-      -- terminate so that we make sure to send any pending messages-      ServerThreadTerminated ->-        tryShowException =<< flushResponses responses writer--      -- When the main server thread aborts, we still attempt to flush any-      -- remaining messages, but the exception that we record is the one from-      -- the server (the writer thread might terminate with a further exception)-      ServerThreadAborted ex -> do-        tryShowException (Just ex)-        void $ flushResponses responses writer--    threadDelay 100000-  where-    tryShowException :: Maybe Ex.SomeException -> IO ()-    tryShowException (Just ex) =-      ignoreIOExceptions $ appendFile errorLog (show ex)-    tryShowException Nothing =-      return ()------------------------------------------------------------------------------------- Internal                                                                   --------------------------------------------------------------------------------------- | We record the reason why the various threads are terminating, so that we--- can take the appropriate action-data ServerEvent =-    -- | The reader thread terminates when the client sends a 'RequestShutdown'-    -- message-    ReaderThreadTerminated--    -- | After the main server thread terminates, we wait for the writer thread-    -- to terminate to make sure there are no pending unsent messages-  | WriterThreadTerminated--    -- | Termination of the main server thread-  | ServerThreadTerminated--    -- | Main server thread threw an exception-  | ServerThreadAborted Ex.SomeException--    -- | The reader thread and writer threads terminate with 'LostConnection'-    -- if an exception occurs-  | LostConnection Ex.SomeException-  deriving Show---- | Decode messages from a handle and forward them to a channel.--- The boolean result indicates whether the shutdown is forced.-readRequests :: Restore -> Handle -> Chan BSL.ByteString -> IO ServerEvent-readRequests restore h ch =-    Ex.handle (return . LostConnection)-              (restore (newStream h >>= go))-  where-    go :: Stream Request -> IO ServerEvent-    go input = do-      req <- nextInStream input-      case req of-        Request req'         -> writeChan ch (unIncBS req') >> go input-        RequestShutdown      -> return ReaderThreadTerminated---- | Encode messages from a channel and forward them on a handle------ Terminates on 'Nothing'.-writeResponses :: Restore -> Chan (Maybe BSL.ByteString) -> Handle -> IO ServerEvent-writeResponses restore ch h =-    Ex.handle (return . LostConnection)-              (restore go)-  where-    go :: IO ServerEvent-    go = do-      mbs <- $readChan ch-      case mbs of-        Just bs -> do hPutFlush h $ encode (Response (IncBS bs)) ; go-        Nothing -> return WriterThreadTerminated---- | Ask the writer thread to terminate and wait for all remaining messages to--- have been sent. Returns 'Nothing' if the writer thread terminated normally,--- or the exception if it didn't.-flushResponses :: Chan (Maybe BSL.ByteString) -> Async ServerEvent -> IO (Maybe Ex.SomeException)-flushResponses responses writer = do-  writeChan responses Nothing-  ev <- $wait writer-  case ev of-    WriterThreadTerminated ->-      return Nothing-    LostConnection ex ->-      return (Just ex)-    _ ->-      error "the impossible happened"---- | Run a handler repeatedly, given input and output channels-channelHandler :: Restore-               -> Chan BSL.ByteString-               -> Chan (Maybe BSL.ByteString)-               -> (RpcConversation -> IO ())-               -> IO ServerEvent-channelHandler restore requests responses server =-    Ex.handle (return . ServerThreadAborted)-              (restore go)-  where-    go :: IO ServerEvent-    go = do-      server RpcConversation {-          get = $readChan requests >>= Ex.evaluate . decode-        , put = writeChan responses . Just . encode-        }-      return ServerThreadTerminated------------------------------------------------------------------------------------- Auxiliary                                                                  -------------------------------------------------------------------------------------type Restore = forall a. IO a -> IO a---- | Set all the specified handles to binary mode and block buffering-setBinaryBlockBuffered :: [Handle] -> IO ()-setBinaryBlockBuffered =-  mapM_ $ \h -> do hSetBinaryMode h True-                   hSetBuffering  h (BlockBuffering Nothing)

@@ -1,47 +0,0 @@--- | Wrapper around binary-{-# LANGUAGE ScopedTypeVariables, GADTs #-}-module IdeSession.RPC.Stream (-    Stream-  , newStream-  , nextInStream-  ) where--import Prelude hiding (take)-import System.IO (Handle)-import qualified Control.Exception as Ex-import qualified Data.ByteString.Lazy.Internal as BSL-import qualified Data.ByteString as BSS-import Data.IORef (IORef, writeIORef, readIORef, newIORef)-import Data.Binary (Binary)-import qualified Data.Binary     as Binary-import qualified Data.Binary.Get as Binary--data Stream a where-  Stream :: Binary a => Handle -> IORef (Binary.Decoder a) -> Stream a--newStream :: Binary a => Handle -> IO (Stream a)-newStream h = do-  st <- newIORef $ Binary.runGetIncremental Binary.get-  return $ Stream h st--nextInStream :: forall a. Stream a -> IO a-nextInStream (Stream h st) = readIORef st >>= go-  where-    go :: Binary.Decoder a -> IO a-    go decoder = case decoder of-      Binary.Fail _ _ err -> do-        writeIORef st decoder-        Ex.throwIO (userError err)-      Binary.Partial k -> do-        mchunk <- Ex.try $ BSS.hGetSome h BSL.defaultChunkSize-        case mchunk of-          Left ex -> do writeIORef st decoder-                        Ex.throwIO (ex :: Ex.SomeException)-          Right chunk | BSS.null chunk -> go . k $ Nothing-                      | otherwise      -> go . k $ Just chunk-      Binary.Done unused _numConsumed a -> do-        writeIORef st $ contDecoder unused-        return a--    contDecoder :: BSS.ByteString -> Binary.Decoder a-    contDecoder = Binary.pushChunk (Binary.runGetIncremental Binary.get)

@@ -1,130 +0,0 @@-{-# LANGUAGE TypeFamilies, FlexibleInstances, StandaloneDeriving #-}-module IdeSession.Strict.Container-  ( StrictContainer(..)-  , Strict(..)-    -- * For convenience, we export the names of the lazy types too-  , Maybe-  , Map-  , IntMap-  , Trie-  ) where--import Control.Applicative-import Data.IntMap (IntMap)-import qualified Data.IntMap as IntMap-import Data.Map (Map)-import qualified Data.Map as Map-import qualified Data.List as List-import Data.Trie (Trie)-import Data.Foldable as Foldable-import Data.Binary (Binary(..))-import IdeSession.Util.PrettyVal--class StrictContainer t where-  data Strict (t :: * -> *) :: * -> *-  force   :: t a -> Strict t a-  project :: Strict t a -> t a--{-------------------------------------------------------------------------------  IntMap-------------------------------------------------------------------------------}--instance StrictContainer IntMap where-  newtype Strict IntMap v = StrictIntMap { toLazyIntMap :: IntMap v }-    deriving Show--  force m = IntMap.foldl' (flip seq) () m `seq` StrictIntMap m-  project = toLazyIntMap--instance Binary v => Binary (Strict IntMap v) where-  put = put . IntMap.toList . toLazyIntMap-  get = (force . IntMap.fromList) <$> get--instance PrettyVal v => PrettyVal (Strict IntMap v) where-  prettyVal = prettyVal . toLazyIntMap--{-------------------------------------------------------------------------------  Lists-------------------------------------------------------------------------------}--instance StrictContainer [] where-  newtype Strict [] a = StrictList { toLazyList :: [a] }-    deriving (Show, Eq)--  force m = List.foldl' (flip seq) () m `seq` StrictList m-  project = toLazyList---- TODO: we can do better than this if we cache the length of the list-instance Binary a => Binary (Strict [] a) where-  put = put . toLazyList-  get = force <$> get--instance PrettyVal a => PrettyVal (Strict [] a) where-  prettyVal = prettyVal . toLazyList--{-------------------------------------------------------------------------------  Map-------------------------------------------------------------------------------}--instance StrictContainer (Map k) where-  newtype Strict (Map k) v = StrictMap { toLazyMap :: Map k v }-    deriving (Show)--  force m = Map.foldl' (flip seq) () m `seq` StrictMap m-  project = toLazyMap--instance (Ord k, Binary k, Binary v) => Binary (Strict (Map k) v) where-  put = put . Map.toList . toLazyMap-  get = (force . Map.fromList) <$> get--instance (PrettyVal k, PrettyVal v) => PrettyVal (Strict (Map k) v) where-  prettyVal = prettyVal . toLazyMap--{-------------------------------------------------------------------------------  Maybe-------------------------------------------------------------------------------}--instance StrictContainer Maybe where-  newtype Strict Maybe a = StrictMaybe { toLazyMaybe :: Maybe a }-    deriving (Show)--  force Nothing  = StrictMaybe Nothing-  force (Just x) = x `seq` StrictMaybe $ Just x-  project = toLazyMaybe--instance Binary a => Binary (Strict Maybe a) where-  put = put . toLazyMaybe-  get = force <$> get--deriving instance Eq  a => Eq  (Strict Maybe a)-deriving instance Ord a => Ord (Strict Maybe a)--instance Functor (Strict Maybe) where-  fmap f = force . fmap f . toLazyMaybe--instance PrettyVal a => PrettyVal (Strict Maybe a) where-  prettyVal = prettyVal . toLazyMaybe--instance Applicative (Strict Maybe) where-  pure    = force . pure-  -- We need 'force' here because we need to force the result of the-  -- function application-  f <*> a = force $ toLazyMaybe f <*> toLazyMaybe a--instance Alternative (Strict Maybe) where-  empty   = StrictMaybe Nothing-  a <|> b = StrictMaybe $ toLazyMaybe a <|> toLazyMaybe b--{-------------------------------------------------------------------------------  Trie-------------------------------------------------------------------------------}--instance StrictContainer Trie where-  newtype Strict Trie a = StrictTrie { toLazyTrie :: Trie a }-    deriving (Show)--  force m = Foldable.foldl (flip seq) () m `seq` StrictTrie m-  project = toLazyTrie--instance PrettyVal a => PrettyVal (Strict Trie a) where-  prettyVal = prettyVal . toLazyTrie

@@ -1,28 +0,0 @@--- IORefs that always evaluate their contents to WHNF-module IdeSession.Strict.IORef (-    StrictIORef -- Abstract-  , newIORef-  , readIORef-  , writeIORef-  , modifyIORef-  ) where--import Control.Applicative ((<$>))-import Control.Exception (evaluate)-import Data.IORef (IORef)-import qualified Data.IORef as IORef--newtype StrictIORef a = StrictIORef (IORef a)--newIORef :: a -> IO (StrictIORef a)-newIORef x = StrictIORef <$> (evaluate x >>= IORef.newIORef)--readIORef :: StrictIORef a -> IO a-readIORef (StrictIORef v) = IORef.readIORef v--writeIORef :: StrictIORef a -> a -> IO ()-writeIORef (StrictIORef v) x = evaluate x >>= IORef.writeIORef v---- base 4.6 exports modifyIORef' but 4.5 does not.-modifyIORef :: StrictIORef a -> (a -> a) -> IO ()-modifyIORef v f = readIORef v >>= writeIORef v . f

@@ -1,68 +0,0 @@-{-# LANGUAGE TypeFamilies, FlexibleInstances #-}--- | Wrapper around Data.IntMap that guarantees elements are evaluated when--- the Map is. containers-0.5 provides this out of the box, but alas ghc 7.4--- is built against containers-0.4.-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}-module IdeSession.Strict.IntMap (-    fromList-  , toList-  , lookup-  , findWithDefault-  , empty-  , adjust-  , insertWith-  , map-  , reverseLookup-  , filter-  , filterWithKey-  , union-  ) where--import Prelude hiding (map, filter, lookup)-import Data.Tuple (swap)-import qualified Data.IntMap as IntMap-import qualified Data.List as List--import IdeSession.Strict.Container--lookup :: Int -> Strict IntMap v -> Maybe v-lookup i = IntMap.lookup i . toLazyIntMap--findWithDefault :: v -> Int -> Strict IntMap v -> v-findWithDefault def i = IntMap.findWithDefault def i . toLazyIntMap--fromList :: [(Int, v)] -> Strict IntMap v-fromList = force . IntMap.fromList--toList :: Strict IntMap v -> [(Int, v)]-toList = IntMap.toList . toLazyIntMap--empty :: Strict IntMap v-empty = StrictIntMap $ IntMap.empty---- We use alter because it gives us something to anchor a seq to-adjust :: forall v. (v -> v) -> Int -> Strict IntMap v -> Strict IntMap v-adjust f i = StrictIntMap . IntMap.alter aux i . toLazyIntMap-  where-    aux :: Maybe v -> Maybe v-    aux Nothing  = Nothing-    aux (Just v) = let v' = f v in v' `seq` Just v'--insertWith :: (v -> v -> v) -> Int -> v -> Strict IntMap v -> Strict IntMap v-insertWith f i v = StrictIntMap . IntMap.insertWith' f i v . toLazyIntMap--map :: (a -> b) -> Strict IntMap a -> Strict IntMap b-map f = force . IntMap.map f . toLazyIntMap---- O(n)-reverseLookup :: Eq v => Strict IntMap v -> v -> Maybe Int-reverseLookup m v = List.lookup v $ List.map swap $ toList m--filter :: (v -> Bool) -> Strict IntMap v -> Strict IntMap v-filter p = StrictIntMap . IntMap.filter p . toLazyIntMap--filterWithKey :: (Int -> v -> Bool) -> Strict IntMap v -> Strict IntMap v-filterWithKey p = StrictIntMap . IntMap.filterWithKey p . toLazyIntMap--union :: Strict IntMap v -> Strict IntMap v -> Strict IntMap v-union a b = StrictIntMap $ IntMap.union (toLazyIntMap a) (toLazyIntMap b)

@@ -1,62 +0,0 @@-module IdeSession.Strict.IntervalMap (-    StrictIntervalMap-  , dominators-  , fromList-  , toList-  , empty-  , insert-    -- * Re-exports-  , Interval(..)-  ) where--import Data.IntervalMap.FingerTree (Interval(..), IntervalMap)-import qualified Data.IntervalMap.FingerTree as IntervalMap-import Text.Show.Pretty--{--  We maintain an interval spanning the entire map, in order to support a toList-  operation.--}--data StrictIntervalMap v a = StrictIntervalMap {-    toLazyIntervalMap :: !(IntervalMap v a)-  , maxInterval       :: !(Maybe (Interval v))-  }--instance (Ord v, Show v, Show a) => Show (StrictIntervalMap v a) where-  show m = "fromList " ++ show (toList m)--instance (Ord v, PrettyVal v, PrettyVal a) => PrettyVal (StrictIntervalMap v a) where-  prettyVal m = Con "fromList" [prettyVal . map flattenIntervals . toList $ m]-    where-      flattenIntervals :: (Interval v, a) -> ((v, v), a)-      flattenIntervals (Interval lo hi, a) = ((lo, hi), a)--unionInterval :: Ord v => Interval v -> Maybe (Interval v) -> Maybe (Interval v)-unionInterval i@(Interval low high) Nothing =-  low `seq` high `seq` Just i-unionInterval (Interval low1 high1) (Just (Interval low2 high2)) =-  let low  = min low1  low2-      high = max high1 high2-  in low `seq` high `seq` Just (Interval low high)--dominators :: Ord v => Interval v -> StrictIntervalMap v a -> [(Interval v, a)]-dominators i = IntervalMap.dominators i . toLazyIntervalMap--empty :: Ord v => StrictIntervalMap v a-empty = StrictIntervalMap IntervalMap.empty Nothing--insert :: Ord v => Interval v -> a -> StrictIntervalMap v a -> StrictIntervalMap v a-insert i a m =-  a `seq` StrictIntervalMap {-      toLazyIntervalMap = IntervalMap.insert i a $ toLazyIntervalMap m-    , maxInterval       = unionInterval i        $ maxInterval m-    }--fromList :: Ord v => [(Interval v, a)] -> StrictIntervalMap v a-fromList = foldr (\(i, a) m -> insert i a m) empty--toList :: Ord v => StrictIntervalMap v a -> [(Interval v, a)]-toList m = case maxInterval m of-             Nothing -> []-             Just i  -> IntervalMap.intersections i (toLazyIntervalMap m)

@@ -1,49 +0,0 @@-{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}--- | Strict lists-module IdeSession.Strict.List (-    nil-  , cons-  , singleton-  , map-  , all-  , any-  , reverse-  , (++)-  , elem-  , (\\)-  ) where--import Prelude hiding (map, all, any, reverse, (++), elem)-import qualified Data.List as List--import IdeSession.Strict.Container--nil :: Strict [] a-nil = StrictList []--cons :: a -> Strict [] a -> Strict [] a-cons x xs = x `seq` StrictList (x : toLazyList xs)--singleton :: a -> Strict [] a-singleton x = x `seq` StrictList [x]--map :: (a -> b) -> Strict [] a -> Strict [] b-map f = force . List.map f . toLazyList--all :: (a -> Bool) -> Strict [] a -> Bool-all p = List.all p . toLazyList--any :: (a -> Bool) -> Strict [] a -> Bool-any p = List.any p . toLazyList--elem :: Eq a => a -> Strict [] a -> Bool-elem x = List.elem x . toLazyList--reverse :: Strict [] a -> Strict [] a-reverse = StrictList . List.reverse . toLazyList--(++) :: Strict [] a -> Strict [] a -> Strict [] a-xs ++ ys = StrictList $ toLazyList xs List.++ toLazyList ys--(\\) :: Eq a => Strict [] a -> Strict [] a -> Strict [] a-xs \\ ys = StrictList $ toLazyList xs List.\\ toLazyList ys

@@ -1,66 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--- | MVar that always evaluates its argument to WHNF-module IdeSession.Strict.MVar (-    StrictMVar -- Abstract-  , newEmptyMVar-  , newMVar-  , takeMVar-  , putMVar-  , readMVar-  , swapMVar-  , tryTakeMVar-  , tryPutMVar-  , isEmptyMVar-  , withMVar-  , modifyMVar_-  , modifyMVar-  ) where--import Control.Concurrent.MVar (MVar)-import qualified Control.Concurrent.MVar as MVar-import Control.Applicative ((<$>))-import Control.Exception (evaluate)-import Control.Monad ((>=>))--newtype StrictMVar a = StrictMVar (MVar a)--newEmptyMVar :: IO (StrictMVar a)-newEmptyMVar = StrictMVar <$> MVar.newEmptyMVar--newMVar :: a -> IO (StrictMVar a)-newMVar x = StrictMVar <$> (evaluate x >>= MVar.newMVar)--takeMVar :: StrictMVar a -> IO a-takeMVar (StrictMVar v) = MVar.takeMVar v--putMVar :: StrictMVar a -> a -> IO ()-putMVar (StrictMVar v) x = evaluate x >>= MVar.putMVar v--readMVar :: StrictMVar a -> IO a-readMVar (StrictMVar v) = MVar.readMVar v--swapMVar :: StrictMVar a -> a -> IO a-swapMVar (StrictMVar v) x = evaluate x >>= MVar.swapMVar v--tryTakeMVar :: StrictMVar a -> IO (Maybe a)-tryTakeMVar (StrictMVar v) = MVar.tryTakeMVar v--tryPutMVar :: StrictMVar a -> a -> IO Bool-tryPutMVar (StrictMVar v) x = evaluate x >>= MVar.tryPutMVar v--isEmptyMVar :: StrictMVar a -> IO Bool-isEmptyMVar (StrictMVar v) = MVar.isEmptyMVar v--withMVar :: StrictMVar a -> (a -> IO b) -> IO b-withMVar (StrictMVar v) f = MVar.withMVar v f--modifyMVar_ :: StrictMVar a -> (a -> IO a) -> IO ()-modifyMVar_ (StrictMVar v) f = MVar.modifyMVar_ v (f >=> evaluate)--modifyMVar :: forall a b. StrictMVar a -> (a -> IO (a, b)) -> IO b-modifyMVar (StrictMVar v) f = MVar.modifyMVar v aux-  where-    aux :: a -> IO (a, b)-    aux x = do (a, b) <- f x-               a' <- evaluate a-               return (a', b)

@@ -1,122 +0,0 @@-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}--- | Wrapper around Data.Map that guarantees elements are evaluated when--- the Map is. containers-0.5 provides this out of the box, but alas ghc 7.4--- is built against containers-0.4.-module IdeSession.Strict.Map (-    toList-  , fromList-  , map-  , mapWithKey-  , mapKeys-  , empty-  , insert-  , union-  , unions-  , filterWithKey-  , lookup-  , findWithDefault-  , keysSet-  , (\\)-  , alter-  , adjust-  , member-  , (!)-  , keys-  , elems-  , delete-  , accessor-  , accessorDefault-  ) where--import Prelude hiding (map, lookup)-import Data.Set (Set)-import qualified Data.Map as Map-import Data.Accessor (Accessor)-import qualified Data.Accessor as Acc-import qualified Data.List as List--import IdeSession.Strict.Container--toList :: Strict (Map k) v -> [(k, v)]-toList = Map.toList . toLazyMap--fromList :: Ord k => [(k, v)] -> Strict (Map k) v-fromList = force . Map.fromList--map :: (a -> b) -> Strict (Map k) a  -> Strict (Map k) b-map f = force . Map.map f . toLazyMap--mapWithKey :: (k -> a -> b) -> Strict (Map k) a  -> Strict (Map k) b-mapWithKey f = force . Map.mapWithKey f . toLazyMap--mapKeys :: Ord k' => (k -> k') -> Strict (Map k) v -> Strict (Map k') v--- Maps are already strict in keys-mapKeys f = StrictMap . Map.mapKeys f . toLazyMap--empty :: Strict (Map k) v-empty = StrictMap Map.empty--insert :: Ord k => k -> v -> Strict (Map k) v -> Strict (Map k) v-insert k v = StrictMap . Map.insertWith' const k v . toLazyMap---- | Left biased union-union :: Ord k => Strict (Map k) v -> Strict (Map k) v -> Strict (Map k) v-union a b = StrictMap $ Map.union (toLazyMap a) (toLazyMap b)--unions :: Ord k => [Strict (Map k) v] -> Strict (Map k) v-unions = StrictMap . Map.unions . List.map toLazyMap--filterWithKey :: Ord k => (k -> v -> Bool) -> Strict (Map k) v -> Strict (Map k) v-filterWithKey p = StrictMap . Map.filterWithKey p . toLazyMap--keysSet :: Strict (Map k) v -> Set k-keysSet = Map.keysSet . toLazyMap--lookup :: Ord k => k -> Strict (Map k) v -> Maybe v-lookup k = Map.lookup k . toLazyMap--findWithDefault :: Ord k => v -> k -> Strict (Map k) v -> v-findWithDefault d k = Map.findWithDefault d k . toLazyMap--(\\) :: Ord k => Strict (Map k) a -> Strict (Map k) b -> Strict (Map k) a-(\\) a b = StrictMap $ (Map.\\) (toLazyMap a) (toLazyMap b)--alter :: forall k a. Ord k-      => (Maybe a -> Maybe a) -> k -> Strict (Map k) a -> Strict (Map k) a-alter f k = StrictMap . Map.alter aux k . toLazyMap-  where-    aux :: Maybe a -> Maybe a-    aux ma = case f ma of-               Nothing -> Nothing-               Just a  -> a `seq` Just a---- We use alter because it gives us something to anchor a seq to-adjust :: forall k v. Ord k => (v -> v) -> k -> Strict (Map k) v -> Strict (Map k) v-adjust f i = StrictMap . Map.alter aux i . toLazyMap-  where-    aux :: Maybe v -> Maybe v-    aux Nothing  = Nothing-    aux (Just v) = let v' = f v in v' `seq` Just v'--member :: Ord k => k -> Strict (Map k) v -> Bool-member k = Map.member k . toLazyMap--(!) :: Ord k => Strict (Map k) v -> k -> v-(!) = (Map.!) . toLazyMap--keys :: Strict (Map k) a -> [k]-keys = Map.keys . toLazyMap--elems :: Strict (Map k) a -> [a]-elems = Map.elems . toLazyMap--delete :: Ord k => k -> Strict (Map k) a -> Strict (Map k) a-delete k = StrictMap . Map.delete k . toLazyMap--accessor :: Ord k => k -> Accessor (Strict (Map k) a) (Maybe a)-accessor key = Acc.accessor (lookup key) (\mval mp -> case mval of-                                            Just val -> insert key val mp-                                            Nothing  -> delete key mp)--accessorDefault :: Ord k => v -> k -> Accessor (Strict (Map k) v) v-accessorDefault d k = Acc.accessor (findWithDefault d k) (insert k)

@@ -1,24 +0,0 @@-{-# LANGUAGE TemplateHaskell, DeriveFunctor #-}--- | Version of maybe that is strict in its argument-module IdeSession.Strict.Maybe (-    nothing-  , just-  , maybe-  , fromMaybe-  ) where--import Prelude hiding (maybe)-import IdeSession.Strict.Container-import qualified Data.Maybe as Maybe--nothing :: Strict Maybe a-nothing = force $ Nothing--just :: a -> Strict Maybe a-just = force . Just--maybe :: b -> (a -> b) -> Strict Maybe a -> b-maybe x f =  Maybe.maybe x f . toLazyMaybe--fromMaybe :: a -> Strict Maybe a -> a-fromMaybe def = Maybe.fromMaybe def . toLazyMaybe

@@ -1,65 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}--- | Version on StateT which evaluates the state strictly at every step-module IdeSession.Strict.StateT (-    -- * Transformer-    StrictStateT(..)-  , modify-  , evalStateT-  , execStateT-    -- * As base monad-  , StrictState-  , runState-  , evalState-  , execState-  ) where--import Control.Applicative-import Control.Monad.State.Class-import Control.Monad.Trans.Class-import Data.Functor.Identity--newtype StrictStateT s m a = StrictStateT { runStateT :: s -> m (a, s) }--instance Monad m => Applicative (StrictStateT s m) where-  pure    = return-  f <*> x = do f' <- f ; x' <- x ; return (f' x')--instance Monad m => Monad (StrictStateT s m) where-  return a = StrictStateT $ \s -> return (a, s)-  x >>= f  = StrictStateT $ \s -> do (a, s')  <- runStateT x s-                                     (b, s'') <- runStateT (f a) s'-                                     return (b, s'')--instance Monad m => Functor (StrictStateT s m) where-  f `fmap` m = m >>= return . f--instance Monad m => MonadState s (StrictStateT s m) where-  get     = StrictStateT $ \s -> return (s, s)-  put s   = StrictStateT $ \_ -> s `seq` return ((), s)-  state f = StrictStateT $ \s -> do let (a, s') = f s-                                    s' `seq` return (a, s')--instance MonadTrans (StrictStateT s) where-  lift m = StrictStateT $ \s -> do a <- m-                                   return (a, s)--evalStateT :: Monad m => StrictStateT s m a -> s -> m a-evalStateT m s = do (a, _) <- runStateT m s ; return a--execStateT :: Monad m => StrictStateT s m a -> s -> m s-execStateT m s = do (_, s') <- runStateT m s ; return s'--{-------------------------------------------------------------------------------  As base monad-------------------------------------------------------------------------------}--type StrictState s = StrictStateT s Identity--runState :: StrictState s a -> s -> (a, s)-runState m s = runIdentity $ runStateT m s--evalState :: StrictState s a -> s -> a-evalState m = fst . runState m--execState :: StrictState s a -> s -> s-execState m = snd . runState m

@@ -1,27 +0,0 @@-module IdeSession.Strict.Trie (-    empty-  , submap-  , elems-  , fromListWith-  , toList-  ) where--import Data.ByteString (ByteString)-import qualified Data.Trie as Trie-import qualified Data.Trie.Convenience as Trie-import IdeSession.Strict.Container--empty :: Strict Trie a-empty = StrictTrie $ Trie.empty--submap :: ByteString -> Strict Trie a -> Strict Trie a-submap bs = StrictTrie . Trie.submap bs . toLazyTrie--elems :: Strict Trie a -> [a]-elems = Trie.elems . toLazyTrie--fromListWith :: (a -> a -> a) -> [(ByteString, a)] -> Strict Trie a-fromListWith f = force . Trie.fromListWith f--toList :: Strict Trie a -> [(ByteString, a)]-toList = Trie.toList . toLazyTrie

@@ -1,411 +0,0 @@-{-# LANGUAGE TemplateHaskell, GeneralizedNewtypeDeriving, DeriveDataTypeable, DeriveGeneric #-}--- | The private types-module IdeSession.Types.Private (-    -- * Types without a public counterpart-    FilePathPtr(..)-  , IdPropPtr(..)-  , UseSites-    -- * Types with a public counterpart-  , Public.IdNameSpace(..)-  , IdInfo(..)-  , IdProp(..)-  , IdScope(..)-  , SourceSpan(..)-  , EitherSpan(..)-  , SourceError(..)-  , Public.SourceErrorKind(..)-  , Public.ModuleName-  , ModuleId(..)-  , PackageId(..)-  , IdList-  , IdMap(..)-  , ExpMap(..)-  , SpanInfo(..)-  , ImportEntities(..)-  , Import(..)-  , RunResult(..)-  , BreakInfo(..)-    -- * Cache-  , ExplicitSharingCache(..)-  , unionCache-    -- * Util-  , mkIdMap-  , mkExpMap-  , dominators-  ) where--import Prelude hiding (span, mod)-import Data.Text (Text)-import Data.ByteString (ByteString)-import Control.Applicative ((<$>), (<*>))-import Control.Arrow (first)-import Data.Binary (Binary(..), getWord8, putWord8)-import Data.Typeable (Typeable)-import GHC.Generics (Generic)--import qualified IdeSession.Types.Public as Public-import IdeSession.Strict.Container-import IdeSession.Strict.IntervalMap (StrictIntervalMap, Interval(..))-import qualified IdeSession.Strict.IntervalMap as IntervalMap-import qualified IdeSession.Strict.IntMap      as IntMap-import IdeSession.Util.PrettyVal--newtype FilePathPtr = FilePathPtr { filePathPtr :: Int }-  deriving (Eq, Ord, Show, Generic)--newtype IdPropPtr = IdPropPtr { idPropPtr :: Int }-  deriving (Eq, Ord, Show, Generic)--data IdInfo = IdInfo {-    idProp  :: {-# UNPACK #-} !IdPropPtr-  , idScope :: !IdScope-  }-  deriving (Show, Typeable, Generic)--data IdProp = IdProp {-    idName       :: !Text-  , idSpace      :: !Public.IdNameSpace-  , idType       :: !(Strict Maybe Public.Type)-  , idDefinedIn  :: {-# UNPACK #-} !ModuleId-  , idDefSpan    :: !EitherSpan-  , idHomeModule :: !(Strict Maybe ModuleId)-  }-  deriving (Show, Generic)--data IdScope =-    -- | This is a binding occurrence (@f x = ..@, @\x -> ..@, etc.)-    Binder-    -- | Defined within this module-  | Local-    -- | Imported from a different module-  | Imported {-        idImportedFrom :: {-# UNPACK #-} !ModuleId-      , idImportSpan   :: !EitherSpan-        -- | Qualifier used for the import-        ---        -- > IMPORTED AS                       idImportQual-        -- > import Data.List                  ""-        -- > import qualified Data.List        "Data.List."-        -- > import qualified Data.List as L   "L."-      , idImportQual   :: !Text-      }-    -- | Wired into the compiler (@()@, @True@, etc.)-  | WiredIn-  deriving (Show, Generic)--data SourceSpan = SourceSpan-  { spanFilePath   :: {-# UNPACK #-} !FilePathPtr-  , spanFromLine   :: {-# UNPACK #-} !Int-  , spanFromColumn :: {-# UNPACK #-} !Int-  , spanToLine     :: {-# UNPACK #-} !Int-  , spanToColumn   :: {-# UNPACK #-} !Int-  }-  deriving (Eq, Ord, Show, Generic)--data EitherSpan =-    ProperSpan {-# UNPACK #-} !SourceSpan-  | TextSpan !Text-  deriving (Show, Generic)--data SourceError = SourceError-  { errorKind :: !Public.SourceErrorKind-  , errorSpan :: !EitherSpan-  , errorMsg  :: !Text-  }-  deriving (Show, Generic)--data ModuleId = ModuleId-  { moduleName    :: !Public.ModuleName-  , modulePackage :: {-# UNPACK #-} !PackageId-  }-  deriving (Show, Eq, Generic)--data PackageId = PackageId-  { packageName    :: !Text-  , packageVersion :: !(Strict Maybe Text)-  , packageKey     :: !Text-  }-  deriving (Show, Eq, Ord, Generic)---- | Used before we convert it to an IdMap-type IdList = [(SourceSpan, SpanInfo)]--data SpanInfo =-   SpanId IdInfo- | SpanQQ IdInfo-   -- We use 'SpanInSplice' for prioritization only (see 'internalGetSpanInfo').-   -- It gets translated to 'Public.SpanId'- | SpanInSplice IdInfo- deriving (Show, Generic)--newtype IdMap = IdMap { idMapToMap :: StrictIntervalMap (FilePathPtr, Int, Int) SpanInfo }-  deriving (Show, Generic)--newtype ExpMap = ExpMap { expMapToMap :: StrictIntervalMap (FilePathPtr, Int, Int) Text }-  deriving (Show, Generic)--type UseSites = Strict (Map IdPropPtr) [SourceSpan]--data ImportEntities =-    ImportOnly   !(Strict [] Text)-  | ImportHiding !(Strict [] Text)-  | ImportAll-  deriving (Show, Eq, Generic)--data Import = Import {-    importModule    :: !ModuleId-  -- | Used only for ghc's PackageImports extension-  , importPackage   :: !(Strict Maybe Text)-  , importQualified :: !Bool-  , importImplicit  :: !Bool-  , importAs        :: !(Strict Maybe Public.ModuleName)-  , importEntities  :: !ImportEntities-  }-  deriving (Show, Eq, Generic)---- | The outcome of running code-data RunResult =-    -- | The code terminated okay-    RunOk-    -- | The code threw an exception-  | RunProgException String-    -- | GHC itself threw an exception when we tried to run the code-  | RunGhcException String-    -- | Execution was paused because of a breakpoint-  | RunBreak BreakInfo-  deriving (Typeable, Show, Generic)---- | Information about a triggered breakpoint-data BreakInfo = BreakInfo {-    breakInfoModule      :: Public.ModuleName-  , breakInfoSpan        :: SourceSpan-  , breakInfoResultType  :: Public.Type-  , breakInfoVariableEnv :: Public.VariableEnv-  }-  deriving (Typeable, Show, Generic)--{-------------------------------------------------------------------------------  Cache-------------------------------------------------------------------------------}---- TODO: Since the ExplicitSharingCache contains internal types, resolving--- references to the cache means we lose implicit sharing because we need--- to translate on every lookup. To avoid this, we'd have to introduce two--- versions of the cache and translate the entire cache first.-data ExplicitSharingCache = ExplicitSharingCache {-    filePathCache :: !(Strict IntMap ByteString)-  , idPropCache   :: !(Strict IntMap IdProp)-  }-  deriving (Show, Generic)--unionCache :: ExplicitSharingCache -> ExplicitSharingCache -> ExplicitSharingCache-unionCache a b = ExplicitSharingCache {-    filePathCache = IntMap.union (filePathCache a) (filePathCache b)-  , idPropCache   = IntMap.union (idPropCache   a) (idPropCache   b)-  }--{-------------------------------------------------------------------------------  Binary instances-------------------------------------------------------------------------------}--instance Binary FilePathPtr where-  put = put . filePathPtr-  get = FilePathPtr <$> get--instance Binary SourceSpan where-  put SourceSpan{..} = do-    put spanFilePath-    put spanFromLine-    put spanFromColumn-    put spanToLine-    put spanToColumn-  get = SourceSpan <$> get <*> get <*> get <*> get <*> get--instance Binary EitherSpan where-  put (ProperSpan span) = putWord8 0 >> put span-  put (TextSpan text)   = putWord8 1 >> put text--  get = do-    header <- getWord8-    case header of-      0 -> ProperSpan <$> get-      1 -> TextSpan <$> get-      _ -> fail "EitherSpan.get: invalid header"--instance Binary SourceError where-  put SourceError{..} = do-    put errorKind-    put errorSpan-    put errorMsg--  get = SourceError <$> get <*> get <*> get--instance Binary IdInfo where-  put IdInfo{..} = put idProp >> put idScope-  get = IdInfo <$> get <*> get--instance Binary IdScope where-  put Binder       = putWord8 0-  put Local        = do putWord8 1-  put Imported{..} = do putWord8 2-                        put idImportedFrom-                        put idImportSpan-                        put idImportQual-  put WiredIn      = putWord8 3--  get = do-    header <- getWord8-    case header of-      0 -> return Binder-      1 -> return Local-      2 -> Imported <$> get <*> get <*> get-      3 -> return WiredIn-      _ -> fail "IdScope.get: invalid header"--instance Binary IdPropPtr where-  put = put . idPropPtr-  get = IdPropPtr <$> get--instance Binary ModuleId where-  put ModuleId{..} = put moduleName >> put modulePackage-  get = ModuleId <$> get <*> get--instance Binary PackageId where-  put PackageId{..} = do-    put packageName-    put packageVersion-    put packageKey-  get = PackageId <$> get <*> get <*> get--instance Binary IdProp where-  put IdProp{..} = do-    put idName-    put idSpace-    put idType-    put idDefinedIn-    put idDefSpan-    put idHomeModule--  get = IdProp <$> get <*> get <*> get <*> get <*> get <*> get--{--instance Binary IdMap where-  put = put . idMapToMap-  get = IdMap <$> get--}--instance Binary ImportEntities where-  put (ImportOnly names)   = putWord8 0 >> put names-  put (ImportHiding names) = putWord8 1 >> put names-  put ImportAll            = putWord8 2--  get = do-    header <- getWord8-    case header of-      0 -> ImportOnly   <$> get-      1 -> ImportHiding <$> get-      2 -> return ImportAll-      _ -> fail "ImportEntities.get: invalid header"--instance Binary Import where-  put Import{..} = do-    put importModule-    put importPackage-    put importQualified-    put importImplicit-    put importAs-    put importEntities--  get = Import <$> get <*> get <*> get <*> get <*> get <*> get--instance Binary ExplicitSharingCache where-  put ExplicitSharingCache{..} = do-    put filePathCache-    put idPropCache--  get = ExplicitSharingCache <$> get <*> get--instance Binary SpanInfo where-  put (SpanId idInfo)       = putWord8 0 >> put idInfo-  put (SpanQQ idInfo)       = putWord8 1 >> put idInfo-  put (SpanInSplice idInfo) = putWord8 2 >> put idInfo--  get = do-    header <- getWord8-    case header of-      0 -> SpanId       <$> get-      1 -> SpanQQ       <$> get-      2 -> SpanInSplice <$> get-      _ -> fail "SpanInfo.get: invalid header"--instance Binary RunResult where-  put RunOk                  = putWord8 0-  put (RunProgException str) = putWord8 1 >> put str-  put (RunGhcException str)  = putWord8 2 >> put str-  put (RunBreak info)        = putWord8 3 >> put info--  get = do-    header <- getWord8-    case header of-      0 -> return RunOk-      1 -> RunProgException <$> get-      2 -> RunGhcException <$> get-      3 -> RunBreak <$> get-      _ -> fail "RunResult.get: invalid header"--instance Binary BreakInfo where-  put (BreakInfo{..}) = do-    put breakInfoModule-    put breakInfoSpan-    put breakInfoResultType-    put breakInfoVariableEnv--  get = BreakInfo <$> get <*> get <*> get <*> get--{-------------------------------------------------------------------------------  PrettyVal instances (these rely on Generics)-------------------------------------------------------------------------------}--instance PrettyVal FilePathPtr-instance PrettyVal IdPropPtr-instance PrettyVal IdInfo-instance PrettyVal IdProp-instance PrettyVal IdScope-instance PrettyVal SourceSpan-instance PrettyVal EitherSpan-instance PrettyVal SourceError-instance PrettyVal ModuleId-instance PrettyVal PackageId-instance PrettyVal SpanInfo-instance PrettyVal IdMap-instance PrettyVal ExpMap-instance PrettyVal ImportEntities-instance PrettyVal Import-instance PrettyVal RunResult-instance PrettyVal BreakInfo-instance PrettyVal ExplicitSharingCache--{-------------------------------------------------------------------------------  Util-------------------------------------------------------------------------------}--mkIdMap :: IdList -> IdMap-mkIdMap = IdMap . IntervalMap.fromList . map (first spanToInterval)--mkExpMap :: [(SourceSpan, Text)] -> ExpMap-mkExpMap = ExpMap . IntervalMap.fromList . map (first spanToInterval)--dominators :: SourceSpan -> StrictIntervalMap (FilePathPtr, Int, Int) a -> [(SourceSpan, a)]-dominators span ivalmap =-    map (\(ival, idInfo) -> (intervalToSpan ival, idInfo))-        (IntervalMap.dominators (spanToInterval span) ivalmap)--spanToInterval :: SourceSpan -> Interval (FilePathPtr, Int, Int)-spanToInterval SourceSpan{..} =-  Interval (spanFilePath, spanFromLine, spanFromColumn)-           (spanFilePath, spanToLine, spanToColumn)--intervalToSpan :: Interval (FilePathPtr, Int, Int) -> SourceSpan-intervalToSpan (Interval (spanFilePath, spanFromLine, spanFromColumn)-                         (_,            spanToLine, spanToColumn)) =-  SourceSpan{..}

@@ -1,61 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-module IdeSession.Types.Progress (-    Progress(..)-  ) where--import Control.Applicative ((<$>), (<*>), (<|>))-import Data.Binary (Binary(..))-import Data.Text (Text)-import Data.Maybe (fromJust)-import GHC.Generics (Generic)-import qualified Data.Text as Text-import Text.Show.Pretty (PrettyVal)--import IdeSession.Util () -- instance Binary Text---- | This type represents intermediate progress information during compilation.-data Progress = Progress {-    -- | The current step number-    ---    -- When these Progress messages are generated from progress updates from-    -- ghc, it is entirely possible that we might get step 4/26, 16/26, 3/26;-    -- the steps may not be continuous, might even be out of order, and may-    -- not finish at X/X.-    progressStep :: Int--    -- | The total number of steps-  , progressNumSteps :: Int--    -- | The parsed message. For instance, in the case of progress messages-    -- during compilation, 'progressOrigMsg' might be-    ---    -- > [1 of 2] Compiling M (some/path/to/file.hs, some/other/path/to/file.o)-    ---    -- while 'progressMsg' will just be 'Compiling M'-  , progressParsedMsg :: Maybe Text--    -- | The full original message (see 'progressMsg')-  , progressOrigMsg :: Maybe Text-  }-  deriving (Eq, Ord, Generic)--instance PrettyVal Progress--instance Binary Progress where-  put (Progress {..}) = do put progressStep-                           put progressNumSteps-                           put progressParsedMsg-                           put progressOrigMsg-  get = Progress <$> get <*> get <*> get <*> get--instance Show Progress where-  show (Progress{..}) =-         "["-      ++ show progressStep-      ++ " of "-      ++ show progressNumSteps-      ++ "]"-      ++ fromJust (pad progressParsedMsg <|> pad progressOrigMsg <|> Just "")-    where-      pad :: Maybe Text -> Maybe String-      pad = fmap $ \t -> " " ++ Text.unpack t

@@ -1,571 +0,0 @@-{-# LANGUAGE TemplateHaskell, DeriveDataTypeable, DeriveGeneric #-}--- | The public types-module IdeSession.Types.Public (-    -- * Types-    IdNameSpace(..)-  , Type-  , Name-  , IdInfo(..)-  , IdProp(..)-  , IdScope(..)-  , SourceSpan(..)-  , EitherSpan(..)-  , SourceError(..)-  , SourceErrorKind(..)-  , ModuleName-  , ModuleId(..)-  , PackageId(..)---  , IdMap(..)---  , LoadedModules-  , ImportEntities(..)-  , Import(..)-  , SpanInfo(..)-  , RunBufferMode(..)-  , RunResult(..)-  , BreakInfo(..)-  , Value-  , VariableEnv-  , Targets(..)-    -- * Util-  , idInfoQN---, idInfoAtLocation-  , haddockLink-  ) where--import Prelude hiding (span)-import Control.Applicative ((<$>), (<*>))-import Data.Text (Text)-import qualified Data.Text as Text-import Data.Binary (Binary(..), getWord8, putWord8)-import Data.Aeson.TH (deriveJSON, defaultOptions)-import Data.Typeable (Typeable)-import GHC.Generics (Generic)--import IdeSession.Util () -- Binary instance for Text-import IdeSession.Util.PrettyVal--{-------------------------------------------------------------------------------  Types-------------------------------------------------------------------------------}---- | Identifiers in Haskell are drawn from a number of different name spaces-data IdNameSpace =-    VarName    -- ^ Variables, including real data constructors-  | DataName   -- ^ Source data constructors-  | TvName     -- ^ Type variables-  | TcClsName  -- ^ Type constructors and classes-  deriving (Show, Eq, Generic)---- | Information about identifiers-data IdInfo = IdInfo {-    idProp  :: {-# UNPACK #-} !IdProp-  , idScope :: !IdScope-  }-  deriving (Eq, Generic)---- | Variable name-type Name = Text---- | For now we represent types in pretty-printed form-type Type = Text---- | Identifier info that is independent of the usage site-data IdProp = IdProp {-    -- | The base name of the identifer at this location. Module prefix-    -- is not included.-    idName  :: !Name-    -- | Namespace this identifier is drawn from-  , idSpace :: !IdNameSpace-    -- | The type-    -- We don't always know this; in particular, we don't know kinds because-    -- the type checker does not give us LSigs for top-level annotations)-  , idType  :: !(Maybe Type)-    -- | Module the identifier was defined in-  , idDefinedIn :: {-# UNPACK #-} !ModuleId-    -- | Where in the module was it defined (not always known)-  , idDefSpan :: !EitherSpan-    -- | Haddock home module-  , idHomeModule :: !(Maybe ModuleId)-  }-  deriving (Eq, Generic)---- TODO: Ideally, we would have--- 1. SourceSpan for Local rather than EitherSpan--- 2. SourceSpan for idImportSpan--- 3. Have a idImportedFromPackage, but unfortunately ghc doesn't give us---    this information (it's marked as a TODO in RdrName.lhs)-data IdScope =-    -- | This is a binding occurrence (@f x = ..@, @\x -> ..@, etc.)-    Binder-    -- | Defined within this module-  | Local-    -- | Imported from a different module-  | Imported {-        idImportedFrom :: {-# UNPACK #-} !ModuleId-      , idImportSpan   :: !EitherSpan-        -- | Qualifier used for the import-        ---        -- > IMPORTED AS                       idImportQual-        -- > import Data.List                  ""-        -- > import qualified Data.List        "Data.List."-        -- > import qualified Data.List as L   "L."-      , idImportQual   :: !Text-      }-    -- | Wired into the compiler (@()@, @True@, etc.)-  | WiredIn-  deriving (Eq, Generic)--data SourceSpan = SourceSpan-  { spanFilePath   :: !FilePath-  , spanFromLine   :: {-# UNPACK #-} !Int-  , spanFromColumn :: {-# UNPACK #-} !Int-  , spanToLine     :: {-# UNPACK #-} !Int-  , spanToColumn   :: {-# UNPACK #-} !Int-  }-  deriving (Eq, Ord, Generic)--data EitherSpan =-    ProperSpan {-# UNPACK #-} !SourceSpan-  | TextSpan !Text-  deriving (Eq, Generic)---- | An error or warning in a source module.------ Most errors are associated with a span of text, but some have only a--- location point.-data SourceError = SourceError-  { errorKind :: !SourceErrorKind-  , errorSpan :: !EitherSpan-  , errorMsg  :: !Text-  }-  deriving (Show, Eq, Generic)---- | Severity of an error.-data SourceErrorKind = KindError | KindWarning | KindServerDied-  deriving (Show, Eq, Generic)--type ModuleName = Text--data ModuleId = ModuleId-  { moduleName    :: !ModuleName-  , modulePackage :: {-# UNPACK #-} !PackageId-  }-  deriving (Eq, Ord, Generic)---- | A package ID in ide-backend consists of a human-readable package name--- and version (what Cabal calls a source ID) along with ghc's internal--- package key (primarily for internal use).-data PackageId = PackageId-  { packageName    :: !Text-  , packageVersion :: !(Maybe Text)-  , packageKey     :: !Text-  }-  deriving (Eq, Ord, Generic)--{--newtype IdMap = IdMap { idMapToMap :: Map SourceSpan IdInfo }--type LoadedModules = Map ModuleName IdMap--}--data ImportEntities =-    ImportOnly   ![Text]-  | ImportHiding ![Text]-  | ImportAll-  deriving (Show, Eq, Ord, Generic)--data Import = Import {-    importModule    :: !ModuleId-  -- | Used only for ghc's PackageImports extension-  , importPackage   :: !(Maybe Text)-  , importQualified :: !Bool-  , importImplicit  :: !Bool-  , importAs        :: !(Maybe ModuleName)-  , importEntities  :: !ImportEntities-  }-  deriving (Show, Eq, Ord, Generic)---- | Returned then the IDE asks "what's at this particular location?"-data SpanInfo =-    -- | Identifier-    SpanId IdInfo-    -- | Quasi-quote. The 'IdInfo' field gives the quasi-quoter-  | SpanQQ IdInfo-  deriving (Generic)---- | Buffer modes for running code------ Note that 'NoBuffering' means that something like 'putStrLn' will do a--- syscall per character, and each of these characters will be read and sent--- back to the client. This results in a large overhead.------ When using 'LineBuffering' or 'BlockBuffering', 'runWait' will not report--- any output from the snippet until it outputs a linebreak/fills the buffer,--- respectively (or does an explicit flush). However, you can specify a timeout--- in addition to the buffering mode; if you set this to @Just n@, the buffer--- will be flushed every @n@ microseconds.------ NOTE: This is duplicated in the IdeBackendRTS (defined in IdeSession)-data RunBufferMode =-    RunNoBuffering-  | RunLineBuffering  { runBufferTimeout   :: Maybe Int }-  | RunBlockBuffering { runBufferBlockSize :: Maybe Int-                      , runBufferTimeout   :: Maybe Int-                      }-  deriving (Typeable, Show, Generic, Eq)---- | The outcome of running code-data RunResult =-    -- | The code terminated okay-    RunOk-    -- | The code threw an exception-  | RunProgException String-    -- | GHC itself threw an exception when we tried to run the code-  | RunGhcException String-    -- | The session was restarted-  | RunForceCancelled-    -- | Execution was paused because of a breakpoint-  | RunBreak-  deriving (Typeable, Show, Eq, Generic)---- | Information about a triggered breakpoint-data BreakInfo = BreakInfo {-    -- | Module containing the breakpoint-    breakInfoModule :: ModuleName-    -- | Location of the breakpoint-  , breakInfoSpan :: SourceSpan-    -- | Type of the result-  , breakInfoResultType :: Type-    -- | Local variables and their values-  , breakInfoVariableEnv :: VariableEnv-  }-  deriving (Typeable, Show, Eq, Generic)---- | We present values only in pretty-printed form-type Value = Text---- | Variables during execution (in debugging mode)-type VariableEnv = [(Name, Type, Value)]--data Targets = TargetsInclude [FilePath] | TargetsExclude [FilePath]-  deriving (Typeable, Generic, Eq, Show)--{-------------------------------------------------------------------------------  Show instances-------------------------------------------------------------------------------}--instance Show SourceSpan where-  show (SourceSpan{..}) =-       spanFilePath ++ "@"-    ++ show spanFromLine ++ ":" ++ show spanFromColumn ++ "-"-    ++ show spanToLine   ++ ":" ++ show spanToColumn--instance Show IdProp where-  show (IdProp {..}) =-       Text.unpack idName ++ " "-    ++ "(" ++ show idSpace ++ ")"-    ++ (case idType of Just typ -> " :: " ++ Text.unpack typ; Nothing -> [])-    ++ " defined in "-    ++ show idDefinedIn-    ++ " at " ++ show idDefSpan-    ++ (case idHomeModule of Just home -> " (home " ++ show home ++ ")"-                             Nothing   -> "")--instance Show IdScope where-  show Binder          = "binding occurrence"-  show Local           = "defined locally"-  show WiredIn         = "wired in to the compiler"-  show (Imported {..}) =-           "imported from " ++ show idImportedFrom-        ++ (if Text.null idImportQual-              then []-              else " as '" ++ Text.unpack idImportQual ++ "'")-        ++ " at "++ show idImportSpan--instance Show EitherSpan where-  show (ProperSpan srcSpan) = show srcSpan-  show (TextSpan str)       = Text.unpack str--instance Show ModuleId where-  show (ModuleId mo pkg) = show pkg ++ ":" ++ Text.unpack mo--instance Show PackageId where-  show (PackageId name (Just version) _pkey) =-    Text.unpack name ++ "-" ++ Text.unpack version-  show (PackageId name Nothing _pkey) =-    Text.unpack name--instance Show IdInfo where-  show IdInfo{..} = show idProp ++ " (" ++ show idScope ++ ")"--instance Show SpanInfo where-  show (SpanId idInfo) = show idInfo-  show (SpanQQ idInfo) = "quasi-quote with quoter " ++ show idInfo--{--instance Show IdMap where-  show =-    let showIdInfo(span, idInfo) = "(" ++ show span ++ "," ++ show idInfo ++ ")"-    in unlines . map showIdInfo . Map.toList . idMapToMap--}--{-------------------------------------------------------------------------------  Binary instances--  We only have Binary instances for those types that are shared between-  the public and private types, and for the "small" types that are the result of-  IDE session queries. We don't want Binary instances for entire LoadedModules-  maps and other "large" types.-------------------------------------------------------------------------------}--instance Binary IdNameSpace where-  put VarName   = putWord8 0-  put DataName  = putWord8 1-  put TvName    = putWord8 2-  put TcClsName = putWord8 3--  get = do-    header <- getWord8-    case header of-      0 -> return VarName-      1 -> return DataName-      2 -> return TvName-      3 -> return TcClsName-      _ -> fail "IdNameSpace.get: invalid header"--instance Binary SourceErrorKind where-  put KindError      = putWord8 0-  put KindWarning    = putWord8 1-  put KindServerDied = putWord8 2--  get = do-    header <- getWord8-    case header of-      0 -> return KindError-      1 -> return KindWarning-      2 -> return KindServerDied-      _ -> fail "SourceErrorKind.get: invalid header"--instance Binary ImportEntities where-  put (ImportOnly names)   = putWord8 0 >> put names-  put (ImportHiding names) = putWord8 1 >> put names-  put ImportAll            = putWord8 2--  get = do-    header <- getWord8-    case header of-      0 -> ImportOnly   <$> get-      1 -> ImportHiding <$> get-      2 -> return ImportAll-      _ -> fail "ImportEntities.get: invalid header"--instance Binary Import where-  put Import{..} = do-    put importModule-    put importPackage-    put importQualified-    put importImplicit-    put importAs-    put importEntities--  get = Import <$> get <*> get <*> get <*> get <*> get <*> get--instance Binary SourceError where-  put SourceError{..} = do-    put errorKind-    put errorSpan-    put errorMsg--  get = SourceError <$> get <*> get <*> get--instance Binary IdProp where-  put IdProp{..} = do-    put idName-    put idSpace-    put idType-    put idDefinedIn-    put idDefSpan-    put idHomeModule--  get = IdProp <$> get <*> get <*> get <*> get <*> get <*> get--instance Binary IdScope where-  put Binder       = putWord8 0-  put Local        = putWord8 1-  put Imported{..} = do putWord8 2-                        put idImportedFrom-                        put idImportSpan-                        put idImportQual-  put WiredIn      = putWord8 3--  get = do-    header <- getWord8-    case header of-      0 -> return Binder-      1 -> return Local-      2 -> Imported <$> get <*> get <*> get-      3 -> return WiredIn-      _ -> fail "IdScope.get: invalid header"--instance Binary SourceSpan where-  put (SourceSpan{..}) = do-    put spanFilePath-    put spanFromLine-    put spanFromColumn-    put spanToLine-    put spanToColumn--  get = SourceSpan <$> get <*> get <*> get <*> get <*> get--instance Binary EitherSpan where-  put (ProperSpan span) = putWord8 0 >> put span-  put (TextSpan text)   = putWord8 1 >> put text--  get = do-    header <- getWord8-    case header of-      0 -> ProperSpan <$> get-      1 -> TextSpan <$> get-      _ -> fail "EitherSpan.get: invalid header"--instance Binary ModuleId where-  put ModuleId{..} = put moduleName >> put modulePackage-  get = ModuleId <$> get <*> get--instance Binary PackageId where-  put PackageId{..} = do-    put packageName-    put packageVersion-    put packageKey-  get = PackageId <$> get <*> get <*> get--instance Binary IdInfo where-  put IdInfo{..} = put idProp >> put idScope-  get = IdInfo <$> get <*> get--instance Binary RunBufferMode where-  put RunNoBuffering        = putWord8 0-  put RunLineBuffering{..}  = do putWord8 1-                                 put runBufferTimeout-  put RunBlockBuffering{..} = do putWord8 2-                                 put runBufferBlockSize-                                 put runBufferTimeout--  get = do-    header <- getWord8-    case header of-      0 -> return RunNoBuffering-      1 -> RunLineBuffering <$> get-      2 -> RunBlockBuffering <$> get <*> get-      _ -> fail "RunBufferMode.get: invalid header"--instance Binary Targets where-  put (TargetsInclude l) = do-    putWord8 0-    put l-  put (TargetsExclude l) = do-    putWord8 1-    put l--  get = do-    header <- getWord8-    case header of-      0 -> TargetsInclude <$> get-      1 -> TargetsExclude <$> get-      _ -> fail "Targets.get: invalid header"--{-------------------------------------------------------------------------------  JSON instances--  We provide these for the convenience of client code only; we don't use them-  internally.-------------------------------------------------------------------------------}--$(deriveJSON defaultOptions ''IdNameSpace)-$(deriveJSON defaultOptions ''SourceErrorKind)-$(deriveJSON defaultOptions ''ImportEntities)-$(deriveJSON defaultOptions ''Import)-$(deriveJSON defaultOptions ''SourceError)-$(deriveJSON defaultOptions ''IdProp)-$(deriveJSON defaultOptions ''IdScope)-$(deriveJSON defaultOptions ''SourceSpan)-$(deriveJSON defaultOptions ''EitherSpan)-$(deriveJSON defaultOptions ''ModuleId)-$(deriveJSON defaultOptions ''PackageId)-$(deriveJSON defaultOptions ''IdInfo)-$(deriveJSON defaultOptions ''SpanInfo)-$(deriveJSON defaultOptions ''BreakInfo)-$(deriveJSON defaultOptions ''RunResult)-$(deriveJSON defaultOptions ''RunBufferMode)--{-------------------------------------------------------------------------------  PrettyVal instances (these rely on Generics)-------------------------------------------------------------------------------}--instance PrettyVal IdNameSpace-instance PrettyVal IdInfo-instance PrettyVal IdProp-instance PrettyVal IdScope-instance PrettyVal SourceSpan-instance PrettyVal EitherSpan-instance PrettyVal SourceError-instance PrettyVal SourceErrorKind-instance PrettyVal ModuleId-instance PrettyVal PackageId-instance PrettyVal ImportEntities-instance PrettyVal Import-instance PrettyVal SpanInfo-instance PrettyVal RunBufferMode-instance PrettyVal RunResult-instance PrettyVal BreakInfo-instance PrettyVal Targets--{-------------------------------------------------------------------------------  Util-------------------------------------------------------------------------------}---- | Construct qualified name following Haskell's scoping rules-idInfoQN :: IdInfo -> String-idInfoQN IdInfo{idProp = IdProp{idName}, idScope} =-  case idScope of-    Binder                 -> Text.unpack idName-    Local{}                -> Text.unpack idName-    Imported{idImportQual} -> Text.unpack idImportQual ++ Text.unpack idName-    WiredIn                -> Text.unpack idName---- | Show approximately what Haddock adds to documentation URLs.-haddockSpaceMarks :: IdNameSpace -> String-haddockSpaceMarks VarName   = "v"-haddockSpaceMarks DataName  = "v"-haddockSpaceMarks TvName    = "t"-haddockSpaceMarks TcClsName = "t"---- | Show approximately a haddock link (without haddock root) for an id.--- This is an illustration and a test of the id info, but under ideal--- conditions could perhaps serve to link to documentation without--- going via Hoogle.-haddockLink :: IdProp -> IdScope -> String-haddockLink IdProp{..} idScope =-  case idScope of-    Imported{idImportedFrom} ->-         dashToSlash (modulePackage idImportedFrom)-      ++ "/doc/html/"-      ++ dotToDash (Text.unpack $ moduleName idImportedFrom) ++ ".html#"-      ++ haddockSpaceMarks idSpace ++ ":"-      ++ Text.unpack idName-    _ -> "<local identifier>"- where-   dotToDash = map (\c -> if c == '.' then '-' else c)-   dashToSlash p = case packageVersion p of-     Nothing      -> Text.unpack (packageName p) ++ "/latest"-     Just version -> Text.unpack (packageName p) ++ "/" ++ Text.unpack version--{--idInfoAtLocation :: Int -> Int -> IdMap -> [(SourceSpan, IdInfo)]-idInfoAtLocation line col = filter inRange . idMapToList-  where-    inRange :: (SourceSpan, a) -> Bool-    inRange (SourceSpan{..}, _) =-      (line   > spanFromLine || (line == spanFromLine && col >= spanFromColumn)) &&-      (line   < spanToLine   || (line == spanToLine   && col <= spanToColumn))--}

@@ -1,255 +0,0 @@-{-# LANGUAGE TypeFamilies, ScopedTypeVariables, TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-}--- | Translation from the private to the public types-module IdeSession.Types.Translation (-    XShared-  , ExplicitSharing(..)-  , IntroduceSharing(..)-  , showNormalized-  , dereferenceFilePathPtr-  ) where--import Prelude hiding (mod, span)-import qualified Data.ByteString.Char8 as BSSC-import qualified Data.Text as Text-import Data.Binary (Binary)--import IdeSession.Strict.Container-import qualified IdeSession.Types.Public  as Public-import qualified IdeSession.Types.Private as Private-import qualified IdeSession.Strict.IntMap as StrictIntMap-import qualified IdeSession.Strict.Maybe  as StrictMaybe---- | The associated type with explicit sharing-type family XShared a---- | The inverse of MShared, only for decidability of type checking-type family MShared a--type instance XShared Public.IdProp          = Private.IdProp-type instance XShared Public.IdInfo          = Private.IdInfo-type instance XShared Public.IdScope         = Private.IdScope-type instance XShared Public.SourceSpan      = Private.SourceSpan-type instance XShared Public.EitherSpan      = Private.EitherSpan-type instance XShared Public.SourceError     = Private.SourceError--- type instance XShared Public.IdMap           = Private.IdMap--- type instance XShared Public.LoadedModules   = Private.LoadedModules-type instance XShared Public.ModuleId        = Private.ModuleId-type instance XShared Public.PackageId       = Private.PackageId-type instance XShared Public.ImportEntities  = Private.ImportEntities-type instance XShared Public.Import          = Private.Import-type instance XShared Public.SpanInfo        = Private.SpanInfo-type instance XShared Public.RunResult       = Private.RunResult-type instance XShared Public.BreakInfo       = Private.BreakInfo--type instance MShared Private.IdProp         = Public.IdProp-type instance MShared Private.IdInfo         = Public.IdInfo-type instance MShared Private.IdScope        = Public.IdScope-type instance MShared Private.SourceSpan     = Public.SourceSpan-type instance MShared Private.EitherSpan     = Public.EitherSpan-type instance MShared Private.SourceError    = Public.SourceError--- type instance MShared Private.IdMap          = Public.IdMap--- type instance MShared Private.LoadedModules  = Public.LoadedModules-type instance MShared Private.ModuleId       = Public.ModuleId-type instance MShared Private.PackageId      = Public.PackageId-type instance MShared Private.ImportEntities = Public.ImportEntities-type instance MShared Private.Import         = Public.Import-type instance MShared Private.SpanInfo       = Public.SpanInfo-type instance MShared Private.RunResult      = Public.RunResult-type instance MShared Private.BreakInfo      = Public.BreakInfo--{-------------------------------------------------------------------------------  Removing explicit sharing-------------------------------------------------------------------------------}---- | Many of the public data types that we export in "IdeSession" have a--- corresponding private @XShared@ version. For instance, we have @IdProp@ and--- @XShared IdProp@, @SourceError@ and @XShared SourceError@, etc. These--- @XShared@ types are abstract; what's important is only that they can be--- serialized (support @FromJSON@ and @ToJSON@). The main difference between--- the public and the private data types is that the private data types use--- explicit sharing. This is important for serialization, because there is--- quite a bit of sharing in the type information that we collect and losing--- this would be a significant performance hit. (The other difference is that--- the private data types use specialized types that guarantee strictness.)------ The @MShared (XShared a) ~ a@ condition on the @ExplicitSharing@ type class--- is there for technical reasons only (it convinces GHC that the @XShared@--- type family is a bijection).-class (MShared (XShared a) ~ a, Binary (XShared a)) => ExplicitSharing a where-  removeExplicitSharing :: Private.ExplicitSharingCache -> XShared a -> a--showNormalized :: forall a. (Show a, ExplicitSharing a)-               => Private.ExplicitSharingCache -> XShared a -> String-showNormalized cache x = show (removeExplicitSharing cache x :: a)--instance ExplicitSharing Public.IdProp where-  removeExplicitSharing cache Private.IdProp{..} = Public.IdProp {-      Public.idName       = idName-    , Public.idSpace      = idSpace-    , Public.idType       = toLazyMaybe idType-    , Public.idDefSpan    = removeExplicitSharing cache idDefSpan-    , Public.idDefinedIn  = removeExplicitSharing cache idDefinedIn-    , Public.idHomeModule = StrictMaybe.maybe-                              Nothing-                              (Just . removeExplicitSharing cache)-                              idHomeModule-    }--instance ExplicitSharing Public.IdInfo where-  removeExplicitSharing cache Private.IdInfo{..} = Public.IdInfo {-      Public.idProp  = case StrictIntMap.lookup (Private.idPropPtr idProp)-                                                (Private.idPropCache cache)-                         of Just idProp' -> removeExplicitSharing cache idProp'-                            Nothing      -> unknownProp-    , Public.idScope = removeExplicitSharing cache idScope-    }-    where-      unknownProp = Public.IdProp {-          idName        = Text.pack "<<unknown id>>"-        , idSpace       = Public.VarName-        , idType        = Nothing-        , idDefinedIn   = unknownModule-        , idDefSpan     = Public.TextSpan (Text.pack "<<unknown span>>")-        , idHomeModule  = Nothing-        }--      unknownModule = Public.ModuleId {-          moduleName    = Text.pack "<<unknown module>>"-        , modulePackage = unknownPackage-        }--      unknownPackage = Public.PackageId {-         packageName    = Text.pack "<<unknown package>>"-       , packageVersion = Nothing-       , packageKey     = Text.pack "<<unknown package>>"-       }--instance ExplicitSharing Public.ModuleId where-  removeExplicitSharing cache Private.ModuleId{..} = Public.ModuleId {-      Public.moduleName    = moduleName-    , Public.modulePackage = removeExplicitSharing cache modulePackage-    }--instance ExplicitSharing Public.PackageId where-  removeExplicitSharing _cache Private.PackageId{..} = Public.PackageId {-      Public.packageName    = packageName-    , Public.packageVersion = toLazyMaybe packageVersion-    , Public.packageKey     = packageKey-    }--instance ExplicitSharing Public.IdScope where-  removeExplicitSharing cache idScope = case idScope of-    Private.Binder -> Public.Binder-    Private.Local  -> Public.Local-    Private.Imported {..} -> Public.Imported {-        Public.idImportedFrom = removeExplicitSharing cache idImportedFrom-      , Public.idImportSpan   = removeExplicitSharing cache idImportSpan-      , Public.idImportQual   = idImportQual-      }-    Private.WiredIn -> Public.WiredIn--instance ExplicitSharing Public.SourceSpan where-  removeExplicitSharing cache Private.SourceSpan{..} = Public.SourceSpan {-      Public.spanFilePath   = dereferenceFilePathPtr cache spanFilePath-    , Public.spanFromLine   = spanFromLine-    , Public.spanFromColumn = spanFromColumn-    , Public.spanToLine     = spanToLine-    , Public.spanToColumn   = spanToColumn-    }--instance ExplicitSharing Public.EitherSpan where-  removeExplicitSharing cache eitherSpan = case eitherSpan of-    Private.ProperSpan sourceSpan ->-      Public.ProperSpan (removeExplicitSharing cache sourceSpan)-    Private.TextSpan str ->-      Public.TextSpan str--instance ExplicitSharing Public.SourceError where-  removeExplicitSharing cache Private.SourceError{..} = Public.SourceError {-      Public.errorKind = errorKind-    , Public.errorSpan = removeExplicitSharing cache errorSpan-    , Public.errorMsg  = errorMsg-    }--{--instance ExplicitSharing Public.IdMap where-  removeExplicitSharing cache = Public.IdMap-                              . toLazyMap-                              . StrictMap.map (removeExplicitSharing cache)-                              . StrictMap.mapKeys (removeExplicitSharing cache)-                              . Private.idMapToMap--}--{--instance ExplicitSharing Public.LoadedModules where-  removeExplicitSharing cache = Map.map (removeExplicitSharing cache)-                              . toLazyMap--}--instance ExplicitSharing Public.ImportEntities where-  removeExplicitSharing _cache entities = case entities of-    Private.ImportAll          -> Public.ImportAll-    Private.ImportHiding names -> Public.ImportHiding (toLazyList names)-    Private.ImportOnly   names -> Public.ImportOnly (toLazyList names)--instance ExplicitSharing Public.Import where-  removeExplicitSharing cache Private.Import{..} = Public.Import {-      Public.importModule     = removeExplicitSharing cache $ importModule-    , Public.importPackage    = toLazyMaybe importPackage-    , Public.importQualified  = importQualified-    , Public.importImplicit   = importImplicit-    , Public.importAs         = toLazyMaybe importAs-    , Public.importEntities   = removeExplicitSharing cache $ importEntities-    }--instance ExplicitSharing Public.SpanInfo where-  removeExplicitSharing cache spanInfo = case spanInfo of-    Private.SpanId       idInfo -> Public.SpanId (removeExplicitSharing cache idInfo)-    Private.SpanQQ       idInfo -> Public.SpanQQ (removeExplicitSharing cache idInfo)-    Private.SpanInSplice idInfo -> Public.SpanId (removeExplicitSharing cache idInfo)--instance ExplicitSharing Public.BreakInfo where-  removeExplicitSharing cache Private.BreakInfo{..} = Public.BreakInfo {-      Public.breakInfoModule      = breakInfoModule-    , Public.breakInfoSpan        = removeExplicitSharing cache breakInfoSpan-    , Public.breakInfoResultType  = breakInfoResultType-    , Public.breakInfoVariableEnv = breakInfoVariableEnv-    }--{-------------------------------------------------------------------------------  Low-level API-------------------------------------------------------------------------------}--dereferenceFilePathPtr :: Private.ExplicitSharingCache-                       -> Private.FilePathPtr -> FilePath-dereferenceFilePathPtr cache ptr = BSSC.unpack $-    StrictIntMap.findWithDefault-      unknownFilePath-      (Private.filePathPtr ptr)-      (Private.filePathCache cache)-  where-    unknownFilePath = BSSC.pack "<<unknown filepath>>"--{-------------------------------------------------------------------------------  Introducing explicit sharing-------------------------------------------------------------------------------}---- | Introduce explicit sharing------ This provides the opposite translation to removeExplicitSharing. Note however--- that this is a partial function -- we never extend the cache, so if a--- required value is missing from the cache we return @Nothing@.-class IntroduceSharing a where-  introduceExplicitSharing :: Private.ExplicitSharingCache -> a -> Maybe (XShared a)--instance IntroduceSharing Public.SourceSpan where-  introduceExplicitSharing cache Public.SourceSpan{..} = do-    ptr <- StrictIntMap.reverseLookup (Private.filePathCache cache)-                                      (BSSC.pack spanFilePath)-    return Private.SourceSpan {-        Private.spanFilePath   = Private.FilePathPtr ptr-      , Private.spanFromLine   = spanFromLine-      , Private.spanFromColumn = spanFromColumn-      , Private.spanToLine     = spanToLine-      , Private.spanToColumn   = spanToColumn-      }

@@ -1,325 +0,0 @@-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, DeriveFunctor, DeriveGeneric, StandaloneDeriving, GeneralizedNewtypeDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-module IdeSession.Util (-    -- * Misc util-    showExWithClass-  , accessorName-  , lookup'-  , envWithPathOverride-  , writeFileAtomic-  , setupEnv-  , relInclToOpts-  , parseProgressMessage-  , ignoreDoesNotExist-  , interruptible-    -- * Simple diffs-  , Diff(..)-  , applyMapDiff-    -- * Manipulating stdout and stderr-  , swizzleStdout-  , swizzleStderr-  , redirectStderr-  , captureOutput-  ) where--import Control.Applicative ((<$>))-import Control.Monad (void, forM_, mplus)-import Crypto.Classes (blockLength, initialCtx, updateCtx, finalize)-import Crypto.Types (BitLength)-import Data.Accessor (Accessor, accessor)-import Data.Binary (Binary(..))-import Data.Char (isSpace)-import Data.Digest.Pure.MD5 (MD5Digest, MD5Context)-import Data.List (intercalate)-import Data.Maybe (fromMaybe)-import Data.Tagged (Tagged, untag)-import Data.Text (Text)-import Data.Typeable (typeOf)-import Foreign.C.Types (CFile)-import Foreign.Ptr (Ptr, castPtr, nullPtr)-import GHC.Generics (Generic)-import GHC.IO (unsafeUnmask)-import System.Directory (createDirectoryIfMissing, removeFile, renameFile)-import System.Environment (getEnvironment)-import System.FilePath (splitFileName, (<.>), (</>))-import System.FilePath (splitSearchPath, searchPathSeparator)-import System.IO-import System.IO.Error (isDoesNotExistError)-import System.IO.Temp (withSystemTempFile)-import System.Posix (Fd)-import System.Posix.Env (setEnv, unsetEnv)-import System.Posix.IO-import System.Posix.Types (CPid(..))-import Text.Show.Pretty-import qualified Control.Exception            as Ex-import qualified Data.Attoparsec.Text         as Att-import qualified Data.Binary                  as Bin-import qualified Data.Binary.Builder.Internal as Bin (writeN)-import qualified Data.Binary.Get.Internal     as Bin (readNWith)-import qualified Data.Binary.Put              as Bin (putBuilder)-import qualified Data.ByteString              as BSS-import qualified Data.ByteString.Lazy         as BSL-import qualified Data.Text                    as Text-import qualified Data.Text.Foreign            as Text-import qualified System.Posix.Files           as Files--import IdeSession.Strict.Container-import qualified IdeSession.Strict.Map as StrictMap--foreign import ccall "fflush" fflush :: Ptr CFile -> IO ()--{-------------------------------------------------------------------------------  Util-------------------------------------------------------------------------------}---- | Show an exception together with its most precise type tag.-showExWithClass :: Ex.SomeException -> String-showExWithClass (Ex.SomeException ex) = show (typeOf ex) ++ ": " ++ show ex---- | Translate record field '_name' to the accessor 'name'-accessorName :: String -> Maybe String-accessorName ('_' : str) = Just str-accessorName _           = Nothing---- | Prelude.lookup as an accessor-lookup' :: Eq a => a -> Accessor [(a, b)] (Maybe b)-lookup' key =-    accessor (lookup key) $ \mVal list ->-      case mVal of-        Nothing  -> delete key list-        Just val -> override key val list-  where-    override :: Eq a => a -> b -> [(a, b)] -> [(a, b)]-    override a b [] = [(a, b)]-    override a b ((a', b') : xs)-      | a == a'   = (a, b) : xs-      | otherwise = (a', b') : override a b xs--    delete :: Eq a => a -> [(a, b)] -> [(a, b)]-    delete _ [] = []-    delete a ((a', b') : xs)-      | a == a'   = xs-      | otherwise = (a', b') : delete a xs--envWithPathOverride :: [FilePath] -> IO (Maybe [(String, String)])-envWithPathOverride []            = return Nothing-envWithPathOverride extraPathDirs = do-    env <- getEnvironment-    let path  = fromMaybe "" (lookup "PATH" env)-        path' = intercalate [searchPathSeparator]-                  (extraPathDirs ++ splitSearchPath path)-        env'  = ("PATH", path') : filter (\(var, _) -> var /= "PATH") env-    return (Just env')---- | Writes a file atomically.------ The file is either written successfully or an IO exception is raised and--- the original file is left unchanged.------ On windows it is not possible to delete a file that is open by a process.--- This case will give an IO exception but the atomic property is not affected.------ Returns the hash of the file; we are careful not to force the entire input--- bytestring into memory (we compute the hash as we write the file).-writeFileAtomic :: FilePath -> BSL.ByteString -> IO MD5Digest-writeFileAtomic targetPath content = do-  let (targetDir, targetFile) = splitFileName targetPath-  createDirectoryIfMissing True targetDir-  Ex.bracketOnError-    (openBinaryTempFile targetDir $ targetFile <.> "tmp")-    (\(tmpPath, handle) -> hClose handle >> removeFile tmpPath)-    (\(tmpPath, handle) -> do-        let bits :: Tagged MD5Digest BitLength ; bits = blockLength-        hash <- go handle initialCtx $ makeBlocks (untag bits `div` 8) content-        hClose handle-        renameFile tmpPath targetPath-        return hash)-  where-    go :: Handle -> MD5Context -> [BSS.ByteString] -> IO MD5Digest-    go _ _   []       = error "Bug in makeBlocks"-    go h ctx [bs]     = BSS.hPut h bs >> return (finalize ctx bs)-    go h ctx (bs:bss) = BSS.hPut h bs >> go h (updateCtx ctx bs) bss---- | @makeBlocks n@ splits a bytestring into blocks with a size that is a--- multiple of 'n', with one left-over smaller bytestring at the end.------ Based from the (unexported) 'makeBlocks' in the crypto-api package, but--- we are careful to be as lazy as possible (the first -- block can be returned--- before the entire input bytestring is forced)-makeBlocks :: Int -> BSL.ByteString -> [BSS.ByteString]-makeBlocks n = go . BSL.toChunks-  where-    go [] = [BSS.empty]-    go (bs:bss)-      | BSS.length bs >= n =-          let l = BSS.length bs - (BSS.length bs `rem` n)-              (bsInit, bsTail) = BSS.splitAt l bs-          in bsInit : go (bsTail : bss)-      | otherwise =-          case bss of-            []         -> [bs]-            (bs':bss') -> go (BSS.append bs bs' : bss')---- | First restore the environment to the specified initial environment, then--- apply the given overrides-setupEnv :: [(String, String)] -> [(String, Maybe String)] -> IO ()-setupEnv initEnv overrides = do-  -- Delete everything in the current environment-  curEnv <- getEnvironment-  forM_ curEnv $ \(var, _val) -> unsetEnv var--  -- Restore initial environment-  forM_ initEnv $ \(var, val) -> setEnv var val True--  -- Apply overrides-  forM_ overrides $ \(var, mVal) ->-    case mVal of-      Just val -> setEnv var val True-      Nothing  -> unsetEnv var--relInclToOpts :: FilePath -> [FilePath] -> [String]-relInclToOpts sourcesDir relIncl =-   ["-i"]  -- reset to empty-   ++ map (\path -> "-i" ++ sourcesDir </> path) relIncl--parseProgressMessage :: Text -> Either String (Int, Int, Text)-parseProgressMessage = Att.parseOnly parser-  where-    parser :: Att.Parser (Int, Int, Text)-    parser = do-      _    <- Att.char '['                ; Att.skipSpace-      step <- Att.decimal                 ; Att.skipSpace-      _    <- Att.string (Text.pack "of") ; Att.skipSpace-      numS <- Att.decimal                 ; Att.skipSpace-      _    <- Att.char ']'                ; Att.skipSpace-      rest <- parseCompiling `mplus` Att.takeText-      return (step, numS, rest)--    parseCompiling :: Att.Parser Text-    parseCompiling = do-      compiling <- Att.string (Text.pack "Compiling") ; Att.skipSpace-      _         <- parseTH                            ; Att.skipSpace-      modName   <- Att.takeTill isSpace-      return $ Text.concat [compiling, Text.pack " ", modName]--    parseTH :: Att.Parser ()-    parseTH = Att.option () $ void $ Att.string (Text.pack "[TH]")---- | Ignore "does not exist" exception-ignoreDoesNotExist :: IO () -> IO ()-ignoreDoesNotExist = Ex.handle $ \e ->-  if isDoesNotExistError e then return ()-                           else Ex.throwIO e---- | Define interruptiple operations------ (TODO: Stick in reference to blog post)-interruptible :: IO a -> IO a-interruptible act = do-  st <- Ex.getMaskingState-  case st of-    Ex.Unmasked              -> act-    Ex.MaskedInterruptible   -> unsafeUnmask act-    Ex.MaskedUninterruptible -> act--{-------------------------------------------------------------------------------  Simple diffs-------------------------------------------------------------------------------}--data Diff a = Keep | Remove | Insert a-  deriving (Show, Functor, Generic)--instance Binary a => Binary (Diff a) where-  put Keep       = Bin.putWord8 0-  put Remove     = Bin.putWord8 1-  put (Insert a) = Bin.putWord8 2 >> Bin.put a--  get = do-    header <- Bin.getWord8-    case header of-      0 -> return Keep-      1 -> return Remove-      2 -> Insert <$> Bin.get-      _ -> fail "Diff.get: invalid header"--instance PrettyVal a => PrettyVal (Diff a) -- relies on Generics--applyMapDiff :: forall k v. Ord k-             => Strict (Map k) (Diff v)-             -> Strict (Map k) v -> Strict (Map k) v-applyMapDiff diff = foldr (.) id (map aux $ StrictMap.toList diff)-  where-    aux :: (k, Diff v) -> Strict (Map k) v -> Strict (Map k) v-    aux (_, Keep)     = id-    aux (k, Remove)   = StrictMap.delete k-    aux (k, Insert x) = StrictMap.insert k x--{--------------------------------------------------------------------------------  Manipulations with stdout and stderr.--------------------------------------------------------------------------------}--swizzleStdout :: Fd -> IO a -> IO a-swizzleStdout = swizzleHandle (stdout, stdOutput)--swizzleStderr :: Fd -> IO a -> IO a-swizzleStderr = swizzleHandle (stderr, stdError)--swizzleHandle :: (Handle, Fd) -> Fd -> IO a -> IO a-swizzleHandle (targetHandle, targetFd) fd act =-    Ex.bracket swizzle unswizzle (\_ -> act)-  where-    swizzle :: IO Fd-    swizzle = do-      -- Flush existing handles-      hFlush targetHandle-      fflush nullPtr--      -- Backup stdout, then replace stdout with the given fd-      backup <- dup targetFd-      _ <- dupTo fd targetFd--      return backup--    unswizzle :: Fd -> IO ()-    unswizzle backup = do-      -- Flush handles again-      hFlush targetHandle-      fflush nullPtr--      -- Restore stdout-      _ <- dupTo backup targetFd-      closeFd backup--redirectStderr :: FilePath -> IO a -> IO a-redirectStderr fp act = do-  Ex.bracket (openFd fp WriteOnly (Just mode) defaultFileFlags)-             closeFd $ \errorLogFd ->-    swizzleStderr errorLogFd $-      act-  where-    mode = Files.unionFileModes Files.ownerReadMode Files.ownerWriteMode--captureOutput :: IO a -> IO (String, a)-captureOutput act = do-  withSystemTempFile "suppressed" $ \fp handle -> do-    fd <- handleToFd handle-    a  <- swizzleStdout fd . swizzleStderr fd $ act-    closeFd fd-    suppressed <- readFile fp-    return (suppressed, a)--{--------------------------------------------------------------------------------  Orphans--------------------------------------------------------------------------------}--instance Binary Text where-  get   = do units <- Bin.get-             Bin.readNWith (units * 2) $ \ptr ->-               Text.fromPtr (castPtr ptr) (fromIntegral units)--  put t = do put (Text.lengthWord16 t)-             Bin.putBuilder $-               Bin.writeN (Text.lengthWord16 t * 2)-                          (\p -> Text.unsafeCopyToPtr t (castPtr p))--deriving instance Binary CPid

@@ -1,253 +0,0 @@-{-# LANGUAGE CPP, TemplateHaskell, NamedFieldPuns #-}--- | Blocking operations such as------ > readMVar v------ may throw an exception such as------ > thread blocked indefinitely in an MVar operation------ Unfortunately, this exception does not give any information of _where_ in--- the code we are blocked indefinitely. Compiling with profiling info and--- running with +RTC -xc can address this to some extent, but (1) it requires--- that all profiling libraries are installed and (2) when we are running--- multithreaded code the resulting stack trace is often difficult to read--- (and still does not include line numbers). With this module you can replace--- the above code with------ > $readMVar v------ and the exception that will be thrown is------ > YourModule:lineNumber: thread blocked indefinitely in an MVar operation------ which is a lot more informative. When the CPP flag DEBUGGING is turned off--- then @$readMVar@ just turns into @readMVar@.------ NOTE: The type of the exception changes when using DEBUGGING mode -- in order--- to be able to add the line number, all exceptions are turned into--- IOExceptions.-module IdeSession.Util.BlockingOps (-    -- * Generic debugging utilities-    lineNumber-  , traceOnException-  , mapExceptionIO-  , mapExceptionShow-    -- * Blocking MVar ops-  , putMVar-  , takeMVar-  , modifyMVar-  , modifyMVar_-  , withMVar-  , readMVar-  , swapMVar-    -- * Same for strict MVars-  , putStrictMVar-  , takeStrictMVar-  , modifyStrictMVar-  , modifyStrictMVar_-  , withStrictMVar-  , readStrictMVar-  , swapStrictMVar-    -- * Blocking Chan ops-  , readChan-    -- * Blocking Async ops-  , wait-  , waitCatch-  , waitAny-  , waitAnyCatchCancel-  ) where--import Language.Haskell.TH-import qualified Control.Concurrent as C-import qualified Control.Concurrent.Async as Async-import System.IO (hPutStrLn, stderr)-import qualified Control.Exception as Ex--import qualified IdeSession.Strict.MVar as StrictMVar--lineNumber :: ExpQ-lineNumber = do-  Loc{loc_module, loc_start=(line, _)} <- location-  [| loc_module ++ ":" ++ show (line :: Int) |]--mapExceptionIO :: (Ex.Exception e1, Ex.Exception e2)-               => (e1 -> e2) -> IO a -> IO a-mapExceptionIO f io = Ex.catch io (Ex.throwIO . f)--mapExceptionShow :: (String -> String) -> IO a -> IO a-mapExceptionShow f = mapExceptionIO (userError . f . showSomeException)-  where-    showSomeException :: Ex.SomeException -> String-    showSomeException = show--traceOnException :: String -> IO a -> IO a-traceOnException str io = Ex.catch io $ \e -> do-  hPutStrLn stderr (str ++ ": " ++ show e)-  Ex.throwIO (e :: Ex.SomeException)--#define DEBUGGING 0--#if DEBUGGING == 1--rethrowWithLineNumber1 :: ExpQ -> ExpQ-rethrowWithLineNumber1 expr =-  [| \arg1 -> mapExceptionShow (\e -> $lineNumber ++ ": " ++ e)-                               ($expr arg1)-   |]--rethrowWithLineNumber2 :: ExpQ -> ExpQ-rethrowWithLineNumber2 expr =-  [| \arg1 arg2 -> mapExceptionShow (\e -> $lineNumber ++ ": " ++ e)-                                    ($expr arg1 arg2)-   |]--{--------------------------------------------------------------------------------  MVar--------------------------------------------------------------------------------}--takeMVar :: ExpQ-takeMVar = rethrowWithLineNumber1 [| C.takeMVar |]--putMVar :: ExpQ-putMVar = rethrowWithLineNumber2 [| C.putMVar |]--readMVar :: ExpQ-readMVar = rethrowWithLineNumber1 [| C.readMVar |]--modifyMVar :: ExpQ-modifyMVar = rethrowWithLineNumber2 [| C.modifyMVar |]--modifyMVar_ :: ExpQ-modifyMVar_ = rethrowWithLineNumber2 [| C.modifyMVar_ |]--withMVar :: ExpQ-withMVar = rethrowWithLineNumber2 [| C.withMVar |]--swapMVar :: ExpQ-swapMVar = rethrowWithLineNumber2 [| C.swapMVar |]--{--------------------------------------------------------------------------------  StrictMVar--------------------------------------------------------------------------------}--takeStrictMVar :: ExpQ-takeStrictMVar = rethrowWithLineNumber1 [| StrictMVar.takeMVar |]--putStrictMVar :: ExpQ-putStrictMVar = rethrowWithLineNumber2 [| StrictMVar.putMVar |]--readStrictMVar :: ExpQ-readStrictMVar = rethrowWithLineNumber1 [| StrictMVar.readMVar |]--modifyStrictMVar :: ExpQ-modifyStrictMVar = rethrowWithLineNumber2 [| StrictMVar.modifyMVar |]--modifyStrictMVar_ :: ExpQ-modifyStrictMVar_ = rethrowWithLineNumber2 [| StrictMVar.modifyMVar_ |]--withStrictMVar :: ExpQ-withStrictMVar = rethrowWithLineNumber2 [| StrictMVar.withMVar |]--swapStrictMVar :: ExpQ-swapStrictMVar = rethrowWithLineNumber2 [| StrictMVar.swapMVar |]--{--------------------------------------------------------------------------------  Chan--------------------------------------------------------------------------------}--readChan :: ExpQ-readChan = rethrowWithLineNumber1 [| C.readChan |]--{--------------------------------------------------------------------------------  Async--------------------------------------------------------------------------------}--wait :: ExpQ-wait = rethrowWithLineNumber1 [| Async.wait |]--waitCatch :: ExpQ-waitCatch = rethrowWithLineNumber1 [| Async.waitCatch |]--waitAny :: ExpQ-waitAny = rethrowWithLineNumber1 [| Async.waitAny |]--waitAnyCatchCancel :: ExpQ-waitAnyCatchCancel = rethrowWithLineNumber1 [| Async.waitAnyCatchCancel |]--#else--{--------------------------------------------------------------------------------  MVar--------------------------------------------------------------------------------}--takeMVar :: ExpQ-takeMVar = [| C.takeMVar |]--putMVar :: ExpQ-putMVar = [| C.putMVar |]--readMVar :: ExpQ-readMVar = [| C.readMVar |]--modifyMVar :: ExpQ-modifyMVar = [| C.modifyMVar |]--modifyMVar_ :: ExpQ-modifyMVar_ = [| C.modifyMVar_ |]--withMVar :: ExpQ-withMVar = [| C.withMVar |]--swapMVar :: ExpQ-swapMVar = [| C.swapMVar |]--{--------------------------------------------------------------------------------  StrictMVar--------------------------------------------------------------------------------}--takeStrictMVar :: ExpQ-takeStrictMVar = [| StrictMVar.takeMVar |]--putStrictMVar :: ExpQ-putStrictMVar = [| StrictMVar.putMVar |]--readStrictMVar :: ExpQ-readStrictMVar = [| StrictMVar.readMVar |]--modifyStrictMVar :: ExpQ-modifyStrictMVar = [| StrictMVar.modifyMVar |]--modifyStrictMVar_ :: ExpQ-modifyStrictMVar_ = [| StrictMVar.modifyMVar_ |]--withStrictMVar :: ExpQ-withStrictMVar = [| StrictMVar.withMVar |]--swapStrictMVar :: ExpQ-swapStrictMVar = [| StrictMVar.swapMVar |]--{--------------------------------------------------------------------------------  Chan--------------------------------------------------------------------------------}--readChan :: ExpQ-readChan = [| C.readChan |]--{--------------------------------------------------------------------------------  Async--------------------------------------------------------------------------------}--wait :: ExpQ-wait = [| Async.wait |]--waitCatch :: ExpQ-waitCatch = [| Async.waitCatch |]--waitAny :: ExpQ-waitAny = [| Async.waitAny |]--waitAnyCatchCancel :: ExpQ-waitAnyCatchCancel = [| Async.waitAnyCatchCancel |]--#endif

@@ -1,42 +0,0 @@--- | (Orphan) PrettyVal instances for various standard datatypes-{-# OPTIONS_GHC -fno-warn-orphans #-}-module IdeSession.Util.PrettyVal (-    -- * Re-exports-    PrettyVal(..)-  ) where--import Text.Show.Pretty-import Data.IntMap (IntMap)-import Data.Map (Map)-import Data.Trie (Trie)-import Data.ByteString (ByteString)-import Data.Text (Text)-import qualified Data.IntMap           as IntMap-import qualified Data.Map              as Map-import qualified Data.Trie             as Trie-import qualified Data.ByteString.Char8 as BSC-import qualified Data.Text             as Text--instance PrettyVal a => PrettyVal (Maybe a) where-  prettyVal Nothing  = Con "Nothing" []-  prettyVal (Just x) = Con "Just"    [prettyVal x]---- TODO: This has encoding issues-instance PrettyVal ByteString where-  prettyVal = prettyVal . BSC.unpack--instance PrettyVal a => PrettyVal (IntMap a) where-  prettyVal m = Con "fromList" [prettyVal . IntMap.toList $ m]--instance (PrettyVal k, PrettyVal a) => PrettyVal (Map k a) where-  prettyVal m = Con "fromList" [prettyVal . Map.toList $ m]--instance PrettyVal a => PrettyVal (Trie a) where-  prettyVal m = Con "fromList" [prettyVal . Trie.toList $ m]--instance PrettyVal Bool where-  prettyVal True  = Con "True"  []-  prettyVal False = Con "False" []--instance PrettyVal Text where-  prettyVal = prettyVal . Text.unpack

@@ -1,7 +1,7 @@ name:                 ide-backend-version:              0.9.0.1+version:              0.9.0.2 synopsis:             An IDE backend library--- description:+description:          See README.md for more details license:              MIT license-file:         LICENSE author:               Duncan Coutts, Mikolaj Konarski, Edsko de Vries@@ -24,30 +24,8 @@                       IdeSession.Update,                       IdeSession.Update.IdeSessionUpdate,                       IdeSession.Update.ExecuteSessionUpdate,-                      IdeSession.RPC.Client,-                      IdeSession.RPC.API,-                      IdeSession.RPC.Stream,-                      IdeSession.Types.Public,-                      IdeSession.Types.Private,-                      IdeSession.Types.Translation,-                      IdeSession.Types.Progress,-                      IdeSession.GHC.API,-                      IdeSession.GHC.Requests,-                      IdeSession.GHC.Responses,-                      IdeSession.GHC.Client,-                      IdeSession.Util,-                      IdeSession.Util.BlockingOps,-                      IdeSession.Util.PrettyVal,-                      IdeSession.Strict.Container,-                      IdeSession.Strict.IntMap,-                      IdeSession.Strict.List,-                      IdeSession.Strict.Map,-                      IdeSession.Strict.Maybe,-                      IdeSession.Strict.Trie,-                      IdeSession.Strict.IntervalMap-                      IdeSession.Strict.MVar-                      IdeSession.Strict.IORef-                      IdeSession.Strict.StateT+                      IdeSession.GHC.Client+                      IdeSession.RPC.Client    build-depends:      base                 ==4.*,                       filemanip            >= 0.3.6.2 && < 0.4,@@ -55,28 +33,21 @@                       filepath             >= 1.3     && < 1.5,                       directory            >= 1.1     && < 1.3,                       containers           >= 0.4.1   && < 1,-                      random               >= 1.0.1   && < 2,                       bytestring           >= 0.9.2   && < 1,                       mtl                  >= 2.1     && < 2.3,                       async                >= 2.0     && < 2.1,-                      aeson                >= 0.6.2   && < 0.9,-                      executable-path      >= 0.0     && < 0.1,                       unix                 >= 2.5     && < 2.8,                       temporary            >= 1.1.2.4 && < 1.3,-                      bytestring-trie      >= 0.2     && < 0.3,-                      unordered-containers >= 0.2.3   && < 0.3,                       text                 >= 0.11    && < 1.3,-                      fingertree           >= 0.0.1   && < 0.2,                       binary               >= 0.7.1.0 && < 0.8,                       data-accessor        >= 0.2     && < 0.3,                       data-accessor-mtl    >= 0.2     && < 0.3,-                      crypto-api           >= 0.12    && < 0.14,                       pureMD5              >= 2.1     && < 2.2,-                      tagged               >= 0.4     && < 0.8,                       transformers         >= 0.3     && < 0.5,                       time                 >= 1.4     && < 1.6,                       attoparsec           >= 0.10    && < 0.13,                       utf8-string          >= 0.3     && < 1.1,+                      ide-backend-common   >= 0.9     && < 0.10,                       template-haskell,                       -- our own private fork:                       Cabal-ide-backend    >= 1.23,@@ -100,9 +71,9 @@   ghc-options:        -Wall -fno-warn-unused-do-bind  executable ide-backend-exe-cabal-  hs-source-dirs:     .   main-is:            ide-backend-exe-cabal.hs   build-depends:      ide-backend,+                      ide-backend-common,                       base                 ==4.*,                       filemanip            >= 0.3.6.2 && < 0.4,                       process              >= 1.1     && < 1.3,@@ -147,7 +118,7 @@   type:               exitcode-stdio-1.0   main-is:            typecheck-dir.hs   hs-source-dirs:     test-  build-depends:      base, ide-backend, temporary, filemanip, directory, time, text+  build-depends:      base, ide-backend, ide-backend-common, temporary, filemanip, directory, time, text    default-language:   Haskell2010   default-extensions: MonoLocalBinds,@@ -198,6 +169,7 @@                       TestTools   build-depends:      base,                       ide-backend,+                      ide-backend-common,                       tasty,                       HUnit,                       tagged,@@ -231,7 +203,7 @@ test-suite rpc-server   type:               exitcode-stdio-1.0   main-is:            rpc-server.hs-  hs-source-dirs:     . server test+  hs-source-dirs:     . test   build-depends:      base                 ==4.*,                       directory            ==1.*,                       filemanip            >= 0.3.6.2 && < 0.4,@@ -249,6 +221,7 @@                       executable-path      >= 0.0     && < 0.1,                       unix                 >= 2.5     && < 2.8,                       binary               >= 0.7.1.0 && < 0.8,+                      ide-backend-common,                       template-haskell    default-language:   Haskell2010@@ -257,4 +230,3 @@   other-extensions:   CPP, TemplateHaskell, ScopedTypeVariables,                       DeriveDataTypeable   ghc-options:        -Wall -fno-warn-unused-do-bind-  other-modules:      IdeSession.RPC.Server