module Development.IDE.Plugin.HLS.Formatter
  (
    formatting
  , rangeFormatting
  )
where

import qualified Data.Map  as Map
import qualified Data.Text as T
import           Development.IDE
import           Ide.PluginUtils
import           Ide.Types
import           Ide.Plugin.Config
import qualified Language.Haskell.LSP.Core as LSP
import           Language.Haskell.LSP.Types
import           Text.Regex.TDFA.Text()

-- ---------------------------------------------------------------------


formatting :: Map.Map PluginId (FormattingProvider IdeState IO)
           -> LSP.LspFuncs Config -> IdeState -> DocumentFormattingParams
           -> IO (Either ResponseError (List TextEdit))
formatting :: Map PluginId (FormattingProvider IdeState IO)
-> LspFuncs Config
-> IdeState
-> DocumentFormattingParams
-> IO (Either ResponseError (List TextEdit))
formatting Map PluginId (FormattingProvider IdeState IO)
providers LspFuncs Config
lf IdeState
ideState
    (DocumentFormattingParams (TextDocumentIdentifier Uri
uri) FormattingOptions
params Maybe ProgressToken
_mprogress)
  = LspFuncs Config
-> Map PluginId (FormattingProvider IdeState IO)
-> IdeState
-> FormattingType
-> Uri
-> FormattingOptions
-> IO (Either ResponseError (List TextEdit))
doFormatting LspFuncs Config
lf Map PluginId (FormattingProvider IdeState IO)
providers IdeState
ideState FormattingType
FormatText Uri
uri FormattingOptions
params

-- ---------------------------------------------------------------------


rangeFormatting :: Map.Map PluginId (FormattingProvider IdeState IO)
                -> LSP.LspFuncs Config -> IdeState -> DocumentRangeFormattingParams
                -> IO (Either ResponseError (List TextEdit))
rangeFormatting :: Map PluginId (FormattingProvider IdeState IO)
-> LspFuncs Config
-> IdeState
-> DocumentRangeFormattingParams
-> IO (Either ResponseError (List TextEdit))
rangeFormatting Map PluginId (FormattingProvider IdeState IO)
providers LspFuncs Config
lf IdeState
ideState
    (DocumentRangeFormattingParams (TextDocumentIdentifier Uri
uri) Range
range FormattingOptions
params Maybe ProgressToken
_mprogress)
  = LspFuncs Config
-> Map PluginId (FormattingProvider IdeState IO)
-> IdeState
-> FormattingType
-> Uri
-> FormattingOptions
-> IO (Either ResponseError (List TextEdit))
doFormatting LspFuncs Config
lf Map PluginId (FormattingProvider IdeState IO)
providers IdeState
ideState (Range -> FormattingType
FormatRange Range
range) Uri
uri FormattingOptions
params

-- ---------------------------------------------------------------------


doFormatting :: LSP.LspFuncs Config -> Map.Map PluginId (FormattingProvider IdeState IO)
             -> IdeState -> FormattingType -> Uri -> FormattingOptions
             -> IO (Either ResponseError (List TextEdit))
doFormatting :: LspFuncs Config
-> Map PluginId (FormattingProvider IdeState IO)
-> IdeState
-> FormattingType
-> Uri
-> FormattingOptions
-> IO (Either ResponseError (List TextEdit))
doFormatting LspFuncs Config
lf Map PluginId (FormattingProvider IdeState IO)
providers IdeState
ideState FormattingType
ft Uri
uri FormattingOptions
params = do
  Maybe Config
mc <- LspFuncs Config -> IO (Maybe Config)
forall c. LspFuncs c -> IO (Maybe c)
LSP.config LspFuncs Config
lf
  let mf :: Text
mf = Text -> (Config -> Text) -> Maybe Config -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"none" Config -> Text
formattingProvider Maybe Config
mc
  case PluginId
-> Map PluginId (FormattingProvider IdeState IO)
-> Maybe (FormattingProvider IdeState IO)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text -> PluginId
PluginId Text
mf) Map PluginId (FormattingProvider IdeState IO)
providers of
      Just FormattingProvider IdeState IO
provider ->
        case Uri -> Maybe FilePath
uriToFilePath Uri
uri of
          Just (FilePath -> NormalizedFilePath
toNormalizedFilePath -> NormalizedFilePath
fp) -> do
            (UTCTime
_, Maybe Text
mb_contents) <- FilePath
-> IdeState
-> Action (UTCTime, Maybe Text)
-> IO (UTCTime, Maybe Text)
forall a. FilePath -> IdeState -> Action a -> IO a
runAction FilePath
"Formatter" IdeState
ideState (Action (UTCTime, Maybe Text) -> IO (UTCTime, Maybe Text))
-> Action (UTCTime, Maybe Text) -> IO (UTCTime, Maybe Text)
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> Action (UTCTime, Maybe Text)
getFileContents NormalizedFilePath
fp
            case Maybe Text
mb_contents of
              Just Text
contents -> do
                  Logger -> Text -> IO ()
logDebug (IdeState -> Logger
ideLogger IdeState
ideState) (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$
                      FilePath
"Formatter.doFormatting: contents=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Text -> FilePath
forall a. Show a => a -> FilePath
show Text
contents -- AZ

                  FormattingProvider IdeState IO
provider LspFuncs Config
lf IdeState
ideState FormattingType
ft Text
contents NormalizedFilePath
fp FormattingOptions
params
              Maybe Text
Nothing -> 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 (Text -> ResponseError) -> Text -> ResponseError
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
"Formatter plugin: could not get file contents for " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Uri -> FilePath
forall a. Show a => a -> FilePath
show Uri
uri
          Maybe FilePath
Nothing -> 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 (Text -> ResponseError) -> Text -> ResponseError
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
"Formatter plugin: uriToFilePath failed for: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Uri -> FilePath
forall a. Show a => a -> FilePath
show Uri
uri
      Maybe (FormattingProvider IdeState IO)
Nothing -> 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 (Text -> ResponseError) -> Text -> ResponseError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"Formatter plugin: no formatter found for:["
        , Text
mf
        , Text
"]"
        , if Text
mf Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"brittany"
          then [Text] -> Text
T.unlines
            [ Text
"\nThe haskell-language-server must be compiled with the agpl flag to provide Brittany."
            , Text
"Stack users add 'agpl: true' in the flags section of the 'stack.yaml' file."
            , Text
"The 'haskell-language-server.cabal' file already has this flag enabled by default."
            , Text
"For more information see: https://github.com/haskell/haskell-language-server/issues/269"
            ]
          else Text
""
        ]