mirror of
https://github.com/haskell/haskell-ide-engine.git
synced 2024-09-11 11:05:30 +03:00
Merge pull request #1602 from Avi-D-coder/ormolu-range
Ormolu range format support
This commit is contained in:
commit
6dffe13522
@ -2,21 +2,31 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Haskell.Ide.Engine.Plugin.Ormolu ( ormoluDescriptor ) where
|
||||
module Haskell.Ide.Engine.Plugin.Ormolu
|
||||
( ormoluDescriptor
|
||||
)
|
||||
where
|
||||
|
||||
import Haskell.Ide.Engine.MonadTypes
|
||||
import Haskell.Ide.Engine.MonadTypes
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 806
|
||||
import Control.Exception
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class ( liftIO , MonadIO(..) )
|
||||
import Data.Aeson ( Value ( Null ) )
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
import Ormolu
|
||||
import Haskell.Ide.Engine.PluginUtils
|
||||
import HIE.Bios.Types
|
||||
import Control.Exception
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class ( liftIO
|
||||
, MonadIO(..)
|
||||
)
|
||||
import Data.Aeson ( Value(Null) )
|
||||
import Data.Char
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
import GHC
|
||||
import Ormolu
|
||||
import Haskell.Ide.Engine.PluginUtils
|
||||
import Haskell.Ide.Engine.Support.HieExtras
|
||||
import HIE.Bios.Types
|
||||
import qualified DynFlags as D
|
||||
import qualified EnumSet as S
|
||||
#endif
|
||||
|
||||
ormoluDescriptor :: PluginId -> PluginDescriptor
|
||||
@ -34,24 +44,71 @@ ormoluDescriptor plId = PluginDescriptor
|
||||
|
||||
|
||||
provider :: FormattingProvider
|
||||
provider _contents _uri _typ _opts =
|
||||
#if __GLASGOW_HASKELL__ >= 806
|
||||
case _typ of
|
||||
FormatRange _ -> return $ IdeResultFail (IdeError PluginError (T.pack "Selection formatting for Ormolu is not currently supported.") Null)
|
||||
FormatText -> pluginGetFile _contents _uri $ \file -> do
|
||||
opts <- lookupComponentOptions file
|
||||
let opts' = map DynOption $ filter exop $ join $ maybeToList $ componentOptions <$> opts
|
||||
conf = Config opts' False False True False
|
||||
result <- liftIO $ try @OrmoluException (ormolu conf file (T.unpack _contents))
|
||||
provider contents uri typ _ = pluginGetFile contents uri $ \fp -> do
|
||||
opts <- lookupComponentOptions fp
|
||||
let cradleOpts =
|
||||
map DynOption
|
||||
$ filter exop
|
||||
$ join
|
||||
$ maybeToList
|
||||
$ componentOptions
|
||||
<$> opts
|
||||
|
||||
case result of
|
||||
Left err -> return $ IdeResultFail (IdeError PluginError (T.pack $ "ormoluCmd: " ++ show err) Null)
|
||||
Right new -> return $ IdeResultOk [TextEdit (fullRange _contents) new]
|
||||
where
|
||||
exop s =
|
||||
"-X" `isPrefixOf` s
|
||||
|| "-fplugin=" `isPrefixOf` s
|
||||
|| "-pgmF=" `isPrefixOf` s
|
||||
fromDyn tcm _ () =
|
||||
let
|
||||
df = getDynFlags tcm
|
||||
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 (("-X" <>) . show) $ S.toList $ D.extensionFlags df
|
||||
in
|
||||
return $ map DynOption $ pp <> pm <> ex
|
||||
fileOpts <- ifCachedModuleAndData fp cradleOpts fromDyn
|
||||
let
|
||||
conf o = Config o False False True False
|
||||
fmt :: T.Text -> [DynOption] -> IdeM (Either OrmoluException T.Text)
|
||||
fmt cont o =
|
||||
liftIO $ try @OrmoluException (ormolu (conf o) fp $ T.unpack cont)
|
||||
|
||||
case typ of
|
||||
FormatText -> ret (fullRange contents) <$> fmt contents cradleOpts
|
||||
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 ws new =
|
||||
fixE $ T.unlines $ map (ws `T.append`) $ fixS $ T.lines new
|
||||
mStrip = case txt of
|
||||
(l : _) ->
|
||||
let ws = fst $ T.span isSpace l
|
||||
in (,) ws . T.unlines <$> traverse (T.stripPrefix ws) txt
|
||||
_ -> Nothing
|
||||
err = return $ IdeResultFail
|
||||
(IdeError
|
||||
PluginError
|
||||
(T.pack
|
||||
"You must format a whole block of code. Ormolu does not support arbitrary ranges."
|
||||
)
|
||||
Null
|
||||
)
|
||||
fmt' (ws, striped) =
|
||||
ret (lineRange r) <$> (fmap (unStrip ws) <$> fmt striped fileOpts)
|
||||
in
|
||||
maybe err fmt' mStrip
|
||||
where
|
||||
ret _ (Left err) = IdeResultFail
|
||||
(IdeError PluginError (T.pack $ "ormoluCmd: " ++ show err) Null)
|
||||
ret r (Right new) = IdeResultOk [TextEdit r new]
|
||||
|
||||
exop s =
|
||||
"-X" `isPrefixOf` s || "-fplugin=" `isPrefixOf` s || "-pgmF=" `isPrefixOf` s
|
||||
#else
|
||||
return $ IdeResultOk [] -- NOP formatter
|
||||
provider _ _ _ _ = return $ IdeResultOk [] -- NOP formatter
|
||||
#endif
|
||||
|
Loading…
Reference in New Issue
Block a user