{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}

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

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

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

descriptor :: PluginId -> PluginDescriptor IdeState
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor PluginId
plId = (PluginId -> Text -> PluginDescriptor IdeState
forall ideState. PluginId -> Text -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId Text
desc)
  { pluginHandlers = mkFormattingHandlers provider
  }
  where
    desc :: Text
desc = Text
"Provides formatting of Haskell files via floskell. Built with floskell-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> VERSION_floskell

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

-- | 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 Maybe ProgressToken
_token FormattingType
typ Text
contents NormalizedFilePath
fp FormattingOptions
_ = do
    let file :: [Char]
file = NormalizedFilePath -> [Char]
fromNormalizedFilePath NormalizedFilePath
fp
    AppConfig
config <- IO AppConfig -> ExceptT PluginError (LspM Config) AppConfig
forall a. IO a -> ExceptT PluginError (LspM Config) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AppConfig -> ExceptT PluginError (LspM Config) AppConfig)
-> IO AppConfig -> ExceptT PluginError (LspM Config) AppConfig
forall a b. (a -> b) -> a -> b
$ [Char] -> IO AppConfig
findConfigOrDefault [Char]
file
    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
extractTextInRange (Range -> Range
extendToFullLines Range
r) Text
contents)
        result :: Either [Char] Text
result = AppConfig -> Maybe [Char] -> Text -> Either [Char] Text
reformat AppConfig
config ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
file) (Text -> Either [Char] Text) -> Text -> Either [Char] Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
selectedContents
    case Either [Char] Text
result of
      Left  [Char]
err -> PluginError
-> ExceptT PluginError (LspM Config) ([TextEdit] |? Null)
forall a. PluginError -> ExceptT PluginError (LspM Config) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError
 -> ExceptT PluginError (LspM Config) ([TextEdit] |? Null))
-> PluginError
-> ExceptT PluginError (LspM Config) ([TextEdit] |? Null)
forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInternalError (Text -> PluginError) -> Text -> PluginError
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"floskellCmd: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
err
      Right Text
new -> ([TextEdit] |? Null)
-> ExceptT PluginError (LspM Config) ([TextEdit] |? Null)
forall a. a -> ExceptT PluginError (LspM Config) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([TextEdit] |? Null)
 -> ExceptT PluginError (LspM Config) ([TextEdit] |? Null))
-> ([TextEdit] |? Null)
-> ExceptT PluginError (LspM Config) ([TextEdit] |? Null)
forall a b. (a -> b) -> a -> b
$ [TextEdit] -> [TextEdit] |? Null
forall a b. a -> a |? b
InL [Range -> Text -> TextEdit
TextEdit Range
range (Text -> TextEdit) -> Text -> TextEdit
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.toStrict Text
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 :: [Char] -> IO AppConfig
findConfigOrDefault [Char]
file = do
  Maybe [Char]
mbConf <- [Char] -> IO (Maybe [Char])
findAppConfigIn [Char]
file
  case Maybe [Char]
mbConf of
    Just [Char]
confFile -> [Char] -> IO AppConfig
readAppConfig [Char]
confFile
    Maybe [Char]
Nothing ->
      let gibiansky :: Style
gibiansky = [Style] -> Style
forall a. HasCallStack => [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 a. a -> IO a
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 = gibiansky }

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