Add fourmolu plugin

cabal.project

@@ -15,3 +15,8 @@ package ghcide
 write-ghc-environment-files: never
 
 index-state: 2020-07-27T12:40:45Z
+
+allow-newer:
+  floskell:aeson
+  HsYAML-aeson:aeson
+  stylish-haskell:aeson

exe/Main.hs

@@ -68,6 +68,7 @@ import Ide.Plugin.Example2                as Example2
 import Ide.Plugin.GhcIde                  as GhcIde
 import Ide.Plugin.Floskell                as Floskell
 import Ide.Plugin.Ormolu                  as Ormolu
+import Ide.Plugin.Fourmolu                as Fourmolu
 import Ide.Plugin.StylishHaskell          as StylishHaskell
 #if AGPL
 import Ide.Plugin.Brittany                as Brittany
@@ -103,6 +104,7 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins
       , Floskell.descriptor "floskell"
       -- , genericDescriptor     "generic"
       -- , ghcmodDescriptor      "ghcmod"
+      , Fourmolu.descriptor "fourmolu"
       , Ormolu.descriptor   "ormolu"
       , StylishHaskell.descriptor "stylish-haskell"
 #if AGPL

haskell-language-server.cabal

@@ -44,6 +44,7 @@ library
       Ide.Plugin.Eval
       Ide.Plugin.Example
       Ide.Plugin.Example2
+      Ide.Plugin.Fourmolu
       Ide.Plugin.GhcIde
       Ide.Plugin.Ormolu
       Ide.Plugin.Pragmas
@@ -70,6 +71,7 @@ library
     , extra
     , filepath
     , floskell == 0.10.*
+    , fourmolu ^>= 0.1.0.0
     , ghc
     , ghcide >= 0.1
     , gitrev

src/Ide/Plugin/Fourmolu.hs

