{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}

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

import           Control.Exception               (try)
import           Control.Monad.IO.Class          (liftIO)
import qualified Data.Text                       as T
import           Development.IDE                 hiding (pluginHandlers)
import           Development.IDE.GHC.Compat      (hsc_dflags, moduleNameString)
import qualified Development.IDE.GHC.Compat      as D
import qualified Development.IDE.GHC.Compat.Util as S
import           GHC.LanguageExtensions.Type
import           Ide.PluginUtils
import           Ide.Types
import           Language.LSP.Server             hiding (defaultConfig)
import           Language.LSP.Types
import           Ormolu
import           System.FilePath                 (takeFileName)

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

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
  }

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

provider :: FormattingHandler IdeState
provider :: FormattingHandler IdeState
provider IdeState
ideState FormattingType
typ Text
contents NormalizedFilePath
fp FormattingOptions
_ = Text
-> ProgressCancellable
-> LspT Config IO (Either ResponseError (List TextEdit))
-> LspT Config IO (Either ResponseError (List TextEdit))
forall c (m :: * -> *) a.
MonadLsp c m =>
Text -> ProgressCancellable -> m a -> m a
withIndefiniteProgress Text
title ProgressCancellable
Cancellable (LspT Config IO (Either ResponseError (List TextEdit))
 -> LspT Config IO (Either ResponseError (List TextEdit)))
-> LspT Config IO (Either ResponseError (List TextEdit))
-> LspT Config IO (Either ResponseError (List TextEdit))
forall a b. (a -> b) -> a -> b
$ 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
  Maybe HscEnvEq
ghc <- String
-> IdeState -> Action (Maybe HscEnvEq) -> IO (Maybe HscEnvEq)
forall a. String -> IdeState -> Action a -> IO a
runAction String
"Ormolu" IdeState
ideState (Action (Maybe HscEnvEq) -> IO (Maybe HscEnvEq))
-> Action (Maybe HscEnvEq) -> IO (Maybe HscEnvEq)
forall a b. (a -> b) -> a -> b
$ GhcSession -> NormalizedFilePath -> Action (Maybe HscEnvEq)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GhcSession
GhcSession NormalizedFilePath
fp
  let df :: Maybe DynFlags
df = HscEnv -> DynFlags
hsc_dflags (HscEnv -> DynFlags)
-> (HscEnvEq -> HscEnv) -> HscEnvEq -> DynFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnvEq -> HscEnv
hscEnv (HscEnvEq -> DynFlags) -> Maybe HscEnvEq -> Maybe DynFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe HscEnvEq
ghc
  [DynOption]
fileOpts <- case Maybe DynFlags
df of
    Maybe DynFlags
Nothing -> [DynOption] -> IO [DynOption]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Just DynFlags
df -> [DynOption] -> IO [DynOption]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([DynOption] -> IO [DynOption]) -> [DynOption] -> IO [DynOption]
forall a b. (a -> b) -> a -> b
$ DynFlags -> [DynOption]
fromDyn DynFlags
df

  let
    fullRegion :: RegionIndices
fullRegion = Maybe Int -> Maybe Int -> RegionIndices
RegionIndices Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing
    rangeRegion :: Int -> Int -> RegionIndices
