Merge pull request #486 from joyfulmantis/helper-functions

Add helper instances and functions

Author: michaelpj

lsp-types/lsp-types.cabal

@@ -71,6 +71,7 @@ library
     , base              >=4.11    && <5
     , binary
     , containers
+    , data-default
     , deepseq
     , Diff              >=0.2
     , dlist
@@ -122,6 +123,7 @@ library
     Language.LSP.Protocol.Types.Location
     Language.LSP.Protocol.Types.LspEnum
     Language.LSP.Protocol.Types.MarkupContent
+    Language.LSP.Protocol.Types.Orphans
     Language.LSP.Protocol.Types.Progress
     Language.LSP.Protocol.Types.SemanticTokens
     Language.LSP.Protocol.Types.Singletons

lsp-types/src/Language/LSP/Protocol/Message/Lens.hs

@@ -1,4 +1,5 @@
 {-#LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Language.LSP.Protocol.Message.Lens where
 

lsp-types/src/Language/LSP/Protocol/Types.hs

@@ -24,6 +24,8 @@ module Language.LSP.Protocol.Types (
   , module WatchKinds
   -- * Main LSP types and functions
   , module Generated
+  -- ** Orphan instances for the generated types
+  , module Orphans
   ) where
 
 import Language.LSP.Protocol.Internal.Types as Generated
@@ -37,4 +39,5 @@ import Language.LSP.Protocol.Types.Singletons as Singletons
 import Language.LSP.Protocol.Types.Uri as Uri
 import Language.LSP.Protocol.Types.Uri.OsPath as Uri
 import Language.LSP.Protocol.Types.Edit as Edits
+import Language.LSP.Protocol.Types.Orphans as Orphans
 import Language.LSP.Protocol.Types.WatchKinds as WatchKinds

lsp-types/src/Language/LSP/Protocol/Types/Common.hs

@@ -19,6 +19,7 @@ module Language.LSP.Protocol.Types.Common (
   , Null (..)
   , absorbNull
   , nullToMaybe
+  , maybeToNull
   , (.=?)
 ) where
 
@@ -153,6 +154,17 @@ nullToMaybe :: a |? Null -> Maybe a
 nullToMaybe (InL a) = Just a
 nullToMaybe (InR _) = Nothing
 
+maybeToNull :: Maybe a -> a |? Null
+maybeToNull (Just x) = InL x
+maybeToNull Nothing  = InR Null
+
+-- This is equivalent to the instance for 'Maybe s'
+instance Semigroup s => Semigroup (s |? Null) where
+  InL x <> InL y = InL (x <> y)
+  InL x <> InR _ = InL x
+  InR _ <> InL x = InL x
+  InR _ <> InR y = InR y
+
   -- We use String so we can use fromString on it to get a key that works
   -- in both aeson-1 and aeson-2
 -- | Include a value in an JSON object optionally, omitting it if it is 'Nothing'.

lsp-types/src/Language/LSP/Protocol/Types/Lens.hs

@@ -1,4 +1,5 @@
 {-#LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Language.LSP.Protocol.Types.Lens where
 

lsp-types/src/Language/LSP/Protocol/Types/Orphans.hs

@@ -0,0 +1,20 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Language.LSP.Protocol.Types.Orphans where
+
+import           Language.LSP.Protocol.Internal.Types
+import           Data.Default
+import           Data.Semigroup                ()
+
+instance Semigroup WorkspaceEdit where
+  (WorkspaceEdit a b c) <> (WorkspaceEdit a' b' c') = WorkspaceEdit (a <> a') (b <> b') (c <> c')
+instance Monoid WorkspaceEdit where
+  mempty = WorkspaceEdit Nothing Nothing Nothing
+
+instance Default ClientCapabilities where
+    def = ClientCapabilities def def def def def Nothing
+instance Default WorkspaceClientCapabilities
+instance Default TextDocumentClientCapabilities
+instance Default NotebookDocumentClientCapabilities where
+instance Default NotebookDocumentSyncClientCapabilities
+instance Default WindowClientCapabilities
+instance Default GeneralClientCapabilities