    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE RecordWildCards #-}

    -- | A formatter for Haskell source code. This module exposes the official
    -- stable API, other modules may be not as reliable.
    module Ormolu
      ( -- * Top-level formatting functions
        ormolu,
        ormoluFile,
        ormoluStdin,

        -- * Configuration
        Config (..),
        ColorMode (..),
        RegionIndices (..),
        SourceType (..),
        defaultConfig,
        detectSourceType,
        refineConfig,
        DynOption (..),

        -- * Cabal info
        CabalUtils.CabalSearchResult (..),
        CabalUtils.CabalInfo (..),
        CabalUtils.getCabalInfoForSourceFile,

        -- * Fixity overrides and module re-exports
        FixityOverrides,
        defaultFixityOverrides,
        ModuleReexports,
        defaultModuleReexports,
        getDotOrmoluForSourceFile,

        -- * Working with exceptions
        OrmoluException (..),
        withPrettyOrmoluExceptions,
      )
    where

    import Control.Exception
    import Control.Monad
    import Control.Monad.IO.Class (MonadIO (..))
    import Data.Map.Strict qualified as Map
    import Data.Maybe (fromMaybe)
    import Data.Set qualified as Set
    import Data.Text (Text)
    import Data.Text qualified as T
    import Data.Text.IO.Utf8 qualified as T.Utf8
    import Debug.Trace
    import GHC.Driver.Errors.Types
    import GHC.Types.Error
    import GHC.Types.SrcLoc
    import GHC.Utils.Error
    import Ormolu.Config
    import Ormolu.Diff.ParseResult
    import Ormolu.Diff.Text
    import Ormolu.Exception
    import Ormolu.Fixity
    import Ormolu.Parser
    import Ormolu.Parser.CommentStream (CommentStream (..))
    import Ormolu.Parser.Result
    import Ormolu.Printer
    import Ormolu.Utils (showOutputable)
    import Ormolu.Utils.Cabal qualified as CabalUtils
    import Ormolu.Utils.Fixity (getDotOrmoluForSourceFile)
    import System.FilePath

    -- | Format a 'Text'.
    --
    -- The function
    --
    --     * Needs 'IO' because some functions from GHC that are necessary to
    --       setup parsing context require 'IO'. There should be no visible
    --       side-effects though.
    --     * Takes file name just to use it in parse error messages.
    --     * Throws 'OrmoluException'.
    --
    -- __NOTE__: The caller is responsible for setting the appropriate value in
    -- the 'cfgSourceType' field. Autodetection of source type won't happen
    -- here, see 'detectSourceType'.
    ormolu ::
      (MonadIO m) =>
      -- | Ormolu configuration
      Config RegionIndices ->
      -- | Location of source file
      FilePath ->
      -- | Input to format
      Text ->
      m Text
    ormolu :: forall (m :: * -> *).
    MonadIO m =>
    Config RegionIndices -> String -> Text -> m Text
    ormolu Config RegionIndices
    cfgWithIndices String
    path Text
    originalInput = do
      let totalLines :: Int
    totalLines = [Text] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (Text -> [Text]
    T.lines Text
    originalInput)
          cfg :: Config RegionDeltas
    cfg = Int -> RegionIndices -> RegionDeltas
    regionIndicesToDeltas Int
    totalLines (RegionIndices -> RegionDeltas)
    -> Config RegionIndices -> Config RegionDeltas
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Config RegionIndices
    cfgWithIndices
          fixityMap :: PackageFixityMap
    fixityMap =
            Set PackageName -> PackageFixityMap
    packageFixityMap
              (Config RegionDeltas -> Set PackageName
    forall region. Config region -> Set PackageName
    overapproximatedDependencies Config RegionDeltas
    cfg) -- memoized on the set of dependencies
      Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Config RegionDeltas -> Bool
    forall region. Config region -> Bool
    cfgDebug Config RegionDeltas
    cfg) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
        String -> m ()
    forall (f :: * -> *). Applicative f => String -> f ()
    traceM (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unwords [String
    "*** CONFIG ***", Config RegionDeltas -> String
    forall a. Show a => a -> String
    show Config RegionDeltas
    cfg]
      (warnings, result0) <-
        Config RegionDeltas
    -> PackageFixityMap
    -> (SrcSpan -> String -> OrmoluException)
    -> String
    -> Text
    -> m (DriverMessages, [SourceSnippet])
    forall (m :: * -> *).
    MonadIO m =>
    Config RegionDeltas
    -> PackageFixityMap
    -> (SrcSpan -> String -> OrmoluException)
    -> String
    -> Text
    -> m (DriverMessages, [SourceSnippet])
    parseModule' Config RegionDeltas
    cfg PackageFixityMap
    fixityMap SrcSpan -> String -> OrmoluException
    OrmoluParsingFailed String
    path Text
    originalInput
      when (cfgDebug cfg) $ do
        forM_ warnings $ \DriverMessage
    driverMsg -> do
          let driverMsgSDoc :: SDoc
    driverMsgSDoc = DecoratedSDoc -> SDoc
    formatBulleted (DecoratedSDoc -> SDoc) -> DecoratedSDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ DiagnosticOpts DriverMessage -> DriverMessage -> DecoratedSDoc
    forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
    diagnosticMessage DiagnosticOpts DriverMessage
    DriverMessageOpts
    forall opts. HasDefaultDiagnosticOpts opts => opts
    defaultOpts DriverMessage
    driverMsg
          String -> m ()
    forall (f :: * -> *). Applicative f => String -> f ()
    traceM (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unwords [String
    "*** WARNING ***", SDoc -> String
    forall o. Outputable o => o -> String
    showOutputable SDoc
    driverMsgSDoc]
        forM_ result0 $ \case
          ParsedSnippet ParseResult
    r -> do
            let CommentStream [LComment]
    comments = ParseResult -> CommentStream
    prCommentStream ParseResult
    r
            [LComment] -> (LComment -> m ()) -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [LComment]
    comments ((LComment -> m ()) -> m ()) -> (LComment -> m ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \(L RealSrcSpan
    loc Comment
    comment) ->
              String -> m ()
    forall (f :: * -> *). Applicative f => String -> f ()
    traceM (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unwords [String
    "*** COMMENT ***", RealSrcSpan -> String
    forall o. Outputable o => o -> String
    showOutputable RealSrcSpan
    loc, Comment -> String
    forall a. Show a => a -> String
    show Comment
    comment]
          SourceSnippet
    _ -> () -> m ()
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
      -- We're forcing 'formattedText' here because otherwise errors (such as
      -- messages about not-yet-supported functionality) will be thrown later
      -- when we try to parse the rendered code back, inside of GHC monad
      -- wrapper which will lead to error messages presenting the exceptions as
      -- GHC bugs.
      let !formattedText = Bool -> [SourceSnippet] -> Text
    printSnippets (Config RegionDeltas -> Bool
    forall region. Config region -> Bool
    cfgDebug Config RegionDeltas
    cfg) [SourceSnippet]
    result0
      when (not (cfgUnsafe cfg) || cfgCheckIdempotence cfg) $ do
        -- Parse the result of pretty-printing again and make sure that AST
        -- is the same as AST of original snippet module span positions.
        (_, result1) <-
          parseModule'
            cfg
            fixityMap
            OrmoluOutputParsingFailed
            path
            formattedText
        unless (cfgUnsafe cfg) . liftIO $ do
          let diff = case Text -> Text -> String -> Maybe TextDiff
    diffText Text
    originalInput Text
    formattedText String
    path of
                Maybe TextDiff
    Nothing -> String -> TextDiff
    forall a. HasCallStack => String -> a
    error String
    "AST differs, yet no changes have been introduced"
                Just TextDiff
    x -> TextDiff
    x
          when (length result0 /= length result1) $
            throwIO (OrmoluASTDiffers diff [])
          forM_ (result0 `zip` result1) $ \case
            (ParsedSnippet ParseResult
    s, ParsedSnippet ParseResult
    s') -> case ParseResult -> ParseResult -> ParseResultDiff
    diffParseResult ParseResult
    s ParseResult
    s' of
              ParseResultDiff
    Same -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              Different [RealSrcSpan]
    ss -> OrmoluException -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (TextDiff -> [RealSrcSpan] -> OrmoluException
    OrmoluASTDiffers ([RealSrcSpan] -> TextDiff -> TextDiff
    selectSpans [RealSrcSpan]
    ss TextDiff
    diff) [RealSrcSpan]
    ss)
            (RawSnippet {}, RawSnippet {}) -> () -> IO ()
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
            (SourceSnippet, SourceSnippet)
    _ -> OrmoluException -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (TextDiff -> [RealSrcSpan] -> OrmoluException
    OrmoluASTDiffers TextDiff
    diff [])
        -- Try re-formatting the formatted result to check if we get exactly
        -- the same output.
        when (cfgCheckIdempotence cfg) . liftIO $
          let reformattedText = Bool -> [SourceSnippet] -> Text
    printSnippets (Config RegionDeltas -> Bool
    forall region. Config region -> Bool
    cfgDebug Config RegionDeltas
    cfg) [SourceSnippet]
    result1
           in case diffText formattedText reformattedText path of
                Maybe TextDiff
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                Just TextDiff
    diff -> OrmoluException -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (TextDiff -> OrmoluException
    OrmoluNonIdempotentOutput TextDiff
    diff)
      return formattedText

    -- | Load a file and format it. The file stays intact and the rendered
    -- version is returned as 'Text'.
    --
    -- __NOTE__: The caller is responsible for setting the appropriate value in
    -- the 'cfgSourceType' field. Autodetection of source type won't happen
    -- here, see 'detectSourceType'.
    ormoluFile ::
      (MonadIO m) =>
      -- | Ormolu configuration
      Config RegionIndices ->
      -- | Location of source file
      FilePath ->
      -- | Resulting rendition
      m Text
    ormoluFile :: forall (m :: * -> *).
    MonadIO m =>
    Config RegionIndices -> String -> m Text
    ormoluFile Config RegionIndices
    cfg String
    path =
      IO Text -> m Text
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (String -> IO Text
    T.Utf8.readFile String
    path) m Text -> (Text -> m Text) -> m Text
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Config RegionIndices -> String -> Text -> m Text
    forall (m :: * -> *).
    MonadIO m =>
    Config RegionIndices -> String -> Text -> m Text
    ormolu Config RegionIndices
    cfg String
    path

    -- | Read input from stdin and format it.
    --
    -- __NOTE__: The caller is responsible for setting the appropriate value in
    -- the 'cfgSourceType' field. Autodetection of source type won't happen
    -- here, see 'detectSourceType'.
    ormoluStdin ::
      (MonadIO m) =>
      -- | Ormolu configuration
      Config RegionIndices ->
      -- | Resulting rendition
      m Text
    ormoluStdin :: forall (m :: * -> *). MonadIO m => Config RegionIndices -> m Text
    ormoluStdin Config RegionIndices
    cfg =
      IO Text -> m Text
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO Text
    T.Utf8.getContents m Text -> (Text -> m Text) -> m Text
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Config RegionIndices -> String -> Text -> m Text
    forall (m :: * -> *).
    MonadIO m =>
    Config RegionIndices -> String -> Text -> m Text
    ormolu Config RegionIndices
    cfg String
    "<stdin>"

    -- | Refine a 'Config' by incorporating given 'SourceType', 'CabalInfo', and
    -- fixity overrides 'FixityMap'. You can use 'detectSourceType' to deduce
    -- 'SourceType' based on the file extension,
    -- 'CabalUtils.getCabalInfoForSourceFile' to obtain 'CabalInfo' and
    -- 'getFixityOverridesForSourceFile' for 'FixityMap'.
    --
    -- @since 0.5.3.0
    refineConfig ::
      -- | Source type to use
      SourceType ->
      -- | Cabal info for the file, if available
      Maybe CabalUtils.CabalInfo ->
      -- | Fixity overrides, if available
      Maybe FixityOverrides ->
      -- | Module re-exports, if available
      Maybe ModuleReexports ->
      -- | 'Config' to refine
      Config region ->
      -- | Refined 'Config'
      Config region
    refineConfig :: forall region.
    SourceType
    -> Maybe CabalInfo
    -> Maybe FixityOverrides
    -> Maybe ModuleReexports
    -> Config region
    -> Config region
    refineConfig SourceType
    sourceType Maybe CabalInfo
    mcabalInfo Maybe FixityOverrides
    mfixityOverrides Maybe ModuleReexports
    mreexports Config region
    rawConfig =
      Config region
    rawConfig
        { cfgDynOptions = cfgDynOptions rawConfig ++ dynOptsFromCabal,
          cfgFixityOverrides =
            FixityOverrides $
              Map.unions
                [ unFixityOverrides fixityOverrides,
                  unFixityOverrides (cfgFixityOverrides rawConfig),
                  unFixityOverrides defaultFixityOverrides
                ],
          cfgModuleReexports =
            ModuleReexports $
              Map.unionsWith
                (<>)
                [ unModuleReexports reexports,
                  unModuleReexports (cfgModuleReexports rawConfig),
                  unModuleReexports defaultModuleReexports
                ],
          cfgDependencies =
            Set.union (cfgDependencies rawConfig) depsFromCabal,
          cfgSourceType = sourceType
        }
      where
        fixityOverrides :: FixityOverrides
    fixityOverrides = FixityOverrides -> Maybe FixityOverrides -> FixityOverrides
    forall a. a -> Maybe a -> a
    fromMaybe FixityOverrides
    defaultFixityOverrides Maybe FixityOverrides
    mfixityOverrides
        reexports :: ModuleReexports
    reexports = ModuleReexports -> Maybe ModuleReexports -> ModuleReexports
    forall a. a -> Maybe a -> a
    fromMaybe ModuleReexports
    defaultModuleReexports Maybe ModuleReexports
    mreexports
        ([DynOption]
    dynOptsFromCabal, Set PackageName
    depsFromCabal) =
          case Maybe CabalInfo
    mcabalInfo of
            Maybe CabalInfo
    Nothing ->
              -- If no cabal info is provided, assume base as a dependency by
              -- default.
              ([], Set PackageName
    defaultDependencies)
            Just CabalUtils.CabalInfo {String
    [DynOption]
    Set PackageName
    PackageName
    ciPackageName :: PackageName
    ciDynOpts :: [DynOption]
    ciDependencies :: Set PackageName
    ciCabalFilePath :: String
    ciCabalFilePath :: CabalInfo -> String
    ciDependencies :: CabalInfo -> Set PackageName
    ciDynOpts :: CabalInfo -> [DynOption]
    ciPackageName :: CabalInfo -> PackageName
    ..} ->
              -- It makes sense to take into account the operator info for the
              -- package itself if we know it, as if it were its own dependency.
              ([DynOption]
    ciDynOpts, PackageName -> Set PackageName -> Set PackageName
    forall a. Ord a => a -> Set a -> Set a
    Set.insert PackageName
    ciPackageName Set PackageName
    ciDependencies)

    ----------------------------------------------------------------------------
    -- Helpers

    -- | A wrapper around 'parseModule'.
    parseModule' ::
      (MonadIO m) =>
      -- | Ormolu configuration
      Config RegionDeltas ->
      -- | Fixity Map for operators
      PackageFixityMap ->
      -- | How to obtain 'OrmoluException' to throw when parsing fails
      (SrcSpan -> String -> OrmoluException) ->
      -- | File name to use in errors
      FilePath ->
      -- | Actual input for the parser
      Text ->
      m (DriverMessages, [SourceSnippet])
    parseModule' :: forall (m :: * -> *).
    MonadIO m =>
    Config RegionDeltas
    -> PackageFixityMap
    -> (SrcSpan -> String -> OrmoluException)
    -> String
    -> Text
    -> m (DriverMessages, [SourceSnippet])
    parseModule' Config RegionDeltas
    cfg PackageFixityMap
    fixityMap SrcSpan -> String -> OrmoluException
    mkException String
    path Text
    str = do
      (warnings, r) <- Config RegionDeltas
    -> PackageFixityMap
    -> String
    -> Text
    -> m (DriverMessages, Either (SrcSpan, String) [SourceSnippet])
    forall (m :: * -> *).
    MonadIO m =>
    Config RegionDeltas
    -> PackageFixityMap
    -> String
    -> Text
    -> m (DriverMessages, Either (SrcSpan, String) [SourceSnippet])
    parseModule Config RegionDeltas
    cfg PackageFixityMap
    fixityMap String
    path Text
    str
      case r of
        Left (SrcSpan
    spn, String
    err) -> IO (DriverMessages, [SourceSnippet])
    -> m (DriverMessages, [SourceSnippet])
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (DriverMessages, [SourceSnippet])
     -> m (DriverMessages, [SourceSnippet]))
    -> IO (DriverMessages, [SourceSnippet])
    -> m (DriverMessages, [SourceSnippet])
    forall a b. (a -> b) -> a -> b
    $ OrmoluException -> IO (DriverMessages, [SourceSnippet])
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (SrcSpan -> String -> OrmoluException
    mkException SrcSpan
    spn String
    err)
        Right [SourceSnippet]
    x -> (DriverMessages, [SourceSnippet])
    -> m (DriverMessages, [SourceSnippet])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DriverMessages
    warnings, [SourceSnippet]
    x)

    -- | Detect 'SourceType' based on the file extension.
    detectSourceType :: FilePath -> SourceType
    detectSourceType :: String -> SourceType
    detectSourceType String
    mpath =
      if String -> String
    takeExtension String
    mpath String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    ".hsig"
        then SourceType
    SignatureSource
        else SourceType
    ModuleSource