Change Hsimport to use configured Formatter on import

hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs

@@ -7,7 +7,6 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE OverloadedStrings #-}
 
@@ -212,16 +211,24 @@ type SymbolProvider = Uri -> IdeDeferM (IdeResult [DocumentSymbol])
 data FormattingType = FormatDocument
                     | FormatRange Range
 
--- | Formats the given Uri with the given options.
+-- | Formats the given Text associated with the given Uri.
+-- Should, but might not, honor the provided formatting options (e.g. Floskell does not).
 -- A formatting type can be given to either format the whole document or only a Range.
+-- 
+-- Text to format, may or may not, originate from the associated Uri. 
+-- E.g. it is ok, to modify the text and then reformat it through this API.
+--
+-- The Uri is mainly used to discover formatting configurations in the file's path.
+--
 -- Fails if the formatter can not parse the source.
--- Failing menas here that a IdeResultFail is returned.
+-- Failing means here that a IdeResultFail is returned.
 -- This can be used to display errors to the user, unless the error is an Internal one.
 -- The record 'IdeError' and 'IdeErrorCode' can be used to determine the type of error.
-type FormattingProvider = Uri -- ^ Uri to the file to format. Can be mapped to a file with `pluginGetFile`
+type FormattingProvider = T.Text -- ^ Text to format
+        -> Uri -- ^ Uri of the file being formatted
         -> FormattingType  -- ^ How much to format
         -> FormattingOptions -- ^ Options for the formatter
-        -> IdeDeferM (IdeResult [TextEdit]) -- ^ Result of the formatting or the unchanged text.
+        -> IdeM (IdeResult [TextEdit]) -- ^ Result of the formatting or the unchanged text.
 
 data PluginDescriptor =
   PluginDescriptor { pluginId                 :: PluginId
@@ -272,7 +279,7 @@ runPluginCommand p com arg = do
   case Map.lookup p m of
     Nothing -> return $
       IdeResultFail $ IdeError UnknownPlugin ("Plugin " <> p <> " doesn't exist") Null
-    Just (PluginDescriptor { pluginCommands = xs }) -> case List.find ((com ==) . commandName) xs of
+    Just PluginDescriptor { pluginCommands = xs } -> case List.find ((com ==) . commandName) xs of
       Nothing -> return $ IdeResultFail $
         IdeError UnknownCommand ("Command " <> com <> " isn't defined for plugin " <> p <> ". Legal commands are: " <> T.pack(show $ map commandName xs)) Null
       Just (PluginCommand _ _ (CmdSync f)) -> case fromJSON arg of

src/Haskell/Ide/Engine/LSP/Reactor.hs

@@ -40,6 +40,8 @@ data REnv = REnv
   , hoverProviders      :: [HoverProvider]
   , symbolProviders     :: [SymbolProvider]
   , formattingProviders :: Map.Map PluginId FormattingProvider
+  -- | Ide Plugins that are available
+  , idePlugins          :: IdePlugins
   -- TODO: Add code action providers here
   }
 
@@ -61,11 +63,12 @@ runReactor
   -> [HoverProvider]
   -> [SymbolProvider]
   -> Map.Map PluginId FormattingProvider
+  -> IdePlugins
   -> R a
   -> IO a
-runReactor lf sc dps hps sps fps f = do
+runReactor lf sc dps hps sps fps plugins f = do
   pid <- getProcessID
-  runReaderT f (REnv sc lf pid dps hps sps fps)
+  runReaderT f (REnv sc lf pid dps hps sps fps plugins)
 
 -- ---------------------------------------------------------------------
 

