From 7d9fea9a6539c1d69a85d7d49cdae5a9681ba077 Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Sun, 5 Oct 2025 12:44:31 +0200 Subject: [PATCH 1/7] Addded jbeam-lsp-server to package.yaml --- app-extra/jbeam-lsp-server/Main.hs | 6 +++++ cabal.project | 2 +- cabal.project.ci | 2 +- cabal.project.dev | 2 +- jbeam-edit.cabal | 39 ++++++++++++++++++++++++++++++ package.yaml | 9 +++++++ 6 files changed, 57 insertions(+), 3 deletions(-) create mode 100644 app-extra/jbeam-lsp-server/Main.hs diff --git a/app-extra/jbeam-lsp-server/Main.hs b/app-extra/jbeam-lsp-server/Main.hs new file mode 100644 index 00000000..0790e412 --- /dev/null +++ b/app-extra/jbeam-lsp-server/Main.hs @@ -0,0 +1,6 @@ +{-# OPTIONS_GHC -Wno-deprecations #-} + +module Main (main) where + +main :: IO () +main = undefined diff --git a/cabal.project b/cabal.project index de9ea8b2..185175cb 100644 --- a/cabal.project +++ b/cabal.project @@ -4,4 +4,4 @@ tests: False package jbeam-edit tests: False - flags: -dump-ast -transformation -windows-example-paths + flags: -dump-ast -transformation -lsp-server -windows-example-paths diff --git a/cabal.project.ci b/cabal.project.ci index 76c99138..83d9959e 100644 --- a/cabal.project.ci +++ b/cabal.project.ci @@ -6,4 +6,4 @@ program-options package jbeam-edit tests: True - flags: +dump-ast +transformation -windows-example-paths + flags: +dump-ast +transformation +lsp-server -windows-example-paths diff --git a/cabal.project.dev b/cabal.project.dev index 030d0de6..3a6cba13 100644 --- a/cabal.project.dev +++ b/cabal.project.dev @@ -11,4 +11,4 @@ package jbeam-edit tests: True haddock-executables: True haddock-internal: True - flags: +dump-ast +transformation -windows-example-paths + flags: +dump-ast +transformation +lsp-server -windows-example-paths diff --git a/jbeam-edit.cabal b/jbeam-edit.cabal index f7237409..beb9b012 100644 --- a/jbeam-edit.cabal +++ b/jbeam-edit.cabal @@ -49,6 +49,11 @@ flag dump-ast default: False manual: True +flag lsp-server + description: Enable LSP server (experimental) + default: False + manual: True + flag transformation description: Enable transformation (experimental) default: False @@ -232,6 +237,40 @@ executable jbeam-edit-dump-ast else buildable: False +executable jbeam-lsp-server + main-is: Main.hs + hs-source-dirs: app-extra/jbeam-lsp-server + other-modules: Paths_jbeam_edit + autogen-modules: Paths_jbeam_edit + default-language: Haskell2010 + default-extensions: OverloadedStrings ImportQualifiedPost + ghc-options: + -Wall -Wcompat -Widentities -Wincomplete-record-updates + -Wincomplete-uni-patterns -Wmissing-export-lists + -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints + -threaded -rtsopts -with-rtsopts=-N + + build-depends: + aeson-pretty, + base >=4.17 && <5, + bytestring >=0.12, + containers >=0.6, + directory >=1.3, + filepath >=1.4, + jbeam-edit, + lsp >=2.7, + megaparsec >=9.6, + prettyprinter, + relude >=1.2, + scientific >=0.3, + text >=2.1, + vector >=0.13 + + mixins: + base hiding (Prelude), + relude (Relude as Prelude), + relude + test-suite jbeam-edit-test type: exitcode-stdio-1.0 main-is: Spec.hs diff --git a/package.yaml b/package.yaml index fad60a82..09c19480 100644 --- a/package.yaml +++ b/package.yaml @@ -62,6 +62,10 @@ flags: description: Enable transformation (experimental) manual: true default: false + lsp-server: + description: Enable LSP server (experimental) + manual: true + default: false windows-example-paths: description: Use executable-relative example paths (for Windows release builds) default: false @@ -99,6 +103,11 @@ executables: cpp-options: -DENABLE_TRANSFORMATION - condition: os(windows) cpp-options: -DENABLE_WINDOWS_NEWLINES + jbeam-lsp-server: + main: Main.hs + source-dirs: app-extra/jbeam-lsp-server + ghc-options: [-threaded, -rtsopts, -with-rtsopts=-N] + dependencies: [jbeam-edit, lsp>=2.7, prettyprinter, aeson-pretty] jbeam-edit-dump-ast: when: condition: (flag(dump-ast) && flag(transformation)) From cae6fe96173c5b1706154fa64c2a8519332197bd Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Sun, 5 Oct 2025 13:21:16 +0200 Subject: [PATCH 2/7] Hide new code behind flag --- jbeam-edit.cabal | 12 +++++++++--- package.yaml | 8 +++++++- 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/jbeam-edit.cabal b/jbeam-edit.cabal index beb9b012..ab02d5ff 100644 --- a/jbeam-edit.cabal +++ b/jbeam-edit.cabal @@ -251,16 +251,13 @@ executable jbeam-lsp-server -threaded -rtsopts -with-rtsopts=-N build-depends: - aeson-pretty, base >=4.17 && <5, bytestring >=0.12, containers >=0.6, directory >=1.3, filepath >=1.4, jbeam-edit, - lsp >=2.7, megaparsec >=9.6, - prettyprinter, relude >=1.2, scientific >=0.3, text >=2.1, @@ -271,6 +268,15 @@ executable jbeam-lsp-server relude (Relude as Prelude), relude + if flag(lsp-server) + build-depends: + aeson-pretty, + lsp >=2.7, + prettyprinter + + else + buildable: False + test-suite jbeam-edit-test type: exitcode-stdio-1.0 main-is: Spec.hs diff --git a/package.yaml b/package.yaml index 09c19480..a10290bf 100644 --- a/package.yaml +++ b/package.yaml @@ -107,7 +107,13 @@ executables: main: Main.hs source-dirs: app-extra/jbeam-lsp-server ghc-options: [-threaded, -rtsopts, -with-rtsopts=-N] - dependencies: [jbeam-edit, lsp>=2.7, prettyprinter, aeson-pretty] + when: + condition: flag(lsp-server) + then: + dependencies: [lsp>=2.7, prettyprinter, aeson-pretty] + else: + buildable: false + dependencies: [jbeam-edit] jbeam-edit-dump-ast: when: condition: (flag(dump-ast) && flag(transformation)) From e22bf9dc6e9121caf8f92fcf71cbb8e35aefc092 Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Wed, 8 Oct 2025 11:38:09 +0200 Subject: [PATCH 3/7] Add JBeam LSP server with formatting support - Implement server in `Server.hs` using `Language.LSP.Server` - Add `Handlers/Formatting.hs` to provide full-document formatting for JBeam files - Add in-memory `DocumentStore` for tracking open and changed documents - Update `Main.hs` to launch the LSP server - Configure `.dir-locals.el` for Haskell development - Update `jbeam-edit.cabal` with new executable and module dependencies --- app-extra/jbeam-lsp-server/.dir-locals.el | 4 + .../jbeam-lsp-server/Handlers/Formatting.hs | 78 +++++++++++++++++++ app-extra/jbeam-lsp-server/Main.hs | 8 +- app-extra/jbeam-lsp-server/Server.hs | 70 +++++++++++++++++ .../Services/DocumentStore.hs | 24 ++++++ hie.yaml | 2 + jbeam-edit.cabal | 14 ++-- package.yaml | 4 +- 8 files changed, 193 insertions(+), 11 deletions(-) create mode 100644 app-extra/jbeam-lsp-server/.dir-locals.el create mode 100644 app-extra/jbeam-lsp-server/Handlers/Formatting.hs create mode 100644 app-extra/jbeam-lsp-server/Server.hs create mode 100644 app-extra/jbeam-lsp-server/Services/DocumentStore.hs diff --git a/app-extra/jbeam-lsp-server/.dir-locals.el b/app-extra/jbeam-lsp-server/.dir-locals.el new file mode 100644 index 00000000..16080c1e --- /dev/null +++ b/app-extra/jbeam-lsp-server/.dir-locals.el @@ -0,0 +1,4 @@ +((haskell-mode + . ((haskell-process-type . cabal-repl) + (eval . (setq-local haskell-process-args-cabal-repl + (append '("jbeam-edit:exe:jbeam-lsp-server" "--project-file" "cabal.project.dev") haskell-process-args-cabal-repl)))))) diff --git a/app-extra/jbeam-lsp-server/Handlers/Formatting.hs b/app-extra/jbeam-lsp-server/Handlers/Formatting.hs new file mode 100644 index 00000000..48394554 --- /dev/null +++ b/app-extra/jbeam-lsp-server/Handlers/Formatting.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} + +module Handlers.Formatting (handlers) where + +import Language.LSP.Server (Handlers, LspM, requestHandler) + +import Data.Text qualified as T +import Formatting qualified as Fmt +import Language.LSP.Protocol.Message qualified as Msg +import Language.LSP.Protocol.Types qualified as J ( + DocumentFormattingParams (..), + Null (..), + Position (..), + Range (..), + TextDocumentIdentifier (..), + TextEdit (..), + type (|?) (..), + ) +import Parsing.Jbeam qualified as JbeamP +import Services.DocumentStore qualified as Docs + +handlers :: Handlers (LspM config) +handlers = + mconcat + [ requestHandler Msg.SMethod_TextDocumentFormatting $ \req responder -> + -- req :: Msg.TRequestMessage ... + -- responder :: Either (Msg.TResponseError ...) (Msg.MessageResult ...) -> LspM config () + case req of + Msg.TRequestMessage _ _ _ params -> handleParams params responder + ] + +handleParams + :: MonadIO m + => J.DocumentFormattingParams + -> (Either a ([J.TextEdit] J.|? J.Null) -> m b) + -> m b +handleParams params responder = + case params of + -- pattern-matcha konkret för att få uri utan ambiguitet + J.DocumentFormattingParams + { J._textDocument = J.TextDocumentIdentifier {J._uri = uri} + } -> do + mText <- liftIO $ Docs.get uri + + case mText of + Nothing -> + -- returnera JSON null + responder (Right $ J.InR J.Null) + Just txt -> + -- anta parseNodes :: ByteString -> Either Text Node + case JbeamP.parseNodes (encodeUtf8 txt) of + Left perr -> do + -- logga parserfel; returnera null (eller publicera diagnostics om du vill) + liftIO $ putStrLn ("Formatting parse error: " ++ toString perr) + responder (Right $ J.InR J.Null) + Right node -> do + let newText = Fmt.formatNode Fmt.newRuleSet node + edit = + J.TextEdit + { J._range = wholeRange txt + , J._newText = newText + } + responder (Right $ J.InL [edit]) + +wholeRange :: Text -> J.Range +wholeRange txt = + let ls = lines txt + numLines = max 1 (length ls) + lastLineLen = maybe 0 (T.length . last) (nonEmpty ls) + in J.Range + (J.Position 0 0) + ( J.Position + (fromIntegral (numLines - 1)) + (fromIntegral lastLineLen) + ) diff --git a/app-extra/jbeam-lsp-server/Main.hs b/app-extra/jbeam-lsp-server/Main.hs index 0790e412..7c9208c7 100644 --- a/app-extra/jbeam-lsp-server/Main.hs +++ b/app-extra/jbeam-lsp-server/Main.hs @@ -1,6 +1,8 @@ -{-# OPTIONS_GHC -Wno-deprecations #-} +module Main ( + main, +) where -module Main (main) where +import Server (runServer) main :: IO () -main = undefined +main = void runServer diff --git a/app-extra/jbeam-lsp-server/Server.hs b/app-extra/jbeam-lsp-server/Server.hs new file mode 100644 index 00000000..b0480aa0 --- /dev/null +++ b/app-extra/jbeam-lsp-server/Server.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeOperators #-} + +module Server (runServer) where + +import Handlers.Formatting qualified as Formatting +import Language.LSP.Protocol.Message qualified as Msg +import Language.LSP.Protocol.Types qualified as J ( + DidChangeTextDocumentParams (..), + DidOpenTextDocumentParams (..), + TextDocumentContentChangeEvent (..), + TextDocumentContentChangePartial (..), + TextDocumentContentChangeWholeDocument (..), + TextDocumentItem (..), + VersionedTextDocumentIdentifier (..), + type (|?) (..), + ) +import Language.LSP.Server qualified as S +import Services.DocumentStore qualified as Docs + +-- | Starta LSP-servern +runServer :: IO Int +runServer = + S.runServer $ + S.ServerDefinition + { defaultConfig = () + , doInitialize = \env _req -> pure (Right env) + , staticHandlers = \_caps -> + mconcat + [ Formatting.handlers + , S.notificationHandler Msg.SMethod_TextDocumentDidOpen handleDidOpen + , S.notificationHandler Msg.SMethod_TextDocumentDidChange handleDidChange + ] + , interpretHandler = \env -> S.Iso (S.runLspT env) liftIO + , options = S.defaultOptions + } + +-- | didOpen: save docuement in DocumentStore +handleDidOpen + :: forall + {f :: Msg.MessageDirection} + {m1 :: Msg.Method f Msg.Notification} + {m2 :: Type -> Type} + . (MonadIO m2, Msg.MessageParams m1 ~ J.DidOpenTextDocumentParams) + => Msg.TNotificationMessage m1 -> m2 () +handleDidOpen (Msg.TNotificationMessage _ _ (J.DidOpenTextDocumentParams textDoc)) = + let J.TextDocumentItem {J._uri = uri, J._text = txt} = textDoc + in liftIO $ Docs.open uri txt + +-- | didChange: update document in DocumentStore +handleDidChange + :: forall + {f :: Msg.MessageDirection} + {m1 :: Msg.Method f Msg.Notification} + {m2 :: Type -> Type} + . ( MonadIO m2 + , Msg.MessageParams m1 ~ J.DidChangeTextDocumentParams + ) + => Msg.TNotificationMessage m1 -> m2 () +handleDidChange (Msg.TNotificationMessage _ _ (J.DidChangeTextDocumentParams docId changes)) = + let J.VersionedTextDocumentIdentifier {_uri = uri} = docId + in case changes of + (J.TextDocumentContentChangeEvent change : _) -> + case change of + J.InL (J.TextDocumentContentChangePartial {J._text = txt}) -> liftIO $ Docs.update uri txt + J.InR (J.TextDocumentContentChangeWholeDocument txt) -> liftIO $ Docs.update uri txt + _ -> pass diff --git a/app-extra/jbeam-lsp-server/Services/DocumentStore.hs b/app-extra/jbeam-lsp-server/Services/DocumentStore.hs new file mode 100644 index 00000000..609a86c0 --- /dev/null +++ b/app-extra/jbeam-lsp-server/Services/DocumentStore.hs @@ -0,0 +1,24 @@ +module Services.DocumentStore (open, update, get) where + +import Control.Concurrent.MVar hiding (newMVar, readMVar) +import Language.LSP.Protocol.Types (Uri) +import System.IO.Unsafe (unsafePerformIO) +import Prelude hiding (get) + +import Data.Map.Strict qualified as M +import Data.Text qualified as T + +type DocumentStore = MVar (M.Map Uri T.Text) + +{-# NOINLINE store #-} +store :: DocumentStore +store = unsafePerformIO (newMVar M.empty) + +open :: Uri -> T.Text -> IO () +open uri text = modifyMVar_ store (pure . M.insert uri text) + +update :: Uri -> T.Text -> IO () +update = open + +get :: Uri -> IO (Maybe T.Text) +get uri = M.lookup uri <$> readMVar store diff --git a/hie.yaml b/hie.yaml index 7d406149..eac81e0e 100644 --- a/hie.yaml +++ b/hie.yaml @@ -16,6 +16,8 @@ cradle: component: jbeam-edit:lib:jbeam-edit-transformation - path: ./app component: exe:jbeam-edit + - path: ./app-extra/jbeam-lsp-server + component: jbeam-edit:exe:jbeam-lsp-server - path: ./tools/dump_ast component: exe:jbeam-edit-dump-ast - path: ./test diff --git a/jbeam-edit.cabal b/jbeam-edit.cabal index ab02d5ff..3a8aec46 100644 --- a/jbeam-edit.cabal +++ b/jbeam-edit.cabal @@ -240,7 +240,12 @@ executable jbeam-edit-dump-ast executable jbeam-lsp-server main-is: Main.hs hs-source-dirs: app-extra/jbeam-lsp-server - other-modules: Paths_jbeam_edit + other-modules: + Handlers.Formatting + Server + Services.DocumentStore + Paths_jbeam_edit + autogen-modules: Paths_jbeam_edit default-language: Haskell2010 default-extensions: OverloadedStrings ImportQualifiedPost @@ -268,11 +273,8 @@ executable jbeam-lsp-server relude (Relude as Prelude), relude - if flag(lsp-server) - build-depends: - aeson-pretty, - lsp >=2.7, - prettyprinter + if (flag(lsp-server) && impl(ghc >=9.6.6)) + build-depends: lsp >=2.7 else buildable: False diff --git a/package.yaml b/package.yaml index a10290bf..260fbcdd 100644 --- a/package.yaml +++ b/package.yaml @@ -108,9 +108,9 @@ executables: source-dirs: app-extra/jbeam-lsp-server ghc-options: [-threaded, -rtsopts, -with-rtsopts=-N] when: - condition: flag(lsp-server) + condition: flag(lsp-server) && impl(ghc >= 9.6.6) then: - dependencies: [lsp>=2.7, prettyprinter, aeson-pretty] + dependencies: [lsp>=2.7] else: buildable: false dependencies: [jbeam-edit] From 54a7093228fc3b3f749e07fe4a28dc0f3c361b50 Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Wed, 8 Oct 2025 16:05:58 +0200 Subject: [PATCH 4/7] Fix formatting capability --- .../jbeam-lsp-server/Handlers/Formatting.hs | 100 +++++++++--------- app-extra/jbeam-lsp-server/Server.hs | 30 ++++-- .../Services/DocumentStore.hs | 4 +- 3 files changed, 74 insertions(+), 60 deletions(-) diff --git a/app-extra/jbeam-lsp-server/Handlers/Formatting.hs b/app-extra/jbeam-lsp-server/Handlers/Formatting.hs index 48394554..e1a9e8f3 100644 --- a/app-extra/jbeam-lsp-server/Handlers/Formatting.hs +++ b/app-extra/jbeam-lsp-server/Handlers/Formatting.hs @@ -1,11 +1,11 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} module Handlers.Formatting (handlers) where -import Language.LSP.Server (Handlers, LspM, requestHandler) +import Formatting.Rules (RuleSet) import Data.Text qualified as T import Formatting qualified as Fmt @@ -19,60 +19,58 @@ import Language.LSP.Protocol.Types qualified as J ( TextEdit (..), type (|?) (..), ) +import Language.LSP.Server qualified as S import Parsing.Jbeam qualified as JbeamP import Services.DocumentStore qualified as Docs -handlers :: Handlers (LspM config) -handlers = - mconcat - [ requestHandler Msg.SMethod_TextDocumentFormatting $ \req responder -> - -- req :: Msg.TRequestMessage ... - -- responder :: Either (Msg.TResponseError ...) (Msg.MessageResult ...) -> LspM config () - case req of - Msg.TRequestMessage _ _ _ params -> handleParams params responder - ] +handlers :: RuleSet -> S.Handlers (S.LspM config) +handlers rs = + S.requestHandler Msg.SMethod_TextDocumentFormatting formattingHandler + where + formattingHandler + :: Msg.TRequestMessage Msg.Method_TextDocumentFormatting + -> ( Either + (Msg.TResponseError Msg.Method_TextDocumentFormatting) + (Msg.MessageResult Msg.Method_TextDocumentFormatting) + -> S.LspM config () + ) + -> S.LspM config () + formattingHandler req responder = do + liftIO $ putStrLn "DEBUG: formattingHandler invoked" + let Msg.TRequestMessage _ _ _ (params :: J.DocumentFormattingParams) = req + handleParams rs params responder handleParams - :: MonadIO m - => J.DocumentFormattingParams - -> (Either a ([J.TextEdit] J.|? J.Null) -> m b) - -> m b -handleParams params responder = - case params of - -- pattern-matcha konkret för att få uri utan ambiguitet - J.DocumentFormattingParams - { J._textDocument = J.TextDocumentIdentifier {J._uri = uri} - } -> do - mText <- liftIO $ Docs.get uri - - case mText of - Nothing -> - -- returnera JSON null - responder (Right $ J.InR J.Null) - Just txt -> - -- anta parseNodes :: ByteString -> Either Text Node - case JbeamP.parseNodes (encodeUtf8 txt) of - Left perr -> do - -- logga parserfel; returnera null (eller publicera diagnostics om du vill) - liftIO $ putStrLn ("Formatting parse error: " ++ toString perr) - responder (Right $ J.InR J.Null) - Right node -> do - let newText = Fmt.formatNode Fmt.newRuleSet node - edit = - J.TextEdit - { J._range = wholeRange txt - , J._newText = newText - } - responder (Right $ J.InL [edit]) + :: RuleSet + -> J.DocumentFormattingParams + -> ( Either + (Msg.TResponseError Msg.Method_TextDocumentFormatting) + (Msg.MessageResult Msg.Method_TextDocumentFormatting) + -> S.LspM config () + ) + -> S.LspM config () +handleParams rs params responder = do + let J.DocumentFormattingParams {J._textDocument = textDocId} = params + J.TextDocumentIdentifier {J._uri = uri} = textDocId + mText <- liftIO $ Docs.get uri + case mText of + Nothing -> do + liftIO . putStrLn $ "DEBUG: no document in store for " ++ show uri + responder (Right (J.InR J.Null)) + Just txt -> + case JbeamP.parseNodes (encodeUtf8 txt) of + Left err -> do + liftIO . putStrLn $ "Parse error: " ++ show err + responder (Right (J.InR J.Null)) + Right node -> do + let newText = Fmt.formatNode rs node + edit = J.TextEdit {J._range = wholeRange txt, J._newText = newText} + responder (Right (J.InL [edit])) wholeRange :: Text -> J.Range wholeRange txt = - let ls = lines txt - numLines = max 1 (length ls) - lastLineLen = maybe 0 (T.length . last) (nonEmpty ls) + let numLines = max 1 . length . lines $ txt + lastLineLen = T.length $ T.takeWhileEnd (/= '\n') txt in J.Range (J.Position 0 0) - ( J.Position - (fromIntegral (numLines - 1)) - (fromIntegral lastLineLen) - ) + (J.Position (fromIntegral (numLines - 1)) (fromIntegral lastLineLen)) diff --git a/app-extra/jbeam-lsp-server/Server.hs b/app-extra/jbeam-lsp-server/Server.hs index b0480aa0..00c6d9f6 100644 --- a/app-extra/jbeam-lsp-server/Server.hs +++ b/app-extra/jbeam-lsp-server/Server.hs @@ -6,6 +6,9 @@ module Server (runServer) where +import Formatting.Rules (RuleSet) + +import Formatting.Config qualified as FmtCfg import Handlers.Formatting qualified as Formatting import Language.LSP.Protocol.Message qualified as Msg import Language.LSP.Protocol.Types qualified as J ( @@ -21,19 +24,30 @@ import Language.LSP.Protocol.Types qualified as J ( import Language.LSP.Server qualified as S import Services.DocumentStore qualified as Docs +staticHandlers :: RuleSet -> S.Handlers (S.LspM config) +staticHandlers rs = + mconcat + [ S.notificationHandler Msg.SMethod_Initialized $ \_notif -> + liftIO $ putStrLn "Client initialized" + , S.notificationHandler Msg.SMethod_WorkspaceDidChangeConfiguration $ \_notif -> + liftIO $ putStrLn "Configuration changed" + , S.notificationHandler Msg.SMethod_TextDocumentDidOpen handleDidOpen + , S.notificationHandler Msg.SMethod_TextDocumentDidChange handleDidChange + ] + <> Formatting.handlers rs + -- | Starta LSP-servern runServer :: IO Int -runServer = +runServer = do + ruleSet <- FmtCfg.readFormattingConfig S.runServer $ S.ServerDefinition - { defaultConfig = () + { configSection = "jbeam-lsp" + , parseConfig = \_ _ -> Right () + , onConfigChange = const >> pure $ pass + , defaultConfig = () , doInitialize = \env _req -> pure (Right env) - , staticHandlers = \_caps -> - mconcat - [ Formatting.handlers - , S.notificationHandler Msg.SMethod_TextDocumentDidOpen handleDidOpen - , S.notificationHandler Msg.SMethod_TextDocumentDidChange handleDidChange - ] + , staticHandlers = const $ staticHandlers ruleSet , interpretHandler = \env -> S.Iso (S.runLspT env) liftIO , options = S.defaultOptions } diff --git a/app-extra/jbeam-lsp-server/Services/DocumentStore.hs b/app-extra/jbeam-lsp-server/Services/DocumentStore.hs index 609a86c0..90cb088d 100644 --- a/app-extra/jbeam-lsp-server/Services/DocumentStore.hs +++ b/app-extra/jbeam-lsp-server/Services/DocumentStore.hs @@ -12,7 +12,9 @@ type DocumentStore = MVar (M.Map Uri T.Text) {-# NOINLINE store #-} store :: DocumentStore -store = unsafePerformIO (newMVar M.empty) +store = unsafePerformIO $ do + putStrLn "[Info] Initializing DocumentStore" + newMVar M.empty open :: Uri -> T.Text -> IO () open uri text = modifyMVar_ store (pure . M.insert uri text) From 721cdf77ecf2eb38504a423af79d6ef89a79dd32 Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Wed, 8 Oct 2025 22:02:10 +0200 Subject: [PATCH 5/7] Add test --- .github/workflows/build-and-release.yaml | 2 +- .github/workflows/build-and-test.yaml | 2 +- .github/workflows/future-proofing.yaml | 2 +- jbeam-edit.cabal | 7 +++++ package.yaml | 9 ++++--- test/LspSpec.hs | 33 ++++++++++++++++++++++++ 6 files changed, 49 insertions(+), 6 deletions(-) create mode 100644 test/LspSpec.hs diff --git a/.github/workflows/build-and-release.yaml b/.github/workflows/build-and-release.yaml index a3cb3b75..f03d1b65 100644 --- a/.github/workflows/build-and-release.yaml +++ b/.github/workflows/build-and-release.yaml @@ -82,7 +82,7 @@ jobs: - name: Build dependencies, good to do separate for caching run: cabal build --project-file cabal.project.release --only-dependencies - name: Build executables - run: cabal build exe:jbeam-edit --project-file cabal.project.release + run: cabal install --project-file cabal.project.release - name: Run tests (GHC ${{ matrix.ghc }}) if: "!startsWith(github.ref, 'refs/tags/')" run: cabal test --project-file cabal.project.release diff --git a/.github/workflows/build-and-test.yaml b/.github/workflows/build-and-test.yaml index 18233b7e..ce9d4cb0 100644 --- a/.github/workflows/build-and-test.yaml +++ b/.github/workflows/build-and-test.yaml @@ -167,6 +167,6 @@ jobs: restore-keys: | ${{ runner.os }}-cabal-${{ matrix.ghc }}- - name: Build project (GHC ${{ steps.setup-ghc.outputs.ghc-version }}) - run: cabal build --project-file cabal.project.ci all + run: cabal install --project-file cabal.project.ci all - name: Run tests (GHC ${{ steps.setup-ghc.outputs.ghc-version }}) run: cabal test --project-file cabal.project.ci diff --git a/.github/workflows/future-proofing.yaml b/.github/workflows/future-proofing.yaml index d142a3f7..0703e356 100644 --- a/.github/workflows/future-proofing.yaml +++ b/.github/workflows/future-proofing.yaml @@ -51,6 +51,6 @@ jobs: restore-keys: | ${{ runner.os }}-cabal-${{ steps.get-ghc.outputs.ghc-version }}- - name: Build project (GHC latest) - run: cabal build --project-file cabal.project.ci all + run: cabal install --project-file cabal.project.ci all - name: Run tests (GHC latest) run: cabal test --project-file cabal.project.ci diff --git a/jbeam-edit.cabal b/jbeam-edit.cabal index 3a8aec46..b48b5bfd 100644 --- a/jbeam-edit.cabal +++ b/jbeam-edit.cabal @@ -290,6 +290,7 @@ test-suite jbeam-edit-test Core.NodeSpec Formatting.RulesSpec FormattingSpec + LspSpec Parsing.DSLSpec Parsing.JbeamSpec SpecHelper @@ -325,6 +326,12 @@ test-suite jbeam-edit-test relude (Relude as Prelude), relude + if (flag(lsp-server) && impl(ghc >=9.6.6)) + cpp-options: -DENABLE_LSP_TESTS + build-depends: + lsp >=2.7, + lsp-test + if flag(transformation) cpp-options: -DENABLE_TRANSFORMATION_TESTS build-depends: jbeam-edit-transformation diff --git a/package.yaml b/package.yaml index 260fbcdd..d9663250 100644 --- a/package.yaml +++ b/package.yaml @@ -134,6 +134,9 @@ tests: dependencies: [jbeam-edit, hspec>=2.11, hspec-megaparsec>=2.2] build-tools: [hspec-discover] when: - condition: flag(transformation) - dependencies: [jbeam-edit-transformation] - cpp-options: -DENABLE_TRANSFORMATION_TESTS + - condition: flag(lsp-server) && impl(ghc >= 9.6.6) + dependencies: [lsp-test, lsp>=2.7] + cpp-options: -DENABLE_LSP_TESTS + - condition: flag(transformation) + dependencies: [jbeam-edit-transformation] + cpp-options: -DENABLE_TRANSFORMATION_TESTS diff --git a/test/LspSpec.hs b/test/LspSpec.hs new file mode 100644 index 00000000..9466c7e3 --- /dev/null +++ b/test/LspSpec.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE CPP #-} + +module LspSpec (spec) where + +import Test.Hspec + +#ifdef ENABLE_LSP_TESTS +import Language.LSP.Test +import Language.LSP.Protocol.Types as LSP +import qualified Data.Text.IO as T +import System.FilePath (()) + +spec :: Spec +spec = describe "JBeam LSP Formatter (single test)" $ do + it "formats a single JBeam file with a single JBFL rule correctly" $ do + runSession "jbeam-lsp-server" fullLatestClientCaps "examples" $ do + let + jbeamFile = "ast" "jbeam" "fender.jbeam" + expectedFile = "formatted_jbeam" "fender-minimal-jbfl.jbeam" + + doc <- openDoc jbeamFile "jbeam" + + formatDoc doc (LSP.FormattingOptions 2 True Nothing Nothing Nothing) + + formatted <- documentContents doc + expected <- liftIO $ T.readFile expectedFile + + liftIO $ formatted `shouldBe` expected + +#else +spec :: Spec +spec = pure () +#endif From ce1963586c880f244c60848bd44c158a9f0c9123 Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Thu, 9 Oct 2025 11:33:18 +0200 Subject: [PATCH 6/7] Fixed LSP formatting test --- .github/workflows/build-and-release.yaml | 5 +- .github/workflows/build-and-test.yaml | 5 +- .github/workflows/future-proofing.yaml | 5 +- app-extra/jbeam-lsp-server/Main.hs | 6 +- hie.yaml | 4 + jbeam-edit.cabal | 86 +++++++++++++++++-- package.yaml | 47 ++++++---- src-extra/language-server/.dir-locals.el | 4 + .../language-server}/Handlers/Formatting.hs | 41 ++++++--- .../language-server}/Server.hs | 29 +++++-- .../Services/DocumentStore.hs | 3 +- test/{LspSpec.hs => WorkspaceLspSpec.hs} | 14 +-- tools/lsp-test-server/.dir-locals.el | 4 + tools/lsp-test-server/Main.hs | 18 ++++ 14 files changed, 219 insertions(+), 52 deletions(-) create mode 100644 src-extra/language-server/.dir-locals.el rename {app-extra/jbeam-lsp-server => src-extra/language-server}/Handlers/Formatting.hs (67%) rename {app-extra/jbeam-lsp-server => src-extra/language-server}/Server.hs (78%) rename {app-extra/jbeam-lsp-server => src-extra/language-server}/Services/DocumentStore.hs (90%) rename test/{LspSpec.hs => WorkspaceLspSpec.hs} (53%) create mode 100644 tools/lsp-test-server/.dir-locals.el create mode 100644 tools/lsp-test-server/Main.hs diff --git a/.github/workflows/build-and-release.yaml b/.github/workflows/build-and-release.yaml index f03d1b65..402a082f 100644 --- a/.github/workflows/build-and-release.yaml +++ b/.github/workflows/build-and-release.yaml @@ -82,7 +82,10 @@ jobs: - name: Build dependencies, good to do separate for caching run: cabal build --project-file cabal.project.release --only-dependencies - name: Build executables - run: cabal install --project-file cabal.project.release + run: cabal build exe:jbeam-edit --project-file cabal.project.release + - name: Build LSP test server + run: | + cabal install exe:jbeam-lsp-test-server --project-file cabal.project.release || true - name: Run tests (GHC ${{ matrix.ghc }}) if: "!startsWith(github.ref, 'refs/tags/')" run: cabal test --project-file cabal.project.release diff --git a/.github/workflows/build-and-test.yaml b/.github/workflows/build-and-test.yaml index ce9d4cb0..0050c135 100644 --- a/.github/workflows/build-and-test.yaml +++ b/.github/workflows/build-and-test.yaml @@ -167,6 +167,9 @@ jobs: restore-keys: | ${{ runner.os }}-cabal-${{ matrix.ghc }}- - name: Build project (GHC ${{ steps.setup-ghc.outputs.ghc-version }}) - run: cabal install --project-file cabal.project.ci all + run: cabal build --project-file cabal.project.ci all + - name: Build LSP test server + run: | + cabal install exe:jbeam-lsp-test-server --project-file cabal.project.ci || true - name: Run tests (GHC ${{ steps.setup-ghc.outputs.ghc-version }}) run: cabal test --project-file cabal.project.ci diff --git a/.github/workflows/future-proofing.yaml b/.github/workflows/future-proofing.yaml index 0703e356..880375c1 100644 --- a/.github/workflows/future-proofing.yaml +++ b/.github/workflows/future-proofing.yaml @@ -51,6 +51,9 @@ jobs: restore-keys: | ${{ runner.os }}-cabal-${{ steps.get-ghc.outputs.ghc-version }}- - name: Build project (GHC latest) - run: cabal install --project-file cabal.project.ci all + run: cabal build --project-file cabal.project.ci all + - name: Build LSP test server + continue-on-error: true + run: cabal install exe:jbeam-lsp-test-server --project-file cabal.project.ci - name: Run tests (GHC latest) run: cabal test --project-file cabal.project.ci diff --git a/app-extra/jbeam-lsp-server/Main.hs b/app-extra/jbeam-lsp-server/Main.hs index 7c9208c7..ff6d0953 100644 --- a/app-extra/jbeam-lsp-server/Main.hs +++ b/app-extra/jbeam-lsp-server/Main.hs @@ -4,5 +4,9 @@ module Main ( import Server (runServer) +import Formatting.Config qualified as FmtCfg + main :: IO () -main = void runServer +main = do + rs <- FmtCfg.readFormattingConfig + void (runServer rs) diff --git a/hie.yaml b/hie.yaml index eac81e0e..065dc2ee 100644 --- a/hie.yaml +++ b/hie.yaml @@ -14,10 +14,14 @@ cradle: component: lib:jbeam-edit - path: ./src-extra/transformation component: jbeam-edit:lib:jbeam-edit-transformation + - path: ./src-extra/language-server + component: jbeam-edit:lib:jbeam-language-server - path: ./app component: exe:jbeam-edit - path: ./app-extra/jbeam-lsp-server component: jbeam-edit:exe:jbeam-lsp-server + - path: ./app-extra/jbeam-lsp-test-server + component: jbeam-edit:exe:jbeam-lsp-test-server - path: ./tools/dump_ast component: exe:jbeam-edit-dump-ast - path: ./test diff --git a/jbeam-edit.cabal b/jbeam-edit.cabal index b48b5bfd..c33228b2 100644 --- a/jbeam-edit.cabal +++ b/jbeam-edit.cabal @@ -157,6 +157,46 @@ library jbeam-edit-transformation else buildable: False +library jbeam-language-server + exposed-modules: + Handlers.Formatting + Server + Services.DocumentStore + + hs-source-dirs: src-extra/language-server + other-modules: Paths_jbeam_edit + autogen-modules: Paths_jbeam_edit + default-language: Haskell2010 + default-extensions: OverloadedStrings ImportQualifiedPost + ghc-options: + -Wall -Wcompat -Widentities -Wincomplete-record-updates + -Wincomplete-uni-patterns -Wmissing-export-lists + -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints + + build-depends: + base >=4.17 && <5, + bytestring >=0.12, + containers >=0.6, + directory >=1.3, + filepath >=1.4, + jbeam-edit, + megaparsec >=9.6, + relude >=1.2, + scientific >=0.3, + text >=2.1, + vector >=0.13 + + mixins: + base hiding (Prelude), + relude (Relude as Prelude), + relude + + if (flag(lsp-server) && impl(ghc >=9.6.6)) + build-depends: lsp >=2.7 + + else + buildable: False + executable jbeam-edit main-is: Main.hs hs-source-dirs: app @@ -240,12 +280,44 @@ executable jbeam-edit-dump-ast executable jbeam-lsp-server main-is: Main.hs hs-source-dirs: app-extra/jbeam-lsp-server - other-modules: - Handlers.Formatting - Server - Services.DocumentStore - Paths_jbeam_edit + other-modules: Paths_jbeam_edit + autogen-modules: Paths_jbeam_edit + default-language: Haskell2010 + default-extensions: OverloadedStrings ImportQualifiedPost + ghc-options: + -Wall -Wcompat -Widentities -Wincomplete-record-updates + -Wincomplete-uni-patterns -Wmissing-export-lists + -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints + -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.17 && <5, + bytestring >=0.12, + containers >=0.6, + directory >=1.3, + filepath >=1.4, + jbeam-edit, + megaparsec >=9.6, + relude >=1.2, + scientific >=0.3, + text >=2.1, + vector >=0.13 + + mixins: + base hiding (Prelude), + relude (Relude as Prelude), + relude + + if (flag(lsp-server) && impl(ghc >=9.6.6)) + build-depends: jbeam-language-server + + else + buildable: False + +executable jbeam-lsp-test-server + main-is: Main.hs + hs-source-dirs: tools/lsp-test-server + other-modules: Paths_jbeam_edit autogen-modules: Paths_jbeam_edit default-language: Haskell2010 default-extensions: OverloadedStrings ImportQualifiedPost @@ -274,7 +346,7 @@ executable jbeam-lsp-server relude if (flag(lsp-server) && impl(ghc >=9.6.6)) - build-depends: lsp >=2.7 + build-depends: jbeam-language-server else buildable: False @@ -290,11 +362,11 @@ test-suite jbeam-edit-test Core.NodeSpec Formatting.RulesSpec FormattingSpec - LspSpec Parsing.DSLSpec Parsing.JbeamSpec SpecHelper TransformationSpec + WorkspaceLspSpec Paths_jbeam_edit autogen-modules: Paths_jbeam_edit diff --git a/package.yaml b/package.yaml index d9663250..af61ce19 100644 --- a/package.yaml +++ b/package.yaml @@ -14,14 +14,16 @@ extra-source-files: - examples/jbeam/*.jbeam - examples/formatted_jbeam/*.jbeam - category: Command Line, Jbeam, Beamng - -synopsis: - A fast and reliable command-line tool for parsing, formatting, and editing JBeam files, supporting consistent node renaming, reference updating, and JBFL-based formatting. - +synopsis: A fast and reliable command-line tool for parsing, formatting, and editing + JBeam files, supporting consistent node renaming, reference updating, and JBFL-based + formatting. description: >- - jbeam-edit is a Haskell-based CLI utility for BeamNG JBeam files. It parses complete JBeam structures, preserves comments and whitespace, formats files consistently, and can automatically rename nodes and update references. Custom formatting rules are supported via JBFL (JBeam Formatting Language). See the README for usage instructions and examples: https://github.com/webdevred/jbeam-edit#readme + jbeam-edit is a Haskell-based CLI utility for BeamNG JBeam files. It parses complete + JBeam structures, preserves comments and whitespace, formats files consistently, + and can automatically rename nodes and update references. Custom formatting rules + are supported via JBFL (JBeam Formatting Language). See the README for usage instructions + and examples: https://github.com/webdevred/jbeam-edit#readme tested-with: [GHC == 9.4.7, GHC == 9.6.6] dependencies: @@ -81,6 +83,15 @@ internal-libraries: buildable: false source-dirs: src-extra/transformation dependencies: [jbeam-edit] + jbeam-language-server: + when: + condition: flag(lsp-server) && impl(ghc >= 9.6.6) + then: + dependencies: [lsp>=2.7] + else: + buildable: false + source-dirs: src-extra/language-server + dependencies: [jbeam-edit] library: source-dirs: src @@ -91,6 +102,17 @@ library: - condition: os(windows) && flag(windows-example-paths) cpp-options: -DWINDOWS_EXAMPLE_PATHS +_jbeam-lsp-common: &jbeam-lsp-common + main: Main.hs + ghc-options: [-threaded, -rtsopts, -with-rtsopts=-N] + when: + condition: flag(lsp-server) && impl(ghc >= 9.6.6) + then: + dependencies: [jbeam-language-server] + else: + buildable: false + dependencies: [jbeam-edit] + executables: jbeam-edit: main: Main.hs @@ -104,16 +126,11 @@ executables: - condition: os(windows) cpp-options: -DENABLE_WINDOWS_NEWLINES jbeam-lsp-server: - main: Main.hs source-dirs: app-extra/jbeam-lsp-server - ghc-options: [-threaded, -rtsopts, -with-rtsopts=-N] - when: - condition: flag(lsp-server) && impl(ghc >= 9.6.6) - then: - dependencies: [lsp>=2.7] - else: - buildable: false - dependencies: [jbeam-edit] + <<: *jbeam-lsp-common + jbeam-lsp-test-server: + source-dirs: tools/lsp-test-server + <<: *jbeam-lsp-common jbeam-edit-dump-ast: when: condition: (flag(dump-ast) && flag(transformation)) diff --git a/src-extra/language-server/.dir-locals.el b/src-extra/language-server/.dir-locals.el new file mode 100644 index 00000000..4ea4e65a --- /dev/null +++ b/src-extra/language-server/.dir-locals.el @@ -0,0 +1,4 @@ +((haskell-mode + . ((haskell-process-type . cabal-repl) + (eval . (setq-local haskell-process-args-cabal-repl + (append '("jbeam-edit:lib:jbeam-language-server" "--project-file" "cabal.project.dev") haskell-process-args-cabal-repl)))))) diff --git a/app-extra/jbeam-lsp-server/Handlers/Formatting.hs b/src-extra/language-server/Handlers/Formatting.hs similarity index 67% rename from app-extra/jbeam-lsp-server/Handlers/Formatting.hs rename to src-extra/language-server/Handlers/Formatting.hs index e1a9e8f3..db341a0a 100644 --- a/app-extra/jbeam-lsp-server/Handlers/Formatting.hs +++ b/src-extra/language-server/Handlers/Formatting.hs @@ -1,11 +1,13 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} module Handlers.Formatting (handlers) where +import Core.Node (Node) import Formatting.Rules (RuleSet) +import IOUtils import Data.Text qualified as T import Formatting qualified as Fmt @@ -23,6 +25,9 @@ import Language.LSP.Server qualified as S import Parsing.Jbeam qualified as JbeamP import Services.DocumentStore qualified as Docs +putErrorLine' :: MonadIO m => Text -> m () +putErrorLine' = liftIO . putErrorLine + handlers :: RuleSet -> S.Handlers (S.LspM config) handlers rs = S.requestHandler Msg.SMethod_TextDocumentFormatting formattingHandler @@ -36,7 +41,7 @@ handlers rs = ) -> S.LspM config () formattingHandler req responder = do - liftIO $ putStrLn "DEBUG: formattingHandler invoked" + putErrorLine' "DEBUG: formattingHandler invoked" let Msg.TRequestMessage _ _ _ (params :: J.DocumentFormattingParams) = req handleParams rs params responder @@ -55,22 +60,38 @@ handleParams rs params responder = do mText <- liftIO $ Docs.get uri case mText of Nothing -> do - liftIO . putStrLn $ "DEBUG: no document in store for " ++ show uri + putErrorLine' ("DEBUG: no document in store for " <> show uri) responder (Right (J.InR J.Null)) Just txt -> case JbeamP.parseNodes (encodeUtf8 txt) of Left err -> do - liftIO . putStrLn $ "Parse error: " ++ show err + liftIO . putErrorLine' $ "Parse error: " <> show err + responder (Right (J.InR J.Null)) + Right node -> runFormatNode responder rs txt node + +runFormatNode + :: (Either a ([J.TextEdit] J.|? J.Null) -> t) + -> RuleSet + -> Text + -> Node + -> t +runFormatNode responder ruleSet txt node = + let newText = Fmt.formatNode ruleSet node + edit = J.TextEdit {J._range = wholeRange txt, J._newText = newText} + in if newText == txt + then responder (Right (J.InR J.Null)) - Right node -> do - let newText = Fmt.formatNode rs node - edit = J.TextEdit {J._range = wholeRange txt, J._newText = newText} + else responder (Right (J.InL [edit])) wholeRange :: Text -> J.Range wholeRange txt = - let numLines = max 1 . length . lines $ txt - lastLineLen = T.length $ T.takeWhileEnd (/= '\n') txt + let ls = lines txt + numLines = max 1 (length ls) + lastLineLen = + case reverse ls of + [] -> 0 + (lastLine : _) -> T.length lastLine in J.Range (J.Position 0 0) - (J.Position (fromIntegral (numLines - 1)) (fromIntegral lastLineLen)) + (J.Position (fromIntegral numLines) (fromIntegral lastLineLen)) diff --git a/app-extra/jbeam-lsp-server/Server.hs b/src-extra/language-server/Server.hs similarity index 78% rename from app-extra/jbeam-lsp-server/Server.hs rename to src-extra/language-server/Server.hs index 00c6d9f6..c758c50a 100644 --- a/app-extra/jbeam-lsp-server/Server.hs +++ b/src-extra/language-server/Server.hs @@ -7,8 +7,8 @@ module Server (runServer) where import Formatting.Rules (RuleSet) +import IOUtils -import Formatting.Config qualified as FmtCfg import Handlers.Formatting qualified as Formatting import Language.LSP.Protocol.Message qualified as Msg import Language.LSP.Protocol.Types qualified as J ( @@ -18,6 +18,8 @@ import Language.LSP.Protocol.Types qualified as J ( TextDocumentContentChangePartial (..), TextDocumentContentChangeWholeDocument (..), TextDocumentItem (..), + TextDocumentSyncKind (..), + TextDocumentSyncOptions (..), VersionedTextDocumentIdentifier (..), type (|?) (..), ) @@ -28,18 +30,17 @@ staticHandlers :: RuleSet -> S.Handlers (S.LspM config) staticHandlers rs = mconcat [ S.notificationHandler Msg.SMethod_Initialized $ \_notif -> - liftIO $ putStrLn "Client initialized" + liftIO $ putErrorLine "Client initialized" , S.notificationHandler Msg.SMethod_WorkspaceDidChangeConfiguration $ \_notif -> - liftIO $ putStrLn "Configuration changed" + liftIO $ putErrorLine "Configuration changed" , S.notificationHandler Msg.SMethod_TextDocumentDidOpen handleDidOpen , S.notificationHandler Msg.SMethod_TextDocumentDidChange handleDidChange ] <> Formatting.handlers rs -- | Starta LSP-servern -runServer :: IO Int -runServer = do - ruleSet <- FmtCfg.readFormattingConfig +runServer :: RuleSet -> IO Int +runServer rs = S.runServer $ S.ServerDefinition { configSection = "jbeam-lsp" @@ -47,9 +48,21 @@ runServer = do , onConfigChange = const >> pure $ pass , defaultConfig = () , doInitialize = \env _req -> pure (Right env) - , staticHandlers = const $ staticHandlers ruleSet + , staticHandlers = const $ staticHandlers rs , interpretHandler = \env -> S.Iso (S.runLspT env) liftIO - , options = S.defaultOptions + , options = + S.defaultOptions + { S.optTextDocumentSync = + Just + ( J.TextDocumentSyncOptions + { J._openClose = Just True + , J._change = Just J.TextDocumentSyncKind_Full + , J._willSave = Nothing + , J._willSaveWaitUntil = Nothing + , J._save = Nothing + } + ) + } } -- | didOpen: save docuement in DocumentStore diff --git a/app-extra/jbeam-lsp-server/Services/DocumentStore.hs b/src-extra/language-server/Services/DocumentStore.hs similarity index 90% rename from app-extra/jbeam-lsp-server/Services/DocumentStore.hs rename to src-extra/language-server/Services/DocumentStore.hs index 90cb088d..4db74e81 100644 --- a/app-extra/jbeam-lsp-server/Services/DocumentStore.hs +++ b/src-extra/language-server/Services/DocumentStore.hs @@ -1,6 +1,7 @@ module Services.DocumentStore (open, update, get) where import Control.Concurrent.MVar hiding (newMVar, readMVar) +import IOUtils import Language.LSP.Protocol.Types (Uri) import System.IO.Unsafe (unsafePerformIO) import Prelude hiding (get) @@ -13,7 +14,7 @@ type DocumentStore = MVar (M.Map Uri T.Text) {-# NOINLINE store #-} store :: DocumentStore store = unsafePerformIO $ do - putStrLn "[Info] Initializing DocumentStore" + putErrorLine "[Info] Initializing DocumentStore" newMVar M.empty open :: Uri -> T.Text -> IO () diff --git a/test/LspSpec.hs b/test/WorkspaceLspSpec.hs similarity index 53% rename from test/LspSpec.hs rename to test/WorkspaceLspSpec.hs index 9466c7e3..b477bf5a 100644 --- a/test/LspSpec.hs +++ b/test/WorkspaceLspSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} -module LspSpec (spec) where +module WorkspaceLspSpec (spec) where import Test.Hspec @@ -11,16 +11,16 @@ import qualified Data.Text.IO as T import System.FilePath (()) spec :: Spec -spec = describe "JBeam LSP Formatter (single test)" $ do +spec = describe "JBeam LSP Formatter" $ do it "formats a single JBeam file with a single JBFL rule correctly" $ do - runSession "jbeam-lsp-server" fullLatestClientCaps "examples" $ do + runSession ("jbeam-lsp-test-server " <> ("examples" "ast" "jbfl" "minimal.hs")) fullLatestClientCaps "examples" $ do let - jbeamFile = "ast" "jbeam" "fender.jbeam" - expectedFile = "formatted_jbeam" "fender-minimal-jbfl.jbeam" + jbeamFile = "jbeam" "fender.jbeam" + expectedFile = "examples" "formatted_jbeam" "fender-minimal-jbfl.jbeam" doc <- openDoc jbeamFile "jbeam" - formatDoc doc (LSP.FormattingOptions 2 True Nothing Nothing Nothing) + formatDoc doc (LSP.FormattingOptions 0 False Nothing Nothing Nothing) formatted <- documentContents doc expected <- liftIO $ T.readFile expectedFile @@ -29,5 +29,5 @@ spec = describe "JBeam LSP Formatter (single test)" $ do #else spec :: Spec -spec = pure () +spec = pass #endif diff --git a/tools/lsp-test-server/.dir-locals.el b/tools/lsp-test-server/.dir-locals.el new file mode 100644 index 00000000..e620035b --- /dev/null +++ b/tools/lsp-test-server/.dir-locals.el @@ -0,0 +1,4 @@ +((haskell-mode + . ((haskell-process-type . cabal-repl) + (eval . (setq-local haskell-process-args-cabal-repl + (append '("jbeam-edit:lib:jbeam-lsp-test-server" "--project-file" "cabal.project.dev") haskell-process-args-cabal-repl)))))) diff --git a/tools/lsp-test-server/Main.hs b/tools/lsp-test-server/Main.hs new file mode 100644 index 00000000..b414102f --- /dev/null +++ b/tools/lsp-test-server/Main.hs @@ -0,0 +1,18 @@ +module Main (main) where + +import Relude.Unsafe (read) +import Server (runServer) + +import System.IO qualified as IO (readFile) + +main :: IO () +main = do + args <- getArgs + jbflPath <- case args of + (p : _) -> pure p + [] -> do + putStrLn "Usage: test-server " + exitFailure + + ruleSet <- read <$> IO.readFile jbflPath + void $ runServer ruleSet From be3cb18e10a85571fe097d463247f1d65e983f1b Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Thu, 9 Oct 2025 15:15:09 +0200 Subject: [PATCH 7/7] Added handling closing files --- src-extra/language-server/Server.hs | 15 +++++++++++++++ .../language-server/Services/DocumentStore.hs | 5 ++++- 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/src-extra/language-server/Server.hs b/src-extra/language-server/Server.hs index c758c50a..c165127f 100644 --- a/src-extra/language-server/Server.hs +++ b/src-extra/language-server/Server.hs @@ -13,10 +13,12 @@ import Handlers.Formatting qualified as Formatting import Language.LSP.Protocol.Message qualified as Msg import Language.LSP.Protocol.Types qualified as J ( DidChangeTextDocumentParams (..), + DidCloseTextDocumentParams (..), DidOpenTextDocumentParams (..), TextDocumentContentChangeEvent (..), TextDocumentContentChangePartial (..), TextDocumentContentChangeWholeDocument (..), + TextDocumentIdentifier (..), TextDocumentItem (..), TextDocumentSyncKind (..), TextDocumentSyncOptions (..), @@ -34,6 +36,7 @@ staticHandlers rs = , S.notificationHandler Msg.SMethod_WorkspaceDidChangeConfiguration $ \_notif -> liftIO $ putErrorLine "Configuration changed" , S.notificationHandler Msg.SMethod_TextDocumentDidOpen handleDidOpen + , S.notificationHandler Msg.SMethod_TextDocumentDidClose handleDidClose , S.notificationHandler Msg.SMethod_TextDocumentDidChange handleDidChange ] <> Formatting.handlers rs @@ -95,3 +98,15 @@ handleDidChange (Msg.TNotificationMessage _ _ (J.DidChangeTextDocumentParams doc J.InL (J.TextDocumentContentChangePartial {J._text = txt}) -> liftIO $ Docs.update uri txt J.InR (J.TextDocumentContentChangeWholeDocument txt) -> liftIO $ Docs.update uri txt _ -> pass + +handleDidClose + :: forall + {f :: Msg.MessageDirection} + {m1 :: Msg.Method f Msg.Notification} + {m2 :: Type -> Type} + . ( MonadIO m2 + , Msg.MessageParams m1 ~ J.DidCloseTextDocumentParams + ) + => Msg.TNotificationMessage m1 -> m2 () +handleDidClose (Msg.TNotificationMessage _ _ (J.DidCloseTextDocumentParams docId)) = + let J.TextDocumentIdentifier {_uri = uri} = docId in liftIO (Docs.delete uri) diff --git a/src-extra/language-server/Services/DocumentStore.hs b/src-extra/language-server/Services/DocumentStore.hs index 4db74e81..caf7dc23 100644 --- a/src-extra/language-server/Services/DocumentStore.hs +++ b/src-extra/language-server/Services/DocumentStore.hs @@ -1,4 +1,4 @@ -module Services.DocumentStore (open, update, get) where +module Services.DocumentStore (open, update, get, delete) where import Control.Concurrent.MVar hiding (newMVar, readMVar) import IOUtils @@ -25,3 +25,6 @@ update = open get :: Uri -> IO (Maybe T.Text) get uri = M.lookup uri <$> readMVar store + +delete :: Uri -> IO () +delete uri = modifyMVar_ store (pure . M.delete uri)