diff --git a/app/ExitCode.hs b/app/ExitCode.hs index f3baa22..910811b 100644 --- a/app/ExitCode.hs +++ b/app/ExitCode.hs @@ -16,13 +16,12 @@ import Text.PrettyPrint.ANSI.Leijen -- should exit with failure if any format differences were found. Otherwise -- assume we are being run in a context where non-zero exit indicates -- failure of the tool to operate properly. -exitCode :: Action -> Bool -> ExitCode -exitCode action formattedCodeDiffers = - if formattedCodeDiffers && failOnDifferences - then ExitFailure formattedCodeDiffersFailureCode - else ExitSuccess - where - failOnDifferences = action == PrintDiffs +exitCode :: Action -> RunResult -> ExitCode +exitCode _ NoDifferences = ExitSuccess +exitCode PrintDiffs HadDifferences = ExitFailure formattedCodeDiffersFailureCode +exitCode _ HadDifferences = ExitSuccess +exitCode _ SourceParseFailure = ExitFailure sourceParseFailureCode +exitCode _ OperationalFailure = ExitFailure operationalFailureCode helpDoc :: Doc helpDoc = diff --git a/app/Main.hs b/app/Main.hs index 98c2928..4e96685 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -16,38 +16,44 @@ import Conduit import Options.Applicative.Extra as OptApp import System.Directory import System.Exit +import System.IO main :: IO () main = do options <- execParser Options.parser - changes <- run options - case changes of - Left err -> print err >> exitWith (ExitFailure sourceParseFailureCode) - Right changes' -> do - formattedCodeDiffers <- - runConduit $ - yieldMany changes' .| mapMC (Actions.act options) .| - anyC' (\(Formatted _ source result) -> wasReformatted source result) - exitWith $ exitCode (optAction options) formattedCodeDiffers + result <- run options + exitWith $ exitCode (optAction options) result -run :: Options -> IO (Either FormatError [Formatted]) -run options = do - changesE <- - runConduit $ sources .| mapMC readSource .| mapMC formatSource .| sinkList - return $ sequence changesE +run :: Options -> IO RunResult +run opt = + runConduit $ + sources opt .| mapMC readSource .| mapMC formatSource .| mapMC doAction .| + foldMapMC toRunResult where - paths = do - let explicitPaths = optPaths options + formatSource source = do + formatter <- defaultFormatter + return $ applyFormatter formatter source + doAction :: FormatResult -> IO FormatResult + doAction = bimapM return (Actions.act opt) + toRunResult :: FormatResult -> IO RunResult + toRunResult (Left err) = do + hPrint stderr (show err) + return SourceParseFailure + toRunResult (Right (Formatted _ source result)) = + if wasReformatted source result + then return HadDifferences + else return NoDifferences + +sources :: Options -> Source IO SourceFile +sources opt = lift paths >>= mapM_ sourcesFromPath + where + explicitPaths = optPaths opt + paths = if null explicitPaths then do currentPath <- getCurrentDirectory return [currentPath] else return explicitPaths - sources :: Source IO SourceFile - sources = lift paths >>= mapM_ sourcesFromPath - formatSource source = do - formatter <- defaultFormatter - return $ applyFormatter formatter source sourcesFromPath :: FilePath -> Source IO SourceFile sourcesFromPath "-" = yield StdinSource @@ -65,11 +71,6 @@ applyFormatter (Formatter doFormat) (SourceFileWithContents file contents) = Left err -> Left (FormatError file err) Right reformat -> Right (Formatted file contents reformat) --- | Check that at least one value in the stream returns True. --- --- Does not shortcut, entire stream is always consumed -anyC' :: Monad m => (a -> Bool) -> Consumer a m Bool -anyC' f = do - result <- anyC f -- Check for at least one value, may shortcut - sinkNull -- consume any remaining input skipped by a shortcut - return result +bimapM :: Monad m => (a -> m c) -> (b -> m d) -> Either a b -> m (Either c d) +bimapM f _ (Left a) = Left <$> f a +bimapM _ g (Right b) = Right <$> g b diff --git a/app/Types.hs b/app/Types.hs index 01b6869..eeece84 100644 --- a/app/Types.hs +++ b/app/Types.hs @@ -4,6 +4,7 @@ module Types , FormatError(..) , Formatted(..) , HaskellSource(..) + , RunResult(..) , SourceFile(..) , SourceFileWithContents(..) ) where @@ -43,3 +44,17 @@ data Formatted = Formatted SourceFile HaskellSource Reformatted + +data RunResult + = OperationalFailure + | SourceParseFailure + | HadDifferences + | NoDifferences + +instance Monoid RunResult where + mempty = NoDifferences + x `mappend` NoDifferences = x + NoDifferences `mappend` x = x + OperationalFailure `mappend` _ = OperationalFailure + SourceParseFailure `mappend` _ = SourceParseFailure + HadDifferences `mappend` _ = HadDifferences