{-# LANGUAGE BangPatterns #-}
module Ormolu
( ormolu,
ormoluFile,
ormoluStdin,
Config (..),
defaultConfig,
DynOption (..),
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 ->
FilePath ->
String ->
m Text
ormolu cfg path str = do
(warnings, result0) <-
parseModule' cfg OrmoluParsingFailed path str
when (cfgDebug cfg) $ do
traceM "warnings:\n"
traceM (concatMap showWarn warnings)
traceM (prettyPrintParseResult result0)
let !txt = printModule result0
when (not (cfgUnsafe cfg) || cfgCheckIdempotency cfg) $ do
let pathRendered = path ++ "<rendered>"
(_, result1) <-
parseModule'
cfg
OrmoluOutputParsingFailed
pathRendered
(T.unpack txt)
unless (cfgUnsafe cfg) $
case diffParseResult result0 result1 of
Same -> return ()
Different ss -> liftIO $ throwIO (OrmoluASTDiffers path ss)
when (cfgCheckIdempotency cfg) $
let txt2 = printModule result1
in case diffText txt txt2 pathRendered of
Nothing -> return ()
Just (loc, l, r) ->
liftIO $
throwIO (OrmoluNonIdempotentOutput loc l r)
return txt
ormoluFile ::
MonadIO m =>
Config ->
FilePath ->
m Text
ormoluFile cfg path =
liftIO (readFile path) >>= ormolu cfg path
ormoluStdin ::
MonadIO m =>
Config ->
m Text
ormoluStdin cfg =
liftIO getContents >>= ormolu cfg "<stdin>"
parseModule' ::
MonadIO m =>
Config ->
(GHC.SrcSpan -> String -> OrmoluException) ->
FilePath ->
String ->
m ([GHC.Warn], ParseResult)
parseModule' cfg mkException path str = do
(warnings, r) <- parseModule cfg path str
case r of
Left (spn, err) -> liftIO $ throwIO (mkException spn err)
Right x -> return (warnings, x)
showWarn :: GHC.Warn -> String
showWarn (GHC.Warn reason l) =
unlines
[ showOutputable reason,
showOutputable l
]