{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}

-- | A formatter for Haskell source code.
module Ormolu
  ( ormolu,
    ormoluFile,
    ormoluStdin,
    Config (..),
    ColorMode (..),
    RegionIndices (..),
    defaultConfig,
    DynOption (..),
    OrmoluException (..),
    withPrettyOrmoluExceptions,
  )
where

import Control.Exception
import Control.Monad
import Control.Monad.IO.Class (MonadIO (..))
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.Parser
import Ormolu.Parser.Result
import Ormolu.Printer
import Ormolu.Utils (showOutputable)
import Ormolu.Utils.IO

-- | Format a 'String', return formatted version as 'Text'.
--
-- The function
--
--     * Takes 'String' because that's what GHC parser accepts.
--     * 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'.
ormolu ::
  MonadIO m =>
  -- | Ormolu configuration
  Config RegionIndices ->
  -- | Location of source file
  FilePath ->
  -- | Input to format
  String ->
  m Text
ormolu :: Config RegionIndices -> FilePath -> FilePath -> m Text
ormolu Config RegionIndices
cfgWithIndices FilePath
path FilePath
str = do
  let totalLines :: Int
totalLines = [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FilePath -> [FilePath]
lines FilePath
str)
      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
  ([Warn]
warnings, [SourceSnippet]
result0) <-
    Config RegionDeltas
-> (SrcSpan -> FilePath -> OrmoluException)
-> FilePath
-> FilePath
-> m ([Warn], [SourceSnippet])
forall (m :: * -> *).
MonadIO m =>
Config RegionDeltas
-> (SrcSpan -> FilePath -> OrmoluException)
-> FilePath
-> FilePath
-> m ([Warn], [SourceSnippet])
parseModule' Config RegionDeltas
cfg SrcSpan -> FilePath -> OrmoluException
OrmoluParsingFailed FilePath
path FilePath
str
  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
    FilePath -> m ()
forall (f :: * -> *). Applicative f => FilePath -> f ()
traceM FilePath
"warnings:\n"
    FilePath -> m ()
forall (f :: * -> *). Applicative f => FilePath -> f ()
traceM ((Warn -> FilePath) -> [Warn] -> FilePath
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Warn -> FilePath
showWarn [Warn]
warnings)
  -- We're forcing 'txt' 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 !txt :: Text
txt = [SourceSnippet] -> Text
printModule [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
-> (SrcSpan -> FilePath -> OrmoluException)
-> FilePath
-> FilePath
-> m ([Warn], [SourceSnippet])
forall (m :: * -> *).
MonadIO m =>
Config RegionDeltas
-> (SrcSpan -> FilePath -> OrmoluException)
-> FilePath
-> FilePath
-> m ([Warn], [SourceSnippet])
parseModule'
        Config RegionDeltas
cfg
        SrcSpan -> FilePath -> OrmoluException
OrmoluOutputParsingFailed
        FilePath
path
        (Text -> FilePath
T.unpack Text
txt)
    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 ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([SourceSnippet] -> 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 (t :: * -> *) a. Foldable t => t a -> Int
length [SourceSnippet]
result1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ OrmoluException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (FilePath -> [SrcSpan] -> OrmoluException
OrmoluASTDiffers FilePath
path [])
      [(SourceSnippet, SourceSnippet)]
-> ((SourceSnippet, SourceSnippet) -> m ()) -> m ()
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) -> m ()) -> m ())
-> ((SourceSnippet, SourceSnippet) -> m ()) -> m ()
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 -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Different [SrcSpan]
ss -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ OrmoluException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (FilePath -> [SrcSpan] -> OrmoluException
OrmoluASTDiffers FilePath
path [SrcSpan]
ss)
        (RawSnippet {}, RawSnippet {}) -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        (SourceSnippet, SourceSnippet)
_ -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ OrmoluException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (FilePath -> [SrcSpan] -> OrmoluException
OrmoluASTDiffers FilePath
path [])
    -- 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 ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      let txt2 :: Text
