From 8e7ed0fb10277f28192399697472d2d48a67e573 Mon Sep 17 00:00:00 2001 From: thomasjm Date: Sun, 11 Oct 2026 17:00:25 -0700 Subject: [PATCH] Split Transformer into a pure class and ProjectIn --- cpp-notebook-language-server.cabal | 3 + package.yaml | 1 + .../LSP/Notebook/DeclarationSifter.hs | 61 +++++++++---------- src/Language/LSP/Transformer.hs | 39 ++++++------ test/TestLib/Core.hs | 4 +- 5 files changed, 56 insertions(+), 52 deletions(-) diff --git a/cpp-notebook-language-server.cabal b/cpp-notebook-language-server.cabal index 95c977d..2dc2c42 100644 --- a/cpp-notebook-language-server.cabal +++ b/cpp-notebook-language-server.cabal @@ -42,6 +42,7 @@ library FlexibleInstances LambdaCase ViewPatterns + MultiParamTypeClasses MultiWayIf TupleSections NumericUnderscores @@ -95,6 +96,7 @@ executable cpp-notebook-language-server FlexibleInstances LambdaCase ViewPatterns + MultiParamTypeClasses MultiWayIf TupleSections NumericUnderscores @@ -152,6 +154,7 @@ test-suite cpp-notebook-language-server-test FlexibleInstances LambdaCase ViewPatterns + MultiParamTypeClasses MultiWayIf TupleSections NumericUnderscores diff --git a/package.yaml b/package.yaml index be4d098..beebfed 100644 --- a/package.yaml +++ b/package.yaml @@ -23,6 +23,7 @@ default-extensions: - FlexibleInstances - LambdaCase - ViewPatterns +- MultiParamTypeClasses - MultiWayIf - TupleSections - NumericUnderscores diff --git a/src/Language/LSP/Notebook/DeclarationSifter.hs b/src/Language/LSP/Notebook/DeclarationSifter.hs index 87d129e..b2fcff7 100644 --- a/src/Language/LSP/Notebook/DeclarationSifter.hs +++ b/src/Language/LSP/Notebook/DeclarationSifter.hs @@ -37,37 +37,6 @@ data DeclarationSifterParams = DeclarationSifterParams { instance Transformer DeclarationSifter where type Params DeclarationSifter = DeclarationSifterParams - getParams _ = DeclarationSifterParams "cling-parser" "__notebook_exec" - - project :: MonadIO m => Params DeclarationSifter -> Doc -> m (Doc, DeclarationSifter, Either Text ()) - project params doc = do - result <- parseCppCode params doc - let originalLines = docToList doc - let numOrigLines = length originalLines - case result of - Left err -> return (doc, mkIdentitySifter numOrigLines, Left (T.pack err)) - Right declarations -> do - let (siftedIdxs, nonSiftedIdxs) = partitionIndices originalLines declarations - siftedLines = map (originalLines !!) siftedIdxs - nonSiftedLines = map (originalLines !!) nonSiftedIdxs - - if not (null nonSiftedLines) && any (not . T.null . T.strip) nonSiftedLines - then do - -- Wrap executable lines in a function - let wrappedLines = wrapInFunction (execFunctionName params) nonSiftedLines - allLines = siftedLines ++ wrappedLines - numSifted = length siftedIdxs - -- Wrapper structure: header, body lines, closing brace - bodyStart = numSifted + 1 -- after function header - bodyEnd = numSifted + length nonSiftedLines -- before closing brace - sifter = mkSifter numOrigLines siftedIdxs nonSiftedIdxs (Just (bodyStart, bodyEnd)) - return (listToDoc allLines, sifter, Right ()) - else do - -- No wrapper needed - let allLines = siftedLines ++ nonSiftedLines - sifter = mkSifter numOrigLines siftedIdxs nonSiftedIdxs Nothing - return (listToDoc allLines, sifter, Right ()) - transformPosition :: DeclarationSifter -> Position -> Maybe Position transformPosition sifter (Position l c) | origLine < 0 || origLine >= V.length (forward sifter) = Nothing @@ -197,3 +166,33 @@ wrapInFunction functionName executableLines = functionStart = "void " <> functionName <> "() {" functionEnd = "}" indentedBody = map (\l -> if T.null l then l else " " <> l) executableLines + +instance MonadIO m => ProjectIn m DeclarationSifter where + project :: Params DeclarationSifter -> Doc -> m (Doc, DeclarationSifter, Either Text ()) + project params doc = do + result <- parseCppCode params doc + let originalLines = docToList doc + let numOrigLines = length originalLines + case result of + Left err -> return (doc, mkIdentitySifter numOrigLines, Left (T.pack err)) + Right declarations -> do + let (siftedIdxs, nonSiftedIdxs) = partitionIndices originalLines declarations + siftedLines = map (originalLines !!) siftedIdxs + nonSiftedLines = map (originalLines !!) nonSiftedIdxs + + if not (null nonSiftedLines) && any (not . T.null . T.strip) nonSiftedLines + then do + -- Wrap executable lines in a function + let wrappedLines = wrapInFunction (execFunctionName params) nonSiftedLines + allLines = siftedLines ++ wrappedLines + numSifted = length siftedIdxs + -- Wrapper structure: header, body lines, closing brace + bodyStart = numSifted + 1 -- after function header + bodyEnd = numSifted + length nonSiftedLines -- before closing brace + sifter = mkSifter numOrigLines siftedIdxs nonSiftedIdxs (Just (bodyStart, bodyEnd)) + return (listToDoc allLines, sifter, Right ()) + else do + -- No wrapper needed + let allLines = siftedLines ++ nonSiftedLines + sifter = mkSifter numOrigLines siftedIdxs nonSiftedIdxs Nothing + return (listToDoc allLines, sifter, Right ()) diff --git a/src/Language/LSP/Transformer.hs b/src/Language/LSP/Transformer.hs index c867259..6aae734 100644 --- a/src/Language/LSP/Transformer.hs +++ b/src/Language/LSP/Transformer.hs @@ -8,6 +8,7 @@ module Language.LSP.Transformer ( Doc , Transformer(..) + , ProjectIn(..) , (:>)(..) , defaultHandleDiff @@ -39,54 +40,54 @@ type Doc = Rope.Rope class Transformer a where type Params a - getParams :: a -> Params a + unproject :: a -> Doc -> Maybe Doc + unproject _ _ = Nothing - project :: MonadIO m => Params a -> Doc -> m (Doc, a, Either Text ()) + transformPosition :: a -> Position -> Maybe Position + + untransformPosition :: a -> Position -> Maybe Position + +class Transformer a => ProjectIn m a where + project :: Params a -> Doc -> m (Doc, a, Either Text ()) - handleDiffMulti :: MonadIO m => Params a -> Doc -> [TextDocumentContentChangeEvent] -> a -> m ([TextDocumentContentChangeEvent], a) + handleDiffMulti :: Monad m => Params a -> Doc -> [TextDocumentContentChangeEvent] -> a -> m ([TextDocumentContentChangeEvent], a) handleDiffMulti params before changes tx = do - result <- foldM f ([], before, tx) changes - let (finalChanges, _finalLines, finalTx) = result + (finalChanges, _finalLines, finalTx) <- foldM f ([], before, tx) changes return (finalChanges, finalTx) where - f :: MonadIO m => ([TextDocumentContentChangeEvent], Doc, a) -> TextDocumentContentChangeEvent -> m ([TextDocumentContentChangeEvent], Doc, a) f (changesSoFar, curLines, txSoFar) change = do (newChanges, tx') <- handleDiff params curLines change txSoFar return (changesSoFar <> newChanges, applyChanges [change] curLines, tx') - handleDiff :: MonadIO m => Params a -> Doc -> TextDocumentContentChangeEvent -> a -> m ([TextDocumentContentChangeEvent], a) + handleDiff :: Monad m => Params a -> Doc -> TextDocumentContentChangeEvent -> a -> m ([TextDocumentContentChangeEvent], a) handleDiff = defaultHandleDiff - -- No 'Params' here: no transformer has ever needed them to map a position, and threading - -- them meant every caller had to be able to build a 'Params'. - transformPosition :: a -> Position -> Maybe Position - - untransformPosition :: a -> Position -> Maybe Position - data (a :: Type) :> (b :: Type) = a :> b deriving Show infixr :> instance (Transformer a, Transformer b) => Transformer (a :> b) where type Params (a :> b) = Params a :> Params b - getParams (x :> y) = getParams x :> getParams y + unproject (x :> y) lines = unproject y lines >>= unproject x + transformPosition (x :> y) p = transformPosition x p >>= transformPosition y + untransformPosition (x :> y) p = untransformPosition y p >>= untransformPosition x + +instance (ProjectIn m a, ProjectIn m b, Monad m) => ProjectIn m (a :> b) where project (xParams :> yParams) lines = do (lines', x, eitherErr1) <- project xParams lines (lines'', y, eitherErr2) <- project yParams lines' let overallErr = case lefts [eitherErr1, eitherErr2] of [] -> Right () - xs -> Left (T.intercalate "; " xs) + errs -> Left (T.intercalate "; " errs) return (lines'', x :> y, overallErr) handleDiff (xParams :> yParams) before change (x :> y) = do (change', x') <- handleDiff xParams before change x - (beforeTransformed, _, _eitherErr1) <- project @a xParams before + (beforeTransformed, _, _err) <- project @m @a xParams before (change'', y') <- handleDiffMulti yParams beforeTransformed change' y return (change'', x' :> y') - transformPosition (x :> y) p = transformPosition x p >>= transformPosition y - untransformPosition (x :> y) p = untransformPosition y p >>= untransformPosition x -- Default implementation uses diff. -defaultHandleDiff :: forall a m. (Transformer a, MonadIO m) => Params a -> Doc -> TextDocumentContentChangeEvent -> a -> m ([TextDocumentContentChangeEvent], a) +defaultHandleDiff :: forall m a. (ProjectIn m a, Monad m) => Params a -> Doc -> TextDocumentContentChangeEvent -> a -> m ([TextDocumentContentChangeEvent], a) defaultHandleDiff params before change _transformer = do (before', _ :: a, _eitherErrBefore) <- project params before let after = applyChanges [change] before diff --git a/test/TestLib/Core.hs b/test/TestLib/Core.hs index 4892141..c5243ac 100644 --- a/test/TestLib/Core.hs +++ b/test/TestLib/Core.hs @@ -10,12 +10,12 @@ import Test.QuickCheck as Q testChange :: forall a m. ( - Transformer a, Eq a, Show a, MonadIO m + ProjectIn m a, Eq a, Show a, MonadIO m ) => Params a -> Doc -> TextDocumentContentChangeEvent -> m Property testChange = testChange' @a (const []) testChange' :: forall a m. ( - Transformer a, Eq a, Show a, MonadIO m + ProjectIn m a, Eq a, Show a, MonadIO m ) => ([TextDocumentContentChangeEvent] -> [Property]) -> Params a -> Doc -> TextDocumentContentChangeEvent -> m Property testChange' extraProps params docLines change = do -- Expected un-projected document after the change