{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
module Ormolu
( ormolu,
ormoluFile,
ormoluStdin,
Config (..),
ColorMode (..),
RegionIndices (..),
defaultConfig,
DynOption (..),
PrinterOpts (..),
PrinterOptsPartial,
PrinterOptsTotal,
defaultPrinterOpts,
loadConfigFile,
ConfigFileLoadResult (..),
configFileName,
fillMissingPrinterOpts,
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
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, [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)
let !txt :: Text
txt = [SourceSnippet] -> PrinterOptsTotal -> Text
printModule [SourceSnippet]
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
([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 [])
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] -> PrinterOptsTotal -> Text
printModule [SourceSnippet]
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 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
ormoluFile ::
MonadIO m =>
Config RegionIndices ->
FilePath ->
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
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], [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)
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
]