{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
module Ide.Plugin.Brittany where
import Control.Exception (bracket_)
import Control.Lens
import Control.Monad.IO.Class
import Control.Monad.Trans.Maybe (MaybeT, runMaybeT)
import Data.Coerce
import Data.Maybe (mapMaybe, maybeToList)
import Data.Semigroup
import Data.Text (Text)
import qualified Data.Text as T
import Development.IDE hiding (pluginHandlers)
import Development.IDE.GHC.Compat (ModSummary (ms_hspp_opts), topDir)
import qualified DynFlags as D
import qualified EnumSet as S
import GHC.LanguageExtensions.Type
import Ide.PluginUtils
import Ide.Types
import Language.Haskell.Brittany
import Language.LSP.Types as J
import qualified Language.LSP.Types.Lens as J
import System.Environment (setEnv, unsetEnv)
import System.FilePath
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor PluginId
plId = (PluginId -> PluginDescriptor IdeState
forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
{ pluginHandlers :: PluginHandlers IdeState
pluginHandlers = FormattingHandler IdeState -> PluginHandlers IdeState
forall a. FormattingHandler a -> PluginHandlers a
mkFormattingHandlers FormattingHandler IdeState
provider
}
provider :: FormattingHandler IdeState
provider :: FormattingHandler IdeState
provider IdeState
ide FormattingType
typ Text
contents NormalizedFilePath
nfp FormattingOptions
opts = IO (Either ResponseError (List TextEdit))
-> LspT Config IO (Either ResponseError (List TextEdit))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ResponseError (List TextEdit))
-> LspT Config IO (Either ResponseError (List TextEdit)))
-> IO (Either ResponseError (List TextEdit))
-> LspT Config IO (Either ResponseError (List TextEdit))
forall a b. (a -> b) -> a -> b
$ do
Maybe FilePath
confFile <- NormalizedFilePath -> IO (Maybe FilePath)
getConfFile NormalizedFilePath
nfp
let (Range
range, Text
selectedContents) = case FormattingType
typ of
FormattingType
FormatText -> (Text -> Range
fullRange Text
contents, Text
contents)
FormatRange Range
r -> (Range -> Range
normalize Range
r, Range -> Text -> Text
extractRange Range
r Text
contents)
ModSummary
modsum <- (ModSummaryResult -> ModSummary)
-> IO ModSummaryResult -> IO ModSummary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModSummaryResult -> ModSummary
msrModSummary (IO ModSummaryResult -> IO ModSummary)
-> IO ModSummaryResult -> IO ModSummary
forall a b. (a -> b) -> a -> b
$ FilePath
-> IdeState -> Action ModSummaryResult -> IO ModSummaryResult
forall a. FilePath -> IdeState -> Action a -> IO a
runAction FilePath
"brittany" IdeState
ide (Action ModSummaryResult -> IO ModSummaryResult)
-> Action ModSummaryResult -> IO ModSummaryResult
forall a b. (a -> b) -> a -> b
$ GetModSummaryWithoutTimestamps
-> NormalizedFilePath -> Action ModSummaryResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
nfp
let dflags :: DynFlags
dflags = ModSummary -> DynFlags
ms_hspp_opts ModSummary
modsum
let withRuntimeLibdir :: IO (Either [BrittanyError] Text)
-> IO (Either [BrittanyError] Text)
withRuntimeLibdir = IO ()
-> IO ()
-> IO (Either [BrittanyError] Text)
-> IO (Either [BrittanyError] Text)
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (FilePath -> FilePath -> IO ()
setEnv FilePath
key (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> FilePath
topDir DynFlags
dflags) (FilePath -> IO ()
unsetEnv FilePath
key)
where key :: FilePath
key = FilePath
"GHC_EXACTPRINT_GHC_LIBDIR"
Either [BrittanyError] Text
res <- IO (Either [BrittanyError] Text)
-> IO (Either [BrittanyError] Text)
withRuntimeLibdir (IO (Either [BrittanyError] Text)
-> IO (Either [BrittanyError] Text))
-> IO (Either [BrittanyError] Text)
-> IO (Either [BrittanyError] Text)
forall a b. (a -> b) -> a -> b
$ DynFlags
-> Maybe FilePath
-> FormattingOptions
-> Text
-> IO (Either [BrittanyError] Text)
forall (m :: * -> *).
MonadIO m =>
DynFlags
-> Maybe FilePath
-> FormattingOptions
-> Text
-> m (Either [BrittanyError] Text)
formatText DynFlags
dflags Maybe FilePath
confFile FormattingOptions
opts Text
selectedContents
case Either [BrittanyError] Text
res of
Left [BrittanyError]
err -> Either ResponseError (List TextEdit)
-> IO (Either ResponseError (List TextEdit))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError (List TextEdit)
-> IO (Either ResponseError (List TextEdit)))
-> Either ResponseError (List TextEdit)
-> IO (Either ResponseError (List TextEdit))
forall a b. (a -> b) -> a -> b
$ ResponseError -> Either ResponseError (List TextEdit)
forall a b. a -> Either a b
Left (ResponseError -> Either ResponseError (List TextEdit))
-> ResponseError -> Either ResponseError (List TextEdit)
forall a b. (a -> b) -> a -> b
$ Text -> ResponseError
responseError (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
"brittanyCmd: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unlines ((BrittanyError -> FilePath) -> [BrittanyError] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map BrittanyError -> FilePath
showErr [BrittanyError]
err))
Right Text
newText -> Either ResponseError (List TextEdit)
-> IO (Either ResponseError (List TextEdit))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError (List TextEdit)
-> IO (Either ResponseError (List TextEdit)))
-> Either ResponseError (List TextEdit)
-> IO (Either ResponseError (List TextEdit))
forall a b. (a -> b) -> a -> b
$ List TextEdit -> Either ResponseError (List TextEdit)
forall a b. b -> Either a b
Right (List TextEdit -> Either ResponseError (List TextEdit))
-> List TextEdit -> Either ResponseError (List TextEdit)
forall a b. (a -> b) -> a -> b
$ [TextEdit] -> List TextEdit
forall a. [a] -> List a
J.List [Range -> Text -> TextEdit
TextEdit Range
range Text
newText]
formatText
:: MonadIO m
=> D.DynFlags
-> Maybe FilePath
-> FormattingOptions
-> Text
-> m (Either [BrittanyError] Text)
formatText :: DynFlags
-> Maybe FilePath
-> FormattingOptions
-> Text
-> m (Either [BrittanyError] Text)
formatText DynFlags
df Maybe FilePath
confFile FormattingOptions
opts Text
text =
IO (Either [BrittanyError] Text) -> m (Either [BrittanyError] Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either [BrittanyError] Text)
-> m (Either [BrittanyError] Text))
-> IO (Either [BrittanyError] Text)
-> m (Either [BrittanyError] Text)
forall a b. (a -> b) -> a -> b
$ Int
-> DynFlags
-> Maybe FilePath
-> Text
-> IO (Either [BrittanyError] Text)
runBrittany Int
tabSize DynFlags
df Maybe FilePath
confFile Text
text
where tabSize :: Int
tabSize = FormattingOptions
opts FormattingOptions -> Getting Int FormattingOptions Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int FormattingOptions Int
forall s a. HasTabSize s a => Lens' s a
J.tabSize
getConfFile :: NormalizedFilePath -> IO (Maybe FilePath)
getConfFile :: NormalizedFilePath -> IO (Maybe FilePath)
getConfFile = FilePath -> IO (Maybe FilePath)
findLocalConfigPath (FilePath -> IO (Maybe FilePath))
-> (NormalizedFilePath -> FilePath)
-> NormalizedFilePath
-> IO (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeDirectory (FilePath -> FilePath)
-> (NormalizedFilePath -> FilePath)
-> NormalizedFilePath
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedFilePath -> FilePath
fromNormalizedFilePath
runBrittany :: Int
-> D.DynFlags
-> Maybe FilePath
-> Text
-> IO (Either [BrittanyError] Text)
runBrittany :: Int
-> DynFlags
-> Maybe FilePath
-> Text
-> IO (Either [BrittanyError] Text)
runBrittany Int
tabSize DynFlags
df Maybe FilePath
confPath Text
text = do
let cfg :: CConfig Option
cfg = CConfig Option
forall a. Monoid a => a
mempty
{ _conf_layout :: CLayoutConfig Option
_conf_layout =
CLayoutConfig Option
forall a. Monoid a => a
mempty { _lconfig_indentAmount :: Option (Last Int)
_lconfig_indentAmount = Last Int -> Option (Last Int)
forall a. a -> Option a
opt (Int -> Last Int
coerce Int
tabSize)
}
, _conf_forward :: CForwardOptions Option
_conf_forward =
(CForwardOptions Option
forall a. Monoid a => a
mempty :: CForwardOptions Option)
{ _options_ghc :: Option [FilePath]
_options_ghc = [FilePath] -> Option [FilePath]
forall a. a -> Option a
opt (DynFlags -> [FilePath]
getExtensions DynFlags
df)
}
}
Config
config <- IO Config -> MaybeT IO Config -> IO Config
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a -> m a
fromMaybeT (Config -> IO Config
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
staticDefaultConfig) (CConfig Option -> [FilePath] -> MaybeT IO Config
readConfigsWithUserConfig CConfig Option
cfg (Maybe FilePath -> [FilePath]
forall a. Maybe a -> [a]
maybeToList Maybe FilePath
confPath))
Config -> Text -> IO (Either [BrittanyError] Text)
parsePrintModule Config
config Text
text
fromMaybeT :: Monad m => m a -> MaybeT m a -> m a
fromMaybeT :: m a -> MaybeT m a -> m a
fromMaybeT m a
def MaybeT m a
act = MaybeT m a -> m (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT m a
act m (Maybe a) -> (Maybe a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m a
def a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
opt :: a -> Option a
opt :: a -> Option a
opt = Maybe a -> Option a
forall a. Maybe a -> Option a
Option (Maybe a -> Option a) -> (a -> Maybe a) -> a -> Option a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
showErr :: BrittanyError -> String
showErr :: BrittanyError -> FilePath
showErr (ErrorInput FilePath
s) = FilePath
s
showErr (ErrorMacroConfig FilePath
err FilePath
input)
= FilePath
"Error: parse error in inline configuration: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" in the string \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
input FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\"."
showErr (ErrorUnusedComment FilePath
s) = FilePath
s
showErr (LayoutWarning FilePath
s) = FilePath
s
showErr (ErrorUnknownNode FilePath
s GenLocated SrcSpan ast
_) = FilePath
s
showErr BrittanyError
ErrorOutputCheck = FilePath
"Brittany error - invalid output"
showExtension :: Extension -> Maybe String
showExtension :: Extension -> Maybe FilePath
showExtension Extension
Cpp = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"-XCPP"
showExtension Extension
DatatypeContexts = Maybe FilePath
forall a. Maybe a
Nothing
showExtension Extension
RecordPuns = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"-XNamedFieldPuns"
showExtension Extension
other = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"-X" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Extension -> FilePath
forall a. Show a => a -> FilePath
show Extension
other
getExtensions :: D.DynFlags -> [String]
getExtensions :: DynFlags -> [FilePath]
getExtensions = (Extension -> Maybe FilePath) -> [Extension] -> [FilePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Extension -> Maybe FilePath
showExtension ([Extension] -> [FilePath])
-> (DynFlags -> [Extension]) -> DynFlags -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumSet Extension -> [Extension]
forall a. Enum a => EnumSet a -> [a]
S.toList (EnumSet Extension -> [Extension])
-> (DynFlags -> EnumSet Extension) -> DynFlags -> [Extension]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> EnumSet Extension
D.extensionFlags