Refactor hover and go-to-definition searching (#260)

The process of searching for definitions is similar to the process of searching
for hover information. In the original code (much of which was written out twice
with occasional stylistic differences) the signal to noise ratio seemed pretty
poor.

Here is a refactoring which aims to make it easier to see the similarities and
differences between these two related functionalities.

ghcide.cabal

@@ -123,8 +123,7 @@ library
         Development.IDE.GHC.Warnings
         Development.IDE.Import.FindImports
         Development.IDE.LSP.CodeAction
-        Development.IDE.LSP.Definition
-        Development.IDE.LSP.Hover
+        Development.IDE.LSP.HoverDefinition
         Development.IDE.LSP.Notifications
         Development.IDE.Spans.AtPoint
         Development.IDE.Spans.Calculate

src/Development/IDE/Core/Rules.hs

@@ -102,17 +102,17 @@ getDependencies file = fmap transitiveModuleDeps <$> use GetDependencies file
 getAtPoint :: NormalizedFilePath -> Position -> Action (Maybe (Maybe Range, [T.Text]))
 getAtPoint file pos = fmap join $ runMaybeT $ do
   opts <- lift getIdeOptions
+  spans <- useE GetSpanInfo file
   files <- transitiveModuleDeps <$> useE GetDependencies file
   tms   <- usesE TypeCheck (file : files)
-  spans <- useE GetSpanInfo file
   return $ AtPoint.atPoint opts (map tmrModule tms) spans pos
 
 -- | Goto Definition.
 getDefinition :: NormalizedFilePath -> Position -> Action (Maybe Location)
 getDefinition file pos = fmap join $ runMaybeT $ do
+    opts <- lift getIdeOptions
     spans <- useE GetSpanInfo file
     pkgState <- hscEnv <$> useE GhcSession file
-    opts <- lift getIdeOptions
     let getHieFile x = useNoFile (GetHieFile x)
     lift $ AtPoint.gotoDefinition getHieFile opts pkgState spans pos
 

src/Development/IDE/LSP/Definition.hs

@@ -1,43 +0,0 @@
--- Copyright (c) 2019 The DAML Authors. All rights reserved.
--- SPDX-License-Identifier: Apache-2.0
-
-
--- | Go to the definition of a variable.
-module Development.IDE.LSP.Definition
-    ( setHandlersDefinition
-    ) where
-
-import           Language.Haskell.LSP.Types
-import Development.IDE.Types.Location
-
-import Development.IDE.Types.Logger
-import Development.IDE.Core.Rules
-import Development.IDE.Core.Service
-import Development.IDE.LSP.Server
-import qualified Language.Haskell.LSP.Core as LSP
-import Language.Haskell.LSP.Messages
-
-import qualified Data.Text as T
-
--- | Go to the definition of a variable.
-gotoDefinition
-    :: IdeState
-    -> TextDocumentPositionParams
-    -> IO LocationResponseParams
-gotoDefinition ide (TextDocumentPositionParams (TextDocumentIdentifier uri) pos _) = do
-    mbResult <- case uriToFilePath' uri of
-        Just path -> do
-            logInfo (ideLogger ide) $
-                "Definition request at position " <> T.pack (showPosition pos) <>
-                " in file: " <> T.pack path
-            runAction ide $ getDefinition (toNormalizedFilePath path) pos
-        Nothing -> pure Nothing
-    pure $ case mbResult of
-        Nothing -> MultiLoc []
-        Just loc -> SingleLoc loc
-
-
-setHandlersDefinition :: PartialHandlers
-setHandlersDefinition = PartialHandlers $ \WithMessage{..} x -> return x{
-    LSP.definitionHandler = withResponse RspDefinition $ const gotoDefinition
-    }

src/Development/IDE/LSP/Hover.hs

@@ -1,47 +0,0 @@
--- Copyright (c) 2019 The DAML Authors. All rights reserved.
--- SPDX-License-Identifier: Apache-2.0
-
-
--- | Display information on hover.
-module Development.IDE.LSP.Hover
-    ( setHandlersHover
-    ) where
-
-import Language.Haskell.LSP.Types
-import Development.IDE.Types.Location
-import Development.IDE.Core.Service
-import Development.IDE.LSP.Server
-import Development.IDE.Types.Logger
-import qualified Language.Haskell.LSP.Core as LSP
-import Language.Haskell.LSP.Messages
-
-import qualified Data.Text as T
-
-import Development.IDE.Core.Rules
-
--- | Display information on hover.
-onHover
-    :: IdeState
-    -> TextDocumentPositionParams
-    -> IO (Maybe Hover)
-onHover ide (TextDocumentPositionParams (TextDocumentIdentifier uri) pos _) = do
-    mbResult <- case uriToFilePath' uri of
-        Just (toNormalizedFilePath -> filePath) -> do
-          logInfo (ideLogger ide) $
-              "Hover request at position " <> T.pack (showPosition pos) <>
-              " in file: " <> T.pack (fromNormalizedFilePath filePath)
-          runAction ide $ getAtPoint filePath pos
-        Nothing       -> pure Nothing
-
-    case mbResult of
-        Just (mbRange, contents) ->
-            pure $ Just $ Hover
-                        (HoverContents $ MarkupContent MkMarkdown $ T.intercalate sectionSeparator contents)
-                        mbRange
-
-        Nothing -> pure Nothing
-
-setHandlersHover :: PartialHandlers
-setHandlersHover = PartialHandlers $ \WithMessage{..} x -> return x{
-    LSP.hoverHandler = withResponse RspHover $ const onHover
-    }

src/Development/IDE/LSP/HoverDefinition.hs

@@ -0,0 +1,59 @@
+-- Copyright (c) 2019 The DAML Authors. All rights reserved.
+-- SPDX-License-Identifier: Apache-2.0
+
+
+-- | Display information on hover.
+module Development.IDE.LSP.HoverDefinition
+    ( setHandlersHover
+    , setHandlersDefinition
+    ) where
+
+import           Development.IDE.Core.Rules
+import           Development.IDE.Core.Service
+import           Development.IDE.LSP.Server
+import           Development.IDE.Types.Location
+import           Development.IDE.Types.Logger
+import           Development.Shake
+import qualified Language.Haskell.LSP.Core       as LSP
+import           Language.Haskell.LSP.Messages
+import           Language.Haskell.LSP.Types
+
+import qualified Data.Text as T
+
+gotoDefinition :: IdeState -> TextDocumentPositionParams -> IO LocationResponseParams
+hover          :: IdeState -> TextDocumentPositionParams -> IO (Maybe Hover)
+gotoDefinition = request "Definition" getDefinition (MultiLoc []) SingleLoc
+hover          = request "Hover"      getAtPoint     Nothing      foundHover
+
+foundHover :: (Maybe Range, [T.Text]) -> Maybe Hover
+foundHover (mbRange, contents) =
+  Just $ Hover (HoverContents $ MarkupContent MkMarkdown $ T.intercalate sectionSeparator contents) mbRange
+
+setHandlersDefinition, setHandlersHover :: PartialHandlers
+setHandlersDefinition = PartialHandlers $ \WithMessage{..} x ->
+  return x{LSP.definitionHandler = withResponse RspDefinition $ const gotoDefinition}
+setHandlersHover      = PartialHandlers $ \WithMessage{..} x ->
+  return x{LSP.hoverHandler      = withResponse RspHover      $ const hover}
+
+-- | Respond to and log a hover or go-to-definition request
+request
+  :: T.Text
+  -> (NormalizedFilePath -> Position -> Action (Maybe a))
+  -> b
+  -> (a -> b)
+  -> IdeState
+  -> TextDocumentPositionParams
+  -> IO b
+request label getResults notFound found ide (TextDocumentPositionParams (TextDocumentIdentifier uri) pos _) = do
+    mbResult <- case uriToFilePath' uri of
+        Just path -> logAndRunRequest label getResults ide pos path
+        Nothing   -> pure Nothing
+    pure $ maybe notFound found mbResult
+
+logAndRunRequest :: T.Text -> (NormalizedFilePath -> Position -> Action b) -> IdeState -> Position -> String -> IO b
+logAndRunRequest label getResults ide pos path = do
+  let filePath = toNormalizedFilePath path
+  logInfo (ideLogger ide) $
+    label <> " request at position " <> T.pack (showPosition pos) <>
+    " in file: " <> T.pack path
+  runAction ide $ getResults filePath pos

src/Development/IDE/LSP/LanguageServer.hs

@@ -28,8 +28,7 @@ import GHC.IO.Handle (hDuplicate)
 import System.IO
 import Control.Monad.Extra
 
-import Development.IDE.LSP.Definition
-import Development.IDE.LSP.Hover
+import Development.IDE.LSP.HoverDefinition
 import Development.IDE.LSP.CodeAction
 import Development.IDE.LSP.Notifications
 import Development.IDE.Core.Service