{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE LambdaCase               #-}
{-# LANGUAGE OverloadedStrings        #-}
{-# LANGUAGE TypeApplications         #-}
{-# LANGUAGE DataKinds                #-}
{-# LANGUAGE OverloadedLabels         #-}

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

import           Control.Exception               (IOException, try)
import           Control.Lens                    ((^.))
import           Control.Monad
import           Control.Monad.IO.Class
import           Data.Bifunctor                  (first)
import           Data.Maybe
import qualified Data.Text                       as T
import qualified Data.Text.IO                    as T
import           Development.IDE                 hiding (pluginHandlers)
import           Development.IDE.GHC.Compat      as Compat hiding (Cpp)
import qualified Development.IDE.GHC.Compat.Util as S
import           GHC.LanguageExtensions.Type     (Extension (Cpp))
import           Ide.Plugin.Properties
import           Ide.PluginUtils                 (makeDiffTextEdit, usePropertyLsp)
import           Ide.Types
import           Language.LSP.Server             hiding (defaultConfig)
import           Language.LSP.Types
import           Language.LSP.Types.Lens         (HasTabSize (tabSize))
import           Ormolu
import           System.Exit
import           System.FilePath
import           System.IO                       (stderr)
import           System.Process.Run              (proc, cwd)
import           System.Process.Text             (readCreateProcessWithExitCode)

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 -> PluginHandlers IdeState)
-> FormattingHandler IdeState -> PluginHandlers IdeState
forall a b. (a -> b) -> a -> b
$ PluginId -> FormattingHandler IdeState
provider PluginId
plId
        }

properties :: Properties '[ 'PropertyKey "external" 'TBoolean]
properties :: Properties '[ 'PropertyKey "external" 'TBoolean]
properties =
    Properties '[]
emptyProperties
        Properties '[]
-> (Properties '[]
    -> Properties '[ 'PropertyKey "external" 'TBoolean])
-> Properties '[ 'PropertyKey "external" 'TBoolean]
forall a b. a -> (a -> b) -> b
& KeyNameProxy "external"
-> Text
-> Bool
-> Properties '[]
-> Properties '[ 'PropertyKey "external" 'TBoolean]
forall (s :: Symbol) (r :: [PropertyKey]).
(KnownSymbol s, NotElem s r) =>
KeyNameProxy s
-> Text
-> Bool
-> Properties r
-> Properties ('PropertyKey s 'TBoolean : r)
defineBooleanProperty
            #external
            Text
"Call out to an external \"fourmolu\" executable, rather than using the bundled library"
            Bool
False

provider :: PluginId -> FormattingHandler IdeState
provider :: PluginId -> FormattingHandler IdeState
provider PluginId
plId IdeState
ideState FormattingType
typ Text
contents NormalizedFilePath
fp FormattingOptions
fo = 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
$ do
    [String]
fileOpts <-
        [String] -> (HscEnvEq -> [String]) -> Maybe HscEnvEq -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (DynFlags -> [String]
convertDynFlags (DynFlags -> [String])
-> (HscEnvEq -> DynFlags) -> HscEnvEq -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnv -> DynFlags
hsc_dflags (HscEnv -> DynFlags)
-> (HscEnvEq -> HscEnv) -> HscEnvEq -> DynFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnvEq -> HscEnv
hscEnv)
            (Maybe HscEnvEq -> [String])
-> LspT Config IO (Maybe HscEnvEq) -> LspT Config IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe HscEnvEq) -> LspT Config IO (Maybe HscEnvEq)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String
-> IdeState -> Action (Maybe HscEnvEq) -> IO (Maybe HscEnvEq)
forall a. String -> IdeState -> Action a -> IO a
runAction String
"Fourmolu" 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)
    Bool
useCLI <- KeyNameProxy "external"
-> PluginId
-> Properties '[ 'PropertyKey "external" 'TBoolean]
-> LspT Config IO (ToHsType 'TBoolean)
forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]) (m :: * -> *).
(HasProperty s k t r, MonadLsp Config m) =>
KeyNameProxy s -> PluginId -> Properties r -> m (ToHsType t)
usePropertyLsp IsLabel "external" (KeyNameProxy "external")
KeyNameProxy "external"
#external PluginId
plId Properties '[ 'PropertyKey "external" 'TBoolean]
properties
    if Bool
useCLI
        then 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))
    -> IO (Either ResponseError (List TextEdit)))
