{-# LANGUAGE CPP          #-}
{-# LANGUAGE LambdaCase   #-}
{-# LANGUAGE MultiWayIf   #-}
{-# LANGUAGE PolyKinds    #-}
{-# LANGUAGE TypeFamilies #-}
module Ide.Plugin.Brittany where

import           Control.Exception                               (bracket_)
import           Control.Lens
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Maybe                       (MaybeT,
                                                                  runMaybeT)
import           Data.Maybe                                      (fromMaybe,
                                                                  mapMaybe,
                                                                  maybeToList)
import           Data.Semigroup
import           Data.Text                                       (Text)
import qualified Data.Text                                       as T
import           Development.IDE                                 hiding
                                                                 (pluginHandlers)
import qualified Development.IDE.GHC.Compat                      as GHC hiding
                                                                        (Cpp)
import qualified Development.IDE.GHC.Compat.Util                 as GHC
import           GHC.LanguageExtensions.Type
import           Ide.PluginUtils
import           Ide.Types
import           Language.Haskell.Brittany
import           Language.LSP.Types                              as J
import qualified Language.LSP.Types.Lens                         as J
import           System.Environment                              (setEnv,
                                                                  unsetEnv)
import           System.FilePath

-- These imports are for the temporary pPrintText & can be removed when
-- issue #2005 is resolved
import           Control.Monad.Trans.Class                       (lift)
import qualified Control.Monad.Trans.Except                      as ExceptT
import           Data.CZipWith
import qualified Data.List                                       as List
import qualified Data.Text                                       as Text
import qualified Data.Text.Lazy                                  as TextL
import qualified GHC.LanguageExtensions.Type                     as GHC
import           Language.Haskell.Brittany.Internal
import           Language.Haskell.Brittany.Internal.Config
import           Language.Haskell.Brittany.Internal.Config.Types
import           Language.Haskell.Brittany.Internal.Obfuscation
import           Language.Haskell.Brittany.Internal.Types
import           Language.Haskell.Brittany.Internal.Utils
import qualified Language.Haskell.GHC.ExactPrint                 as ExactPrint
import qualified Language.Haskell.GHC.ExactPrint.Types           as ExactPrint


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
  }

-- | Formatter provider of Brittany.
-- 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
ide FormattingType
typ Text
contents NormalizedFilePath
nfp FormattingOptions
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
    Maybe FilePath
confFile <- NormalizedFilePath -> IO (Maybe FilePath)
getConfFile NormalizedFilePath
nfp
    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
extractRange Range
r Text
contents)
    ModSummary
modsum <- (ModSummaryResult -> ModSummary)
-> IO ModSummaryResult -> IO ModSummary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModSummaryResult -> ModSummary
msrModSummary (IO ModSummaryResult -> IO ModSummary)
-> IO ModSummaryResult -> IO ModSummary
forall a b. (a -> b) -> a -> b
$ FilePath
-> IdeState -> Action ModSummaryResult -> IO ModSummaryResult
forall a. FilePath -> IdeState -> Action a -> IO a
runAction FilePath
"brittany" IdeState
ide (Action ModSummaryResult -> IO ModSummaryResult)
-> Action ModSummaryResult -> IO ModSummaryResult
forall a b. (a -> b) -> a -> b
$ GetModSummaryWithoutTimestamps
-> NormalizedFilePath -> Action ModSummaryResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
nfp
    let dflags :: DynFlags
dflags = ModSummary -> DynFlags
GHC.ms_hspp_opts ModSummary
modsum
    let withRuntimeLibdir :: IO (Either [BrittanyError] Text)
-> IO (Either [BrittanyError] Text)
withRuntimeLibdir = IO ()
-> IO ()
-> IO (Either [BrittanyError] Text)
-> IO (Either [BrittanyError] Text)
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (FilePath -> FilePath -> IO ()
setEnv FilePath
key (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> FilePath
GHC.topDir DynFlags
dflags) (FilePath -> IO ()
unsetEnv FilePath
key)
          where key :: FilePath
key = FilePath
"GHC_EXACTPRINT_GHC_LIBDIR"
    Either [BrittanyError] Text
res <- IO (Either [BrittanyError] Text)
-> IO (Either [BrittanyError] Text)
withRuntimeLibdir (IO (Either [BrittanyError] Text)
 -> IO (Either [BrittanyError] Text))
-> IO (Either [BrittanyError] Text)
-> IO (Either [BrittanyError] Text)
forall a b. (a -> b) -> a -> b
$ DynFlags
-> Maybe FilePath
-> FormattingOptions
-> Text
-> IO (Either [BrittanyError] Text)
forall (m :: * -> *).
MonadIO m =>
DynFlags
-> Maybe FilePath
-> FormattingOptions
-> Text
-> m (Either [BrittanyError] Text)
formatText DynFlags
dflags Maybe FilePath
confFile FormattingOptions
opts Text
selectedContents
    case Either [BrittanyError] Text
res of
      Left [BrittanyError]
err -> 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 (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
"brittanyCmd: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unlines ((BrittanyError -> FilePath) -> [BrittanyError] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map BrittanyError -> FilePath
showErr [BrittanyError]
err))
      Right Text
newText -> 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 (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
J.List [Range -> Text -> TextEdit
TextEdit Range
range Text
newText]

-- | Primitive to format text with the given option.
-- May not throw exceptions but return a Left value.
-- Errors may be presented to the user.
formatText
  :: MonadIO m
  => GHC.DynFlags
  -> Maybe FilePath -- ^ Path to configs. If Nothing, default configs will be used.
  -> FormattingOptions -- ^ Options for the formatter such as indentation.
  -> Text -- ^ Text to format
  -> m (Either [BrittanyError] Text) -- ^ Either formatted Text or a error from Brittany.
formatText :: DynFlags
-> Maybe FilePath
-> FormattingOptions
-> Text
-> m (Either [BrittanyError] Text)
formatText DynFlags
df Maybe FilePath
confFile FormattingOptions
opts Text
text =
  IO (Either [BrittanyError] Text) -> m (Either [BrittanyError] Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either [BrittanyError] Text)
 -> m (Either [BrittanyError] Text))
-> IO (Either [BrittanyError] Text)
-> m (Either [BrittanyError] Text)
forall a b. (a -> b) -> a -> b
$ Int
-> DynFlags
-> Maybe FilePath
-> Text
-> IO (Either [BrittanyError] Text)
runBrittany Int
tabSize DynFlags
df Maybe FilePath
confFile Text
text
  where tabSize :: Int
tabSize = UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt -> Int) -> UInt -> Int
forall a b. (a -> b) -> a -> b
$ FormattingOptions
opts 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
J.tabSize

-- | Recursively search in every directory of the given filepath for brittany.yaml.
-- If no such file has been found, return Nothing.
getConfFile :: NormalizedFilePath -> IO (Maybe FilePath)
getConfFile :: NormalizedFilePath -> IO (Maybe FilePath)
getConfFile = FilePath -> IO (Maybe FilePath)
findLocalConfigPath (FilePath -> IO (Maybe FilePath))
-> (NormalizedFilePath -> FilePath)
-> NormalizedFilePath
-> IO (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeDirectory (FilePath -> FilePath)
-> (NormalizedFilePath -> FilePath)
-> NormalizedFilePath
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedFilePath -> FilePath
fromNormalizedFilePath

-- | Run Brittany on the given text with the given tab size and
-- a configuration path. If no configuration path is given, a
-- default configuration is chosen. The configuration may overwrite
-- tab size parameter.
--
-- Returns either a list of Brittany Errors or the reformatted text.
-- May not throw an exception.
runBrittany :: Int              -- ^ tab  size
            -> GHC.DynFlags
            -> Maybe FilePath   -- ^ local config file
            -> Text             -- ^ text to format
            -> IO (Either [BrittanyError] Text)
runBrittany :: Int
-> DynFlags
-> Maybe FilePath
-> Text
-> IO (Either [BrittanyError] Text)
runBrittany Int
tabSize DynFlags
df Maybe FilePath
confPath Text
text = do
  let cfg :: CConfig Option
cfg = CConfig Option
forall a. Monoid a => a
mempty
              { _conf_layout :: CLayoutConfig Option
_conf_layout =
                  CLayoutConfig Option
forall a. Monoid a => a
mempty { _lconfig_indentAmount :: Option (Last Int)
_lconfig_indentAmount = Last Int -> Option (Last Int)
forall a. a -> Option a
opt (Int -> Last Int
forall a. a -> Last a
Last Int
tabSize)
                         }
              , _conf_forward :: CForwardOptions Option
_conf_forward =
                  (CForwardOptions Option
forall a. Monoid a => a
mempty :: CForwardOptions CMaybe)
                    { _options_ghc :: Option [FilePath]
_options_ghc = [FilePath] -> Option [FilePath]
forall a. a -> Option a
opt (DynFlags -> [FilePath]
getExtensions DynFlags
df)
                    }
              }
  Config
config <- IO Config -> MaybeT IO Config -> IO Config
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a -> m a
fromMaybeT (Config -> IO Config
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
staticDefaultConfig)
                       (CConfig Option -> [FilePath] -> MaybeT IO Config
readConfigsWithUserConfig CConfig Option
cfg (Maybe FilePath -> [FilePath]
forall a. Maybe a -> [a]
maybeToList Maybe FilePath
confPath))
  ([BrittanyError]
errsAndWarnings, Text
resultText) <- Config -> Text -> IO ([BrittanyError], Text)
pPrintText Config
config Text
text
  if (BrittanyError -> Bool) -> [BrittanyError] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any BrittanyError -> Bool
isError [BrittanyError]
errsAndWarnings then
    Either [BrittanyError] Text -> IO (Either [BrittanyError] Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [BrittanyError] Text -> IO (Either [BrittanyError] Text))
-> Either [BrittanyError] Text -> IO (Either [BrittanyError] Text)
forall a b. (a -> b) -> a -> b
$ [BrittanyError] -> Either [BrittanyError] Text
forall a b. a -> Either a b
Left [BrittanyError]
errsAndWarnings
  else
    Either [BrittanyError] Text -> IO (Either [BrittanyError] Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [BrittanyError] Text -> IO (Either [BrittanyError] Text))
-> Either [BrittanyError] Text -> IO (Either [BrittanyError] Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either [BrittanyError] Text
forall a b. b -> Either a b
Right Text
resultText

#if MIN_VERSION_brittany(0,14,0)
type CMaybe = Maybe
opt :: a -> Maybe a
opt = Just
#else
type CMaybe = Option
opt :: a -> Option a
opt :: a -> Option a
opt = Maybe a -> Option a
forall a. Maybe a -> Option a
Option (Maybe a -> Option a) -> (a -> Maybe a) -> a -> Option a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
#endif

fromMaybeT :: Monad m => m a -> MaybeT m a -> m a
fromMaybeT :: m a -> MaybeT m a -> m a
fromMaybeT m a
def MaybeT m a
act = MaybeT m a -> m (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT m a
act m (Maybe a) -> (Maybe a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m a
def a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

showErr :: BrittanyError -> String
showErr :: BrittanyError -> FilePath
showErr (ErrorInput FilePath
s)          = FilePath
s
showErr (ErrorMacroConfig  FilePath
err FilePath
input)
  = FilePath
"Error: parse error in inline configuration: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" in the string \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
input FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\"."
showErr (ErrorUnusedComment FilePath
s)  = FilePath
s
showErr (LayoutWarning FilePath
s)       = FilePath
s
showErr (ErrorUnknownNode FilePath
s GenLocated SrcSpan ast
_)  = FilePath
s
showErr BrittanyError
ErrorOutputCheck        = FilePath
"Brittany error - invalid output"

showExtension :: Extension -> Maybe String
showExtension :: Extension -> Maybe FilePath
showExtension Extension
Cpp              = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"-XCPP"
-- Brittany chokes on parsing extensions that produce warnings
showExtension Extension
DatatypeContexts = Maybe FilePath
forall a. Maybe a
Nothing
showExtension Extension
RecordPuns       = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"-XNamedFieldPuns"
showExtension Extension
other            = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"-X" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Extension -> FilePath
forall a. Show a => a -> FilePath
show Extension
other

getExtensions :: GHC.DynFlags -> [String]
getExtensions :: DynFlags -> [FilePath]
getExtensions = (Extension -> Maybe FilePath) -> [Extension] -> [FilePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Extension -> Maybe FilePath
showExtension ([Extension] -> [FilePath])
-> (DynFlags -> [Extension]) -> DynFlags -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumSet Extension -> [Extension]
forall a. Enum a => EnumSet a -> [a]
GHC.toList (EnumSet Extension -> [Extension])
-> (DynFlags -> EnumSet Extension) -> DynFlags -> [Extension]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> EnumSet Extension
GHC.extensionFlags


-- | This is a temporary fix that allows us to format the text if brittany
-- throws warnings during pretty printing.
--
-- It should be removed when our PR to brittany is merged + released.
-- See:
--  - https://github.com/haskell/haskell-language-server/issues/2005
--  - https://github.com/lspitzner/brittany/pull/351
pPrintText
  :: Config -- ^ global program config
  -> Text   -- ^ input text
  -> IO ([BrittanyError], Text) -- ^ list of errors/warnings & result text
pPrintText :: Config -> Text -> IO ([BrittanyError], Text)
pPrintText Config
config Text
text =
  (Either ([BrittanyError], Text) ([BrittanyError], Text)
 -> ([BrittanyError], Text))
-> IO (Either ([BrittanyError], Text) ([BrittanyError], Text))
-> IO ([BrittanyError], Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((([BrittanyError], Text) -> ([BrittanyError], Text))
-> (([BrittanyError], Text) -> ([BrittanyError], Text))
-> Either ([BrittanyError], Text) ([BrittanyError], Text)
-> ([BrittanyError], Text)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([BrittanyError], Text) -> ([BrittanyError], Text)
forall a. a -> a
id ([BrittanyError], Text) -> ([BrittanyError], Text)
forall a. a -> a
id) (IO (Either ([BrittanyError], Text) ([BrittanyError], Text))
 -> IO ([BrittanyError], Text))
-> (ExceptT ([BrittanyError], Text) IO ([BrittanyError], Text)
    -> IO (Either ([BrittanyError], Text) ([BrittanyError], Text)))
-> ExceptT ([BrittanyError], Text) IO ([BrittanyError], Text)
-> IO ([BrittanyError], Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT ([BrittanyError], Text) IO ([BrittanyError], Text)
-> IO (Either ([BrittanyError], Text) ([BrittanyError], Text))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
ExceptT.runExceptT (ExceptT ([BrittanyError], Text) IO ([BrittanyError], Text)
 -> IO ([BrittanyError], Text))
-> ExceptT ([BrittanyError], Text) IO ([BrittanyError], Text)
-> IO ([BrittanyError], Text)
forall a b. (a -> b) -> a -> b
$ do
    let ghcOptions :: [FilePath]
ghcOptions = Config
config Config
-> (Config -> CForwardOptions Identity) -> CForwardOptions Identity
forall a b. a -> (a -> b) -> b
& Config -> CForwardOptions Identity
forall (f :: * -> *). CConfig f -> CForwardOptions f
_conf_forward CForwardOptions Identity
-> (CForwardOptions Identity -> Identity [FilePath])
-> Identity [FilePath]
forall a b. a -> (a -> b) -> b
& CForwardOptions Identity -> Identity [FilePath]
forall (f :: * -> *). CForwardOptions f -> f [FilePath]
_options_ghc Identity [FilePath]
-> (Identity [FilePath] -> [FilePath]) -> [FilePath]
forall a b. a -> (a -> b) -> b
& Identity [FilePath] -> [FilePath]
forall a. Identity a -> a
runIdentity
    -- there is a good of code duplication between the following code and the
    -- `pureModuleTransform` function. Unfortunately, there are also a good
    -- amount of slight differences: This module is a bit more verbose, and
    -- it tries to use the full-blown `parseModule` function which supports
    -- CPP (but requires the input to be a file..).
    let cppMode :: CPPMode
cppMode    = Config
config Config
-> (Config -> CPreProcessorConfig Identity)
-> CPreProcessorConfig Identity
forall a b. a -> (a -> b) -> b
& Config -> CPreProcessorConfig Identity
forall (f :: * -> *). CConfig f -> CPreProcessorConfig f
_conf_preprocessor CPreProcessorConfig Identity
-> (CPreProcessorConfig Identity -> Identity (Last CPPMode))
-> Identity (Last CPPMode)
forall a b. a -> (a -> b) -> b
& CPreProcessorConfig Identity -> Identity (Last CPPMode)
forall (f :: * -> *). CPreProcessorConfig f -> f (Last CPPMode)
_ppconf_CPPMode Identity (Last CPPMode)
-> (Identity (Last CPPMode) -> CPPMode) -> CPPMode
forall a b. a -> (a -> b) -> b
& Identity (Last CPPMode) -> CPPMode
forall a b. Coercible a b => Identity a -> b
confUnpack
    -- the flag will do the following: insert a marker string
    -- ("-- BRITANY_INCLUDE_HACK ") right before any lines starting with
    -- "#include" before processing (parsing) input; and remove that marker
    -- string from the transformation output.
    -- The flag is intentionally misspelled to prevent clashing with
    -- inline-config stuff.
    let hackAroundIncludes :: Bool
hackAroundIncludes =
          Config
config Config
-> (Config -> CPreProcessorConfig Identity)
-> CPreProcessorConfig Identity
forall a b. a -> (a -> b) -> b
& Config -> CPreProcessorConfig Identity
forall (f :: * -> *). CConfig f -> CPreProcessorConfig f
_conf_preprocessor CPreProcessorConfig Identity
-> (CPreProcessorConfig Identity -> Identity (Last Bool))
-> Identity (Last Bool)
forall a b. a -> (a -> b) -> b
& CPreProcessorConfig Identity -> Identity (Last Bool)
forall (f :: * -> *). CPreProcessorConfig f -> f (Last Bool)
_ppconf_hackAroundIncludes Identity (Last Bool) -> (Identity (Last Bool) -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& Identity (Last Bool) -> Bool
forall a b. Coercible a b => Identity a -> b
confUnpack
    let exactprintOnly :: Bool
exactprintOnly = Bool
viaGlobal Bool -> Bool -> Bool
|| Bool
viaDebug
         where
          viaGlobal :: Bool
viaGlobal = Config
config Config -> (Config -> Identity (Last Bool)) -> Identity (Last Bool)
forall a b. a -> (a -> b) -> b
& Config -> Identity (Last Bool)
forall (f :: * -> *). CConfig f -> f (Last Bool)
_conf_roundtrip_exactprint_only Identity (Last Bool) -> (Identity (Last Bool) -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& Identity (Last Bool) -> Bool
forall a b. Coercible a b => Identity a -> b
confUnpack
          viaDebug :: Bool
viaDebug =
            Config
config Config
-> (Config -> CDebugConfig Identity) -> CDebugConfig Identity
forall a b. a -> (a -> b) -> b
& Config -> CDebugConfig Identity
forall (f :: * -> *). CConfig f -> CDebugConfig f
_conf_debug CDebugConfig Identity
-> (CDebugConfig Identity -> Identity (Last Bool))
-> Identity (Last Bool)
forall a b. a -> (a -> b) -> b
& CDebugConfig Identity -> Identity (Last Bool)
forall (f :: * -> *). CDebugConfig f -> f (Last Bool)
_dconf_roundtrip_exactprint_only Identity (Last Bool) -> (Identity (Last Bool) -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& Identity (Last Bool) -> Bool
forall a b. Coercible a b => Identity a -> b
confUnpack

    let cppCheckFunc :: DynFlags -> IO (Either FilePath Bool)
cppCheckFunc DynFlags
dynFlags = if Extension -> DynFlags -> Bool
GHC.xopt Extension
GHC.Cpp DynFlags
dynFlags
          then case CPPMode
cppMode of
            CPPMode
CPPModeAbort ->
              Either FilePath Bool -> IO (Either FilePath Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath Bool -> IO (Either FilePath Bool))
-> Either FilePath Bool -> IO (Either FilePath Bool)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath Bool
forall a b. a -> Either a b
Left FilePath
"Encountered -XCPP. Aborting."
            CPPMode
CPPModeWarn ->
              Either FilePath Bool -> IO (Either FilePath Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath Bool -> IO (Either FilePath Bool))
-> Either FilePath Bool -> IO (Either FilePath Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Either FilePath Bool
forall a b. b -> Either a b
Right Bool
True
            CPPMode
CPPModeNowarn ->
              Either FilePath Bool -> IO (Either FilePath Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath Bool -> IO (Either FilePath Bool))
-> Either FilePath Bool -> IO (Either FilePath Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Either FilePath Bool
forall a b. b -> Either a b
Right Bool
True
          else Either FilePath Bool -> IO (Either FilePath Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath Bool -> IO (Either FilePath Bool))
-> Either FilePath Bool -> IO (Either FilePath Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Either FilePath Bool
forall a b. b -> Either a b
Right Bool
False
    Either FilePath (Anns, ParsedSource, Bool)
parseResult <- do
        -- TODO: refactor this hack to not be mixed into parsing logic
        let hackF :: FilePath -> FilePath
hackF FilePath
s = if FilePath
"#include" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` FilePath
s
              then FilePath
"-- BRITANY_INCLUDE_HACK " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
              else FilePath
s
        let hackTransform :: FilePath -> FilePath
hackTransform = if Bool
hackAroundIncludes Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
exactprintOnly
              then FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
List.intercalate FilePath
"\n" ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
hackF ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines'
              else FilePath -> FilePath
forall a. a -> a
id
        IO (Either FilePath (Anns, ParsedSource, Bool))
-> ExceptT
     ([BrittanyError], Text)
     IO
     (Either FilePath (Anns, ParsedSource, Bool))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either FilePath (Anns, ParsedSource, Bool))
 -> ExceptT
      ([BrittanyError], Text)
      IO
      (Either FilePath (Anns, ParsedSource, Bool)))
-> IO (Either FilePath (Anns, ParsedSource, Bool))
-> ExceptT
     ([BrittanyError], Text)
     IO
     (Either FilePath (Anns, ParsedSource, Bool))
forall a b. (a -> b) -> a -> b
$ [FilePath]
-> FilePath
-> (DynFlags -> IO (Either FilePath Bool))
-> FilePath
-> IO (Either FilePath (Anns, ParsedSource, Bool))
forall a.
[FilePath]
-> FilePath
-> (DynFlags -> IO (Either FilePath a))
-> FilePath
-> IO (Either FilePath (Anns, ParsedSource, a))
parseModuleFromString [FilePath]
ghcOptions
                                                   FilePath
"stdin"
                                                   DynFlags -> IO (Either FilePath Bool)
cppCheckFunc
                                                   (FilePath -> FilePath
hackTransform (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
Text.unpack Text
text)
    case Either FilePath (Anns, ParsedSource, Bool)
parseResult of
      Left FilePath
left -> do
        ([BrittanyError], Text)
-> ExceptT ([BrittanyError], Text) IO ([BrittanyError], Text)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
ExceptT.throwE ([FilePath -> BrittanyError
ErrorInput FilePath
left], Text
text)
      Right (Anns
anns, ParsedSource
parsedSource, Bool
hasCPP) -> do
        (CConfig Option
inlineConf, PerItemConfig
perItemConf) <-
          case
            Anns
-> TopLevelDeclNameMap
-> Either (FilePath, FilePath) (CConfig Option, PerItemConfig)
extractCommentConfigs Anns
anns (ParsedSource -> TopLevelDeclNameMap
getTopLevelDeclNameMap ParsedSource
parsedSource)
          of
            Left (FilePath
err, FilePath
input) -> do
              let errMsg :: FilePath
errMsg =
                    FilePath
"Error: parse error in inline configuration: "
                    FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
err
                    FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"  in the string \""
                    FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
input
                    FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"\"."
              ([BrittanyError], Text)
-> ExceptT
     ([BrittanyError], Text) IO (CConfig Option, PerItemConfig)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
ExceptT.throwE ([FilePath -> BrittanyError
ErrorInput FilePath
errMsg], Text
text)
            Right (CConfig Option, PerItemConfig)
c ->
              (CConfig Option, PerItemConfig)
-> ExceptT
     ([BrittanyError], Text) IO (CConfig Option, PerItemConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CConfig Option, PerItemConfig)
c
        let moduleConf :: Config
moduleConf = (forall a. Identity a -> Option a -> Identity a)
-> Config -> CConfig Option -> Config
forall (k :: (* -> *) -> *) (g :: * -> *) (h :: * -> *)
       (i :: * -> *).
CZipWith k =>
(forall a. g a -> h a -> i a) -> k g -> k h -> k i
cZipWith forall a. Identity a -> Option a -> Identity a
fromOptionIdentity Config
config CConfig Option
inlineConf
        let disableFormatting :: Bool
disableFormatting =
              Config
moduleConf Config -> (Config -> Identity (Last Bool)) -> Identity (Last Bool)
forall a b. a -> (a -> b) -> b
& Config -> Identity (Last Bool)
forall (f :: * -> *). CConfig f -> f (Last Bool)
_conf_disable_formatting Identity (Last Bool) -> (Identity (Last Bool) -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& Identity (Last Bool) -> Bool
forall a b. Coercible a b => Identity a -> b
confUnpack
        ([BrittanyError]
errsWarns, Text
outSText, Bool
_) <- do
          if
            | Bool
disableFormatting -> do
              ([BrittanyError], Text, Bool)
-> ExceptT ([BrittanyError], Text) IO ([BrittanyError], Text, Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], Text
text, Bool
False)
            | Bool
exactprintOnly -> do
              let r :: Text
r = FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ ParsedSource -> Anns -> FilePath
forall ast. Annotate ast => Located ast -> Anns -> FilePath
ExactPrint.exactPrint ParsedSource
parsedSource Anns
anns
              ([BrittanyError], Text, Bool)
-> ExceptT ([BrittanyError], Text) IO ([BrittanyError], Text, Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], Text
r, Text
r Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
text)
            | Bool
otherwise -> do
              ([BrittanyError]
ews, Text
outRaw) <- if Bool
hasCPP
                then ([BrittanyError], Text)
-> ExceptT ([BrittanyError], Text) IO ([BrittanyError], Text)
forall (m :: * -> *) a. Monad m => a -> m a
return
                  (([BrittanyError], Text)
 -> ExceptT ([BrittanyError], Text) IO ([BrittanyError], Text))
-> ([BrittanyError], Text)
-> ExceptT ([BrittanyError], Text) IO ([BrittanyError], Text)
forall a b. (a -> b) -> a -> b
$ Config
-> PerItemConfig -> Anns -> ParsedSource -> ([BrittanyError], Text)
pPrintModule Config
moduleConf PerItemConfig
perItemConf Anns
anns ParsedSource
parsedSource
                else IO ([BrittanyError], Text)
-> ExceptT ([BrittanyError], Text) IO ([BrittanyError], Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([BrittanyError], Text)
 -> ExceptT ([BrittanyError], Text) IO ([BrittanyError], Text))
-> IO ([BrittanyError], Text)
-> ExceptT ([BrittanyError], Text) IO ([BrittanyError], Text)
forall a b. (a -> b) -> a -> b
$ Config
-> PerItemConfig
-> Anns
-> ParsedSource
-> IO ([BrittanyError], Text)
pPrintModuleAndCheck Config
moduleConf
                                                   PerItemConfig
perItemConf
                                                   Anns
anns
                                                   ParsedSource
parsedSource
              let hackF :: Text -> Text
hackF Text
s = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
s (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
TextL.stripPrefix
                    (FilePath -> Text
TextL.pack FilePath
"-- BRITANY_INCLUDE_HACK ")
                    Text
s
              let out :: Text
out = Text -> Text
TextL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ if Bool
hackAroundIncludes
                    then
                      Text -> [Text] -> Text
TextL.intercalate (FilePath -> Text
TextL.pack FilePath
"\n")
                      ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
hackF
                      (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> [Text]
TextL.splitOn (FilePath -> Text
TextL.pack FilePath
"\n") Text
outRaw
                    else Text
outRaw
              Text
out' <- if Config
moduleConf Config -> (Config -> Identity (Last Bool)) -> Identity (Last Bool)
forall a b. a -> (a -> b) -> b
& Config -> Identity (Last Bool)
forall (f :: * -> *). CConfig f -> f (Last Bool)
_conf_obfuscate Identity (Last Bool) -> (Identity (Last Bool) -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& Identity (Last Bool) -> Bool
forall a b. Coercible a b => Identity a -> b
confUnpack
                then IO Text -> ExceptT ([BrittanyError], Text) IO Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Text -> ExceptT ([BrittanyError], Text) IO Text)
-> IO Text -> ExceptT ([BrittanyError], Text) IO Text
forall a b. (a -> b) -> a -> b
$ Text -> IO Text
obfuscate Text
out
                else Text -> ExceptT ([BrittanyError], Text) IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
out
              ([BrittanyError], Text, Bool)
-> ExceptT ([BrittanyError], Text) IO ([BrittanyError], Text, Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([BrittanyError]
ews, Text
out', Text
out' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
text)
        let customErrOrder :: BrittanyError -> Int
customErrOrder ErrorInput{}         = Int
4
            customErrOrder LayoutWarning{}      = -Int
1 :: Int
            customErrOrder ErrorOutputCheck{}   = Int
1
            customErrOrder ErrorUnusedComment{} = Int
2
            customErrOrder ErrorUnknownNode{}   = -Int
2 :: Int
            customErrOrder ErrorMacroConfig{}   = Int
5
            hasErrors :: Bool
hasErrors =
              if Config
config Config
-> (Config -> CErrorHandlingConfig Identity)
-> CErrorHandlingConfig Identity
forall a b. a -> (a -> b) -> b
& Config -> CErrorHandlingConfig Identity
forall (f :: * -> *). CConfig f -> CErrorHandlingConfig f
_conf_errorHandling CErrorHandlingConfig Identity
-> (CErrorHandlingConfig Identity -> Identity (Last Bool))
-> Identity (Last Bool)
forall a b. a -> (a -> b) -> b
& CErrorHandlingConfig Identity -> Identity (Last Bool)
forall (f :: * -> *). CErrorHandlingConfig f -> f (Last Bool)
_econf_Werror Identity (Last Bool) -> (Identity (Last Bool) -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& Identity (Last Bool) -> Bool
forall a b. Coercible a b => Identity a -> b
confUnpack
                then Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [BrittanyError] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [BrittanyError]
errsWarns
                else Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (-Int
1 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (BrittanyError -> Int) -> [BrittanyError] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BrittanyError -> Int
customErrOrder [BrittanyError]
errsWarns)
        ([BrittanyError], Text)
-> ExceptT ([BrittanyError], Text) IO ([BrittanyError], Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ([BrittanyError]
errsWarns, if Bool
hasErrors then Text
text else Text
outSText)

isError :: BrittanyError -> Bool
isError :: BrittanyError -> Bool
isError = \case
    LayoutWarning{}    -> Bool
False
    ErrorUnknownNode{} -> Bool
False
    BrittanyError
_                  -> Bool
True