Execute formatter provider

Implement Cmds for floskell and brittany to format text.
Make it callable for other plugins.

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

@@ -75,7 +75,7 @@ module Haskell.Ide.Engine.PluginsIdeMonads
   , PublishDiagnosticsParams(..)
   , List(..)
   , FormattingOptions(..)
-  , FormatCmdParams(..)
+  , FormatTextCmdParams(..)
   )
 where
 
@@ -209,15 +209,16 @@ type HoverProvider = Uri -> Position -> IdeM (IdeResult [Hover])
 
 type SymbolProvider = Uri -> IdeDeferM (IdeResult [DocumentSymbol])
 
--- |Format Paramaters for Cmd.
--- Turns the 'FormattingType' into a record.
-data FormatCmdParams = FormatCmdParams
-  { fmtUri ::  Uri -- ^ Uri to the file to format
-  , fmtType :: FormattingType -- ^ How much and what to format
-  , fmtOptions :: FormattingOptions -- ^ Options for the formatter
+-- |Format Paramaters for Cmd. 
+-- Can be used to send messages to formatters
+data FormatTextCmdParams = FormatTextCmdParams
+  { fmtText ::  T.Text -- ^ Text to format
+  , fmtResultRange :: Range -- ^ Range where the text will be inserted.
+  , fmtTextOptions :: FormattingOptions -- ^ Options for the formatter
   }
   deriving (Eq, Show, Generic, FromJSON, ToJSON)
 
+
 -- | Format the document either as a whole or only a given Range of it.
 data FormattingType = FormatDocument
                     | FormatRange Range

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

@@ -25,14 +25,17 @@ data FormatParams = FormatParams Int Uri (Maybe Range)
 
 brittanyDescriptor :: PluginId -> PluginDescriptor
 brittanyDescriptor plId = PluginDescriptor
-  { pluginId = plId
-  , pluginName = "Brittany"
-  , pluginDesc = "Brittany is a tool to format source code."
-  , pluginCommands = [PluginCommand "format" "Format the document" formatCmd]
+  { pluginId                 = plId
+  , pluginName               = "Brittany"
+  , pluginDesc               = "Brittany is a tool to format source code."
+  , pluginCommands           = [ PluginCommand "formatText"
+                                               "Format the given Text with Brittany"
+                                               formatCmd
+                               ]
   , pluginCodeActionProvider = Nothing
   , pluginDiagnosticProvider = Nothing
-  , pluginHoverProvider = Nothing
-  , pluginSymbolProvider = Nothing
+  , pluginHoverProvider      = Nothing
+  , pluginSymbolProvider     = Nothing
   , pluginFormattingProvider = Just provider
   }
 
@@ -45,51 +48,71 @@ provider = format
 -- |Formatter 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.
-format :: (MonadIO m, MonadIde m)
-       => Uri
-       -> FormattingType
-       -> FormattingOptions
-       -> m (IdeResult [TextEdit])
+format
+  :: (MonadIO m, MonadIde m)
+  => Uri
+  -> FormattingType
+  -> FormattingOptions
+  -> m (IdeResult [TextEdit])
 format uri formatType opts = pluginGetFile "brittanyCmd: " uri $ \fp -> do
   confFile <- liftIO $ getConfFile fp
-  mtext <- readVFS uri
+  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]
-  where
-    tabSize = opts ^. J.tabSize
+    -- Uri could not be read from the virtual file system.
+    Nothing ->
+      return $ IdeResultFail (IdeError InternalError "File was not open" Null)
+    Just text -> do
+      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
 
 -- | Format a source with the given options.
 -- Synchronized command.
 -- Other plugins can use this Command it to execute formatters.
--- Command can be run by ``
-formatCmd :: CommandFunc FormatCmdParams [TextEdit]
-formatCmd = CmdSync $ \fmtParam -> 
-  format (fmtUri fmtParam) (fmtType fmtParam) (fmtOptions fmtParam)
+-- Command can be run by 
+-- ```
+-- runPluginCommand
+--     (pluginId plugin)
+--     "formatText"
+--     (dynToJSON $ toDynJSON $ FormatTextCmdParams t r (FormattingOptions 2 True))
+-- ```
+formatCmd :: CommandFunc FormatTextCmdParams [TextEdit]
+formatCmd = CmdSync $ \(FormatTextCmdParams text fmtRange fmtOpts) -> do
+  rootPath <- getRootPath
+  textEdit <- formatText rootPath fmtOpts text
+  case textEdit of
+    Left err -> return $ IdeResultFail
+      (IdeError PluginError
+                (T.pack $ "brittanyCmd: " ++ unlines (map showErr err))
+                Null
+      )
+    Right newText -> do
+      let edit = J.TextEdit fmtRange newText
+      return $ IdeResultOk [edit]
 
 -- | Extend to the line below to replace newline character, as above.
 normalize :: Range -> Range

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

@@ -10,16 +10,21 @@ import           Data.Aeson                     (Value (Null))
 import qualified Data.ByteString.Lazy           as BS
 import qualified Data.Text                      as T
 import qualified Data.Text.Encoding             as T
+import           Data.Maybe
 import           Floskell
 import           Haskell.Ide.Engine.MonadTypes
 import           Haskell.Ide.Engine.PluginUtils
+import qualified Language.Haskell.LSP.Types            as J
 
 floskellDescriptor :: PluginId -> PluginDescriptor
 floskellDescriptor plId = PluginDescriptor
   { pluginId                 = plId
   , pluginName               = "Floskell"
   , pluginDesc               = "A flexible Haskell source code pretty printer."
-  , pluginCommands           = []
+  , pluginCommands = [ PluginCommand "formatText"
+                                     "Format the given Text with Floskell"
+                                     formatCmd
+                     ]
   , pluginCodeActionProvider = Nothing
   , pluginDiagnosticProvider = Nothing
   , pluginHoverProvider      = Nothing
@@ -40,11 +45,35 @@ provider uri typ _opts =
               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)
+              Left  err -> return $ IdeResultFail (IdeError PluginError (T.pack $  "floskellCmd: " ++ err) Null)
               Right new -> return $ IdeResultOk [TextEdit range (T.decodeUtf8 (BS.toStrict new))]
 
+-- | Format a source with the given options.
+-- Synchronized command.
+-- Other plugins can use this Command it to execute formatters.
+-- Command can be run by 
+-- ```
+-- runPluginCommand
+--     (pluginId plugin)
+--     "formatText"
+--     (dynToJSON $ toDynJSON $ FormatTextCmdParams t r (FormattingOptions 2 True))
+-- ```
+formatCmd :: CommandFunc FormatTextCmdParams [TextEdit]
+formatCmd = CmdSync $ \(FormatTextCmdParams text fmtRange _) -> do
+  rootPath <- getRootPath
+  config   <- liftIO $ findConfigOrDefault (fromMaybe "" rootPath)
+  let textEdit = reformat config Nothing (BS.fromStrict (T.encodeUtf8 text))
+  case textEdit of
+    Left err -> return $ IdeResultFail
+      (IdeError PluginError (T.pack $ "floskellCmd: " ++ err) Null)
+    Right newText -> do
+      let edit = J.TextEdit fmtRange (T.decodeUtf8 (BS.toStrict newText))
+      return $ IdeResultOk [edit]
 
-
+-- |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.
+-- Also looks into places such as XDG_CONFIG_DIRECTORY<https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html>.
+-- This function may not throw an exception and returns a default config.
 findConfigOrDefault :: FilePath -> IO AppConfig
 findConfigOrDefault file = do
   mbConf <- findAppConfigIn file

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                    ( (<>) )
@@ -25,8 +24,6 @@ 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
@@ -55,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
@@ -80,36 +75,51 @@ 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
-              config <- getConfig
+              config  <- getConfig
               plugins <- getPlugins
               let mprovider = Hie.getFormattingPlugin config plugins
-              case mprovider of 
-                Nothing -> return $ IdeResultOk (J.WorkspaceEdit mChanges mDocChanges)
-                Just (plugin, _) -> do
-                  let fmtCmd = J.Command "unused" 
-                  results <- forM mChanges $ mapM $ mapM $ (runPluginCommand (pluginId plugin) "format" . dynToJSON . toDynJSON)
-
+              case mprovider of
+                Nothing -> 
+                  return $ IdeResultOk (J.WorkspaceEdit mChanges mDocChanges)
 
-
-                  -- -- 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 mChanges mDocChanges) -- (J.WorkspaceEdit newChanges newDocChanges)
-            else
+                Just (plugin, _) -> do
+                  newChanges <- forM mChanges $ \change -> do
+                    let func = mapM (formatTextEdit plugin)
+                    res <- mapM func change
+                    return $ fmap flatten res 
+
+                  newDocChanges <- forM mDocChanges $ \change -> do
+                    let cmd (J.TextDocumentEdit vids edits) = do
+                          newEdits <- mapM (formatTextEdit plugin) edits
+                          return $ J.TextDocumentEdit vids (flatten newEdits)
+                    mapM cmd change
+
+                  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)
+ where
+flatten :: List [a] -> List a
+flatten (J.List list) = J.List (join list)
+
+formatTextEdit :: PluginDescriptor -> J.TextEdit -> IdeGhcM [J.TextEdit]
+formatTextEdit plugin edit@(J.TextEdit r t) = do
+  result <- runPluginCommand
+    (pluginId plugin)
+    "formatText"
+    -- TODO: should this be in the configs?
+    (dynToJSON $ toDynJSON $ FormatTextCmdParams t r (FormattingOptions 2 True))
+  return $ case result of
+    IdeResultOk e -> fromMaybe [edit] (fromDynJSON e)
+    _             -> [edit]
 
 codeActionProvider :: CodeActionProvider
 codeActionProvider plId docId _ context = do