-> IO (Either ResponseError (List TextEdit))
-> LspT Config IO (Either ResponseError (List TextEdit))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either IOException (Either ResponseError (List TextEdit))
 -> Either ResponseError (List TextEdit))
-> IO (Either IOException (Either ResponseError (List TextEdit)))
-> IO (Either ResponseError (List TextEdit))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either ResponseError (Either ResponseError (List TextEdit))
-> Either ResponseError (List TextEdit)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either ResponseError (Either ResponseError (List TextEdit))
 -> Either ResponseError (List TextEdit))
-> (Either IOException (Either ResponseError (List TextEdit))
    -> Either ResponseError (Either ResponseError (List TextEdit)))
-> Either IOException (Either ResponseError (List TextEdit))
-> Either ResponseError (List TextEdit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IOException -> ResponseError)
-> Either IOException (Either ResponseError (List TextEdit))
-> Either ResponseError (Either ResponseError (List TextEdit))
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> ResponseError
mkError (String -> ResponseError)
-> (IOException -> String) -> IOException -> ResponseError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> String
forall a. Show a => a -> String
show))
            (IO (Either IOException (Either ResponseError (List TextEdit)))
 -> IO (Either ResponseError (List TextEdit)))
-> (IO (Either ResponseError (List TextEdit))
    -> IO (Either IOException (Either ResponseError (List TextEdit))))
-> IO (Either ResponseError (List TextEdit))
-> IO (Either ResponseError (List TextEdit))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Exception IOException =>
IO a -> IO (Either IOException a)
forall e a. Exception e => IO a -> IO (Either e a)
try @IOException
            (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
                (ExitCode
exitCode, Text
out, Text
err) <-
                    CreateProcess -> Text -> IO (ExitCode, Text, Text)
readCreateProcessWithExitCode
                        ( String -> [String] -> CreateProcess
proc String
"fourmolu" ([String] -> CreateProcess) -> [String] -> CreateProcess
forall a b. (a -> b) -> a -> b
$
                            [String
"-d"]
                                [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes
                                    [ (String
"--start-line=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Maybe Int -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RegionIndices -> Maybe Int
regionStartLine RegionIndices
region
                                    , (String
"--end-line=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Maybe Int -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RegionIndices -> Maybe Int
regionEndLine RegionIndices
region
                                    ]
                                [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"-o" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) [String]
fileOpts
                        ){cwd :: Maybe String
cwd = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
fp'}
                        Text
contents
                Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr Text
err
                case ExitCode
exitCode of
                    ExitCode
ExitSuccess ->
                        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)))
-> (List TextEdit -> Either ResponseError (List TextEdit))
-> List TextEdit
-> IO (Either ResponseError (List TextEdit))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List TextEdit -> Either ResponseError (List TextEdit)
forall a b. b -> Either a b
Right (List TextEdit -> IO (Either ResponseError (List TextEdit)))
-> List TextEdit -> IO (Either ResponseError (List TextEdit))
forall a b. (a -> b) -> a -> b
$ Text -> Text -> List TextEdit
makeDiffTextEdit Text
contents Text
out
                    ExitFailure Int
n ->
                        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)))
-> (Text -> Either ResponseError (List TextEdit))
-> Text
-> IO (Either ResponseError (List TextEdit))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResponseError -> Either ResponseError (List TextEdit)
forall a b. a -> Either a b
Left (ResponseError -> Either ResponseError (List TextEdit))
-> (Text -> ResponseError)
-> Text
-> Either ResponseError (List TextEdit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ResponseError
responseError (Text -> IO (Either ResponseError (List TextEdit)))
-> Text -> IO (Either ResponseError (List TextEdit))
forall a b. (a -> b) -> a -> b
$ Text
"Fourmolu failed with exit code " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
n)
        else do
            let format :: PrinterOpts Maybe -> IO (Either ResponseError (List TextEdit))
