Update to ormolu 0.5.0 and simplify plugin

Move makeDiffTextEdit from Haskell-IDE-Engine to PluginUtils.

Author: fendor

cabal.project

@@ -24,4 +24,4 @@ package ghcide
 
 write-ghc-environment-files: never
 
-index-state: 2020-03-24T21:15:10Z
+index-state: 2020-04-24T21:15:10Z

haskell-language-server.cabal

@@ -49,6 +49,7 @@ library
       Ide.Plugin.Pragmas
       Ide.Plugin.Floskell
       Ide.Plugin.Formatter
+      Ide.PluginUtils
       Ide.Types
       Ide.Version
   other-modules:
@@ -65,6 +66,7 @@ library
     , containers
     , data-default
     , deepseq
+    , Diff 
     , directory
     , extra
     , filepath
@@ -95,7 +97,7 @@ library
       Ide.Plugin.Brittany
 
   if impl(ghc >= 8.6)
-     build-depends: ormolu >= 0.0.3.1
+     build-depends: ormolu ^>= 0.0.5
 
   ghc-options:
          -Wall
@@ -151,7 +153,7 @@ executable haskell-language-server
      -- which works for now.
     , ghc
      --------------------------------------------------------------
-    , ghc-check
+    , ghc-check ^>= 0.1
     , ghc-paths
     , ghcide
     , gitrev

src/Ide/Plugin/Brittany.hs

@@ -36,7 +36,7 @@ descriptor plId = PluginDescriptor
 -- If the provider fails an error is returned that can be displayed to the user.
 provider
   :: FormattingProvider IO
-provider _ideState typ contents fp opts = do
+provider _lf _ideState typ contents fp opts = do
 -- text uri formatType opts = pluginGetFile "brittanyCmd: " uri $ \fp -> do
   confFile <- liftIO $ getConfFile fp
   let (range, selectedContents) = case typ of

src/Ide/Plugin/Floskell.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -45,7 +44,7 @@ descriptor 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 IO
-provider _ideState typ contents fp _ = do
+provider _lf _ideState typ contents fp _ = do
     let file = fromNormalizedFilePath fp
     config <- findConfigOrDefault file
     let (range, selectedContents) = case typ of

src/Ide/Plugin/Formatter.hs

@@ -70,15 +70,15 @@ doFormatting lf providers ideState ft uri params = do
               Just contents -> do
                   logDebug (ideLogger ideState) $ T.pack $
                       "Formatter.doFormatting: contents=" ++ show contents -- AZ
-                  provider ideState ft contents fp params
+                  provider lf ideState ft contents fp params
               Nothing -> return $ Left $ responseError $ T.pack $ "Formatter plugin: could not get file contents for " ++ show uri
           Nothing -> return $ Left $ responseError $ T.pack $ "Formatter plugin: uriToFilePath failed for: " ++ show uri
       Nothing -> return $ Left $ responseError $ T.pack $ "Formatter plugin: no formatter found for:[" ++ T.unpack mf ++ "]"
 
 -- ---------------------------------------------------------------------
 
 noneProvider :: FormattingProvider IO
-noneProvider _ _ _ _ _ = return $ Right (List [])
+noneProvider _ _ _ _ _ _ = return $ Right (List [])
 
 -- ---------------------------------------------------------------------
 

src/Ide/Plugin/Ormolu.hs

@@ -13,10 +13,6 @@ module Ide.Plugin.Ormolu
 where
 
 import           Control.Exception
-import           Control.Monad
-import           Data.Char
-import           Data.List
-import           Data.Maybe
 import qualified Data.Text as T
 import           Development.IDE.Core.Rules
 import           Development.IDE.Types.Diagnostics as D
@@ -25,7 +21,7 @@ import qualified DynFlags as D
 import qualified EnumSet  as S
 import           GHC
 import           Ide.Types
-import qualified HIE.Bios as BIOS
+import           Ide.PluginUtils
 import           Ide.Plugin.Formatter
 import           Language.Haskell.LSP.Types
 import           Ormolu
@@ -51,18 +47,7 @@ descriptor plId = PluginDescriptor
 
 provider :: FormattingProvider IO
 #if __GLASGOW_HASKELL__ >= 806
-provider ideState typ contents fp _ = do
-  let
-    exop s =
-      "-X" `isPrefixOf` s || "-fplugin=" `isPrefixOf` s || "-pgmF=" `isPrefixOf` s
-  opts <- lookupBiosComponentOptions fp
-  let cradleOpts =
-        map DynOption
-          $   filter exop
-          $   join
-          $   maybeToList
-          $   BIOS.componentOptions
-          <$> opts
+provider _lf ideState typ contents fp _ = do
   let
     fromDyn :: ParsedModule -> IO [DynOption]
     fromDyn pmod =
