Remove onInitialConfiguration

See haskell#210 and haskell#211
Also rename Progress to ProgressAmount to avoid clashing with Progress
method in haskell-lsp-types
Also fix haskell#252, wrapping sendProgress notifications in bracket
Also add example func-test for said bug

cabal.project

@@ -1,6 +1,13 @@
 packages:
          ./
          ./haskell-lsp-types/
+         ./func-test/
 
 package haskell-lsp
   flags: +demo
+
+
+source-repository-package
+    type: git
+    location: https://github.com/wz1000/lsp-test.git
+    tag: 826575195f87238c46431ed70bda8f97f079ffc9

example/Reactor.hs

@@ -70,14 +70,13 @@ run = flip E.catches handlers $ do
 
   let
     callbacks = InitializeCallbacks
-      { onInitialConfiguration = const $ pure (Config False 0)
-      , onConfigurationChange = \v -> case J.fromJSON v of
+      { onConfigurationChange = \v -> case J.fromJSON v of
           J.Error e -> pure $ Left (T.pack e)
           J.Success cfg -> do
             sendNotification J.SWindowShowMessage $
               J.ShowMessageParams J.MtInfo $ "Wibble factor set to " <> T.pack (show (wibbleFactor cfg))
             pure $ Right cfg
-      , onStartup = liftBaseDiscard forkIO (reactor rin) >> pure Nothing
+      , doInitialize = const $ liftBaseDiscard forkIO (reactor rin) >> pure Nothing
       }
 
   flip E.finally finalProc $ do
@@ -275,7 +274,7 @@ handle J.SWorkspaceExecuteCommand = Just $ \req responder -> do
 
   void $ withProgress "Executing some long running command" Cancellable $ \update ->
     forM [(0 :: Double)..10] $ \i -> do
-      update (Progress (Just (i * 10)) (Just "Doing stuff"))
+      update (ProgressAmount (Just (i * 10)) (Just "Doing stuff"))
       liftIO $ threadDelay (1 * 1000000)
 
 

example/Simple.hs

@@ -36,9 +36,8 @@ handlers STextDocumentHover = Just $ \req responder -> do
 handlers _ = Nothing
 
 initCallbacks = InitializeCallbacks
-  { onInitialConfiguration = const $ Right ()
-  , onConfigurationChange = const $ pure $ Right ()
-  , onStartup = pure Nothing
+  { onConfigurationChange = const $ pure $ Right ()
+  , doInitialize = const $ pure Nothing
   }
 
 main = run initCallbacks handlers def

func-test/FuncTest.hs

@@ -0,0 +1,58 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE GADTs, OverloadedStrings #-}
+module Main where
+
+import Data.Default
+import Language.Haskell.LSP.Core
+import Language.Haskell.LSP.Control
+import qualified Language.Haskell.LSP.Test as Test
+import Language.Haskell.LSP.Types
+import Language.Haskell.LSP.Types.Lens
+import Control.Monad.IO.Class
+import System.IO
+import Control.Concurrent
+import Control.Monad
+import System.Process
+import Control.Applicative.Combinators
+import Control.Monad.Trans.Control
+import Control.Lens
+
+main :: IO ()
+main = do
+  (hinRead, hinWrite) <- createPipe
+  (houtRead, houtWrite) <- createPipe
+
+  killVar <- newEmptyMVar
+
+  forkIO $ void $ runWithHandles hinRead houtWrite initCallbacks (handlers killVar) def
+
+  Test.runSessionWithHandles hinWrite houtRead Test.defaultConfig Test.fullCaps "." $ do
+    skipManyTill Test.anyMessage $ do
+      x <- Test.message SProgress
+      let isBegin (Begin _) = True
+          isBegin _ = False
+      guard $ isBegin $ x ^. params . value
+    liftIO $ putMVar killVar ()
+    skipManyTill Test.anyMessage $ do
+      x <- Test.message SProgress
+      let isEnd (End _) = True
+          isEnd _ = False
+      guard $ isEnd $ x ^. params . value
+    liftIO $ putStrLn "Hello, Haskell!"
+
+initCallbacks :: InitializeCallbacks ()
+initCallbacks = InitializeCallbacks
+  { onConfigurationChange = const $ pure $ Right ()
+  , onInitialization = const $ pure Nothing
+  }
+
+handlers :: MVar () -> Handlers ()
+handlers killVar SInitialized = Just $ \noti -> do
+  tid <- liftBaseDiscard forkIO $
+    withProgress "Doing something" NotCancellable $ \updater ->
+      liftIO $ threadDelay (1 * 1000000)
+  liftIO $ void $ forkIO $ do
+    takeMVar killVar
+    killThread tid
+
+handlers _ _ = Nothing

func-test/func-test.cabal

@@ -0,0 +1,15 @@
+cabal-version:       >=1.10
+name:                func-test
+version:             0.1.0.0
+build-type:          Simple
+
+executable func-test
+  main-is:             FuncTest.hs
+  build-depends:       base >=4.14 && <4.15
+                     , lsp-test
+                     , haskell-lsp
+                     , data-default
+                     , process
+                     , lens
+                     , monad-control
+  default-language:    Haskell2010

haskell-lsp-types/src/Language/Haskell/LSP/Types.hs

@@ -13,6 +13,7 @@ module Language.Haskell.LSP.Types
   , module Language.Haskell.LSP.Types.DocumentFilter
   , module Language.Haskell.LSP.Types.DocumentHighlight
   , module Language.Haskell.LSP.Types.DocumentLink
+  , module Language.Haskell.LSP.Types.DocumentSymbol
   , module Language.Haskell.LSP.Types.FoldingRange
   , module Language.Haskell.LSP.Types.Formatting
   , module Language.Haskell.LSP.Types.Hover
@@ -29,7 +30,6 @@ module Language.Haskell.LSP.Types
   , module Language.Haskell.LSP.Types.Rename
   , module Language.Haskell.LSP.Types.SignatureHelp
   , module Language.Haskell.LSP.Types.StaticRegistrationOptions
-  , module Language.Haskell.LSP.Types.DocumentSymbol
   , module Language.Haskell.LSP.Types.SelectionRange
   , module Language.Haskell.LSP.Types.Synonyms
   , module Language.Haskell.LSP.Types.TextDocument
@@ -57,6 +57,7 @@ import           Language.Haskell.LSP.Types.DocumentColor
 import           Language.Haskell.LSP.Types.DocumentFilter
 import           Language.Haskell.LSP.Types.DocumentHighlight
 import           Language.Haskell.LSP.Types.DocumentLink
+import           Language.Haskell.LSP.Types.DocumentSymbol
 import           Language.Haskell.LSP.Types.FoldingRange
 import           Language.Haskell.LSP.Types.Formatting
 import           Language.Haskell.LSP.Types.Hover
@@ -74,7 +75,6 @@ import           Language.Haskell.LSP.Types.Rename
 import           Language.Haskell.LSP.Types.SelectionRange
 import           Language.Haskell.LSP.Types.SignatureHelp
 import           Language.Haskell.LSP.Types.StaticRegistrationOptions
-import           Language.Haskell.LSP.Types.DocumentSymbol
 import           Language.Haskell.LSP.Types.Synonyms
 import           Language.Haskell.LSP.Types.TextDocument
 import           Language.Haskell.LSP.Types.TypeDefinition

haskell-lsp-types/src/Language/Haskell/LSP/Types/Capabilities.hs

@@ -14,8 +14,7 @@ import Language.Haskell.LSP.Types.ServerCapabilities
 import Language.Haskell.LSP.Types.WorkspaceEdit
 import Language.Haskell.LSP.Types
 
--- | The whole shebang. The real deal.
--- Capabilities for full conformance to the current (v3.15) LSP specification.
+-- | Capabilities for full conformance to the current (v3.15) LSP specification.
 fullCaps :: ClientCapabilities
 fullCaps = capsForVersion (LSPVersion maxBound maxBound)
 
@@ -35,7 +34,7 @@ data LSPVersion = LSPVersion Int Int -- ^ Construct a major.minor version
 -- * 3.4 extended completion item and symbol item kinds
 -- * 3.0 dynamic registration
 capsForVersion :: LSPVersion -> ClientCapabilities
-capsForVersion (LSPVersion maj min) = ClientCapabilities (Just w) (Just td) Nothing Nothing
+capsForVersion (LSPVersion maj min) = ClientCapabilities (Just w) (Just td) (Just window) Nothing
   where
     w = WorkspaceClientCapabilities
           (Just True)
@@ -243,3 +242,5 @@ capsForVersion (LSPVersion maj min) = ClientCapabilities (Just w) (Just td) Noth
     since x y a
       | maj >= x && min >= y = Just a
       | otherwise            = Nothing
+
+    window = WindowClientCapabilities (since 3 15 True)

haskell-lsp-types/src/Language/Haskell/LSP/Types/Common.hs

@@ -23,7 +23,10 @@ instance (ToJSON a, ToJSON b) => ToJSON (a |? b) where
   toJSON (R x) = toJSON x
 
 instance (FromJSON a, FromJSON b) => FromJSON (a |? b) where
-  parseJSON v = L <$> parseJSON v <|> R <$> parseJSON v
+  -- Important: Try to parse the **rightmost** type first, as in the specification
+  -- the more complex types tend to appear on the right of the |, i.e.
+  -- @colorProvider?: boolean | DocumentColorOptions | DocumentColorRegistrationOptions;@
+  parseJSON v = R <$> parseJSON v <|> L <$> parseJSON v
 
 instance (NFData a, NFData b) => NFData (a |? b)
 

haskell-lsp.cabal

@@ -125,7 +125,6 @@ test-suite haskell-lsp-test
                        VspSpec
                        WorkspaceEditSpec
                        WorkspaceFoldersSpec
-                       InitialConfigurationSpec
   build-depends:       base
                      , QuickCheck
                      , aeson

hie.yaml

@@ -13,6 +13,8 @@ cradle:
         component: "haskell-lsp"
       - path: "./test"
         component: "haskell-lsp-test"
+      - path: "./func-test"
+        component: "func-test"
       - path: "./example/Reactor.hs"
         component: "lsp-demo-reactor-server"
       - path: "./example/Simple.hs"