txt2 = [SourceSnippet] -> Text
printModule [SourceSnippet]
result1
       in case Text -> Text -> FilePath -> Maybe TextDiff
diffText Text
txt Text
txt2 FilePath
path of
            Maybe TextDiff
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just TextDiff
diff ->
              IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
                OrmoluException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (TextDiff -> OrmoluException
OrmoluNonIdempotentOutput TextDiff
diff)
  Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
txt

-- | Load a file and format it. The file stays intact and the rendered
-- version is returned as 'Text'.
--
-- > ormoluFile cfg path =
-- >   liftIO (readFile path) >>= ormolu cfg path
ormoluFile ::
  MonadIO m =>
  -- | Ormolu configuration
  Config RegionIndices ->
  -- | Location of source file
  FilePath ->
  -- | Resulting rendition
  m Text
ormoluFile :: Config RegionIndices -> FilePath -> m Text
ormoluFile Config RegionIndices
cfg FilePath
path =
  FilePath -> m Text
forall (m :: * -> *). MonadIO m => FilePath -> m Text
readFileUtf8 FilePath
path m Text -> (Text -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Config RegionIndices -> FilePath -> FilePath -> m Text
forall (m :: * -> *).
MonadIO m =>
Config RegionIndices -> FilePath -> FilePath -> m Text
ormolu Config RegionIndices
cfg FilePath
path (FilePath -> m Text) -> (Text -> FilePath) -> Text -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack

-- | Read input from stdin and format it.
--
-- > ormoluStdin cfg =
-- >   liftIO (hGetContents stdin) >>= ormolu cfg "<stdin>"
ormoluStdin ::
  MonadIO m =>
  -- | Ormolu configuration
  Config RegionIndices ->
  -- | Resulting rendition
  m Text
ormoluStdin :: Config RegionIndices -> m Text
ormoluStdin Config RegionIndices
cfg =
  IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getContents m FilePath -> (FilePath -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Config RegionIndices -> FilePath -> FilePath -> m Text
forall (m :: * -> *).
MonadIO m =>
Config RegionIndices -> FilePath -> FilePath -> m Text
ormolu Config RegionIndices
cfg FilePath
"<stdin>"

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

-- | A wrapper around 'parseModule'.
parseModule' ::
  MonadIO m =>
  -- | Ormolu configuration
  Config RegionDeltas ->
  -- | 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
  String ->
  m ([GHC.Warn], [SourceSnippet])
parseModule' :: Config RegionDeltas
-> (SrcSpan -> FilePath -> OrmoluException)
-> FilePath
-> FilePath
-> m ([Warn], [SourceSnippet])
parseModule' Config RegionDeltas
cfg SrcSpan -> FilePath -> OrmoluException
mkException FilePath
path FilePath
str = do
  ([Warn]
warnings, Either (SrcSpan, FilePath) [SourceSnippet]
r) <- Config RegionDeltas
-> FilePath
-> FilePath
-> m ([Warn], Either (SrcSpan, FilePath) [SourceSnippet])
forall (m :: * -> *).
MonadIO m =>
Config RegionDeltas
-> FilePath
-> FilePath
-> m ([Warn], Either (SrcSpan, FilePath) [SourceSnippet])
parseModule Config RegionDeltas
cfg FilePath
path FilePath
str
  case Either (SrcSpan, FilePath) [SourceSnippet]
r of
    Left (SrcSpan
spn, FilePath
err) -> IO ([Warn], [SourceSnippet]) -> m ([Warn], [SourceSnippet])
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 -> FilePath -> OrmoluException
mkException SrcSpan
spn FilePath
err)
    Right [SourceSnippet]
x -> ([Warn], [SourceSnippet]) -> m ([Warn], [SourceSnippet])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Warn]
warnings, [SourceSnippet]
x)

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