{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}

module Ide.Plugin.Formatter
  (
    formatting
  , rangeFormatting
  , noneProvider
  , responseError
  , extractRange
  , fullRange
  )
where

import qualified Data.Map  as Map
import qualified Data.Text as T
import           Development.IDE
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 IO)
           -> LSP.LspFuncs Config -> IdeState -> DocumentFormattingParams
           -> IO (Either ResponseError (List TextEdit))
formatting :: Map PluginId (FormattingProvider IO)
-> LspFuncs Config
-> IdeState
-> DocumentFormattingParams
-> IO (Either ResponseError (List TextEdit))
formatting Map PluginId (FormattingProvider IO)
providers LspFuncs Config
lf IdeState
ideState
    (DocumentFormattingParams (TextDocumentIdentifier Uri
uri) FormattingOptions
params Maybe ProgressToken
_mprogress)
  = LspFuncs Config
-> Map PluginId (FormattingProvider IO)
-> IdeState
-> FormattingType
-> Uri
-> FormattingOptions
-> IO (Either ResponseError (List TextEdit))
doFormatting LspFuncs Config
lf Map PluginId (FormattingProvider IO)
providers IdeState
ideState FormattingType
FormatText Uri
uri FormattingOptions
params

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

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

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

doFormatting :: LSP.LspFuncs Config -> Map.Map PluginId (FormattingProvider IO)
             -> IdeState -> FormattingType -> Uri -> FormattingOptions
             -> IO (Either ResponseError (List TextEdit))
doFormatting :: LspFuncs Config
-> Map PluginId (FormattingProvider IO)
-> IdeState
-> FormattingType
-> Uri
-> FormattingOptions
-> IO (Either ResponseError (List TextEdit))
doFormatting LspFuncs Config
lf Map PluginId (FormattingProvider 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 IO)
-> Maybe (FormattingProvider IO)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text -> PluginId
PluginId Text
mf) Map PluginId (FormattingProvider IO)
providers of
      Just FormattingProvider 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 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 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
""
        ]

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

noneProvider :: FormattingProvider IO
noneProvider :: FormattingProvider IO
noneProvider LspFuncs Config
_ IdeState
_ FormattingType
_ Text
_ NormalizedFilePath
_ FormattingOptions
_ = 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 ([TextEdit] -> List TextEdit
forall a. [a] -> List a
List [])

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

responseError :: T.Text -> ResponseError
responseError :: Text -> ResponseError
responseError Text
txt = ErrorCode -> Text -> Maybe Value -> ResponseError
ResponseError ErrorCode
InvalidParams Text
txt Maybe Value
forall a. Maybe a
Nothing

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

extractRange :: Range -> T.Text -> T.Text
extractRange :: Range -> Text -> Text
extractRange (Range (Position Int
sl Int
_) (Position Int
el Int
_)) Text
s = Text
newS
  where focusLines :: [Text]
focusLines = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take (Int
elInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
slInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
sl ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
s
        newS :: Text
newS = [Text] -> Text
T.unlines [Text]
focusLines

-- | Gets the range that covers the entire text
fullRange :: T.Text -> Range
fullRange :: Text -> Range
fullRange Text
s = Position -> Position -> Range
Range Position
startPos Position
endPos
  where startPos :: Position
startPos = Int -> Int -> Position
Position Int
0 Int
0
        endPos :: Position
endPos = Int -> Int -> Position
Position Int
lastLine Int
0
        {-
        In order to replace everything including newline characters,
        the end range should extend below the last line. From the specification:
        "If you want to specify a range that contains a line including
        the line ending character(s) then use an end position denoting
        the start of the next line"
        -}
        lastLine :: Int
lastLine = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> Int) -> [Text] -> Int
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
s

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