Merge pull request #52 from bubba/session-newtype

Make Session a newtype

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index 1b2e7ba867a6ebc4356b008e29a7c4ce53eee962..61fc908d8eb33b56265c98f0a82a2524930657e5 100644 (file)
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -8,7 +8,7 @@ Module      : Language.Haskell.LSP.Test
 Description : A functional testing framework for LSP servers.
 Maintainer  : luke_lau@icloud.com
 Stability   : experimental
-Portability : POSIX
+Portability : non-portable
 
 Provides the framework to start functionally testing
 <https://github.com/Microsoft/language-server-protocol Language Server Protocol servers>.
@@ -163,8 +163,7 @@ runSessionWithConfig config serverExe caps rootDir session = do
         Nothing -> return ()
 
       -- Run the actual test
-      result <- session
-      return result
+      session
   where
   -- | Asks the server to shutdown and exit politely
   exitServer :: Session ()

diff --git a/src/Language/Haskell/LSP/Test/Parsing.hs b/src/Language/Haskell/LSP/Test/Parsing.hs
index 52f97ae8e80a62da02e4614f5f00a5241cd5f175..70481b979a83a67434dff19f1bb304af3ee65789 100644 (file)
--- a/src/Language/Haskell/LSP/Test/Parsing.hs
+++ b/src/Language/Haskell/LSP/Test/Parsing.hs
@@ -23,7 +23,8 @@ import Control.Monad.IO.Class
 import Control.Monad
 import Data.Aeson
 import qualified Data.ByteString.Lazy.Char8 as B
-import Data.Conduit.Parser
+import Data.Conduit.Parser hiding (named)
+import qualified Data.Conduit.Parser (named)
 import qualified Data.Text as T
 import Data.Typeable
 import Language.Haskell.LSP.Messages
@@ -81,7 +82,7 @@ satisfyMaybe pred = do
       threadDelay (timeout * 1000000)
       writeChan chan (TimeoutMessage timeoutId)
 
-  x <- await
+  x <- Session await
 
   unless skipTimeout $
     modify $ \s -> s { curTimeoutId = timeoutId + 1 }
@@ -94,6 +95,9 @@ satisfyMaybe pred = do
       return a
     Nothing -> empty
 
+named :: T.Text -> Session a -> Session a
+named s (Session x) = Session (Data.Conduit.Parser.named s x)
+
 -- | Matches a message of type @a@.
 message :: forall a. (Typeable a, FromJSON a) => Session a
 message =

diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs
index b8286a208c8f5e5369171b87ad62802d899b485d..b8dbe2ac04797c21ddf2d6b7a4beba3036d67c86 100644 (file)
--- a/src/Language/Haskell/LSP/Test/Session.hs
+++ b/src/Language/Haskell/LSP/Test/Session.hs
@@ -1,12 +1,13 @@
 {-# LANGUAGE CPP               #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE RankNTypes #-}
 
 module Language.Haskell.LSP.Test.Session
-  ( Session
+  ( Session(..)
   , SessionConfig(..)
   , defaultConfig
   , SessionMessage(..)
@@ -28,6 +29,7 @@ module Language.Haskell.LSP.Test.Session
 
 where
 
+import Control.Applicative
 import Control.Concurrent hiding (yield)
 import Control.Exception
 import Control.Lens hiding (List)
@@ -40,7 +42,7 @@ import Control.Monad.Fail
 import Control.Monad.Trans.Reader (ReaderT, runReaderT)
 import qualified Control.Monad.Trans.Reader as Reader (ask)
 import Control.Monad.Trans.State (StateT, runStateT)
-import qualified Control.Monad.Trans.State as State (get, put)
+import qualified Control.Monad.Trans.State as State
 import qualified Data.ByteString.Lazy.Char8 as B
 import Data.Aeson
 import Data.Aeson.Encode.Pretty
@@ -76,7 +78,8 @@ import System.Timeout
 -- 'Language.Haskell.LSP.Test.sendRequest' and
 -- 'Language.Haskell.LSP.Test.sendNotification'.
 
-type Session = ParserStateReader FromServerMessage SessionState SessionContext IO
+newtype Session a = Session (ConduitParser FromServerMessage (StateT SessionState (ReaderT SessionContext IO)) a)
+  deriving (Functor, Applicative, Monad, MonadIO, Alternative)
 
 #if __GLASGOW_HASKELL__ >= 806
 instance MonadFail Session where
@@ -121,10 +124,10 @@ class Monad m => HasReader r m where
   asks :: (r -> b) -> m b
   asks f = f <$> ask
 
-instance Monad m => HasReader r (ParserStateReader a s r m) where
-  ask = lift $ lift Reader.ask
+instance HasReader SessionContext Session where
+  ask  = Session (lift $ lift Reader.ask)
 
-instance Monad m => HasReader SessionContext (ConduitM a b (StateT s (ReaderT SessionContext m))) where
+instance Monad m => HasReader r (ConduitM a b (StateT s (ReaderT r m))) where
   ask = lift $ lift Reader.ask
 
 data SessionState = SessionState
@@ -150,19 +153,22 @@ class Monad m => HasState s m where
   modifyM :: (HasState s m, Monad m) => (s -> m s) -> m ()
   modifyM f = get >>= f >>= put
 
-instance Monad m => HasState s (ParserStateReader a s r m) where
+instance HasState SessionState Session where
+  get = Session (lift State.get)
+  put = Session . lift . State.put
+
+instance Monad m => HasState s (ConduitM a b (StateT s m))
+ where
   get = lift State.get
   put = lift . State.put
 
-instance Monad m => HasState SessionState (ConduitM a b (StateT SessionState m))
+instance Monad m => HasState s (ConduitParser a (StateT s m))
  where
   get = lift State.get
   put = lift . State.put
 
-type ParserStateReader a s r m = ConduitParser a (StateT s (ReaderT r m))
-
 runSession :: SessionContext -> SessionState -> Session a -> IO (a, SessionState)
-runSession context state session = runReaderT (runStateT conduit state) context
+runSession context state (Session session) = runReaderT (runStateT conduit state) context
   where
     conduit = runConduit $ chanSource .| watchdog .| updateStateC .| runConduitParser (catchError session handler)
 
@@ -235,7 +241,8 @@ updateStateC = awaitForever $ \msg -> do
   updateState msg
   yield msg
 
-updateState :: (MonadIO m, HasReader SessionContext m, HasState SessionState m) => FromServerMessage -> m ()
+updateState :: (MonadIO m, HasReader SessionContext m, HasState SessionState m)
+            => FromServerMessage -> m ()
 updateState (NotPublishDiagnostics n) = do
   let List diags = n ^. params . diagnostics
       doc = n ^. params . uri