@@ -82,56 +67,31 @@ provider ideState typ contents fp _ = do
           Just pm -> fromDyn pm
 
   let
-    conf o = Config o False False True False
-    fmt :: T.Text -> [DynOption] -> IO (Either OrmoluException T.Text)
-    fmt cont o =
-      try @OrmoluException (ormolu (conf o) (fromNormalizedFilePath fp) $ T.unpack cont)
+    fullRegion = RegionIndices Nothing Nothing
+    rangeRegion s e = RegionIndices (Just s) (Just e)
+    mkConf o region = defaultConfig { cfgDynOptions = o,  cfgRegion = region }
+    fmt :: T.Text -> Config RegionIndices -> IO (Either OrmoluException T.Text)
+    fmt cont conf =
+      try @OrmoluException (ormolu conf (fromNormalizedFilePath fp) $ T.unpack cont)
 
   case typ of
-    FormatText -> ret (fullRange contents) <$> fmt contents cradleOpts
+    FormatText -> ret <$> fmt contents (mkConf fileOpts fullRegion)
     FormatRange r ->
       let
-        txt = T.lines $ extractRange r contents
-        lineRange (Range (Position sl _) (Position el _)) =
-          Range (Position sl 0) $ Position el $ T.length $ last txt
-        hIsSpace (h : _) = T.all isSpace h
-        hIsSpace _       = True
-        fixS t = if hIsSpace txt && (not $ hIsSpace t) then "" : t else t
-        fixE t = if T.all isSpace $ last txt then t else T.init t
-        unStrip :: T.Text -> T.Text -> T.Text
-        unStrip ws new =
-          fixE $ T.unlines $ map (ws `T.append`) $ fixS $ T.lines new
-        mStrip :: Maybe (T.Text, T.Text)
-        mStrip = case txt of
-          (l : _) ->
-            let ws = fst $ T.span isSpace l
-            in  (,) ws . T.unlines <$> traverse (T.stripPrefix ws) txt
-          _ -> Nothing
-        err :: IO (Either ResponseError (List TextEdit))
-        err = return $ Left $ responseError
-          $ T.pack "You must format a whole block of code. Ormolu does not support arbitrary ranges."
-        fmt' :: (T.Text, T.Text) -> IO (Either ResponseError (List TextEdit))
-        fmt' (ws, striped) =
-          ret (lineRange r) <$> (fmap (unStrip ws) <$> fmt striped fileOpts)
+        Range (Position sl _) (Position el _) = normalize r
       in
-        maybe err fmt' mStrip
+        ret <$> fmt contents (mkConf fileOpts (rangeRegion sl el))
  where
-  ret :: Range -> Either OrmoluException T.Text -> Either ResponseError (List TextEdit)
-  ret _ (Left err) = Left
+  ret :: Either OrmoluException T.Text -> Either ResponseError (List TextEdit)
+  ret (Left err) = Left
     (responseError (T.pack $ "ormoluCmd: " ++ show err) )
-  ret r (Right new) = Right (List [TextEdit r new])
+  ret (Right new) = Right (makeDiffTextEdit contents new)
 
 #else
 provider _ _ _ _ = return $ Right [] -- NOP formatter
 #endif
 
--- ---------------------------------------------------------------------
-
--- | Find the cradle wide 'ComponentOptions' that apply to a 'FilePath'
-lookupBiosComponentOptions :: (Monad m) => NormalizedFilePath -> m (Maybe BIOS.ComponentOptions)
-lookupBiosComponentOptions _fp = do
-  -- gmc <- getModuleCache
-  -- return $ lookupInCache fp gmc (const Just) (Just . compOpts) Nothing
-  return Nothing
-
--- ---------------------------------------------------------------------
+-- | Extend to the line below and above to replace newline character.
+normalize :: Range -> Range
+normalize (Range (Position sl _) (Position el _)) =
+  Range (Position sl 0) (Position (el + 1) 0)

src/Ide/PluginUtils.hs

