{-# LANGUAGE BangPatterns #-}
module Ormolu
( ormolu,
ormoluFile,
ormoluStdin,
Config (..),
RegionIndices (..),
defaultConfig,
DynOption (..),
PrinterOpts (..),
PrinterOptsPartial,
PrinterOptsTotal,
defaultPrinterOpts,
loadConfigFile,
ConfigFileLoadResult (..),
configFileName,
fillMissingPrinterOpts,
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
ormolu ::
MonadIO m =>
Config RegionIndices ->
FilePath ->
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)
let !txt :: Text
txt = ParseResult -> PrinterOptsTotal -> Text
printModule ParseResult
result0 (PrinterOptsTotal -> Text) -> PrinterOptsTotal -> Text
forall a b. (a -> b) -> a -> b
$ Config RegionIndices -> PrinterOptsTotal
forall region. Config region -> PrinterOptsTotal
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>"
([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)
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 -> PrinterOptsTotal -> Text
printModule ParseResult
result1 (PrinterOptsTotal -> Text) -> PrinterOptsTotal -> Text
forall a b. (a -> b) -> a -> b
$ Config RegionIndices -> PrinterOptsTotal
forall region. Config region -> PrinterOptsTotal
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
ormoluFile ::
MonadIO m =>
Config RegionIndices ->
FilePath ->
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
ormoluStdin ::
MonadIO m =>
Config RegionIndices ->
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>"
parseModule' ::
MonadIO m =>
Config RegionDeltas ->
(GHC.SrcSpan -> String -> OrmoluException) ->
FilePath ->
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)
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
]