format PrinterOpts Maybe
printerOpts =
                    (OrmoluException -> ResponseError)
-> Either OrmoluException (List TextEdit)
-> Either ResponseError (List TextEdit)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> ResponseError
mkError (String -> ResponseError)
-> (OrmoluException -> String) -> OrmoluException -> ResponseError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrmoluException -> String
forall a. Show a => a -> String
show)
                        (Either OrmoluException (List TextEdit)
 -> Either ResponseError (List TextEdit))
-> IO (Either OrmoluException (List TextEdit))
-> IO (Either ResponseError (List TextEdit))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (List TextEdit) -> IO (Either OrmoluException (List TextEdit))
forall e a. Exception e => IO a -> IO (Either e a)
try @OrmoluException (Text -> Text -> List TextEdit
makeDiffTextEdit Text
contents (Text -> List TextEdit) -> IO Text -> IO (List TextEdit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config RegionIndices -> String -> String -> IO Text
forall (m :: * -> *).
MonadIO m =>
Config RegionIndices -> String -> String -> m Text
ormolu Config RegionIndices
config String
fp' (Text -> String
T.unpack Text
contents))
                  where
                    config :: Config RegionIndices
config =
                        Config RegionIndices
defaultConfig
                            { cfgDynOptions :: [DynOption]
cfgDynOptions = (String -> DynOption) -> [String] -> [DynOption]
forall a b. (a -> b) -> [a] -> [b]
map String -> DynOption
DynOption [String]
fileOpts
                            , cfgRegion :: RegionIndices
cfgRegion = RegionIndices
region
                            , cfgDebug :: Bool
cfgDebug = Bool
True
                            , cfgPrinterOpts :: PrinterOptsTotal
cfgPrinterOpts =
                                PrinterOpts Maybe -> PrinterOptsTotal -> PrinterOptsTotal
forall (f :: * -> *).
Applicative f =>
PrinterOpts Maybe -> PrinterOpts f -> PrinterOpts f
fillMissingPrinterOpts
                                    (PrinterOpts Maybe
printerOpts PrinterOpts Maybe -> PrinterOpts Maybe -> PrinterOpts Maybe
forall a. Semigroup a => a -> a -> a
<> PrinterOpts Maybe
lspPrinterOpts)
                                    PrinterOptsTotal
defaultPrinterOpts
                            }
             in IO ConfigFileLoadResult -> LspT Config IO ConfigFileLoadResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ConfigFileLoadResult
loadConfigFile String
fp') LspT Config IO ConfigFileLoadResult
-> (ConfigFileLoadResult
    -> LspT Config IO (Either ResponseError (List TextEdit)))
-> LspT Config IO (Either ResponseError (List TextEdit))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    ConfigLoaded String
file PrinterOpts Maybe
opts -> 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
                        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Loaded Fourmolu config from: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
file
                        PrinterOpts Maybe -> IO (Either ResponseError (List TextEdit))
format PrinterOpts Maybe
opts
                    ConfigNotFound [String]
searchDirs -> 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
                        String -> IO ()
