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