Update Fourmolu to 0.2

cabal.project

@@ -20,6 +20,6 @@ package ghcide
 
 write-ghc-environment-files: never
 
-index-state: 2020-09-23T17:24:43Z
+index-state: 2020-10-02T22:25:53Z
 
 allow-newer: data-tree-print:base

haskell-language-server.cabal

@@ -116,7 +116,7 @@ executable haskell-language-server
     , containers
     , deepseq
     , floskell                 ^>=0.10
-    , fourmolu                 ^>=0.1
+    , fourmolu                 ^>=0.2
     , ghc
     , ghc-boot-th
     , ghcide                   >=0.1
@@ -147,7 +147,7 @@ executable haskell-language-server
     , transformers
     , unordered-containers
     , ghc-source-gen
-    , refinery
+    , refinery                 ^>=0.1
     , ghc-exactprint
 
   if flag(agpl)

plugins/default/src/Ide/Plugin/Fourmolu.hs

@@ -1,90 +1,111 @@
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE PackageImports      #-}
-{-# LANGUAGE RecordWildCards     #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeApplications #-}
 
-module Ide.Plugin.Fourmolu
-  (
-    descriptor
-  , provider
-  )
-where
+module Ide.Plugin.Fourmolu (
+    descriptor,
+    provider,
+) where
 
-import           Control.Exception
-import qualified Data.Text                         as T
-import           Development.IDE                   as D
-import qualified DynFlags                          as D
-import qualified EnumSet                           as S
-import           GHC
-import           GHC.LanguageExtensions.Type
-import           GhcPlugins                        (HscEnv (hsc_dflags))
-import           Ide.Plugin.Formatter
-import           Ide.PluginUtils
-import           Ide.Types
-import           Language.Haskell.LSP.Core         (LspFuncs (withIndefiniteProgress),
-                                                    ProgressCancellable (Cancellable))
-import           Language.Haskell.LSP.Types
+import Control.Exception
+import Data.Either.Extra
+import System.FilePath
+
+import Control.Lens ((^.))
+import qualified Data.Text as T
+import Development.IDE as D
+import qualified DynFlags as D
+import qualified EnumSet as S
+import GHC (DynFlags, moduleNameString)
+import GHC.LanguageExtensions.Type (Extension (Cpp))
+import GhcPlugins (HscEnv (hsc_dflags))
+import Ide.Plugin.Formatter (responseError)
+import Ide.PluginUtils (makeDiffTextEdit)
+import Language.Haskell.LSP.Messages (FromServerMessage (ReqShowMessage))
+
+import Ide.Types
+import Language.Haskell.LSP.Core
+import Language.Haskell.LSP.Types
+import Language.Haskell.LSP.Types.Lens
 import "fourmolu" Ormolu
-import           System.FilePath                   (takeFileName)
-import           Text.Regex.TDFA.Text              ()
 
 -- ---------------------------------------------------------------------
 
 descriptor :: PluginId -> PluginDescriptor
-descriptor plId = (defaultPluginDescriptor plId)
-  { pluginFormattingProvider = Just provider
-  }
+descriptor plId =
+    (defaultPluginDescriptor plId)
+        { pluginFormattingProvider = Just provider
+        }
 
 -- ---------------------------------------------------------------------
 
 provider :: FormattingProvider IO
-provider lf ideState typ contents fp _ = withIndefiniteProgress lf title Cancellable $ do
-  let
-    fromDyn :: DynFlags -> IO [DynOption]
-    fromDyn df =
-      let
-        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 showExtension $ S.toList $ D.extensionFlags df
-      in
-        return $ map DynOption $ pp <> pm <> ex
+provider lf ideState typ contents fp fo = withIndefiniteProgress lf title Cancellable $ do
+    ghc <- runAction "Fourmolu" ideState $ use GhcSession fp
+    fileOpts <- case hsc_dflags . hscEnv <$> ghc of
+        Nothing -> return []
+        Just df -> convertDynFlags df
 
-  ghc <- runAction "Fourmolu" ideState $ use GhcSession fp
-  let df = hsc_dflags . hscEnv <$> ghc
-  fileOpts <- case df of
-          Nothing -> return []
-          Just df -> fromDyn df
+    let format printerOpts =
+            mapLeft (responseError . ("Fourmolu: " <>) . T.pack . show)
+                <$> try @OrmoluException (makeDiffTextEdit contents <$> ormolu config fp' (T.unpack contents))
+          where
+            config =
+                defaultConfig
+                    { cfgDynOptions = fileOpts
+                    , cfgRegion = region
+                    , cfgDebug = True
+                    , cfgPrinterOpts =
+                        fillMissingPrinterOpts
+                            (lspPrinterOpts <> printerOpts)
+                            defaultPrinterOpts
+                    }
 
-  let
-    fullRegion = RegionIndices Nothing Nothing
-    rangeRegion s e = RegionIndices (Just $ s + 1) (Just $ e + 1)
-    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)
+    loadConfigFile fp' >>= \case
+        ConfigLoaded file opts -> do
+            putStrLn $ "Loaded Fourmolu config from: " <> file
+            format opts
+        ConfigNotFound searchDirs -> do
+            putStrLn
+                . unlines
+                $ ("No " ++ show configFileName ++ " found in any of:") :
+                map ("  " ++) searchDirs
+            format mempty
+        ConfigParseError f (_, err) -> do
+            sendFunc lf . ReqShowMessage $
+                RequestMessage
+                    { _jsonrpc = ""
+                    , _id = IdString "fourmolu"
+                    , _method = WindowShowMessageRequest
+                    , _params =
+                        ShowMessageRequestParams
+                            { _xtype = MtError
+                            , _message = errorMessage
+                            , _actions = Nothing
+                            }
+                    }
+            return . Left $ responseError errorMessage
+          where
+            errorMessage = "Failed to load " <> T.pack f <> ": " <> T.pack err
+  where
     fp' = fromNormalizedFilePath fp
+    title = "Formatting " <> T.pack (takeFileName fp')
+    lspPrinterOpts = mempty{poIndentation = Just $ fo ^. tabSize}
+    region = case typ of
+        FormatText ->
+            RegionIndices Nothing Nothing
+        FormatRange (Range (Position sl _) (Position el _)) ->
+            RegionIndices (Just $ sl + 1) (Just $ el + 1)
 
-  case typ of
-    FormatText -> ret <$> (fmt contents =<< mkConf fileOpts fullRegion)
-    FormatRange (Range (Position sl _) (Position el _)) ->
-      ret <$> (fmt contents =<< mkConf fileOpts (rangeRegion sl el))
- where
-  title = T.pack $ "Formatting " <> takeFileName (fromNormalizedFilePath fp)
-  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)
-
-showExtension :: Extension -> String
-showExtension Cpp   = "-XCPP"
-showExtension other = "-X" ++ show other
+convertDynFlags :: DynFlags -> IO [DynOption]
+convertDynFlags df =
+    let pp = if null p then [] else ["-pgmF=" <> p]
+        p = D.sPgm_F $ D.settings df
+        pm = map (("-fplugin=" <>) . moduleNameString) $ D.pluginModNames df
+        ex = map showExtension $ S.toList $ D.extensionFlags df
+        showExtension = \case
+            Cpp -> "-XCPP"
+            x -> "-X" ++ show x
+     in return $ map DynOption $ pp <> pm <> ex

stack-8.10.1.yaml

@@ -16,7 +16,7 @@ extra-deps:
 - clock-0.7.2
 - data-tree-print-0.1.0.2
 - floskell-0.10.4
-- fourmolu-0.1.0.0@rev:1
+- fourmolu-0.2.0.0
 - HsYAML-aeson-0.2.0.0@rev:2
 - monad-dijkstra-0.1.1.2
 - opentelemetry-0.4.2

stack-8.10.2.yaml

@@ -17,7 +17,7 @@ extra-deps:
 - clock-0.7.2
 - data-tree-print-0.1.0.2
 - floskell-0.10.4
-- fourmolu-0.1.0.0@rev:1
+- fourmolu-0.2.0.0
 - HsYAML-aeson-0.2.0.0@rev:2
 - monad-dijkstra-0.1.1.2
 - opentelemetry-0.4.2

stack-8.6.4.yaml

@@ -21,7 +21,7 @@ extra-deps:
 - clock-0.7.2
 - extra-1.7.3
 - floskell-0.10.4
-- fourmolu-0.1.0.0@rev:1
+- fourmolu-0.2.0.0
 - fuzzy-0.1.0.0
 # - ghcide-0.1.0
 - ghc-check-0.5.0.1

stack-8.6.5.yaml

@@ -20,7 +20,7 @@ extra-deps:
 - clock-0.7.2
 - extra-1.7.3
 - floskell-0.10.4
-- fourmolu-0.1.0.0@rev:1
+- fourmolu-0.2.0.0
 - fuzzy-0.1.0.0
 # - ghcide-0.1.0
 - ghc-check-0.5.0.1

stack-8.8.2.yaml

@@ -19,7 +19,7 @@ extra-deps:
 - constrained-dynamic-0.1.0.0
 - extra-1.7.3
 - floskell-0.10.4
-- fourmolu-0.1.0.0@rev:1
+- fourmolu-0.2.0.0
 # - ghcide-0.1.0
 - ghc-check-0.5.0.1
 - ghc-lib-parser-8.10.1.20200523

stack-8.8.3.yaml

@@ -19,7 +19,7 @@ extra-deps:
 - constrained-dynamic-0.1.0.0
 - extra-1.7.3
 - floskell-0.10.4
-- fourmolu-0.1.0.0@rev:1
+- fourmolu-0.2.0.0
 # - ghcide-0.1.0
 - haskell-src-exts-1.21.1
 - hlint-2.2.8

stack-8.8.4.yaml

@@ -21,7 +21,7 @@ extra-deps:
 - constrained-dynamic-0.1.0.0
 - extra-1.7.3
 - floskell-0.10.4
-- fourmolu-0.1.0.0@rev:1
+- fourmolu-0.2.0.0
 # - ghcide-0.1.0
 - haskell-src-exts-1.21.1
 - hie-bios-0.7.1

stack.yaml

@@ -20,7 +20,7 @@ extra-deps:
 - clock-0.7.2
 - extra-1.7.3
 - floskell-0.10.4
-- fourmolu-0.1.0.0@rev:1
+- fourmolu-0.2.0.0
 - fuzzy-0.1.0.0
 # - ghcide-0.1.0
 - ghc-check-0.5.0.1

test/testdata/Format.fourmolu.formatted.hs

@@ -1,13 +1,13 @@
 module Format where
 
-import Data.Int
 import Data.List
+
+import Data.Int
 import Prelude
 
 foo :: Int -> Int
 foo 3 = 2
 foo x = x
-
 bar :: String -> IO String
 bar s = do
     x <- return "hello"