{-# LANGUAGE BangPatterns #-}

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

import qualified CmdLineParser as GHC
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 Ormolu.Config
import Ormolu.Diff
import Ormolu.Exception
import Ormolu.Parser
import Ormolu.Parser.Result
import Ormolu.Printer
import Ormolu.Utils (showOutputable)
import qualified SrcLoc as GHC

-- | 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, ParseResult
result0) <-
    Config RegionDeltas
-> (SrcSpan -> FilePath -> OrmoluException)
-> FilePath
-> FilePath
-> m ([Warn], ParseResult)
forall (m :: * -> *).
MonadIO m =>
Config RegionDeltas
-> (SrcSpan -> FilePath -> OrmoluException)
-> FilePath
-> FilePath
-> m ([Warn], ParseResult)
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)
    FilePath -> m ()
forall (f :: * -> *). Applicative f => FilePath -> f ()
traceM (ParseResult -> FilePath
prettyPrintParseResult ParseResult
result0)
  -- 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 = ParseResult -> PrinterOpts -> Text
printModule ParseResult
result0 (PrinterOpts -> Text) -> PrinterOpts -> Text
forall a b. (a -> b) -> a -> b
$ Config RegionIndices -> PrinterOpts
forall region. Config region -> PrinterOpts
cfgPrinterOpts Config RegionIndices
cfgWithIndices
  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
    let pathRendered :: FilePath
pathRendered = FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"<rendered>"
    -- Parse the result of pretty-printing again and make sure that AST
    -- is the same as AST of original snippet module span positions.
    ([Warn]
_, ParseResult
result1) <-
      Config RegionDeltas
-> (SrcSpan -> FilePath -> OrmoluException)
-> FilePath
-> FilePath
-> m ([Warn], ParseResult)
forall (m :: * -> *).
MonadIO m =>
Config RegionDeltas
-> (SrcSpan -> FilePath -> OrmoluException)
-> FilePath
-> FilePath
-> m ([Warn], ParseResult)
parseModule'
        Config RegionDeltas
cfg
        SrcSpan -> FilePath -> OrmoluException
OrmoluOutputParsingFailed
        FilePath
pathRendered
        (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
$
      case ParseResult -> ParseResult -> Diff
diffParseResult ParseResult
result0 ParseResult
result1 of
        Diff
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)
    -- 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 = ParseResult -> PrinterOpts -> Text
printModule ParseResult
result1 (PrinterOpts -> Text) -> PrinterOpts -> Text
forall a b. (a -> b) -> a -> b
$ Config RegionIndices -> PrinterOpts
forall region. Config region -> PrinterOpts
cfgPrinterOpts Config RegionIndices
cfgWithIndices
       in case Text -> Text -> FilePath -> Maybe (RealSrcLoc, Text, Text)
diffText Text
txt Text
txt2 FilePath
pathRendered of
            Maybe (RealSrcLoc, Text, Text)
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just (RealSrcLoc
loc, Text
l, Text
r) ->
              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 (RealSrcLoc -> Text -> Text -> OrmoluException
OrmoluNonIdempotentOutput RealSrcLoc
loc Text
l Text
r)
  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 =
  IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO FilePath
readFile FilePath
path) 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
path

-- | 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], ParseResult)
parseModule' :: Config RegionDeltas
-> (SrcSpan -> FilePath -> OrmoluException)
-> FilePath
-> FilePath
-> m ([Warn], ParseResult)
parseModule' Config RegionDeltas
cfg SrcSpan -> FilePath -> OrmoluException
mkException FilePath
path FilePath
str = do
  ([Warn]
warnings, Either (SrcSpan, FilePath) ParseResult
r) <- Config RegionDeltas
-> FilePath
-> FilePath
-> m ([Warn], Either (SrcSpan, FilePath) ParseResult)
forall (m :: * -> *).
MonadIO m =>
Config RegionDeltas
-> FilePath
-> FilePath
-> m ([Warn], Either (SrcSpan, FilePath) ParseResult)
parseModule Config RegionDeltas
cfg FilePath
path FilePath
str
  case Either (SrcSpan, FilePath) ParseResult
r of
    Left (SrcSpan
spn, FilePath
err) -> IO ([Warn], ParseResult) -> m ([Warn], ParseResult)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([Warn], ParseResult) -> m ([Warn], ParseResult))
-> IO ([Warn], ParseResult) -> m ([Warn], ParseResult)
forall a b. (a -> b) -> a -> b
$ OrmoluException -> IO ([Warn], ParseResult)
forall e a. Exception e => e -> IO a
throwIO (SrcSpan -> FilePath -> OrmoluException
mkException SrcSpan
spn FilePath
err)
    Right ParseResult
x -> ([Warn], ParseResult) -> m ([Warn], ParseResult)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Warn]
warnings, ParseResult
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
    ]