{-# LANGUAGE OverloadedStrings #-}

module Ide.Plugin.Floskell
  ( descriptor
  , provider
  ) where

import           Control.Monad.IO.Class
import qualified Data.Text               as T
import qualified Data.Text.Lazy          as TL
import qualified Data.Text.Lazy.Encoding as TL
import           Development.IDE         hiding (pluginHandlers)
import           Floskell
import           Ide.PluginUtils
import           Ide.Types
import           Language.LSP.Types

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

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
  }

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

-- | Format provider of Floskell.
-- 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
_ideState FormattingType
typ Text
contents NormalizedFilePath
fp FormattingOptions
_ = 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
    let file :: FilePath
file = NormalizedFilePath -> FilePath
fromNormalizedFilePath NormalizedFilePath
fp
    AppConfig
config <- FilePath -> IO AppConfig
findConfigOrDefault FilePath
file
    let (Range
range, Text
selectedContents) = case FormattingType
typ of
          FormattingType
FormatText    -> (Text -> Range
fullRange Text
contents, Text
contents)
          FormatRange Range
r -> (Range
r, Range -> Text -> Text
extractRange Range
r Text
contents)
        result :: Either FilePath ByteString
result = AppConfig
-> Maybe FilePath -> ByteString -> Either FilePath ByteString
reformat AppConfig
config (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
file) (ByteString -> Either FilePath ByteString)
-> (Text -> ByteString) -> Text -> Either FilePath ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TL.encodeUtf8 (Text -> Either FilePath ByteString)
-> Text -> Either FilePath ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
selectedContents
    case Either FilePath ByteString
result of
      Left  FilePath
err -> Either ResponseError (List TextEdit)
-> IO (Either ResponseError (List TextEdit))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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
"floskellCmd: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err
      Right ByteString
new -> Either ResponseError (List TextEdit)
-> IO (Either ResponseError (List TextEdit))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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
List [Range -> Text -> TextEdit
TextEdit Range
range (Text -> TextEdit) -> (Text -> Text) -> Text -> TextEdit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict (Text -> TextEdit) -> Text -> TextEdit
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TL.decodeUtf8 ByteString
new]

-- | Find Floskell Config, user and system wide or provides a default style.
-- Every directory of the filepath will be searched to find a user configuration.
-- Also looks into places such as XDG_CONFIG_DIRECTORY<https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html>.
-- This function may not throw an exception and returns a default config.
findConfigOrDefault :: FilePath -> IO AppConfig
findConfigOrDefault :: FilePath -> IO AppConfig
findConfigOrDefault FilePath
file = do
  Maybe FilePath
mbConf <- FilePath -> IO (Maybe FilePath)
findAppConfigIn FilePath
file
  case Maybe FilePath
mbConf of
    Just FilePath
confFile -> FilePath -> IO AppConfig
readAppConfig FilePath
confFile
    Maybe FilePath
Nothing ->
      let gibiansky :: Style
gibiansky = [Style] -> Style
forall a. [a] -> a
head ((Style -> Bool) -> [Style] -> [Style]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Style
s -> Style -> Text
styleName Style
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"gibiansky") [Style]
styles)
      in AppConfig -> IO AppConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AppConfig -> IO AppConfig) -> AppConfig -> IO AppConfig
forall a b. (a -> b) -> a -> b
$ AppConfig
defaultAppConfig { appStyle :: Style
appStyle = Style
gibiansky }

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