@@ -0,0 +1,89 @@
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module Ide.Plugin.Fourmolu
+  (
+    descriptor
+  , provider
+  )
+where
+
+import           Control.Exception
+import qualified Data.Text as T
+import           Development.IDE.Core.Rules
+import           Development.IDE.Types.Diagnostics as D
+import           Development.IDE.Types.Location
+import qualified DynFlags as D
+import qualified EnumSet  as S
+import           GHC
+import           Ide.Types
+import           Ide.PluginUtils
+import           Ide.Plugin.Formatter
+import           Language.Haskell.LSP.Types
+import "fourmolu" Ormolu
+import           Text.Regex.TDFA.Text()
+
+-- ---------------------------------------------------------------------
+
+descriptor :: PluginId -> PluginDescriptor
+descriptor plId = (defaultPluginDescriptor plId)
+  { pluginFormattingProvider = Just provider
+  }
+
+-- ---------------------------------------------------------------------
+
+provider :: FormattingProvider IO
+provider _lf ideState typ contents fp _ = do
+  let
+    fromDyn :: ParsedModule -> IO [DynOption]
+    fromDyn pmod =
+      let
+        df = ms_hspp_opts $ pm_mod_summary pmod
+        pp =
+          let p = D.sPgm_F $ D.settings df
+          in  if null p then [] else ["-pgmF=" <> p]
+        pm = map (("-fplugin=" <>) . moduleNameString) $ D.pluginModNames df
+        ex = map (("-X" <>) . show') $ S.toList $ D.extensionFlags df
+        show' x = case show x of
+          "Cpp" -> "CPP"
+          s -> s
+      in
+        return $ map DynOption $ pp <> pm <> ex
+
+  m_parsed <- runAction "Fourmolu" ideState $ getParsedModule fp
+  fileOpts <- case m_parsed of
+          Nothing -> return []
+          Just pm -> fromDyn pm
+
+  let
+    fullRegion = RegionIndices Nothing Nothing
+    rangeRegion s e = RegionIndices (Just s) (Just e)
+    mkConf o region = do
+      printerOpts <- loadConfigFile True (Just fp') defaultPrinterOpts
+      return $ defaultConfig
+        { cfgDynOptions = o
+        , cfgRegion = region
+        , cfgDebug = True
+        , cfgPrinterOpts = printerOpts
+        }
+    fmt :: T.Text -> Config RegionIndices -> IO (Either OrmoluException T.Text)
+    fmt cont conf =
+      try @OrmoluException (ormolu conf fp' $ T.unpack cont)
+    fp' = fromNormalizedFilePath fp
+
+  case typ of
+    FormatText -> ret <$> (fmt contents =<< mkConf fileOpts fullRegion)
+    FormatRange r ->
+      let
+        Range (Position sl _) (Position el _) = normalize r
+      in
+        ret <$> (fmt contents =<< mkConf fileOpts (rangeRegion sl el))
+ where
+  ret :: Either OrmoluException T.Text -> Either ResponseError (List TextEdit)
+  ret (Left err) = Left
+    (responseError (T.pack $ "fourmoluCmd: " ++ show err) )
+  ret (Right new) = Right (makeDiffTextEdit contents new)

src/Ide/Plugin/Ormolu.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE PackageImports #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -23,7 +24,7 @@ import           Ide.Types
 import           Ide.PluginUtils
 import           Ide.Plugin.Formatter
 import           Language.Haskell.LSP.Types
-import           Ormolu
+import "ormolu"  Ormolu
 import           Text.Regex.TDFA.Text()
 
 -- ---------------------------------------------------------------------

stack-8.10.1.yaml

@@ -13,6 +13,7 @@ extra-deps:
 - cabal-plan-0.7.0.0
 - clock-0.7.2
 - floskell-0.10.3
+- fourmolu-0.1.0.0
 - ghc-exactprint-0.6.3
 - lens-4.19.1
 - lsp-test-0.11.0.3

stack-8.6.4.yaml

@@ -20,6 +20,7 @@ extra-deps:
 # - ghcide-0.1.0
 - extra-1.7.3
 - floskell-0.10.3
+- fourmolu-0.1.0.0
 - fuzzy-0.1.0.0
 - ghc-check-0.5.0.1
 - ghc-exactprint-0.6.2 # for HaRe

stack-8.6.5.yaml

@@ -17,6 +17,7 @@ extra-deps:
 - clock-0.7.2
 - extra-1.7.3
 - floskell-0.10.3
+- fourmolu-0.1.0.0
 - fuzzy-0.1.0.0
 # - ghcide-0.1.0
 - ghc-check-0.5.0.1

stack-8.8.2.yaml

@@ -16,6 +16,7 @@ extra-deps:
 - constrained-dynamic-0.1.0.0
 - extra-1.7.3
 - floskell-0.10.3
+- fourmolu-0.1.0.0
 # - ghcide-0.1.0
 - ghc-check-0.5.0.1
 - ghc-lib-parser-8.10.1.20200523

stack-8.8.3.yaml

@@ -15,6 +15,7 @@ extra-deps:
 - constrained-dynamic-0.1.0.0
 - extra-1.7.3
 - floskell-0.10.3
+- fourmolu-0.1.0.0
 # - ghcide-0.1.0
 - haskell-src-exts-1.21.1
 - hie-bios-0.6.1

stack.yaml

@@ -17,6 +17,7 @@ extra-deps:
 - clock-0.7.2
 - extra-1.7.3
 - floskell-0.10.3
+- fourmolu-0.1.0.0
 - fuzzy-0.1.0.0
 # - ghcide-0.1.0
 - ghc-check-0.5.0.1

test/functional/Format.hs

@@ -36,6 +36,7 @@ tests = testGroup "format document" [
     , brittanyTests
 #endif
     , ormoluTests
+    , fourmoluTests
     ]
 
 rangeTests :: TestTree
@@ -156,6 +157,17 @@ ormoluTests = testGroup "ormolu" [
       GHC86 -> "formatted"
       _ -> "unchanged"
 
+fourmoluTests :: TestTree
+fourmoluTests = testGroup "fourmolu" [
+    goldenVsStringDiff "formats correctly" goldenGitDiff ("test/testdata/Format.fourmolu.hs") $ runSession hieCommand fullCaps "test/testdata" $ do
+        let formatLspConfig provider =
+                object [ "languageServerHaskell" .= object ["formattingProvider" .= (provider :: Value)] ]
+        sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "fourmolu"))
+        doc <- openDoc "Format.hs" "haskell"
+        formatDoc doc (FormattingOptions 4 True)
+        BS.fromStrict . T.encodeUtf8 <$> documentContents doc
+    ]
+
 
 formatLspConfig :: Value -> Value
 formatLspConfig provider = object [ "haskell" .= object ["formattingProvider" .= (provider :: Value)] ]

test/testdata/Format.fourmolu.hs

@@ -0,0 +1,12 @@
+module Format where
+
+foo :: Int -> Int
+foo 3 = 2
+foo x = x
+bar :: String -> IO String
+bar s = do
+    x <- return "hello"
+    return "asdf"
+
+data Baz = Baz {a :: Int, b :: String}
+