rangeRegion Int
s Int
e = Maybe Int -> Maybe Int -> RegionIndices
RegionIndices (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    mkConf :: [DynOption] -> region -> Config region
mkConf [DynOption]
o region
region = Config RegionIndices
defaultConfig { cfgDynOptions :: [DynOption]
cfgDynOptions = [DynOption]
o, cfgRegion :: region
cfgRegion = region
region }
    fmt :: T.Text -> Config RegionIndices -> IO (Either OrmoluException T.Text)
    fmt :: Text -> Config RegionIndices -> IO (Either OrmoluException Text)
fmt Text
cont Config RegionIndices
conf =
      forall a.
Exception OrmoluException =>
IO a -> IO (Either OrmoluException a)
forall e a. Exception e => IO a -> IO (Either e a)
try @OrmoluException (IO Text -> IO (Either OrmoluException Text))
-> IO Text -> IO (Either OrmoluException Text)
forall a b. (a -> b) -> a -> b
$ Config RegionIndices -> String -> String -> IO Text
forall (m :: * -> *).
MonadIO m =>
Config RegionIndices -> String -> String -> m Text
ormolu Config RegionIndices
conf (NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
fp) (String -> IO Text) -> String -> IO Text
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
cont

  case FormattingType
typ of
    FormattingType
FormatText -> Either OrmoluException Text -> Either ResponseError (List TextEdit)
ret (Either OrmoluException Text
 -> Either ResponseError (List TextEdit))
-> IO (Either OrmoluException Text)
-> IO (Either ResponseError (List TextEdit))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Config RegionIndices -> IO (Either OrmoluException Text)
fmt Text
contents ([DynOption] -> RegionIndices -> Config RegionIndices
forall region. [DynOption] -> region -> Config region
mkConf [DynOption]
fileOpts RegionIndices
fullRegion)
    FormatRange (Range (Position UInt
sl UInt
_) (Position UInt
el UInt
_)) ->
      Either OrmoluException Text -> Either ResponseError (List TextEdit)
ret (Either OrmoluException Text
 -> Either ResponseError (List TextEdit))
-> IO (Either OrmoluException Text)
-> IO (Either ResponseError (List TextEdit))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Config RegionIndices -> IO (Either OrmoluException Text)
fmt Text
contents ([DynOption] -> RegionIndices -> Config RegionIndices
forall region. [DynOption] -> region -> Config region
mkConf [DynOption]
fileOpts (Int -> Int -> RegionIndices
rangeRegion (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
sl) (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
el)))
 where
   title :: Text
title = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Formatting " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
takeFileName (NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
fp)

   ret :: Either OrmoluException T.Text -> Either ResponseError (List TextEdit)
   ret :: Either OrmoluException Text -> Either ResponseError (List TextEdit)
ret (Left OrmoluException
err)  = ResponseError -> Either ResponseError (List TextEdit)
forall a b. a -> Either a b
Left (ResponseError -> Either ResponseError (List TextEdit))
-> (String -> ResponseError)
-> String
-> Either ResponseError (List TextEdit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ResponseError
responseError (Text -> ResponseError)
-> (String -> Text) -> String -> ResponseError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Either ResponseError (List TextEdit))
-> String -> Either ResponseError (List TextEdit)
forall a b. (a -> b) -> a -> b
$ String
"ormoluCmd: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ OrmoluException -> String
forall a. Show a => a -> String
show OrmoluException
err
   ret (Right Text
new) = 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
$ Text -> Text -> List TextEdit
makeDiffTextEdit Text
contents Text
new

   fromDyn :: D.DynFlags -> [DynOption]
   fromDyn :: DynFlags -> [DynOption]
fromDyn DynFlags
df =
     let
       pp :: [String]
pp =
         let p :: String
p = Settings -> String
D.sPgm_F (Settings -> String) -> Settings -> String
forall a b. (a -> b) -> a -> b
$ DynFlags -> Settings
D.settings DynFlags
df
         in  [String
"-pgmF=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
p | Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
p)]
       pm :: [String]
pm = (String
"-fplugin=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (String -> String)
-> (ModuleName -> String) -> ModuleName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
moduleNameString (ModuleName -> String) -> [ModuleName] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynFlags -> [ModuleName]
D.pluginModNames DynFlags
df
       ex :: [String]
ex = Extension -> String
showExtension (Extension -> String) -> [Extension] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnumSet Extension -> [Extension]
forall a. Enum a => EnumSet a -> [a]
S.toList (DynFlags -> EnumSet Extension
D.extensionFlags DynFlags
df)
     in
       String -> DynOption
DynOption (String -> DynOption) -> [String] -> [DynOption]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
pp [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
pm [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
ex

showExtension :: Extension -> String
showExtension :: Extension -> String
showExtension Extension
Cpp   = String
"-XCPP"
showExtension Extension
other = String
"-X" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Extension -> String
forall a. Show a => a -> String
show Extension
other