putStrLn
                            (String -> IO ()) -> ([String] -> String) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines
                            ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ (String
"No " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
configFileName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" found in any of:") String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
                            (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
searchDirs
                        PrinterOpts Maybe -> IO (Either ResponseError (List TextEdit))
format PrinterOpts Maybe
forall a. Monoid a => a
mempty
                    ConfigParseError String
f (Pos
_, String
err) -> do
                        SServerMethod 'WindowShowMessage
-> MessageParams 'WindowShowMessage -> LspT Config IO ()
forall (m :: Method 'FromServer 'Notification) (f :: * -> *)
       config.
MonadLsp config f =>
SServerMethod m -> MessageParams m -> f ()
sendNotification SServerMethod 'WindowShowMessage
SWindowShowMessage (MessageParams 'WindowShowMessage -> LspT Config IO ())
-> MessageParams 'WindowShowMessage -> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$
                            ShowMessageParams :: MessageType -> Text -> ShowMessageParams
ShowMessageParams
                                { $sel:_xtype:ShowMessageParams :: MessageType
_xtype = MessageType
MtError
                                , $sel:_message:ShowMessageParams :: Text
_message = Text
errorMessage
                                }
                        Either ResponseError (List TextEdit)
-> LspT Config IO (Either ResponseError (List TextEdit))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError (List TextEdit)
 -> LspT Config IO (Either ResponseError (List TextEdit)))
-> (ResponseError -> Either ResponseError (List TextEdit))
-> ResponseError
-> LspT Config IO (Either ResponseError (List TextEdit))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResponseError -> Either ResponseError (List TextEdit)
forall a b. a -> Either a b
Left (ResponseError
 -> LspT Config IO (Either ResponseError (List TextEdit)))
-> ResponseError
-> LspT Config IO (Either ResponseError (List TextEdit))
forall a b. (a -> b) -> a -> b
$ Text -> ResponseError
responseError Text
errorMessage
                      where
                        errorMessage :: Text
errorMessage = Text
"Failed to load " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
err
  where
    fp' :: String
fp' = NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
fp
    title :: Text
title = Text
"Formatting " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (String -> String
takeFileName String
fp')
    mkError :: String -> ResponseError
mkError = Text -> ResponseError
responseError (Text -> ResponseError)
-> (String -> Text) -> String -> ResponseError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"Fourmolu: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
    lspPrinterOpts :: PrinterOpts Maybe
lspPrinterOpts = PrinterOpts Maybe
forall a. Monoid a => a
mempty{poIndentation :: Maybe Int
poIndentation = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt -> Int) -> UInt -> Int
forall a b. (a -> b) -> a -> b
$ FormattingOptions
fo FormattingOptions -> Getting UInt FormattingOptions UInt -> UInt
forall s a. s -> Getting a s a -> a
^. Getting UInt FormattingOptions UInt
forall s a. HasTabSize s a => Lens' s a
tabSize}
    region :: RegionIndices
region = case FormattingType
typ of
        FormattingType
FormatText ->
            Maybe Int -> Maybe Int -> RegionIndices
RegionIndices Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing
        FormatRange (Range (Position UInt
sl UInt
_) (Position UInt
el UInt
_)) ->
            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
$ UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt -> Int) -> UInt -> Int
forall a b. (a -> b) -> a -> b
$ UInt
sl UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+ UInt
1) (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt -> Int) -> UInt -> Int
forall a b. (a -> b) -> a -> b
$ UInt
el UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+ UInt
1)

convertDynFlags :: DynFlags -> [String]
convertDynFlags :: DynFlags -> [String]
convertDynFlags DynFlags
df =
    let pp :: [String]
pp = [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)]
        p :: String
p = Settings -> String
sPgm_F (Settings -> String) -> Settings -> String
forall a b. (a -> b) -> a -> b
$ DynFlags -> Settings
Compat.settings DynFlags
df
        pm :: [String]
pm = (ModuleName -> String) -> [ModuleName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((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 a b. (a -> b) -> a -> b
$ DynFlags -> [ModuleName]
pluginModNames DynFlags
df
        ex :: [String]
ex = (Extension -> String) -> [Extension] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Extension -> String
showExtension ([Extension] -> [String]) -> [Extension] -> [String]
forall a b. (a -> b) -> a -> b
$ EnumSet Extension -> [Extension]
forall a. Enum a => EnumSet a -> [a]
S.toList (EnumSet Extension -> [Extension])
-> EnumSet Extension -> [Extension]
forall a b. (a -> b) -> a -> b
$ DynFlags -> EnumSet Extension
extensionFlags DynFlags
df
        showExtension :: Extension -> String
showExtension = \case
            Extension
Cpp -> String
"-XCPP"
            Extension
x   -> String
"-X" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Extension -> String
forall a. Show a => a -> String
show Extension
x
     in [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