@@ -0,0 +1,103 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Ide.PluginUtils where
+
+import qualified Data.Text as T
+import           Data.Maybe
+import           Data.Algorithm.DiffOutput
+import           Data.Algorithm.Diff
+import qualified Data.HashMap.Strict as H
+import           Language.Haskell.LSP.Types.Capabilities
+import qualified Language.Haskell.LSP.Types            as J
+import           Language.Haskell.LSP.Types
+
+data WithDeletions = IncludeDeletions | SkipDeletions
+  deriving Eq
+
+-- | Generate a 'WorkspaceEdit' value from a pair of source Text
+diffText :: ClientCapabilities -> (Uri,T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit
+diffText clientCaps old new withDeletions =
+  let
+    supports = clientSupportsDocumentChanges clientCaps
+  in diffText' supports old new withDeletions
+
+makeDiffTextEdit :: T.Text -> T.Text -> List TextEdit
+makeDiffTextEdit f1 f2 = diffTextEdit f1 f2 IncludeDeletions
+
+makeDiffTextEditAdditive :: T.Text -> T.Text -> List TextEdit
+makeDiffTextEditAdditive f1 f2 = diffTextEdit f1 f2 SkipDeletions
+
+diffTextEdit :: T.Text -> T.Text -> WithDeletions -> List TextEdit
+diffTextEdit fText f2Text withDeletions = J.List r
+  where
+    r = map diffOperationToTextEdit diffOps
+    d = getGroupedDiff (lines $ T.unpack fText) (lines $ T.unpack f2Text)
+
+    diffOps = filter (\x -> (withDeletions == IncludeDeletions) || not (isDeletion x))
+                     (diffToLineRanges d)
+
+    isDeletion (Deletion _ _) = True
+    isDeletion _ = False
+
+
+    diffOperationToTextEdit :: DiffOperation LineRange -> J.TextEdit
+    diffOperationToTextEdit (Change fm to) = J.TextEdit range nt
+      where
+        range = calcRange fm
+        nt = T.pack $ init $ unlines $ lrContents to
+
+    {-
+      In order to replace everything including newline characters,
+      the end range should extend below the last line. From the specification:
+      "If you want to specify a range that contains a line including
+      the line ending character(s) then use an end position denoting
+      the start of the next line"
+    -}
+    diffOperationToTextEdit (Deletion (LineRange (sl, el) _) _) = J.TextEdit range ""
+      where
+        range = J.Range (J.Position (sl - 1) 0)
+                        (J.Position el 0)
+
+    diffOperationToTextEdit (Addition fm l) = J.TextEdit range nt
+    -- fm has a range wrt to the changed file, which starts in the current file at l
+    -- So the range has to be shifted to start at l
+      where
+        range = J.Range (J.Position (l' - 1) 0)
+                        (J.Position (l' - 1) 0)
+        l' = max l sl -- Needed to add at the end of the file
+        sl = fst $ lrNumbers fm
+        nt = T.pack $ unlines $ lrContents fm
+
+
+    calcRange fm = J.Range s e
+      where
+        sl = fst $ lrNumbers fm
+        sc = 0
+        s = J.Position (sl - 1) sc -- Note: zero-based lines
+        el = snd $ lrNumbers fm
+        ec = length $ last $ lrContents fm
+        e = J.Position (el - 1) ec  -- Note: zero-based lines
+
+
+-- | A pure version of 'diffText' for testing
+diffText' :: Bool -> (Uri,T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit
+diffText' supports (f,fText) f2Text withDeletions  =
+  if supports
+    then WorkspaceEdit Nothing (Just docChanges)
+    else WorkspaceEdit (Just h) Nothing
+  where
+    diff = diffTextEdit fText f2Text withDeletions
+    h = H.singleton f diff
+    docChanges = J.List [docEdit]
+    docEdit = J.TextDocumentEdit (J.VersionedTextDocumentIdentifier f (Just 0)) diff
+
+-- ---------------------------------------------------------------------
+
+clientSupportsDocumentChanges :: ClientCapabilities -> Bool
+clientSupportsDocumentChanges caps =
+  let ClientCapabilities mwCaps _ _ _ = caps
+      supports = do
+        wCaps <- mwCaps
+        WorkspaceEditClientCapabilities mDc <- _workspaceEdit wCaps
+        mDc
+  in
+    fromMaybe False supports

src/Ide/Types.hs

@@ -169,7 +169,8 @@ data FormattingType = FormatText
 -- It is required to pass in the whole Document Text for that to happen, an empty text
 -- and file uri, does not suffice.
 type FormattingProvider m
-        = IdeState
+        = LSP.LspFuncs Config
+        -> IdeState
         -> FormattingType  -- ^ How much to format
         -> T.Text -- ^ Text to format
         -> NormalizedFilePath -- ^ location of the file being formatted

stack-8.6.4.yaml

@@ -36,7 +36,7 @@ extra-deps:
 - monad-dijkstra-0.1.1.2
 - monad-memo-0.4.1
 - multistate-0.8.0.1
-- ormolu-0.0.3.1
+- ormolu-0.0.5.0
 - parser-combinators-1.2.1
 - regex-base-0.94.0.0
 - regex-tdfa-1.3.1.0

stack-8.6.5.yaml

@@ -28,7 +28,7 @@ extra-deps:
 - monad-dijkstra-0.1.1.2
 - optics-core-0.2
 - optparse-applicative-0.15.1.0
-- ormolu-0.0.3.1
+- ormolu-0.0.5.0
 - parser-combinators-1.2.1
 - regex-base-0.94.0.0
 - regex-pcre-builtin-0.95.1.1.8.43