    {-# LANGUAGE BangPatterns #-}
    {-# 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
        FixityMap,
        getFixityOverridesForSourceFile,

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

    import Control.Exception
    import Control.Monad
    import Control.Monad.IO.Class (MonadIO (..))
    import qualified Data.Map.Strict as Map
    import qualified Data.Set as Set
    import Data.Text (Text)
    import qualified Data.Text as T
    import Debug.Trace
    import qualified GHC.Driver.CmdLine as GHC
    import qualified GHC.Types.SrcLoc as GHC
    import Ormolu.Config
    import Ormolu.Diff.ParseResult
    import Ormolu.Diff.Text
    import Ormolu.Exception
    import Ormolu.Fixity
    import Ormolu.Parser
    import Ormolu.Parser.CommentStream (showCommentStream)
    import Ormolu.Parser.Result
    import Ormolu.Printer
    import Ormolu.Utils (showOutputable)
    import qualified Ormolu.Utils.Cabal as CabalUtils
    import Ormolu.Utils.Fixity (getFixityOverridesForSourceFile)
    import Ormolu.Utils.IO
    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 :: LazyFixityMap
    fixityMap =
            -- It is important to keep all arguments (but last) of
            -- 'buildFixityMap' constant (such as 'defaultStrategyThreshold'),
            -- otherwise it is going to break memoization.
            Float -> Set PackageName -> LazyFixityMap
    buildFixityMap
              Float
    defaultStrategyThreshold
              (Config RegionDeltas -> Set PackageName
    forall region. Config region -> Set PackageName
    cfgDependencies Config RegionDeltas
    cfg) -- memoized on the set of dependencies
      ([Warn]
    warnings, [SourceSnippet]
    result0) <-
        Config RegionDeltas
    -> LazyFixityMap
    -> (SrcSpan -> String -> OrmoluException)
    -> String
    -> Text
    -> m ([Warn], [SourceSnippet])
    forall (m :: * -> *).
    MonadIO m =>
    Config RegionDeltas
    -> LazyFixityMap
    -> (SrcSpan -> String -> OrmoluException)
    -> String
    -> Text
    -> m ([Warn], [SourceSnippet])
    parseModule' Config RegionDeltas
    cfg LazyFixityMap
    fixityMap SrcSpan -> String -> OrmoluException
    OrmoluParsingFailed String
    path Text
    originalInput
      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
    "warnings:\n"
        String -> m ()
    forall (f :: * -> *). Applicative f => String -> f ()
    traceM ((Warn -> String) -> [Warn] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Warn -> String
    showWarn [Warn]
    warnings)
        [SourceSnippet] -> (SourceSnippet -> m ()) -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [SourceSnippet]
    result0 ((SourceSnippet -> m ()) -> m ())
    -> (SourceSnippet -> m ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \case
          ParsedSnippet ParseResult
    r -> String -> m ()
    forall (f :: * -> *). Applicative f => String -> f ()
    traceM (String -> m ()) -> (ParseResult -> String) -> ParseResult -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CommentStream -> String
    showCommentStream (CommentStream -> String)
    -> (ParseResult -> CommentStream) -> ParseResult -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseResult -> CommentStream
    prCommentStream (ParseResult -> m ()) -> ParseResult -> m ()
    forall a b. (a -> b) -> a -> b
    $ ParseResult
    r
          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 :: Text
    formattedText = [SourceSnippet] -> Text
    printSnippets [SourceSnippet]
    result0
      Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (Config RegionDeltas -> Bool
    forall region. Config region -> Bool
    cfgUnsafe Config RegionDeltas
    cfg) Bool -> Bool -> Bool
    || Config RegionDeltas -> Bool
    forall region. Config region -> Bool
    cfgCheckIdempotence Config RegionDeltas
    cfg) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
        -- Parse the result of pretty-printing again and make sure that AST
        -- is the same as AST of original snippet module span positions.
        ([Warn]
    _, [SourceSnippet]
    result1) <-
          Config RegionDeltas
    -> LazyFixityMap
    -> (SrcSpan -> String -> OrmoluException)
    -> String
    -> Text
    -> m ([Warn], [SourceSnippet])
    forall (m :: * -> *).
    MonadIO m =>
    Config RegionDeltas
    -> LazyFixityMap
    -> (SrcSpan -> String -> OrmoluException)
    -> String
    -> Text
    -> m ([Warn], [SourceSnippet])
    parseModule'
            Config RegionDeltas
    cfg
            LazyFixityMap
    fixityMap
            SrcSpan -> String -> OrmoluException
    OrmoluOutputParsingFailed
            String
    path
            Text
    formattedText
        Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Config RegionDeltas -> Bool
    forall region. Config region -> Bool
    cfgUnsafe Config RegionDeltas
    cfg) (m () -> m ()) -> (IO () -> m ()) -> IO () -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
          let diff :: TextDiff
    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
          Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([SourceSnippet] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [SourceSnippet]
    result0 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [SourceSnippet] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [SourceSnippet]
    result1) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            OrmoluException -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO (TextDiff -> [RealSrcSpan] -> OrmoluException
    OrmoluASTDiffers TextDiff
    diff [])
          [(SourceSnippet, SourceSnippet)]
    -> ((SourceSnippet, SourceSnippet) -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ ([SourceSnippet]
    result0 [SourceSnippet]
    -> [SourceSnippet] -> [(SourceSnippet, SourceSnippet)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [SourceSnippet]
    result1) (((SourceSnippet, SourceSnippet) -> IO ()) -> IO ())
    -> ((SourceSnippet, SourceSnippet) -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \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. 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. 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.
        Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Config RegionDeltas -> Bool
    forall region. Config region -> Bool
    cfgCheckIdempotence Config RegionDeltas
    cfg) (m () -> m ()) -> (IO () -> m ()) -> IO () -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $
          let reformattedText :: Text
    reformattedText = [SourceSnippet] -> Text
    printSnippets [SourceSnippet]
    result1
           in case Text -> Text -> String -> Maybe TextDiff
    diffText Text
    formattedText Text
    reformattedText String
    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. Exception e => e -> IO a
    throwIO (TextDiff -> OrmoluException
    OrmoluNonIdempotentOutput TextDiff
    diff)
      Text -> m Text
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    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 =
      String -> m Text
    forall (m :: * -> *). MonadIO m => String -> m Text
    readFileUtf8 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 =
      m Text
    forall (m :: * -> *). MonadIO m => m Text
    getContentsUtf8 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 FixityMap ->
      -- | 'Config' to refine
      Config region ->
      -- | Refined 'Config'
      Config region
    refineConfig :: forall region.
    SourceType
    -> Maybe CabalInfo
    -> Maybe FixityMap
    -> Config region
    -> Config region
    refineConfig SourceType
    sourceType Maybe CabalInfo
    mcabalInfo Maybe FixityMap
    mfixityOverrides Config region
    rawConfig =
      Config region
    rawConfig
        { cfgDynOptions :: [DynOption]
    cfgDynOptions = Config region -> [DynOption]
    forall region. Config region -> [DynOption]
    cfgDynOptions Config region
    rawConfig [DynOption] -> [DynOption] -> [DynOption]
    forall a. [a] -> [a] -> [a]
    ++ [DynOption]
    dynOptsFromCabal,
          cfgFixityOverrides :: FixityMap
    cfgFixityOverrides =
            (FixityInfo -> FixityInfo -> FixityInfo)
    -> FixityMap -> FixityMap -> FixityMap
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    Map.unionWith FixityInfo -> FixityInfo -> FixityInfo
    forall a. Semigroup a => a -> a -> a
    (<>) (Config region -> FixityMap
    forall region. Config region -> FixityMap
    cfgFixityOverrides Config region
    rawConfig) FixityMap
    fixityOverrides,
          cfgDependencies :: Set PackageName
    cfgDependencies =
            Set PackageName -> Set PackageName -> Set PackageName
    forall a. Ord a => Set a -> Set a -> Set a
    Set.union (Config region -> Set PackageName
    forall region. Config region -> Set PackageName
    cfgDependencies Config region
    rawConfig) Set PackageName
    depsFromCabal,
          cfgSourceType :: SourceType
    cfgSourceType = SourceType
    sourceType
        }
      where
        fixityOverrides :: FixityMap
    fixityOverrides =
          case Maybe FixityMap
    mfixityOverrides of
            Maybe FixityMap
    Nothing -> FixityMap
    forall k a. Map k a
    Map.empty
            Just FixityMap
    x -> FixityMap
    x
        ([DynOption]
    dynOptsFromCabal, Set PackageName
    depsFromCabal) =
          case Maybe CabalInfo
    mcabalInfo of
            Maybe CabalInfo
    Nothing -> ([], Set PackageName
    forall a. Set a
    Set.empty)
            Just CabalUtils.CabalInfo {String
    [DynOption]
    Set PackageName
    PackageName
    ciPackageName :: PackageName
    ciDynOpts :: [DynOption]
    ciDependencies :: Set PackageName
    ciCabalFilePath :: String
    ciPackageName :: CabalInfo -> PackageName
    ciDynOpts :: CabalInfo -> [DynOption]
    ciDependencies :: CabalInfo -> Set PackageName
    ciCabalFilePath :: CabalInfo -> String
    ..} ->
              -- 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
      LazyFixityMap ->
      -- | How to obtain 'OrmoluException' to throw when parsing fails
      (GHC.SrcSpan -> String -> OrmoluException) ->
      -- | File name to use in errors
      FilePath ->
      -- | Actual input for the parser
      Text ->
      m ([GHC.Warn], [SourceSnippet])
    parseModule' :: forall (m :: * -> *).
    MonadIO m =>
    Config RegionDeltas
    -> LazyFixityMap
    -> (SrcSpan -> String -> OrmoluException)
    -> String
    -> Text
    -> m ([Warn], [SourceSnippet])
    parseModule' Config RegionDeltas
    cfg LazyFixityMap
    fixityMap SrcSpan -> String -> OrmoluException
    mkException String
    path Text
    str = do
      ([Warn]
    warnings, Either (SrcSpan, String) [SourceSnippet]
    r) <- Config RegionDeltas
    -> LazyFixityMap
    -> String
    -> Text
    -> m ([Warn], Either (SrcSpan, String) [SourceSnippet])
    forall (m :: * -> *).
    MonadIO m =>
    Config RegionDeltas
    -> LazyFixityMap
    -> String
    -> Text
    -> m ([Warn], Either (SrcSpan, String) [SourceSnippet])
    parseModule Config RegionDeltas
    cfg LazyFixityMap
    fixityMap String
    path Text
    str
      case Either (SrcSpan, String) [SourceSnippet]
    r of
        Left (SrcSpan
    spn, String
    err) -> IO ([Warn], [SourceSnippet]) -> m ([Warn], [SourceSnippet])
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ([Warn], [SourceSnippet]) -> m ([Warn], [SourceSnippet]))
    -> IO ([Warn], [SourceSnippet]) -> m ([Warn], [SourceSnippet])
    forall a b. (a -> b) -> a -> b
    $ OrmoluException -> IO ([Warn], [SourceSnippet])
    forall e a. Exception e => e -> IO a
    throwIO (SrcSpan -> String -> OrmoluException
    mkException SrcSpan
    spn String
    err)
        Right [SourceSnippet]
    x -> ([Warn], [SourceSnippet]) -> m ([Warn], [SourceSnippet])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Warn]
    warnings, [SourceSnippet]
    x)

    -- | Pretty-print a 'GHC.Warn'.
    showWarn :: GHC.Warn -> String
    showWarn :: Warn -> String
    showWarn (GHC.Warn DiagnosticReason
    reason Located String
    l) =
      [String] -> String
    unlines
        [ DiagnosticReason -> String
    forall o. Outputable o => o -> String
    showOutputable DiagnosticReason
    reason,
          Located String -> String
    forall o. Outputable o => o -> String
    showOutputable Located String
    l
        ]

    -- | 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