diff --git a/hls-plugin-api.cabal b/hls-plugin-api.cabal --- a/hls-plugin-api.cabal +++ b/hls-plugin-api.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-plugin-api -version: 1.2.0.2 +version: 1.3.0.0 synopsis: Haskell Language Server API for plugin communication description: Please see the README on GitHub at @@ -43,17 +43,20 @@ , dependent-sum , Diff ^>=0.4.0 , dlist + , extra , ghc , hashable - , hls-graph >=1.4 && < 1.6 + , hls-graph ^>= 1.6 , hslogger , lens - , lsp ^>=1.2.0.1 + , lens-aeson + , lsp ^>=1.4.0.0 , opentelemetry , optparse-applicative , process , regex-tdfa >=1.3.1.0 , text + , transformers , unordered-containers if os(windows) @@ -74,3 +77,18 @@ DataKinds KindSignatures TypeOperators + +test-suite tests + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N + other-modules: Ide.PluginUtilsTest + build-depends: + base + , hls-plugin-api + , tasty + , tasty-hunit + , tasty-rerun + , lsp-types diff --git a/src/Ide/Plugin/Config.hs b/src/Ide/Plugin/Config.hs --- a/src/Ide/Plugin/Config.hs +++ b/src/Ide/Plugin/Config.hs @@ -47,25 +47,17 @@ -- will be surprises relating to config options being ignored, initially though. data Config = Config - { checkParents :: CheckParents - , checkProject :: !Bool - , hlintOn :: !Bool - , diagnosticsOnChange :: !Bool - , liquidOn :: !Bool - , formatOnImportOn :: !Bool - , formattingProvider :: !T.Text - , maxCompletions :: !Int - , plugins :: !(Map.Map T.Text PluginConfig) + { checkParents :: CheckParents + , checkProject :: !Bool + , formattingProvider :: !T.Text + , maxCompletions :: !Int + , plugins :: !(Map.Map T.Text PluginConfig) } deriving (Show,Eq) instance Default Config where def = Config { checkParents = CheckOnSave , checkProject = True - , hlintOn = True - , diagnosticsOnChange = True - , liquidOn = False - , formatOnImportOn = True -- , formattingProvider = "brittany" , formattingProvider = "ormolu" -- , formattingProvider = "floskell" @@ -85,10 +77,6 @@ Just s -> flip (A.withObject "Config.settings") s $ \o -> Config <$> (o .:? "checkParents" <|> v .:? "checkParents") .!= checkParents defValue <*> (o .:? "checkProject" <|> v .:? "checkProject") .!= checkProject defValue - <*> o .:? "hlintOn" .!= hlintOn defValue - <*> o .:? "diagnosticsOnChange" .!= diagnosticsOnChange defValue - <*> o .:? "liquidOn" .!= liquidOn defValue - <*> o .:? "formatOnImportOn" .!= formatOnImportOn defValue <*> o .:? "formattingProvider" .!= formattingProvider defValue <*> o .:? "maxCompletions" .!= maxCompletions defValue <*> o .:? "plugin" .!= plugins defValue @@ -99,10 +87,6 @@ where r = object [ "checkParents" .= checkParents , "checkProject" .= checkProject - , "hlintOn" .= hlintOn - , "diagnosticsOnChange" .= diagnosticsOnChange - , "liquidOn" .= liquidOn - , "formatOnImportOn" .= formatOnImportOn , "formattingProvider" .= formattingProvider , "maxCompletions" .= maxCompletions , "plugin" .= plugins @@ -116,58 +100,62 @@ -- This provides a regular naming scheme for all plugin config. data PluginConfig = PluginConfig - { plcGlobalOn :: !Bool - , plcCallHierarchyOn :: !Bool - , plcCodeActionsOn :: !Bool - , plcCodeLensOn :: !Bool - , plcDiagnosticsOn :: !Bool - , plcHoverOn :: !Bool - , plcSymbolsOn :: !Bool - , plcCompletionOn :: !Bool - , plcRenameOn :: !Bool - , plcConfig :: !A.Object + { plcGlobalOn :: !Bool + , plcCallHierarchyOn :: !Bool + , plcCodeActionsOn :: !Bool + , plcCodeLensOn :: !Bool + , plcDiagnosticsOn :: !Bool + , plcHoverOn :: !Bool + , plcSymbolsOn :: !Bool + , plcCompletionOn :: !Bool + , plcRenameOn :: !Bool + , plcSelectionRangeOn :: !Bool + , plcConfig :: !A.Object } deriving (Show,Eq) instance Default PluginConfig where def = PluginConfig - { plcGlobalOn = True - , plcCallHierarchyOn = True - , plcCodeActionsOn = True - , plcCodeLensOn = True - , plcDiagnosticsOn = True - , plcHoverOn = True - , plcSymbolsOn = True - , plcCompletionOn = True - , plcRenameOn = True - , plcConfig = mempty + { plcGlobalOn = True + , plcCallHierarchyOn = True + , plcCodeActionsOn = True + , plcCodeLensOn = True + , plcDiagnosticsOn = True + , plcHoverOn = True + , plcSymbolsOn = True + , plcCompletionOn = True + , plcRenameOn = True + , plcSelectionRangeOn = True + , plcConfig = mempty } instance A.ToJSON PluginConfig where - toJSON (PluginConfig g ch ca cl d h s c rn cfg) = r + toJSON (PluginConfig g ch ca cl d h s c rn sr cfg) = r where - r = object [ "globalOn" .= g - , "callHierarchyOn" .= ch - , "codeActionsOn" .= ca - , "codeLensOn" .= cl - , "diagnosticsOn" .= d - , "hoverOn" .= h - , "symbolsOn" .= s - , "completionOn" .= c - , "renameOn" .= rn - , "config" .= cfg + r = object [ "globalOn" .= g + , "callHierarchyOn" .= ch + , "codeActionsOn" .= ca + , "codeLensOn" .= cl + , "diagnosticsOn" .= d + , "hoverOn" .= h + , "symbolsOn" .= s + , "completionOn" .= c + , "renameOn" .= rn + , "selectionRangeOn" .= sr + , "config" .= cfg ] instance A.FromJSON PluginConfig where parseJSON = A.withObject "PluginConfig" $ \o -> PluginConfig - <$> o .:? "globalOn" .!= plcGlobalOn def - <*> o .:? "callHierarchyOn" .!= plcCallHierarchyOn def - <*> o .:? "codeActionsOn" .!= plcCodeActionsOn def - <*> o .:? "codeLensOn" .!= plcCodeLensOn def - <*> o .:? "diagnosticsOn" .!= plcDiagnosticsOn def -- AZ - <*> o .:? "hoverOn" .!= plcHoverOn def - <*> o .:? "symbolsOn" .!= plcSymbolsOn def - <*> o .:? "completionOn" .!= plcCompletionOn def - <*> o .:? "renameOn" .!= plcRenameOn def - <*> o .:? "config" .!= plcConfig def + <$> o .:? "globalOn" .!= plcGlobalOn def + <*> o .:? "callHierarchyOn" .!= plcCallHierarchyOn def + <*> o .:? "codeActionsOn" .!= plcCodeActionsOn def + <*> o .:? "codeLensOn" .!= plcCodeLensOn def + <*> o .:? "diagnosticsOn" .!= plcDiagnosticsOn def -- AZ + <*> o .:? "hoverOn" .!= plcHoverOn def + <*> o .:? "symbolsOn" .!= plcSymbolsOn def + <*> o .:? "completionOn" .!= plcCompletionOn def + <*> o .:? "renameOn" .!= plcRenameOn def + <*> o .:? "selectionRangeOn" .!= plcSelectionRangeOn def + <*> o .:? "config" .!= plcConfig def -- --------------------------------------------------------------------- diff --git a/src/Ide/Plugin/ConfigUtils.hs b/src/Ide/Plugin/ConfigUtils.hs --- a/src/Ide/Plugin/ConfigUtils.hs +++ b/src/Ide/Plugin/ConfigUtils.hs @@ -5,13 +5,16 @@ module Ide.Plugin.ConfigUtils where +import Control.Lens (at, ix, (&), (?~)) import qualified Data.Aeson as A +import Data.Aeson.Lens (_Object) import qualified Data.Aeson.Types as A import Data.Default (def) import qualified Data.Dependent.Map as DMap import qualified Data.Dependent.Sum as DSum -import qualified Data.HashMap.Lazy as HMap import Data.List (nub) +import Data.String (IsString (fromString)) +import qualified Data.Text as T import Ide.Plugin.Config import Ide.Plugin.Properties (toDefaultJSON, toVSCodeExtensionSchema) import Ide.Types @@ -25,17 +28,12 @@ -- | Generates a default 'Config', but remains only effective items pluginsToDefaultConfig :: IdePlugins a -> A.Value pluginsToDefaultConfig IdePlugins {..} = - A.Object $ - HMap.adjust - ( \(unsafeValueToObject -> o) -> - A.Object $ HMap.insert "plugin" elems o -- inplace the "plugin" section with our 'elems', leaving others unchanged - ) - "haskell" - (unsafeValueToObject (A.toJSON defaultConfig)) + -- Use 'ix' to look at all the "haskell" keys in the outer value (since we're not + -- setting it if missing), then we use '_Object' and 'at' to get at the "plugin" key + -- and actually set it. + A.toJSON defaultConfig & ix "haskell" . _Object . at "plugin" ?~ elems where defaultConfig@Config {} = def - unsafeValueToObject (A.Object o) = o - unsafeValueToObject _ = error "impossible" elems = A.object $ mconcat $ singlePlugin <$> map snd ipMap -- Splice genericDefaultConfig and dedicatedDefaultConfig -- Example: @@ -52,7 +50,7 @@ -- } singlePlugin PluginDescriptor {pluginConfigDescriptor = ConfigDescriptor {..}, ..} = let x = genericDefaultConfig <> dedicatedDefaultConfig - in [pId A..= A.object x | not $ null x] + in [fromString (T.unpack pId) A..= A.object x | not $ null x] where (PluginHandlers (DMap.toList -> handlers)) = pluginHandlers customConfigToDedicatedDefaultConfig (CustomConfig p) = toDefaultJSON p @@ -107,22 +105,22 @@ (PluginId pId) = pluginId genericSchema = let x = - [withIdPrefix "diagnosticsOn" A..= schemaEntry "diagnostics" | configHasDiagnostics] + [toKey' "diagnosticsOn" A..= schemaEntry "diagnostics" | configHasDiagnostics] <> nub (mconcat (handlersToGenericSchema <$> handlers)) in case x of -- If the plugin has only one capability, we produce globalOn instead of the specific one; -- otherwise we don't produce globalOn at all - [_] -> [withIdPrefix "globalOn" A..= schemaEntry "plugin"] + [_] -> [toKey' "globalOn" A..= schemaEntry "plugin"] _ -> x dedicatedSchema = customConfigToDedicatedSchema configCustomConfig handlersToGenericSchema (IdeMethod m DSum.:=> _) = case m of - STextDocumentCodeAction -> [withIdPrefix "codeActionsOn" A..= schemaEntry "code actions"] - STextDocumentCodeLens -> [withIdPrefix "codeLensOn" A..= schemaEntry "code lenses"] - STextDocumentRename -> [withIdPrefix "renameOn" A..= schemaEntry "rename"] - STextDocumentHover -> [withIdPrefix "hoverOn" A..= schemaEntry "hover"] - STextDocumentDocumentSymbol -> [withIdPrefix "symbolsOn" A..= schemaEntry "symbols"] - STextDocumentCompletion -> [withIdPrefix "completionOn" A..= schemaEntry "completions"] - STextDocumentPrepareCallHierarchy -> [withIdPrefix "callHierarchyOn" A..= schemaEntry "call hierarchy"] + STextDocumentCodeAction -> [toKey' "codeActionsOn" A..= schemaEntry "code actions"] + STextDocumentCodeLens -> [toKey' "codeLensOn" A..= schemaEntry "code lenses"] + STextDocumentRename -> [toKey' "renameOn" A..= schemaEntry "rename"] + STextDocumentHover -> [toKey' "hoverOn" A..= schemaEntry "hover"] + STextDocumentDocumentSymbol -> [toKey' "symbolsOn" A..= schemaEntry "symbols"] + STextDocumentCompletion -> [toKey' "completionOn" A..= schemaEntry "completions"] + STextDocumentPrepareCallHierarchy -> [toKey' "callHierarchyOn" A..= schemaEntry "call hierarchy"] _ -> [] schemaEntry desc = A.object @@ -132,3 +130,4 @@ "description" A..= A.String ("Enables " <> pId <> " " <> desc) ] withIdPrefix x = "haskell.plugin." <> pId <> "." <> x + toKey' = fromString . T.unpack . withIdPrefix diff --git a/src/Ide/Plugin/Properties.hs b/src/Ide/Plugin/Properties.hs --- a/src/Ide/Plugin/Properties.hs +++ b/src/Ide/Plugin/Properties.hs @@ -3,17 +3,14 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE ViewPatterns #-} -- See Note [Constraints] {-# OPTIONS_GHC -Wno-redundant-constraints #-} @@ -49,6 +46,7 @@ import Data.Kind (Constraint, Type) import qualified Data.Map.Strict as Map import Data.Proxy (Proxy (..)) +import Data.String (IsString (fromString)) import qualified Data.Text as T import GHC.OverloadedLabels (IsLabel (..)) import GHC.TypeLits @@ -164,6 +162,7 @@ -- "Description of exampleNumber" -- 233 -- @ + emptyProperties :: Properties '[] emptyProperties = Properties Map.empty @@ -237,7 +236,7 @@ (SEnum _, EnumMetaData {..}) -> A.parseEither ( \o -> do - txt <- o A..: keyName + txt <- o A..: key if txt `elem` enumValues then pure txt else @@ -249,9 +248,9 @@ ) x where - keyName = T.pack $ symbolVal kn + key = fromString $ symbolVal kn parseEither :: forall a. A.FromJSON a => Either String a - parseEither = A.parseEither (A..: keyName) x + parseEither = A.parseEither (A..: key) x -- --------------------------------------------------------------------- @@ -354,26 +353,26 @@ toDefaultJSON (Properties p) = [toEntry s v | (s, v) <- Map.toList p] where toEntry :: String -> SomePropertyKeyWithMetaData -> A.Pair - toEntry (T.pack -> s) = \case + toEntry s = \case (SomePropertyKeyWithMetaData SNumber MetaData {..}) -> - s A..= defaultValue + fromString s A..= defaultValue (SomePropertyKeyWithMetaData SInteger MetaData {..}) -> - s A..= defaultValue + fromString s A..= defaultValue (SomePropertyKeyWithMetaData SString MetaData {..}) -> - s A..= defaultValue + fromString s A..= defaultValue (SomePropertyKeyWithMetaData SBoolean MetaData {..}) -> - s A..= defaultValue + fromString s A..= defaultValue (SomePropertyKeyWithMetaData (SObject _) MetaData {..}) -> - s A..= defaultValue + fromString s A..= defaultValue (SomePropertyKeyWithMetaData (SArray _) MetaData {..}) -> - s A..= defaultValue + fromString s A..= defaultValue (SomePropertyKeyWithMetaData (SEnum _) EnumMetaData {..}) -> - s A..= defaultValue + fromString s A..= defaultValue -- | Converts a properties definition into kv pairs as vscode schema toVSCodeExtensionSchema :: T.Text -> Properties r -> [A.Pair] toVSCodeExtensionSchema prefix (Properties p) = - [(prefix <> T.pack k) A..= toEntry v | (k, v) <- Map.toList p] + [fromString (T.unpack prefix <> k) A..= toEntry v | (k, v) <- Map.toList p] where toEntry :: SomePropertyKeyWithMetaData -> A.Value toEntry = \case diff --git a/src/Ide/PluginUtils.hs b/src/Ide/PluginUtils.hs --- a/src/Ide/PluginUtils.hs +++ b/src/Ide/PluginUtils.hs @@ -25,15 +25,24 @@ allLspCmdIds', installSigUsr1Handler, subRange, + positionInRange, usePropertyLsp, + response, + handleMaybe, + handleMaybeM, ) where +import Control.Monad.Extra (maybeM) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE) import Data.Algorithm.Diff import Data.Algorithm.DiffOutput +import Data.Bifunctor (Bifunctor (first)) import Data.Containers.ListUtils (nubOrdOn) import qualified Data.HashMap.Strict as H +import Data.String (IsString (fromString)) import qualified Data.Text as T import Ide.Plugin.Config import Ide.Plugin.Properties @@ -99,15 +108,15 @@ -} diffOperationToTextEdit (Deletion (LineRange (sl, el) _) _) = J.TextEdit range "" where - range = J.Range (J.Position (sl - 1) 0) - (J.Position el 0) + range = J.Range (J.Position (fromIntegral $ sl - 1) 0) + (J.Position (fromIntegral el) 0) diffOperationToTextEdit (Addition fm l) = J.TextEdit range nt -- fm has a range wrt to the changed file, which starts in the current file at l + 1 -- So the range has to be shifted to start at l + 1 where - range = J.Range (J.Position l 0) - (J.Position l 0) + range = J.Range (J.Position (fromIntegral l) 0) + (J.Position (fromIntegral l) 0) nt = T.pack $ unlines $ lrContents fm @@ -115,10 +124,10 @@ where sl = fst $ lrNumbers fm sc = 0 - s = J.Position (sl - 1) sc -- Note: zero-based lines + s = J.Position (fromIntegral $ sl - 1) sc -- Note: zero-based lines el = snd $ lrNumbers fm - ec = length $ last $ lrContents fm - e = J.Position (el - 1) ec -- Note: zero-based lines + ec = fromIntegral $ length $ last $ lrContents fm + e = J.Position (fromIntegral $ el - 1) ec -- Note: zero-based lines -- | A pure version of 'diffText' for testing @@ -137,7 +146,7 @@ clientSupportsDocumentChanges :: ClientCapabilities -> Bool clientSupportsDocumentChanges caps = - let ClientCapabilities mwCaps _ _ _ = caps + let ClientCapabilities mwCaps _ _ _ _ = caps supports = do wCaps <- mwCaps WorkspaceEditClientCapabilities mDc _ _ _ _ <- _workspaceEdit wCaps @@ -170,7 +179,7 @@ getPluginConfig :: MonadLsp Config m => PluginId -> m PluginConfig getPluginConfig plugin = do config <- getClientConfig - return $ flip configForPlugin plugin config + return $ configForPlugin config plugin -- --------------------------------------------------------------------- @@ -189,7 +198,7 @@ extractRange :: Range -> T.Text -> T.Text extractRange (Range (Position sl _) (Position el _)) s = newS - where focusLines = take (el-sl+1) $ drop sl $ T.lines s + where focusLines = take (fromIntegral $ el-sl+1) $ drop (fromIntegral sl) $ T.lines s newS = T.unlines focusLines -- | Gets the range that covers the entire text @@ -204,7 +213,7 @@ the line ending character(s) then use an end position denoting the start of the next line" -} - lastLine = length $ T.lines s + lastLine = fromIntegral $ length $ T.lines s subRange :: Range -> Range -> Bool subRange smallRange range = @@ -212,11 +221,7 @@ && positionInRange (_end smallRange) range positionInRange :: Position -> Range -> Bool -positionInRange (Position pl po) (Range (Position sl so) (Position el eo)) = - pl > sl && pl < el - || pl == sl && pl == el && po >= so && po <= eo - || pl == sl && po >= so - || pl == el && po <= eo +positionInRange p (Range sp ep) = sp <= p && p <= ep -- --------------------------------------------------------------------- @@ -236,3 +241,15 @@ where go (plid, cmds) = map (mkLspCmdId pid plid . commandId) cmds +-- --------------------------------------------------------------------- + +handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b +handleMaybe msg = maybe (throwE msg) return + +handleMaybeM :: Monad m => e -> m (Maybe b) -> ExceptT e m b +handleMaybeM msg act = maybeM (throwE msg) return $ lift act + +response :: Monad m => ExceptT String m a -> m (Either ResponseError a) +response = + fmap (first (\msg -> ResponseError InternalError (fromString msg) Nothing)) + . runExceptT diff --git a/src/Ide/Types.hs b/src/Ide/Types.hs --- a/src/Ide/Types.hs +++ b/src/Ide/Types.hs @@ -24,11 +24,11 @@ #ifdef mingw32_HOST_OS import qualified System.Win32.Process as P (getCurrentProcessId) #else +import Control.Monad (void) import qualified System.Posix.Process as P (getProcessID) import System.Posix.Signals #endif import Control.Lens ((^.)) -import Control.Monad import Data.Aeson hiding (defaultOptions) import qualified Data.DList as DList import qualified Data.Default @@ -178,7 +178,7 @@ instance PluginMethod TextDocumentCodeAction where pluginEnabled _ = pluginEnabledConfig plcCodeActionsOn - combineResponses _method _config (ClientCapabilities _ textDocCaps _ _) (CodeActionParams _ _ _ _ context) resps = + combineResponses _method _config (ClientCapabilities _ textDocCaps _ _ _) (CodeActionParams _ _ _ _ context) resps = fmap compat $ List $ filter wasRequested $ (\(List x) -> x) $ sconcat resps where @@ -202,11 +202,7 @@ -- should check whether the requested kind is a *prefix* of the action kind. -- That means, for example, we will return actions with kinds `quickfix.import` and -- `quickfix.somethingElse` if the requested kind is `quickfix`. - -- TODO: add helpers in `lsp` for handling code action hierarchies - -- For now we abuse the fact that the JSON representation gives us the hierarchical string. - , Just caKind <- ca ^. kind - , String caKindStr <- toJSON caKind = - any (\k -> k `T.isPrefixOf` caKindStr) [kstr | k <- allowed, let String kstr = toJSON k ] + , Just caKind <- ca ^. kind = any (\k -> k `codeActionKindSubsumes` caKind) allowed | otherwise = False instance PluginMethod TextDocumentCodeLens where @@ -224,7 +220,7 @@ instance PluginMethod TextDocumentDocumentSymbol where pluginEnabled _ = pluginEnabledConfig plcSymbolsOn - combineResponses _ _ (ClientCapabilities _ tdc _ _) params xs = res + combineResponses _ _ (ClientCapabilities _ tdc _ _ _) params xs = res where uri' = params ^. textDocument . uri supportsHierarchy = Just True == (tdc >>= _documentSymbol >>= _hierarchicalDocumentSymbolSupport) @@ -249,7 +245,7 @@ combineResponses _ conf _ _ (toList -> xs) = snd $ consumeCompletionResponse limit $ combine xs where limit = maxCompletions conf - combine :: [List CompletionItem |? CompletionList] -> ((List CompletionItem) |? CompletionList) + combine :: [List CompletionItem |? CompletionList] -> (List CompletionItem |? CompletionList) combine cs = go True mempty cs go !comp acc [] = @@ -283,6 +279,10 @@ instance PluginMethod TextDocumentPrepareCallHierarchy where pluginEnabled _ = pluginEnabledConfig plcCallHierarchyOn + +instance PluginMethod TextDocumentSelectionRange where + pluginEnabled _ = pluginEnabledConfig plcSelectionRangeOn + combineResponses _ _ _ _ (x :| _) = x instance PluginMethod CallHierarchyIncomingCalls where pluginEnabled _ = pluginEnabledConfig plcCallHierarchyOn diff --git a/test/Ide/PluginUtilsTest.hs b/test/Ide/PluginUtilsTest.hs new file mode 100644 --- /dev/null +++ b/test/Ide/PluginUtilsTest.hs @@ -0,0 +1,27 @@ +module Ide.PluginUtilsTest + ( tests + ) where + +import Ide.PluginUtils (positionInRange) +import Language.LSP.Types (Position (Position), Range (Range)) +import Test.Tasty +import Test.Tasty.HUnit + +tests :: TestTree +tests = testGroup "PluginUtils" + [ positionInRangeTest + ] + +positionInRangeTest :: TestTree +positionInRangeTest = testGroup "positionInRange" + [ testCase "single line, after the end" $ + positionInRange (Position 1 10) (Range (Position 1 1) (Position 1 3)) @?= False + , testCase "single line, before the begining" $ + positionInRange (Position 1 0) (Range (Position 1 1) (Position 1 6)) @?= False + , testCase "single line, in range" $ + positionInRange (Position 1 5) (Range (Position 1 1) (Position 1 6)) @?= True + , testCase "multiline, in range" $ + positionInRange (Position 3 5) (Range (Position 1 1) (Position 5 6)) @?= True + , testCase "multiline, out of range" $ + positionInRange (Position 3 5) (Range (Position 3 6) (Position 4 10)) @?= False + ] diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,13 @@ +module Main where + +import qualified Ide.PluginUtilsTest as PluginUtilsTest +import Test.Tasty +import Test.Tasty.Ingredients.Rerun + +main :: IO () +main = defaultMainWithRerun tests + +tests :: TestTree +tests = testGroup "Main" + [ PluginUtilsTest.tests + ]