Merge pull request #266 from pepeiborra/retrie

Initial Retrie plugin
haskell · Aug 3, 2020 · ba46353 · ba46353
2 parents 6c7b43a + 366e8b6
commit ba46353
Show file tree

Hide file tree

Showing 14 changed files with 600 additions and 36 deletions.
diff --git a/README.md b/README.md
@@ -71,6 +71,10 @@ This is *very* early stage software.
 
   This will cause compilation errors if a dependency contains invalid Haddock markup, though in a future version of GHC (hopefully 8.12), [these will be demoted to warnings](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/2377).
 
+ - Integration with [retrie](https://hackage.haskell.org/package/retrie)
+
+   ![Retrie](https://i.imgur.com/fEKjrUG.gif)
+
  - Many more (TBD)
 
 ## Installation

diff --git a/exe/Main.hs b/exe/Main.hs
@@ -69,6 +69,7 @@ import Ide.Plugin.GhcIde                  as GhcIde
 import Ide.Plugin.Floskell                as Floskell
 import Ide.Plugin.Ormolu                  as Ormolu
 import Ide.Plugin.StylishHaskell          as StylishHaskell
+import Ide.Plugin.Retrie                  as Retrie
 #if AGPL
 import Ide.Plugin.Brittany                as Brittany
 #endif
@@ -105,6 +106,7 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins
       -- , ghcmodDescriptor      "ghcmod"
       , Ormolu.descriptor   "ormolu"
       , StylishHaskell.descriptor "stylish-haskell"
+      , Retrie.descriptor "retrie"
 #if AGPL
       , Brittany.descriptor    "brittany"
 #endif

diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal
@@ -15,6 +15,7 @@ build-type:     Simple
 extra-source-files:
     README.md
     ChangeLog.md
+    include/ghc-api-version.h
 
 flag agpl
   Description: Enable AGPL dependencies
@@ -47,6 +48,7 @@ library
       Ide.Plugin.GhcIde
       Ide.Plugin.Ormolu
       Ide.Plugin.Pragmas
+      Ide.Plugin.Retrie
       Ide.Plugin.Floskell
       Ide.Plugin.Formatter
       Ide.Plugin.StylishHaskell
@@ -83,13 +85,17 @@ library
     , optparse-simple
     , process
     , regex-tdfa >= 1.3.1.0
+    , retrie >= 0.1.1.0
+    , safe-exceptions
     , shake >= 0.17.5
     , stylish-haskell == 0.11.*
     , temporary
     , text
     , time
     , transformers
     , unordered-containers
+  include-dirs:
+        include
   if os(windows)
     build-depends:     Win32
   else

diff --git a/include/ghc-api-version.h b/include/ghc-api-version.h
@@ -0,0 +1,10 @@
+#ifndef GHC_API_VERSION_H
+#define GHC_API_VERSION_H
+
+#ifdef GHC_LIB
+#define MIN_GHC_API_VERSION(x,y,z) MIN_VERSION_ghc_lib(x,y,z)
+#else
+#define MIN_GHC_API_VERSION(x,y,z) MIN_VERSION_ghc(x,y,z)
+#endif
+
+#endif
diff --git a/shell.nix b/shell.nix
@@ -17,7 +17,8 @@ let defaultCompiler = "ghc" + lib.replaceStrings ["."] [""] haskellPackages.ghc.
             # for all other compilers there is no Nix cache so dont bother building deps with NIx
             else haskell.packages.${compiler}.ghcWithPackages (_: []);
 
-   compilerWithPackages = haskellPackagesForProject(p:
+    retrie = with haskell.lib; dontCheck(disableLibraryProfiling(haskellPackages.retrie));
+    compilerWithPackages = haskellPackagesForProject(p:
         with p;
         [
           Diff
@@ -66,6 +67,7 @@ let defaultCompiler = "ghc" + lib.replaceStrings ["."] [""] haskellPackages.ghc.
           primes
           psqueues
           regex-tdfa
+          retrie
           rope-utf16-splay
           safe-exceptions
           shake

diff --git a/src/Ide/Plugin.hs b/src/Ide/Plugin.hs
@@ -18,6 +18,7 @@ module Ide.Plugin
     , responseError
     ) where
 
+import           Control.Exception(SomeException, catch)
 import           Control.Lens ( (^.) )
 import           Control.Monad
 import qualified Data.Aeson as J
@@ -206,7 +207,7 @@ executeCommandHandlers ecs = PartialHandlers $ \WithMessage{..} x -> return x{
 --                             -> ExecuteCommandParams
 --                             -> IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))
 makeExecuteCommands :: [(PluginId, [PluginCommand])] -> LSP.LspFuncs Config -> ExecuteCommandProvider
-makeExecuteCommands ecs lf ide = do
+makeExecuteCommands ecs lf ide = wrapUnhandledExceptions $ do
   let
       pluginMap = Map.fromList ecs
       parseCmdId :: T.Text -> Maybe (PluginId, CommandId)
@@ -331,6 +332,14 @@ makeExecuteCommands ecs lf ide = do
 -}
 
 -- -----------------------------------------------------------
+wrapUnhandledExceptions ::
+    (a -> IO (Either ResponseError J.Value, Maybe b)) ->
+       a -> IO (Either ResponseError J.Value, Maybe b)
+wrapUnhandledExceptions action input =
+    catch (action input) $ \(e::SomeException) -> do
+        let resp = ResponseError InternalError (T.pack $ show e) Nothing
+        return (Left resp, Nothing)
+
 
 -- | Runs a plugin command given a PluginId, CommandId and
 -- arguments in the form of a JSON object.