{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
module Ormolu
( ormolu,
ormoluFile,
ormoluStdin,
Config (..),
ColorMode (..),
RegionIndices (..),
SourceType (..),
defaultConfig,
detectSourceType,
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.Fixity
import Ormolu.Parser
import Ormolu.Parser.CommentStream (showCommentStream)
import Ormolu.Parser.Result
import Ormolu.Printer
import Ormolu.Utils (showOutputable)
import Ormolu.Utils.IO
import System.FilePath
ormolu ::
MonadIO m =>
Config RegionIndices ->
FilePath ->
String ->
m Text
ormolu :: Config RegionIndices -> FilePath -> FilePath -> m Text
ormolu Config RegionIndices
cfgWithIndices FilePath
path FilePath
originalInput = do
let totalLines :: Int
totalLines = [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FilePath -> [FilePath]
lines FilePath
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 =
Float -> Set FilePath -> LazyFixityMap
buildFixityMap
Float
defaultStrategyThreshold
(Config RegionDeltas -> Set FilePath
forall region. Config region -> Set FilePath
cfgDependencies Config RegionDeltas
cfg)
([Warn]
warnings, [SourceSnippet]
result0) <-
Config RegionDeltas
-> LazyFixityMap
-> (SrcSpan -> FilePath -> OrmoluException)
-> FilePath
-> FilePath
-> m ([Warn], [SourceSnippet])
forall (m :: * -> *).
MonadIO m =>
Config RegionDeltas
-> LazyFixityMap
-> (SrcSpan -> FilePath -> OrmoluException)
-> FilePath
-> FilePath
-> m ([Warn], [SourceSnippet])
parseModule' Config RegionDeltas
cfg LazyFixityMap
fixityMap SrcSpan -> FilePath -> OrmoluException
OrmoluParsingFailed FilePath
path FilePath
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
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)
[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 -> FilePath -> m ()
forall (f :: * -> *). Applicative f => FilePath -> f ()
traceM (FilePath -> m ())
-> (ParseResult -> FilePath) -> ParseResult -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentStream -> FilePath
showCommentStream (CommentStream -> FilePath)
-> (ParseResult -> CommentStream) -> ParseResult -> FilePath
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 (f :: * -> *) a. Applicative f => a -> f a
pure ()
let !formattedText :: Text
formattedText = [SourceSnippet] -> PrinterOptsTotal -> Text
printSnippets [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
-> LazyFixityMap
-> (SrcSpan -> FilePath -> OrmoluException)
-> FilePath
-> FilePath
-> m ([Warn], [SourceSnippet])
forall (m :: * -> *).
MonadIO m =>
Config RegionDeltas
-> LazyFixityMap
-> (SrcSpan -> FilePath -> OrmoluException)
-> FilePath
-> FilePath
-> m ([Warn], [SourceSnippet])
parseModule'
Config RegionDeltas
cfg
LazyFixityMap
fixityMap
SrcSpan -> FilePath -> OrmoluException
OrmoluOutputParsingFailed
FilePath
path
(Text -> FilePath
T.unpack 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 (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 -> FilePath -> Maybe TextDiff
diffText (FilePath -> Text
T.pack FilePath
originalInput) Text
formattedText FilePath
path of
Maybe TextDiff
Nothing -> FilePath -> TextDiff
forall a. HasCallStack => FilePath -> a
error FilePath
"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 (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) (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 (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 (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 [])
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 (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] -> PrinterOptsTotal -> Text
printSnippets [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
formattedText Text
reformattedText FilePath
path of
Maybe TextDiff
Nothing -> () -> IO ()
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 (m :: * -> *) a. Monad m => a -> m a
return Text
formattedText
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 =
m Text
forall (m :: * -> *). MonadIO m => m Text
getContentsUtf8 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
"<stdin>" (FilePath -> m Text) -> (Text -> FilePath) -> Text -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack
parseModule' ::
MonadIO m =>
Config RegionDeltas ->
LazyFixityMap ->
(GHC.SrcSpan -> String -> OrmoluException) ->
FilePath ->
String ->
m ([GHC.Warn], [SourceSnippet])
parseModule' :: Config RegionDeltas
-> LazyFixityMap
-> (SrcSpan -> FilePath -> OrmoluException)
-> FilePath
-> FilePath
-> m ([Warn], [SourceSnippet])
parseModule' Config RegionDeltas
cfg LazyFixityMap
fixityMap SrcSpan -> FilePath -> OrmoluException
mkException FilePath
path FilePath
str = do
([Warn]
warnings, Either (SrcSpan, FilePath) [SourceSnippet]
r) <- Config RegionDeltas
-> LazyFixityMap
-> FilePath
-> FilePath
-> m ([Warn], Either (SrcSpan, FilePath) [SourceSnippet])
forall (m :: * -> *).
MonadIO m =>
Config RegionDeltas
-> LazyFixityMap
-> FilePath
-> FilePath
-> m ([Warn], Either (SrcSpan, FilePath) [SourceSnippet])
parseModule Config RegionDeltas
cfg LazyFixityMap
fixityMap 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
]
detectSourceType :: FilePath -> SourceType
detectSourceType :: FilePath -> SourceType
detectSourceType FilePath
mpath =
if FilePath -> FilePath
takeExtension FilePath
mpath FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".hsig"
then SourceType
SignatureSource
else SourceType
ModuleSource