Add plugin for formatting cabal files using cabal-fmt

Introduce configuration for a cabal formatting provider.

Author: Jana Chadt

cabal.project

@@ -23,6 +23,7 @@ packages:
          ./plugins/hls-module-name-plugin
          ./plugins/hls-ormolu-plugin
          ./plugins/hls-call-hierarchy-plugin
+         ./plugins/hls-cabal-fmt-plugin
 tests: true
 
 package *

exe/Plugins.hs

@@ -82,7 +82,9 @@ import           Ide.Plugin.StylishHaskell         as StylishHaskell
 #if brittany
 import           Ide.Plugin.Brittany               as Brittany
 #endif
-
+#if cabalfmt
+import           Ide.Plugin.CabalFmt               as CabalFmt
+#endif
 -- ---------------------------------------------------------------------
 
 -- | The plugins configured for use in this instance of the language
@@ -124,6 +126,9 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins
 #if callHierarchy
       CallHierarchy.descriptor "callHierarchy":
 #endif
+#if cabalfmt
+      CabalFmt.descriptor "cabal-fmt" :
+#endif
 #if class
       Class.descriptor "class" :
 #endif

ghcide/src/Development/IDE/LSP/Notifications.hs

@@ -7,7 +7,7 @@
 {-# LANGUAGE RankNTypes            #-}
 
 module Development.IDE.LSP.Notifications
-    ( whenUriFile
+    ( whenUriHaskellFile
     , descriptor
     ) where
 
@@ -38,16 +38,21 @@ import           Development.IDE.Core.RuleTypes        (GetClientSettings (..))
 import           Development.IDE.Types.Shake           (toKey)
 import           Ide.Plugin.Config                     (CheckParents (CheckOnClose))
 import           Ide.Types
+import System.FilePath (takeExtension)
 
-whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()
-whenUriFile uri act = whenJust (LSP.uriToFilePath uri) $ act . toNormalizedFilePath'
+whenUriHaskellFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()
+whenUriHaskellFile uri act = whenJust maybeHaskellFile $ act . toNormalizedFilePath'
+  where 
+    maybeHaskellFile = do 
+      fp <- LSP.uriToFilePath uri
+      if takeExtension fp `elem` [".hs", ".lhs"] then Just fp else Nothing 
 
 descriptor :: PluginId -> PluginDescriptor IdeState
 descriptor plId = (defaultPluginDescriptor plId) { pluginNotificationHandlers = mconcat
   [ mkPluginNotificationHandler LSP.STextDocumentDidOpen $
       \ide _ (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> liftIO $ do
       updatePositionMapping ide (VersionedTextDocumentIdentifier _uri (Just _version)) (List [])
-      whenUriFile _uri $ \file -> do
+      whenUriHaskellFile _uri $ \file -> do
           -- We don't know if the file actually exists, or if the contents match those on disk
           -- For example, vscode restores previously unsaved contents on open
           addFileOfInterest ide file Modified{firstOpen=True}
@@ -57,21 +62,21 @@ descriptor plId = (defaultPluginDescriptor plId) { pluginNotificationHandlers =
   , mkPluginNotificationHandler LSP.STextDocumentDidChange $
       \ide _ (DidChangeTextDocumentParams identifier@VersionedTextDocumentIdentifier{_uri} changes) -> liftIO $ do
         updatePositionMapping ide identifier changes
-        whenUriFile _uri $ \file -> do
+        whenUriHaskellFile _uri $ \file -> do
           addFileOfInterest ide file Modified{firstOpen=False}
           setFileModified ide False file
         logDebug (ideLogger ide) $ "Modified text document: " <> getUri _uri
 
   , mkPluginNotificationHandler LSP.STextDocumentDidSave $
       \ide _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do
-        whenUriFile _uri $ \file -> do
+        whenUriHaskellFile _uri $ \file -> do
             addFileOfInterest ide file OnDisk
             setFileModified ide True file
         logDebug (ideLogger ide) $ "Saved text document: " <> getUri _uri
 
   , mkPluginNotificationHandler LSP.STextDocumentDidClose $
         \ide _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do
-          whenUriFile _uri $ \file -> do
+          whenUriHaskellFile _uri $ \file -> do
               deleteFileOfInterest ide file
               -- Refresh all the files that depended on this
               checkParents <- optCheckParents =<< getIdeOptionsIO (shakeExtras ide)
@@ -120,3 +125,4 @@ descriptor plId = (defaultPluginDescriptor plId) { pluginNotificationHandlers =
         liftIO $ logDebug (ideLogger ide) "Warning: Client does not support watched files. Falling back to OS polling"
   ]
     }
+

haskell-language-server.cabal

@@ -188,6 +188,11 @@ flag brittany
   default:     True
   manual:      True
 
+flag cabalfmt
+  description: Enable cabal-fmt plugin
+  default:     True
+  manual:      True
+
 common example-plugins
   hs-source-dirs: plugins/default/src
   other-modules: Ide.Plugin.Example,
@@ -280,6 +285,11 @@ common brittany
     build-depends: hls-brittany-plugin ^>= 1.0.0.1
     cpp-options: -Dbrittany
 
+common cabalfmt
+  if (flag(cabalfmt) || flag(all-formatters))
+    build-depends: hls-cabal-fmt-plugin ^>= 0.1.0.0
+    cpp-options: -Dcabalfmt
+
 executable haskell-language-server
   import:             common-deps
                     -- plugins
@@ -301,6 +311,7 @@ executable haskell-language-server
                     , ormolu
                     , stylishHaskell
                     , brittany
+                    , cabalfmt
 
   main-is:          Main.hs
   hs-source-dirs:   exe

hls-plugin-api/src/Ide/Plugin/Config.hs

@@ -56,6 +56,7 @@ data Config =
     , liquidOn                    :: !Bool
     , formatOnImportOn            :: !Bool
     , formattingProvider          :: !T.Text
+    , cabalFormattingProvider     :: !T.Text
     , maxCompletions              :: !Int
     , plugins                     :: !(Map.Map T.Text PluginConfig)
     } deriving (Show,Eq)
@@ -73,6 +74,7 @@ instance Default Config where
     , formattingProvider          = "ormolu"
     -- , formattingProvider          = "floskell"
     -- , formattingProvider          = "stylish-haskell"
+    , cabalFormattingProvider     = "cabal-fmt"
     , maxCompletions              = 40
     , plugins                     = Map.empty
     }
@@ -94,6 +96,7 @@ parseConfig defValue = A.withObject "Config" $ \v -> do
         <*> o .:? "liquidOn"                                .!= liquidOn defValue
         <*> o .:? "formatOnImportOn"                        .!= formatOnImportOn defValue
         <*> o .:? "formattingProvider"                      .!= formattingProvider defValue
+        <*> o .:? "cabalFormattingProvider"                 .!= cabalFormattingProvider defValue
         <*> o .:? "maxCompletions"                          .!= maxCompletions defValue
         <*> o .:? "plugin"                                  .!= plugins defValue
 

hls-plugin-api/src/Ide/Types.hs

@@ -248,11 +248,12 @@ instance PluginMethod TextDocumentCompletion where
           consumeCompletionResponse n (InR (CompletionList isCompleteResponse (List xx)))
 
 instance PluginMethod TextDocumentFormatting where
-  pluginEnabled _ pid conf = (PluginId $ formattingProvider conf) == pid
-  combineResponses _ _ _ _ (x :| _) = x
+  pluginEnabled STextDocumentFormatting pid conf = 
+    PluginId (formattingProvider conf) == pid || PluginId (cabalFormattingProvider conf) == pid
+  combineResponses _ _ _ _ x = sconcat x
 
 instance PluginMethod TextDocumentRangeFormatting where
-  pluginEnabled _ pid conf = (PluginId $ formattingProvider conf) == pid
+  pluginEnabled _ pid conf = PluginId (formattingProvider conf) == pid
   combineResponses _ _ _ _ (x :| _) = x
 
 instance PluginMethod TextDocumentPrepareCallHierarchy where

hls-test-utils/src/Test/Hls.hs

@@ -14,9 +14,11 @@ module Test.Hls
     goldenGitDiff,
     goldenWithHaskellDoc,
     goldenWithHaskellDocFormatter,
+    goldenWithCabalDocFormatter,
     def,
     runSessionWithServer,
     runSessionWithServerFormatter,
+    runSessionWithCabalServerFormatter,
     runSessionWithServer',
     waitForProgressDone,
     PluginDescriptor,
@@ -43,7 +45,7 @@ import qualified Development.IDE.Main              as Ghcide
 import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
 import           Development.IDE.Types.Options
 import           GHC.IO.Handle
-import           Ide.Plugin.Config                 (Config, formattingProvider)
+import           Ide.Plugin.Config                 (Config (cabalFormattingProvider), formattingProvider)
 import           Ide.PluginUtils                   (pluginDescToIdePlugins)
 import           Ide.Types
 import           Language.LSP.Test
@@ -121,6 +123,34 @@ runSessionWithServerFormatter plugin formatter =
     def
     fullCaps
 
+goldenWithCabalDocFormatter
+  :: PluginDescriptor IdeState
+  -> String
+  -> TestName
+  -> FilePath
+  -> FilePath
+  -> FilePath
+  -> FilePath
+  -> (TextDocumentIdentifier -> Session ())
+  -> TestTree
+goldenWithCabalDocFormatter plugin formatter title testDataDir path desc ext act =
+  goldenGitDiff title (testDataDir </> path <.> desc <.> ext)
+  $ runSessionWithServerFormatter plugin formatter testDataDir
+  $ TL.encodeUtf8 . TL.fromStrict
+  <$> do
+    doc <- openDoc (path <.> ext) "cabal"
+    act doc
+    documentContents doc
+
+runSessionWithCabalServerFormatter :: PluginDescriptor IdeState -> String -> FilePath -> Session a -> IO a
+runSessionWithCabalServerFormatter plugin formatter =
+  runSessionWithServer'
+    [plugin]
+    def {cabalFormattingProvider = T.pack formatter}
+    def
+    fullCaps
+
+
 -- | Run an action, with stderr silenced
 silenceStderr :: IO a -> IO a
 silenceStderr action = withTempFile $ \temp ->