{-# LANGUAGE OverloadedStrings #-}
module Ide.Plugin.StylishHaskell
( descriptor
, provider
)
where
import Control.Monad.IO.Class
import Data.Text (Text)
import qualified Data.Text as T
import Development.IDE hiding (pluginHandlers)
import Development.IDE.GHC.Compat (ModSummary (ms_hspp_opts),
extensionFlags)
import qualified Development.IDE.GHC.Compat.Util as Util
import GHC.LanguageExtensions.Type
import Ide.PluginUtils
import Ide.Types hiding (Config)
import Language.Haskell.Stylish
import Language.LSP.Types as J
import System.Directory
import System.FilePath
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor PluginId
plId = (forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
{ pluginHandlers :: PluginHandlers IdeState
pluginHandlers = forall a. FormattingHandler a -> PluginHandlers a
mkFormattingHandlers FormattingHandler IdeState
provider
}
provider :: FormattingHandler IdeState
provider :: FormattingHandler IdeState
provider IdeState
ide FormattingType
typ Text
contents NormalizedFilePath
fp FormattingOptions
_opts = do
DynFlags
dyn <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ModSummary -> DynFlags
ms_hspp_opts forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummaryResult -> ModSummary
msrModSummary) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. String -> IdeState -> Action a -> IO a
runAction String
"stylish-haskell" IdeState
ide forall a b. (a -> b) -> a -> b
$ forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModSummary
GetModSummary NormalizedFilePath
fp
let file :: String
file = NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
fp
Config
config <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Config
loadConfigFrom String
file
Config
mergedConfig <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DynFlags -> Config -> IO Config
getMergedConfig DynFlags
dyn Config
config
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)
result :: Either String Text
result = String -> Config -> Text -> Either String Text
runStylishHaskell String
file Config
mergedConfig Text
selectedContents
case Either String Text
result of
Left String
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> ResponseError
responseError forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"stylishHaskellCmd: " forall a. [a] -> [a] -> [a]
++ String
err
Right Text
new -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
J.List [Range -> Text -> TextEdit
TextEdit Range
range Text
new]
where
getMergedConfig :: DynFlags -> Config -> IO Config
getMergedConfig DynFlags
dyn Config
config
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Config -> [String]
configLanguageExtensions Config
config)
= do
Logger -> Text -> IO ()
logInfo (IdeState -> Logger
ideLogger IdeState
ide) Text
"stylish-haskell uses the language extensions from DynFlags"
forall (f :: * -> *) a. Applicative f => a -> f a
pure
forall a b. (a -> b) -> a -> b
$ Config
config
{ configLanguageExtensions :: [String]
configLanguageExtensions = DynFlags -> [String]
getExtensions DynFlags
dyn }
| Bool
otherwise
= forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config
getExtensions :: DynFlags -> [String]
getExtensions = forall a b. (a -> b) -> [a] -> [b]
map Extension -> String
showExtension forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => EnumSet a -> [a]
Util.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> EnumSet Extension
extensionFlags
showExtension :: Extension -> String
showExtension Extension
Cpp = String
"CPP"
showExtension Extension
other = forall a. Show a => a -> String
show Extension
other
loadConfigFrom :: FilePath -> IO Config
loadConfigFrom :: String -> IO Config
loadConfigFrom String
file = do
String
currDir <- IO String
getCurrentDirectory
String -> IO ()
setCurrentDirectory (String -> String
takeDirectory String
file)
Config
config <- (String -> IO ()) -> Maybe String -> IO Config
loadConfig (Bool -> String -> IO ()
makeVerbose Bool
False) forall a. Maybe a
Nothing
String -> IO ()
setCurrentDirectory String
currDir
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config
runStylishHaskell :: FilePath
-> Config
-> Text
-> Either String Text
runStylishHaskell :: String -> Config -> Text -> Either String Text
runStylishHaskell String
file Config
config = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> Text
fromLines forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Either String [String]
fmt forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [String]
toLines
where
fromLines :: [String] -> Text
fromLines = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines
fmt :: [String] -> Either String [String]
fmt = [String]
-> Maybe String -> [Step] -> [String] -> Either String [String]
runSteps (Config -> [String]
configLanguageExtensions Config
config) (forall a. a -> Maybe a
Just String
file) (Config -> [Step]
configSteps Config
config)
toLines :: Text -> [String]
toLines = String -> [String]
lines forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack