diff --git a/lsp-tests/Test.hs b/lsp-tests/Test.hs index cfc2e30e..a0c3154e 100644 --- a/lsp-tests/Test.hs +++ b/lsp-tests/Test.hs @@ -9,19 +9,19 @@ import Language.LSP.Types import Control.Monad.IO.Class (MonadIO(liftIO)) import qualified Data.Text as T import qualified Language.LSP.Types as J -import L4LSP (handleUriErrs, LspError (ReadFileErr)) +import L4LSP (handleUriErrs, LspError (ReadFileErr), realSRngToRange, posToPosition) import Lexer (Err(Err)) -import Annotation (SRng(DummySRng)) +import Annotation (SRng(DummySRng), Pos (Pos), RealSRng) main :: IO () main = defaultMain $ testGroup "Tests" [hoverTests, hoverTypeInfoTests, typeCheckerTests, unitTests] -- | Takes 1-indexed range positions and converts them to 0-indexed range positions for LSP-server mkRange' :: Int -> Int -> Int -> Int -> Range -mkRange' l1 c1 l2 c2 = mkRange (l1-1) (c1-1) (l2-1) (c2-1) +mkRange' l1 c1 l2 c2 = realSRngToRange $ RealSRng (Pos l1 c1) (Pos l2 c2) mkPosition :: Int -> Int -> Position -mkPosition l c = Position (l-1) (c-1) +mkPosition l c = posToPosition $ Pos l c hoverTests :: TestTree hoverTests = testGroup "Hover tests" diff --git a/src/Annotation.hs b/src/Annotation.hs index cc6da99e..017e5b74 100644 --- a/src/Annotation.hs +++ b/src/Annotation.hs @@ -44,7 +44,7 @@ type Reason = String data SRng = RealSRng RealSRng - | DummySRng Reason + | DummySRng Reason deriving (Eq, Ord, Show, Read, Data, Typeable) data RealSRng = SRng diff --git a/src/L4LSP.hs b/src/L4LSP.hs index 63208bea..1a736385 100644 --- a/src/L4LSP.hs +++ b/src/L4LSP.hs @@ -256,11 +256,17 @@ posInRange (Position line col) srng = case sRngToRange srng of Nothing -> False --- | Convert l4 source ranges to lsp source ranges +-- | Convert 1-indexed l4 source ranges to 0-indexed lsp source ranges sRngToRange :: SRng -> Maybe Range -sRngToRange (RealSRng (SRng (Pos l1 c1) (Pos l2 c2))) = Just $ Range (Position (l1-1) (c1-1)) (Position (l2-1) (c2-1)) +sRngToRange (RealSRng srng) = Just $ realSRngToRange srng sRngToRange (DummySRng _) = Nothing +realSRngToRange :: RealSRng -> Range +realSRngToRange (SRng p1 p2) = Range (posToPosition p1) (posToPosition p2) + +posToPosition :: Pos -> Position +posToPosition (Pos l c) = Position (l-1) (c-1) + -- | Extract the range from an alex/happy error errorRange :: Err -> Range errorRange (Err s _)