mirror of
https://github.com/haskell/haskell-ide-engine.git
synced 2024-10-26 11:18:42 +03:00
Starting to add extensible state as per xmonad
This commit is contained in:
parent
2947e3a40e
commit
4606d5b744
@ -118,7 +118,7 @@ run opts = do
|
|||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
|
|
||||||
-- launch the dispatcher.
|
-- launch the dispatcher.
|
||||||
_ <- forkIO (runIdeM (IdeState plugins) (dispatcher cin))
|
_ <- forkIO (runIdeM (IdeState plugins Map.empty) (dispatcher cin))
|
||||||
|
|
||||||
-- TODO: pass port in as a param from GlobalOpts
|
-- TODO: pass port in as a param from GlobalOpts
|
||||||
when (optHttp opts) $
|
when (optHttp opts) $
|
||||||
|
123
hie-plugin-api/Haskell/Ide/Engine/ExtensibleState.hs
Normal file
123
hie-plugin-api/Haskell/Ide/Engine/ExtensibleState.hs
Normal file
@ -0,0 +1,123 @@
|
|||||||
|
{-# LANGUAGE PatternGuards #-}
|
||||||
|
-- Based on the one in xmonad-contrib, original header below
|
||||||
|
-----------------------------------------------------------------------------
|
||||||
|
-- |
|
||||||
|
-- Module : XMonad.Util.ExtensibleState
|
||||||
|
-- Copyright : (c) Daniel Schoepe 2009
|
||||||
|
-- License : BSD3-style (see LICENSE)
|
||||||
|
--
|
||||||
|
-- Maintainer : daniel.schoepe@gmail.com
|
||||||
|
-- Stability : unstable
|
||||||
|
-- Portability : not portable
|
||||||
|
--
|
||||||
|
-- Module for storing custom mutable state in xmonad.
|
||||||
|
--
|
||||||
|
-----------------------------------------------------------------------------
|
||||||
|
|
||||||
|
module Haskell.Ide.Engine.ExtensibleState (
|
||||||
|
-- * Usage
|
||||||
|
-- $usage
|
||||||
|
put
|
||||||
|
, modify
|
||||||
|
, remove
|
||||||
|
, get
|
||||||
|
, gets
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Applicative
|
||||||
|
import Data.Typeable (typeOf,Typeable,cast)
|
||||||
|
import qualified Data.Map as M
|
||||||
|
import Haskell.Ide.Engine.PluginDescriptor
|
||||||
|
-- import XMonad.Core
|
||||||
|
-- import qualified Control.Monad.State as State
|
||||||
|
import qualified Control.Monad.State.Strict as State
|
||||||
|
import Data.Maybe (fromMaybe)
|
||||||
|
import Control.Monad
|
||||||
|
import Control.Monad.Trans.Class
|
||||||
|
|
||||||
|
-- ---------------------------------------------------------------------
|
||||||
|
-- $usage
|
||||||
|
--
|
||||||
|
-- To utilize this feature in a contrib module, create a data type
|
||||||
|
-- and make it an instance of ExtensionClass. You can then use
|
||||||
|
-- the functions from this module for storing and retrieving your data:
|
||||||
|
--
|
||||||
|
-- > {-# LANGUAGE DeriveDataTypeable #-}
|
||||||
|
-- > import qualified XMonad.Util.ExtensibleState as XS
|
||||||
|
-- >
|
||||||
|
-- > data ListStorage = ListStorage [Integer] deriving Typeable
|
||||||
|
-- > instance ExtensionClass ListStorage where
|
||||||
|
-- > initialValue = ListStorage []
|
||||||
|
-- >
|
||||||
|
-- > .. XS.put (ListStorage [23,42])
|
||||||
|
--
|
||||||
|
-- To retrieve the stored value call:
|
||||||
|
--
|
||||||
|
-- > .. XS.get
|
||||||
|
--
|
||||||
|
-- If the type can't be inferred from the usage of the retrieved data, you
|
||||||
|
-- have to add an explicit type signature:
|
||||||
|
--
|
||||||
|
-- > .. XS.get :: X ListStorage
|
||||||
|
--
|
||||||
|
-- To make your data persistent between restarts, the data type needs to be
|
||||||
|
-- an instance of Read and Show and the instance declaration has to be changed:
|
||||||
|
--
|
||||||
|
-- > data ListStorage = ListStorage [Integer] deriving (Typeable,Read,Show)
|
||||||
|
-- >
|
||||||
|
-- > instance ExtensionClass ListStorage where
|
||||||
|
-- > initialValue = ListStorage []
|
||||||
|
-- > extensionType = PersistentExtension
|
||||||
|
--
|
||||||
|
-- One should take care that the string representation of the chosen type
|
||||||
|
-- is unique among the stored values, otherwise it will be overwritten.
|
||||||
|
-- Normally these string representations contain fully qualified module names
|
||||||
|
-- when automatically deriving Typeable, so
|
||||||
|
-- name collisions should not be a problem in most cases.
|
||||||
|
-- A module should not try to store common datatypes(e.g. a list of Integers)
|
||||||
|
-- without a custom data type as a wrapper to avoid collisions with other modules
|
||||||
|
-- trying to store the same data type without a wrapper.
|
||||||
|
--
|
||||||
|
|
||||||
|
-- | Modify the map of state extensions by applying the given function.
|
||||||
|
modifyStateExts :: (M.Map String (Either String StateExtension)
|
||||||
|
-> M.Map String (Either String StateExtension))
|
||||||
|
-> IdeM ()
|
||||||
|
modifyStateExts f = lift $ lift $ State.modify $ \st -> st { extensibleState = f (extensibleState st) }
|
||||||
|
|
||||||
|
-- | Apply a function to a stored value of the matching type or the initial value if there
|
||||||
|
-- is none.
|
||||||
|
modify :: ExtensionClass a => (a -> a) -> IdeM ()
|
||||||
|
modify f = put . f =<< get
|
||||||
|
|
||||||
|
-- | Add a value to the extensible state field. A previously stored value with the same
|
||||||
|
-- type will be overwritten. (More precisely: A value whose string representation of its type
|
||||||
|
-- is equal to the new one's)
|
||||||
|
put :: ExtensionClass a => a -> IdeM ()
|
||||||
|
put v = modifyStateExts . M.insert (show . typeOf $ v) . Right . extensionType $ v
|
||||||
|
|
||||||
|
-- | Try to retrieve a value of the requested type, return an initial value if there is no such value.
|
||||||
|
get :: ExtensionClass a => IdeM a
|
||||||
|
get = getState' undefined -- `trick' to avoid needing -XScopedTypeVariables
|
||||||
|
where toValue val = maybe initialValue id $ cast val
|
||||||
|
getState' :: ExtensionClass a => a -> IdeM a
|
||||||
|
getState' k = do
|
||||||
|
v <- lift $ lift $ State.gets $ M.lookup (show . typeOf $ k) . extensibleState
|
||||||
|
case v of
|
||||||
|
Just (Right (StateExtension val)) -> return $ toValue val
|
||||||
|
Just (Right (PersistentExtension val)) -> return $ toValue val
|
||||||
|
Just (Left str) | PersistentExtension x <- extensionType k -> do
|
||||||
|
let val = fromMaybe initialValue $ cast =<< safeRead str `asTypeOf` Just x
|
||||||
|
put (val `asTypeOf` k)
|
||||||
|
return val
|
||||||
|
_ -> return $ initialValue
|
||||||
|
safeRead str = case reads str of
|
||||||
|
[(x,"")] -> Just x
|
||||||
|
_ -> Nothing
|
||||||
|
|
||||||
|
gets :: ExtensionClass a => (a -> b) -> IdeM b
|
||||||
|
gets = flip fmap get
|
||||||
|
|
||||||
|
-- | Remove the value from the extensible state field that has the same type as the supplied argument
|
||||||
|
remove :: ExtensionClass a => a -> IdeM ()
|
||||||
|
remove wit = modifyStateExts $ M.delete (show . typeOf $ wit)
|
@ -85,6 +85,8 @@ module Haskell.Ide.Engine.PluginDescriptor
|
|||||||
-- * The IDE monad
|
-- * The IDE monad
|
||||||
, IdeM
|
, IdeM
|
||||||
, IdeState(..)
|
, IdeState(..)
|
||||||
|
, StateExtension(..)
|
||||||
|
, ExtensionClass(..)
|
||||||
, getPlugins
|
, getPlugins
|
||||||
) where
|
) where
|
||||||
|
|
||||||
@ -358,6 +360,12 @@ type SyncCommandFunc resp
|
|||||||
type AsyncCommandFunc resp = (IdeResponse resp -> IO ())
|
type AsyncCommandFunc resp = (IdeResponse resp -> IO ())
|
||||||
-> [AcceptedContext] -> IdeRequest -> IdeM ()
|
-> [AcceptedContext] -> IdeRequest -> IdeM ()
|
||||||
|
|
||||||
|
-- ---------------------------------------------------------------------
|
||||||
|
-- Based on
|
||||||
|
-- http://xmonad.org/xmonad-docs/xmonad/XMonad-Core.html#t:ExtensionClass
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- ---------------------------------------------------------------------
|
-- ---------------------------------------------------------------------
|
||||||
-- ValidResponse instances
|
-- ValidResponse instances
|
||||||
|
|
||||||
@ -600,9 +608,42 @@ type IdeT m = GM.GhcModT (StateT IdeState m)
|
|||||||
data IdeState = IdeState
|
data IdeState = IdeState
|
||||||
{
|
{
|
||||||
idePlugins :: Plugins
|
idePlugins :: Plugins
|
||||||
|
, extensibleState :: !(Map.Map String (Either String StateExtension))
|
||||||
|
-- ^ stores custom state information.
|
||||||
} deriving (Show)
|
} deriving (Show)
|
||||||
|
|
||||||
getPlugins :: IdeM Plugins
|
getPlugins :: IdeM Plugins
|
||||||
getPlugins = lift $ lift $ idePlugins <$> get
|
getPlugins = lift $ lift $ idePlugins <$> get
|
||||||
|
|
||||||
|
-- ---------------------------------------------------------------------
|
||||||
|
-- Extensible state, based on
|
||||||
|
-- http://xmonad.org/xmonad-docs/xmonad/XMonad-Core.html#t:ExtensionClass
|
||||||
|
--
|
||||||
|
|
||||||
|
-- | Every module must make the data it wants to store
|
||||||
|
-- an instance of this class.
|
||||||
|
--
|
||||||
|
-- Minimal complete definition: initialValue
|
||||||
|
class Typeable a => ExtensionClass a where
|
||||||
|
-- | Defines an initial value for the state extension
|
||||||
|
initialValue :: a
|
||||||
|
-- | Specifies whether the state extension should be
|
||||||
|
-- persistent. Setting this method to 'PersistentExtension'
|
||||||
|
-- will make the stored data survive restarts, but
|
||||||
|
-- requires a to be an instance of Read and Show.
|
||||||
|
--
|
||||||
|
-- It defaults to 'StateExtension', i.e. no persistence.
|
||||||
|
extensionType :: a -> StateExtension
|
||||||
|
extensionType = StateExtension
|
||||||
|
|
||||||
|
-- | Existential type to store a state extension.
|
||||||
|
data StateExtension =
|
||||||
|
forall a. ExtensionClass a => StateExtension a
|
||||||
|
-- ^ Non-persistent state extension
|
||||||
|
| forall a. (Read a, Show a, ExtensionClass a) => PersistentExtension a
|
||||||
|
-- ^ Persistent extension
|
||||||
|
|
||||||
|
instance Show StateExtension where
|
||||||
|
show _ = "StateExtension"
|
||||||
|
|
||||||
-- EOF
|
-- EOF
|
||||||
|
@ -12,7 +12,9 @@ build-type: Simple
|
|||||||
cabal-version: >=1.10
|
cabal-version: >=1.10
|
||||||
|
|
||||||
library
|
library
|
||||||
exposed-modules: Haskell.Ide.Engine.Monad
|
exposed-modules:
|
||||||
|
Haskell.Ide.Engine.ExtensibleState
|
||||||
|
Haskell.Ide.Engine.Monad
|
||||||
Haskell.Ide.Engine.MonadFunctions
|
Haskell.Ide.Engine.MonadFunctions
|
||||||
Haskell.Ide.Engine.PluginDescriptor
|
Haskell.Ide.Engine.PluginDescriptor
|
||||||
Haskell.Ide.Engine.PluginUtils
|
Haskell.Ide.Engine.PluginUtils
|
||||||
|
@ -40,7 +40,7 @@ dispatchRequest :: IdeRequest -> IO (Maybe (IdeResponse Object))
|
|||||||
dispatchRequest req = do
|
dispatchRequest req = do
|
||||||
testChan <- atomically newTChan
|
testChan <- atomically newTChan
|
||||||
let cr = CReq "applyrefact" 1 req testChan
|
let cr = CReq "applyrefact" 1 req testChan
|
||||||
r <- withStdoutLogging $ runIdeM (IdeState Map.empty) (doDispatch testPlugins cr)
|
r <- withStdoutLogging $ runIdeM (IdeState Map.empty Map.empty) (doDispatch testPlugins cr)
|
||||||
return r
|
return r
|
||||||
|
|
||||||
-- ---------------------------------------------------------------------
|
-- ---------------------------------------------------------------------
|
||||||
|
@ -44,7 +44,7 @@ dispatcherSpec = do
|
|||||||
chSync <- atomically newTChan
|
chSync <- atomically newTChan
|
||||||
let req = IdeRequest "cmd1" (Map.fromList [])
|
let req = IdeRequest "cmd1" (Map.fromList [])
|
||||||
cr = CReq "test" 1 req chan
|
cr = CReq "test" 1 req chan
|
||||||
r <- withStdoutLogging $ runIdeM (IdeState Map.empty) (doDispatch (testPlugins chSync) cr)
|
r <- withStdoutLogging $ runIdeM (IdeState Map.empty Map.empty) (doDispatch (testPlugins chSync) cr)
|
||||||
r `shouldBe` Just (IdeResponseOk (H.fromList ["ok" .= ("result:ctxs=[CtxNone]"::String)]))
|
r `shouldBe` Just (IdeResponseOk (H.fromList ["ok" .= ("result:ctxs=[CtxNone]"::String)]))
|
||||||
|
|
||||||
-- ---------------------------------
|
-- ---------------------------------
|
||||||
@ -54,7 +54,7 @@ dispatcherSpec = do
|
|||||||
chSync <- atomically newTChan
|
chSync <- atomically newTChan
|
||||||
let req = IdeRequest "cmd2" (Map.fromList [])
|
let req = IdeRequest "cmd2" (Map.fromList [])
|
||||||
cr = CReq "test" 1 req chan
|
cr = CReq "test" 1 req chan
|
||||||
r <- withStdoutLogging $ runIdeM (IdeState Map.empty) (doDispatch (testPlugins chSync) cr)
|
r <- withStdoutLogging $ runIdeM (IdeState Map.empty Map.empty) (doDispatch (testPlugins chSync) cr)
|
||||||
r `shouldBe` Just (IdeResponseFail (IdeError {ideCode = MissingParameter, ideMessage = "need `file` parameter", ideInfo = Just (String "file")}))
|
r `shouldBe` Just (IdeResponseFail (IdeError {ideCode = MissingParameter, ideMessage = "need `file` parameter", ideInfo = Just (String "file")}))
|
||||||
|
|
||||||
-- ---------------------------------
|
-- ---------------------------------
|
||||||
@ -64,7 +64,7 @@ dispatcherSpec = do
|
|||||||
chSync <- atomically newTChan
|
chSync <- atomically newTChan
|
||||||
let req = IdeRequest "cmd2" (Map.fromList [("file", ParamFileP "foo.hs")])
|
let req = IdeRequest "cmd2" (Map.fromList [("file", ParamFileP "foo.hs")])
|
||||||
cr = CReq "test" 1 req chan
|
cr = CReq "test" 1 req chan
|
||||||
r <- withStdoutLogging $ runIdeM (IdeState Map.empty) (doDispatch (testPlugins chSync) cr)
|
r <- withStdoutLogging $ runIdeM (IdeState Map.empty Map.empty) (doDispatch (testPlugins chSync) cr)
|
||||||
r `shouldBe` Just (IdeResponseOk (H.fromList ["ok" .= ("result:ctxs=[CtxFile]"::String)]))
|
r `shouldBe` Just (IdeResponseOk (H.fromList ["ok" .= ("result:ctxs=[CtxFile]"::String)]))
|
||||||
|
|
||||||
-- ---------------------------------
|
-- ---------------------------------
|
||||||
@ -74,7 +74,7 @@ dispatcherSpec = do
|
|||||||
chSync <- atomically newTChan
|
chSync <- atomically newTChan
|
||||||
let req = IdeRequest "cmd3" (Map.fromList [("file", ParamFileP "foo.hs"),("start_pos", ParamPosP (1,2))])
|
let req = IdeRequest "cmd3" (Map.fromList [("file", ParamFileP "foo.hs"),("start_pos", ParamPosP (1,2))])
|
||||||
cr = CReq "test" 1 req chan
|
cr = CReq "test" 1 req chan
|
||||||
r <- withStdoutLogging $ runIdeM (IdeState Map.empty) (doDispatch (testPlugins chSync) cr)
|
r <- withStdoutLogging $ runIdeM (IdeState Map.empty Map.empty) (doDispatch (testPlugins chSync) cr)
|
||||||
r `shouldBe` Just (IdeResponseOk (H.fromList ["ok" .= ("result:ctxs=[CtxPoint]"::String)]))
|
r `shouldBe` Just (IdeResponseOk (H.fromList ["ok" .= ("result:ctxs=[CtxPoint]"::String)]))
|
||||||
|
|
||||||
-- ---------------------------------
|
-- ---------------------------------
|
||||||
@ -86,7 +86,7 @@ dispatcherSpec = do
|
|||||||
,("start_pos", ParamPosP (1,2))
|
,("start_pos", ParamPosP (1,2))
|
||||||
,("end_pos", ParamPosP (3,4))])
|
,("end_pos", ParamPosP (3,4))])
|
||||||
cr = CReq "test" 1 req chan
|
cr = CReq "test" 1 req chan
|
||||||
r <- withStdoutLogging $ runIdeM (IdeState Map.empty) (doDispatch (testPlugins chSync) cr)
|
r <- withStdoutLogging $ runIdeM (IdeState Map.empty Map.empty) (doDispatch (testPlugins chSync) cr)
|
||||||
r `shouldBe` Just (IdeResponseOk (H.fromList ["ok" .= ("result:ctxs=[CtxRegion]"::String)]))
|
r `shouldBe` Just (IdeResponseOk (H.fromList ["ok" .= ("result:ctxs=[CtxRegion]"::String)]))
|
||||||
|
|
||||||
-- ---------------------------------
|
-- ---------------------------------
|
||||||
@ -96,7 +96,7 @@ dispatcherSpec = do
|
|||||||
chSync <- atomically newTChan
|
chSync <- atomically newTChan
|
||||||
let req = IdeRequest "cmd5" (Map.fromList [("cabal", ParamTextP "lib")])
|
let req = IdeRequest "cmd5" (Map.fromList [("cabal", ParamTextP "lib")])
|
||||||
cr = CReq "test" 1 req chan
|
cr = CReq "test" 1 req chan
|
||||||
r <- withStdoutLogging $ runIdeM (IdeState Map.empty) (doDispatch (testPlugins chSync) cr)
|
r <- withStdoutLogging $ runIdeM (IdeState Map.empty Map.empty) (doDispatch (testPlugins chSync) cr)
|
||||||
r `shouldBe` Just (IdeResponseOk (H.fromList ["ok" .= ("result:ctxs=[CtxCabalTarget]"::String)]))
|
r `shouldBe` Just (IdeResponseOk (H.fromList ["ok" .= ("result:ctxs=[CtxCabalTarget]"::String)]))
|
||||||
|
|
||||||
|
|
||||||
@ -107,7 +107,7 @@ dispatcherSpec = do
|
|||||||
chSync <- atomically newTChan
|
chSync <- atomically newTChan
|
||||||
let req = IdeRequest "cmd6" (Map.fromList [("dir", ParamFileP ".")])
|
let req = IdeRequest "cmd6" (Map.fromList [("dir", ParamFileP ".")])
|
||||||
cr = CReq "test" 1 req chan
|
cr = CReq "test" 1 req chan
|
||||||
r <- withStdoutLogging $ runIdeM (IdeState Map.empty) (doDispatch (testPlugins chSync) cr)
|
r <- withStdoutLogging $ runIdeM (IdeState Map.empty Map.empty) (doDispatch (testPlugins chSync) cr)
|
||||||
r `shouldBe` Just (IdeResponseOk (H.fromList ["ok" .= ("result:ctxs=[CtxProject]"::String)]))
|
r `shouldBe` Just (IdeResponseOk (H.fromList ["ok" .= ("result:ctxs=[CtxProject]"::String)]))
|
||||||
|
|
||||||
-- ---------------------------------
|
-- ---------------------------------
|
||||||
@ -119,7 +119,7 @@ dispatcherSpec = do
|
|||||||
,("start_pos", ParamPosP (1,2))
|
,("start_pos", ParamPosP (1,2))
|
||||||
,("end_pos", ParamPosP (3,4))])
|
,("end_pos", ParamPosP (3,4))])
|
||||||
cr = CReq "test" 1 req chan
|
cr = CReq "test" 1 req chan
|
||||||
r <- withStdoutLogging $ runIdeM (IdeState Map.empty) (doDispatch (testPlugins chSync) cr)
|
r <- withStdoutLogging $ runIdeM (IdeState Map.empty Map.empty) (doDispatch (testPlugins chSync) cr)
|
||||||
r `shouldBe` Just (IdeResponseOk (H.fromList ["ok" .= ("result:ctxs=[CtxFile,CtxPoint,CtxRegion]"::String)]))
|
r `shouldBe` Just (IdeResponseOk (H.fromList ["ok" .= ("result:ctxs=[CtxFile,CtxPoint,CtxRegion]"::String)]))
|
||||||
|
|
||||||
-- ---------------------------------
|
-- ---------------------------------
|
||||||
@ -130,7 +130,7 @@ dispatcherSpec = do
|
|||||||
let req = IdeRequest "cmdmultiple" (Map.fromList [("file", ParamFileP "foo.hs")
|
let req = IdeRequest "cmdmultiple" (Map.fromList [("file", ParamFileP "foo.hs")
|
||||||
,("start_pos", ParamPosP (1,2))])
|
,("start_pos", ParamPosP (1,2))])
|
||||||
cr = CReq "test" 1 req chan
|
cr = CReq "test" 1 req chan
|
||||||
r <- withStdoutLogging $ runIdeM (IdeState Map.empty) (doDispatch (testPlugins chSync) cr)
|
r <- withStdoutLogging $ runIdeM (IdeState Map.empty Map.empty) (doDispatch (testPlugins chSync) cr)
|
||||||
r `shouldBe` Just (IdeResponseOk (H.fromList ["ok" .= ("result:ctxs=[CtxFile,CtxPoint]"::String)]))
|
r `shouldBe` Just (IdeResponseOk (H.fromList ["ok" .= ("result:ctxs=[CtxFile,CtxPoint]"::String)]))
|
||||||
|
|
||||||
-- ---------------------------------
|
-- ---------------------------------
|
||||||
@ -140,7 +140,7 @@ dispatcherSpec = do
|
|||||||
chSync <- atomically newTChan
|
chSync <- atomically newTChan
|
||||||
let req = IdeRequest "cmdmultiple" (Map.fromList [("cabal", ParamTextP "lib")])
|
let req = IdeRequest "cmdmultiple" (Map.fromList [("cabal", ParamTextP "lib")])
|
||||||
cr = CReq "test" 1 req chan
|
cr = CReq "test" 1 req chan
|
||||||
r <- withStdoutLogging $ runIdeM (IdeState Map.empty) (doDispatch (testPlugins chSync) cr)
|
r <- withStdoutLogging $ runIdeM (IdeState Map.empty Map.empty) (doDispatch (testPlugins chSync) cr)
|
||||||
r `shouldBe`
|
r `shouldBe`
|
||||||
Just (IdeResponseFail (IdeError { ideCode = MissingParameter
|
Just (IdeResponseFail (IdeError { ideCode = MissingParameter
|
||||||
, ideMessage = "need `file` parameter"
|
, ideMessage = "need `file` parameter"
|
||||||
@ -159,7 +159,7 @@ dispatcherSpec = do
|
|||||||
,("pos", ParamPosP (1,2))
|
,("pos", ParamPosP (1,2))
|
||||||
])
|
])
|
||||||
cr = CReq "test" 1 req chan
|
cr = CReq "test" 1 req chan
|
||||||
r <- withStdoutLogging $ runIdeM (IdeState Map.empty) (doDispatch (testPlugins chSync) cr)
|
r <- withStdoutLogging $ runIdeM (IdeState Map.empty Map.empty) (doDispatch (testPlugins chSync) cr)
|
||||||
r `shouldBe` Just (IdeResponseOk (H.fromList ["ok" .= ("result:ctxs=[CtxFile]"::String)]))
|
r `shouldBe` Just (IdeResponseOk (H.fromList ["ok" .= ("result:ctxs=[CtxFile]"::String)]))
|
||||||
|
|
||||||
|
|
||||||
@ -174,7 +174,7 @@ dispatcherSpec = do
|
|||||||
,("pos", ParamPosP (1,2))
|
,("pos", ParamPosP (1,2))
|
||||||
])
|
])
|
||||||
cr = CReq "test" 1 req chan
|
cr = CReq "test" 1 req chan
|
||||||
r <- withStdoutLogging $ runIdeM (IdeState Map.empty) (doDispatch (testPlugins chSync) cr)
|
r <- withStdoutLogging $ runIdeM (IdeState Map.empty Map.empty) (doDispatch (testPlugins chSync) cr)
|
||||||
r `shouldBe`
|
r `shouldBe`
|
||||||
Just (IdeResponseFail
|
Just (IdeResponseFail
|
||||||
(IdeError
|
(IdeError
|
||||||
@ -194,7 +194,7 @@ dispatcherSpec = do
|
|||||||
,("poso", ParamPosP (1,2))
|
,("poso", ParamPosP (1,2))
|
||||||
])
|
])
|
||||||
cr = CReq "test" 1 req chan
|
cr = CReq "test" 1 req chan
|
||||||
r <- withStdoutLogging $ runIdeM (IdeState Map.empty) (doDispatch (testPlugins chSync) cr)
|
r <- withStdoutLogging $ runIdeM (IdeState Map.empty Map.empty) (doDispatch (testPlugins chSync) cr)
|
||||||
r `shouldBe` Just (IdeResponseOk (H.fromList ["ok" .= ("result:ctxs=[CtxNone]"::String)]))
|
r `shouldBe` Just (IdeResponseOk (H.fromList ["ok" .= ("result:ctxs=[CtxNone]"::String)]))
|
||||||
|
|
||||||
-- ---------------------------------
|
-- ---------------------------------
|
||||||
@ -207,7 +207,7 @@ dispatcherSpec = do
|
|||||||
,("poso", ParamPosP (1,2))
|
,("poso", ParamPosP (1,2))
|
||||||
])
|
])
|
||||||
cr = CReq "test" 1 req chan
|
cr = CReq "test" 1 req chan
|
||||||
r <- withStdoutLogging $ runIdeM (IdeState Map.empty) (doDispatch (testPlugins chSync) cr)
|
r <- withStdoutLogging $ runIdeM (IdeState Map.empty Map.empty) (doDispatch (testPlugins chSync) cr)
|
||||||
r `shouldBe`
|
r `shouldBe`
|
||||||
Just (IdeResponseFail
|
Just (IdeResponseFail
|
||||||
(IdeError { ideCode = IncorrectParameterType
|
(IdeError { ideCode = IncorrectParameterType
|
||||||
@ -229,8 +229,8 @@ dispatcherSpec = do
|
|||||||
req2 = IdeRequest "cmdasync2" Map.empty
|
req2 = IdeRequest "cmdasync2" Map.empty
|
||||||
cr1 = CReq "test" 1 req1 chan
|
cr1 = CReq "test" 1 req1 chan
|
||||||
cr2 = CReq "test" 2 req2 chan
|
cr2 = CReq "test" 2 req2 chan
|
||||||
r1 <- withStdoutLogging $ runIdeM (IdeState Map.empty) (doDispatch (testPlugins chSync) cr1)
|
r1 <- withStdoutLogging $ runIdeM (IdeState Map.empty Map.empty) (doDispatch (testPlugins chSync) cr1)
|
||||||
r2 <- withStdoutLogging $ runIdeM (IdeState Map.empty) (doDispatch (testPlugins chSync) cr2)
|
r2 <- withStdoutLogging $ runIdeM (IdeState Map.empty Map.empty) (doDispatch (testPlugins chSync) cr2)
|
||||||
r1 `shouldBe` Nothing
|
r1 `shouldBe` Nothing
|
||||||
r2 `shouldBe` Nothing
|
r2 `shouldBe` Nothing
|
||||||
rc1 <- atomically $ readTChan chan
|
rc1 <- atomically $ readTChan chan
|
||||||
|
@ -44,7 +44,7 @@ dispatchRequest :: IdeRequest -> IO (Maybe (IdeResponse Object))
|
|||||||
dispatchRequest req = do
|
dispatchRequest req = do
|
||||||
testChan <- atomically newTChan
|
testChan <- atomically newTChan
|
||||||
let cr = CReq "ghcmod" 1 req testChan
|
let cr = CReq "ghcmod" 1 req testChan
|
||||||
r <- withStdoutLogging $ runIdeM (IdeState Map.empty) (doDispatch testPlugins cr)
|
r <- withStdoutLogging $ runIdeM (IdeState Map.empty Map.empty) (doDispatch testPlugins cr)
|
||||||
return r
|
return r
|
||||||
|
|
||||||
-- ---------------------------------------------------------------------
|
-- ---------------------------------------------------------------------
|
||||||
|
@ -40,7 +40,7 @@ dispatchRequest :: IdeRequest -> IO (Maybe (IdeResponse Object))
|
|||||||
dispatchRequest req = do
|
dispatchRequest req = do
|
||||||
testChan <- atomically newTChan
|
testChan <- atomically newTChan
|
||||||
let cr = CReq "hare" 1 req testChan
|
let cr = CReq "hare" 1 req testChan
|
||||||
r <- withStdoutLogging $ runIdeM (IdeState Map.empty) (doDispatch testPlugins cr)
|
r <- withStdoutLogging $ runIdeM (IdeState Map.empty Map.empty) (doDispatch testPlugins cr)
|
||||||
return r
|
return r
|
||||||
|
|
||||||
-- ---------------------------------------------------------------------
|
-- ---------------------------------------------------------------------
|
||||||
|
Loading…
Reference in New Issue
Block a user