{-# 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
  }

-- | Formatter provider of stylish-haskell.
-- 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 :: 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

-- | Recursively search in every directory of the given filepath for .stylish-haskell.yaml.
-- If no such file has been found, return default config.
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

-- | Run stylish-haskell on the given text with the given configuration.
runStylishHaskell :: FilePath           -- ^ Location of the file being formatted. Used for error message
                  -> Config             -- ^ Configuration for stylish-haskell
                  -> Text               -- ^ Text to format
                  -> Either String Text -- ^ Either formatted Text or an error message
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