src/Haskell/Ide/Engine/Plugin/Brittany.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE DeriveAnyClass    #-}
-{-# LANGUAGE DeriveGeneric     #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Haskell.Ide.Engine.Plugin.Brittany where
 
@@ -11,7 +9,6 @@ import           Data.Coerce
 import           Data.Semigroup
 import           Data.Text                             (Text)
 import qualified Data.Text                             as T
-import           GHC.Generics
 import           Haskell.Ide.Engine.MonadTypes
 import           Haskell.Ide.Engine.PluginUtils
 import           Language.Haskell.Brittany
@@ -20,52 +17,62 @@ import qualified Language.Haskell.LSP.Types.Lens       as J
 import           System.FilePath (FilePath, takeDirectory)
 import           Data.Maybe (maybeToList)
 
-data FormatParams = FormatParams Int Uri (Maybe Range)
-     deriving (Eq, Show, Generic, FromJSON, ToJSON)
-
 brittanyDescriptor :: PluginId -> PluginDescriptor
 brittanyDescriptor plId = PluginDescriptor
-  { pluginId       = plId
-  , pluginName     = "Brittany"
-  , pluginDesc     = "Brittany is a tool to format source code."
-  , pluginCommands = []
+  { pluginId                 = plId
+  , pluginName               = "Brittany"
+  , pluginDesc               = "Brittany is a tool to format source code."
+  , pluginCommands           = []
   , pluginCodeActionProvider = Nothing
   , pluginDiagnosticProvider = Nothing
-  , pluginHoverProvider = Nothing
-  , pluginSymbolProvider = Nothing
+  , pluginHoverProvider      = Nothing
+  , pluginSymbolProvider     = Nothing
   , pluginFormattingProvider = Just provider
   }
 
 -- | Formatter provider of Brittany.
 -- Formats the given source in either a given Range or the whole Document.
 -- If the provider fails an error is returned that can be displayed to the user.
-provider :: FormattingProvider
-provider uri formatType opts = pluginGetFile "brittanyCmd: " uri $ \file -> do
-  confFile <- liftIO $ getConfFile file
-  mtext <- readVFS uri
-  case mtext of
-    Nothing -> return $ IdeResultFail (IdeError InternalError "File was not open" Null)
-    Just text -> case formatType of
-      FormatRange r -> do
-        res <- liftIO $ runBrittany tabSize confFile $ extractRange r text
-        case res of
-          Left err -> return $ IdeResultFail (IdeError PluginError
-                      (T.pack $ "brittanyCmd: " ++ unlines (map showErr err)) Null)
-          Right newText -> do
-            let textEdit = J.TextEdit (normalize r) newText
-            return $ IdeResultOk [textEdit]
-      FormatDocument -> do
-        res <- liftIO $ runBrittany tabSize confFile text
-        case res of
-          Left err -> return $ IdeResultFail (IdeError PluginError
-                      (T.pack $ "brittanyCmd: " ++ unlines (map showErr err)) Null)
-          Right newText ->
-            return $ IdeResultOk [J.TextEdit (fullRange text) newText]
+provider
+  :: MonadIO m
+  => Text
+  -> Uri
+  -> FormattingType
+  -> FormattingOptions
+  -> m (IdeResult [TextEdit])
+provider text uri formatType opts = pluginGetFile "brittanyCmd: " uri $ \fp -> do
+  confFile <- liftIO $ getConfFile fp
+  let (range, selectedContents) = case formatType of
+        FormatDocument -> (fullRange text, text)
+        FormatRange r  -> (normalize r, extractRange r text)
+
+  res <- formatText confFile opts selectedContents
+  case res of
+    Left err -> return $ IdeResultFail
+      (IdeError PluginError
+                (T.pack $ "brittanyCmd: " ++ unlines (map showErr err))
+                Null
+      )
+    Right newText -> do
+      let textEdit = J.TextEdit range newText
+      return $ IdeResultOk [textEdit]
+
+-- | Primitive to format text with the given option.
+-- May not throw exceptions but return a Left value.
+-- Errors may be presented to the user.
+formatText
+  :: MonadIO m
+  => Maybe FilePath -- ^ Path to configs. If Nothing, default configs will be used.
+  -> FormattingOptions -- ^ Options for the formatter such as indentation.
+  -> Text -- ^ Text to format
+  -> m (Either [BrittanyError] Text) -- ^ Either formatted Text or a error from Brittany. 
+formatText confFile opts text = 
+  liftIO $ runBrittany tabSize confFile text
   where tabSize = opts ^. J.tabSize
 
+-- | Extend to the line below to replace newline character, as above.
 normalize :: Range -> Range
 normalize (Range (Position sl _) (Position el _)) =
-  -- Extend to the line below to replace newline character, as above
   Range (Position sl 0) (Position (el + 1) 0)
 
 -- | Recursively search in every directory of the given filepath for brittany.yaml

src/Haskell/Ide/Engine/Plugin/Floskell.hs

@@ -31,20 +31,16 @@ floskellDescriptor plId = PluginDescriptor
 -- Formats the given source in either a given Range or the whole Document.
 -- If the provider fails an error is returned that can be displayed to the user.
 provider :: FormattingProvider
-provider uri typ _opts =
+provider contents uri typ _opts =
   pluginGetFile "Floskell: " uri $ \file -> do
     config <- liftIO $ findConfigOrDefault file
-    mContents <- readVFS uri
-    case mContents of
-      Nothing -> return $ IdeResultFail (IdeError InternalError "File was not open" Null)
-      Just contents ->
-        let (range, selectedContents) = case typ of
-              FormatDocument -> (fullRange contents, contents)
-              FormatRange r  -> (r, extractRange r contents)
-            result = reformat config (uriToFilePath uri) (BS.fromStrict (T.encodeUtf8 selectedContents))
-        in  case result of
-              Left  err -> return $ IdeResultFail (IdeError PluginError (T.pack err) Null)
-              Right new -> return $ IdeResultOk [TextEdit range (T.decodeUtf8 (BS.toStrict new))]
+    let (range, selectedContents) = case typ of
+          FormatDocument -> (fullRange contents, contents)
+          FormatRange r  -> (r, extractRange r contents)
+        result = reformat config (uriToFilePath uri) (BS.fromStrict (T.encodeUtf8 selectedContents))
+    case result of
+      Left  err -> return $ IdeResultFail (IdeError PluginError (T.pack $  "floskellCmd: " ++ err) Null)
+      Right new -> return $ IdeResultOk [TextEdit range (T.decodeUtf8 (BS.toStrict new))]
 
 -- | Find Floskell Config, user and system wide or provides a default style.
 -- Every directory of the filepath will be searched to find a user configuration.

src/Haskell/Ide/Engine/Plugin/HsImport.hs

@@ -10,7 +10,6 @@ import           Control.Monad
 import           Data.Aeson
 import           Data.Bitraversable
 import           Data.Bifunctor
-import           Data.Either
 import           Data.Foldable
 import           Data.Maybe
 import           Data.Monoid                    ( (<>) )
@@ -21,11 +20,10 @@ import qualified GhcMod.Utils                  as GM
 import           HsImport
 import           Haskell.Ide.Engine.Config
 import           Haskell.Ide.Engine.MonadTypes
+import qualified Haskell.Ide.Engine.Support.HieExtras as Hie
 import qualified Language.Haskell.LSP.Types      as J
 import qualified Language.Haskell.LSP.Types.Lens as J
 import           Haskell.Ide.Engine.PluginUtils
-import qualified Haskell.Ide.Engine.Plugin.Brittany
-                                               as Brittany
 import qualified Haskell.Ide.Engine.Plugin.Hoogle
                                                as Hoogle
 import           System.Directory
@@ -54,12 +52,10 @@ importCmd :: CommandFunc ImportParams J.WorkspaceEdit
 importCmd = CmdSync $ \(ImportParams uri modName) -> importModule uri modName
 
 importModule :: Uri -> T.Text -> IdeGhcM (IdeResult J.WorkspaceEdit)
-importModule uri modName =
-  pluginGetFile "hsimport cmd: " uri $ \origInput -> do
-
+importModule uri modName = pluginGetFile "hsimport cmd: " uri $ \origInput -> do
     shouldFormat <- formatOnImportOn <$> getConfig
 
-    fileMap <- GM.mkRevRedirMapFunc
+    fileMap      <- GM.mkRevRedirMapFunc
     GM.withMappedFile origInput $ \input -> do
 
       tmpDir            <- liftIO getTemporaryDirectory
@@ -79,25 +75,40 @@ importModule uri modName =
         Nothing -> do
           newText <- liftIO $ T.readFile output
           liftIO $ removeFile output
-          J.WorkspaceEdit mChanges mDocChanges <- liftToGhc $ makeDiffResult input newText fileMap
+          J.WorkspaceEdit mChanges mDocChanges <- liftToGhc
+            $ makeDiffResult input newText fileMap
 
           if shouldFormat
             then do
-              -- Format the import with Brittany
-              confFile <- liftIO $ Brittany.getConfFile origInput
-              newChanges <- forM mChanges $ mapM $ mapM (formatTextEdit confFile)
-              newDocChanges <- forM mDocChanges $ mapM $ \(J.TextDocumentEdit vDocId tes) -> do
-                ftes <- forM tes (formatTextEdit confFile)
-                return (J.TextDocumentEdit vDocId ftes)
-
-              return $ IdeResultOk (J.WorkspaceEdit newChanges newDocChanges)
-            else
-              return $ IdeResultOk (J.WorkspaceEdit mChanges mDocChanges)
-
-  where formatTextEdit confFile (J.TextEdit r t) = do
-          -- TODO: This tab size of 2 spaces should probably be taken from a config
-          ft <- fromRight t <$> liftIO (Brittany.runBrittany 2 confFile t)
-          return (J.TextEdit r ft)
+              config  <- getConfig
+              plugins <- getPlugins
+              let mprovider = Hie.getFormattingPlugin config plugins
+              case mprovider of
+                Nothing ->
+                  return $ IdeResultOk (J.WorkspaceEdit mChanges mDocChanges)
+
+                Just (_, provider) -> do
+                  let formatEdit :: J.TextEdit -> IdeGhcM J.TextEdit
+                      formatEdit origEdit@(J.TextEdit _ t) = do
+                        -- TODO: are these default FormattingOptions ok?
+                        res <- liftToGhc $ provider t uri FormatDocument (FormattingOptions 2 True)
+                        let formatEdits = case res of
+                                            IdeResultOk xs -> xs
+                                            _ -> []
+                        return $ foldl' J.editTextEdit origEdit formatEdits
+
+                  -- behold: the legendary triple mapM
+                  newChanges <- (mapM . mapM . mapM) formatEdit mChanges
+
+                  newDocChanges <- forM mDocChanges $ \change -> do
+                    let cmd (J.TextDocumentEdit vids edits) = do
+                          newEdits <- mapM formatEdit edits
+                          return $ J.TextDocumentEdit vids newEdits
+                    mapM cmd change
+
+                  return
+                    $ IdeResultOk (J.WorkspaceEdit newChanges newDocChanges)
+            else return $ IdeResultOk (J.WorkspaceEdit mChanges mDocChanges)
 
 codeActionProvider :: CodeActionProvider
 codeActionProvider plId docId _ context = do

src/Haskell/Ide/Engine/Support/HieExtras.hs

@@ -22,6 +22,7 @@ module Haskell.Ide.Engine.Support.HieExtras
   , runGhcModCommand
   , splitCaseCmd'
   , splitCaseCmd
+  , getFormattingPlugin
   ) where
 
 import           ConLike
@@ -55,6 +56,7 @@ import qualified GhcMod.Gap                                   as GM
 import qualified GhcMod.LightGhc                              as GM
 import qualified GhcMod.Utils                                 as GM
 import           Haskell.Ide.Engine.ArtifactMap
+import           Haskell.Ide.Engine.Config
 import           Haskell.Ide.Engine.Context
 import           Haskell.Ide.Engine.MonadFunctions
 import           Haskell.Ide.Engine.MonadTypes
@@ -799,3 +801,12 @@ prefixes =
   , "$c"
   , "$m"
   ]
+
+-- ---------------------------------------------------------------------
+
+getFormattingPlugin :: Config -> IdePlugins -> Maybe (PluginDescriptor, FormattingProvider)
+getFormattingPlugin config plugins = do 
+  let providerName = formattingProvider config
+  fmtPlugin <- Map.lookup providerName (ipMap plugins)
+  fmtProvider <- pluginFormattingProvider fmtPlugin
+  return (fmtPlugin, fmtProvider)