From c7095132094d1adcc8622cd4ded738131432f9dc Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Sat, 25 Nov 2017 19:23:56 +0100 Subject: [PATCH] Remove dependency on either package Following the deprecation and removal of the EitherT transformer --- brittany.cabal | 4 -- src-brittany/Main.hs | 8 ++-- src/Language/Haskell/Brittany/Internal.hs | 8 ++-- .../Brittany/Internal/ExactPrintUtils.hs | 37 +++++++++---------- srcinc/prelude.inc | 2 +- 5 files changed, 26 insertions(+), 33 deletions(-) diff --git a/brittany.cabal b/brittany.cabal index ca639b8..bf2ba63 100644 --- a/brittany.cabal +++ b/brittany.cabal @@ -112,7 +112,6 @@ library { , unsafe >=0.0 && <0.1 , safe >=0.3.9 && <0.4 , deepseq >=1.4.2.0 && <1.5 - , either >=4.4.1.1 && <4.5 , semigroups >=0.18.2 && <0.19 , cmdargs >=0.10.14 && <0.11 , czipwith >=1.0.0.0 && <1.1 @@ -175,7 +174,6 @@ executable brittany , unsafe , safe , deepseq - , either , semigroups , cmdargs , czipwith @@ -252,7 +250,6 @@ test-suite unittests , unsafe , safe , deepseq - , either , semigroups , cmdargs , czipwith @@ -324,7 +321,6 @@ test-suite littests , unsafe , safe , deepseq - , either , semigroups , cmdargs , czipwith diff --git a/src-brittany/Main.hs b/src-brittany/Main.hs index 4928acf..046c830 100644 --- a/src-brittany/Main.hs +++ b/src-brittany/Main.hs @@ -193,8 +193,8 @@ coreIO -> Maybe FilePath.FilePath -- ^ input filepath; stdin if Nothing. -> Maybe FilePath.FilePath -- ^ output filepath; stdout if Nothing. -> IO (Either Int ()) -- ^ Either an errorNo, or success. -coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = EitherT.runEitherT $ do - let putErrorLn = liftIO . putErrorLnIO :: String -> EitherT.EitherT e IO () +coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = ExceptT.runExceptT $ do + let putErrorLn = liftIO . putErrorLnIO :: String -> ExceptT.ExceptT e IO () let ghcOptions = config & _conf_forward & _options_ghc & runIdentity -- there is a good of code duplication between the following code and the -- `pureModuleTransform` function. Unfortunately, there are also a good @@ -234,7 +234,7 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = EitherT.runEi Left left -> do putErrorLn "parse error:" putErrorLn $ show left - EitherT.left 60 + ExceptT.throwE 60 Right (anns, parsedSource, hasCPP) -> do when (config & _conf_debug .> _dconf_dump_ast_full .> confUnpack) $ do let val = printTreeWithCustom 100 (customLayouterF anns) parsedSource @@ -300,7 +300,7 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = EitherT.runEi Nothing -> liftIO $ TextL.IO.putStr $ outLText Just p -> liftIO $ TextL.IO.writeFile p $ outLText - when hasErrors $ EitherT.left 70 + when hasErrors $ ExceptT.throwE 70 where addTraceSep conf = if or diff --git a/src/Language/Haskell/Brittany/Internal.hs b/src/Language/Haskell/Brittany/Internal.hs index 4c4bbf0..64c139a 100644 --- a/src/Language/Haskell/Brittany/Internal.hs +++ b/src/Language/Haskell/Brittany/Internal.hs @@ -20,7 +20,7 @@ import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint.Parsers import Data.Data -import Control.Monad.Trans.Either +import Control.Monad.Trans.Except import Data.HList.HList import Data.CZipWith @@ -62,7 +62,7 @@ import qualified GHC.LanguageExtensions.Type as GHC -- Note that this function ignores/resets all config values regarding -- debugging, i.e. it will never use `trace`/write to stderr. parsePrintModule :: Config -> Text -> IO (Either [BrittanyError] Text) -parsePrintModule configRaw inputText = runEitherT $ do +parsePrintModule configRaw inputText = runExceptT $ do let config = configRaw { _conf_debug = _conf_debug staticDefaultConfig } let ghcOptions = config & _conf_forward & _options_ghc & runIdentity let config_pp = config & _conf_preprocessor @@ -87,7 +87,7 @@ parsePrintModule configRaw inputText = runEitherT $ do cppCheckFunc (hackTransform $ Text.unpack inputText) case parseResult of - Left err -> left $ [ErrorInput err] + Left err -> throwE $ [ErrorInput err] Right x -> pure $ x (errsWarns, outputTextL) <- do let omitCheck = @@ -117,7 +117,7 @@ parsePrintModule configRaw inputText = runEitherT $ do case config & _conf_errorHandling & _econf_Werror & confUnpack of False -> 0 < maximum (-1 : fmap customErrOrder errsWarns) True -> not $ null errsWarns - if hasErrors then left $ errsWarns else pure $ TextL.toStrict outputTextL + if hasErrors then throwE $ errsWarns else pure $ TextL.toStrict outputTextL diff --git a/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs b/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs index faa9526..74ed50d 100644 --- a/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs +++ b/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs @@ -58,26 +58,24 @@ parseModuleWithCpp -> (GHC.DynFlags -> IO (Either String a)) -> IO (Either String (ExactPrint.Anns, GHC.ParsedSource, a)) parseModuleWithCpp cpp opts args fp dynCheck = - ExactPrint.ghcWrapper $ EitherT.runEitherT $ do + ExactPrint.ghcWrapper $ ExceptT.runExceptT $ do dflags0 <- lift $ GHC.getSessionDynFlags - (dflags1, leftover, warnings) <- lift $ GHC.parseDynamicFlagsCmdLine - dflags0 - (GHC.noLoc <$> args) + (dflags1, leftover, warnings) <- lift + $ GHC.parseDynamicFlagsCmdLine dflags0 (GHC.noLoc <$> args) void $ lift $ GHC.setSessionDynFlags dflags1 - dflags2 <- lift $ ExactPrint.initDynFlags fp + dflags2 <- lift $ ExactPrint.initDynFlags fp when (not $ null leftover) - $ EitherT.left + $ ExceptT.throwE $ "when parsing ghc flags: leftover flags: " ++ show (leftover <&> \(L _ s) -> s) when (not $ null warnings) - $ EitherT.left + $ ExceptT.throwE $ "when parsing ghc flags: encountered warnings: " ++ show (warnings <&> \(L _ s) -> s) - x <- EitherT.EitherT $ liftIO $ dynCheck dflags2 + x <- ExceptT.ExceptT $ liftIO $ dynCheck dflags2 res <- lift $ ExactPrint.parseModuleApiAnnsWithCppInternal cpp dflags2 fp - EitherT.hoistEither - $ either (\(span, err) -> Left $ show span ++ ": " ++ err) - (\(a, m) -> Right (a, m, x)) + either (\(span, err) -> ExceptT.throwE $ show span ++ ": " ++ err) + (\(a, m) -> pure (a, m, x)) $ ExactPrint.postParseTransform res opts parseModuleFromString @@ -87,22 +85,21 @@ parseModuleFromString -> String -> IO (Either String (ExactPrint.Anns, GHC.ParsedSource, a)) parseModuleFromString args fp dynCheck str = - ExactPrint.ghcWrapper $ EitherT.runEitherT $ do + ExactPrint.ghcWrapper $ ExceptT.runExceptT $ do dflags0 <- lift $ ExactPrint.initDynFlagsPure fp str - (dflags1, leftover, warnings) <- - lift $ GHC.parseDynamicFlagsCmdLine dflags0 (GHC.noLoc <$> args) + (dflags1, leftover, warnings) <- lift + $ GHC.parseDynamicFlagsCmdLine dflags0 (GHC.noLoc <$> args) when (not $ null leftover) - $ EitherT.left + $ ExceptT.throwE $ "when parsing ghc flags: leftover flags: " ++ show (leftover <&> \(L _ s) -> s) when (not $ null warnings) - $ EitherT.left + $ ExceptT.throwE $ "when parsing ghc flags: encountered warnings: " ++ show (warnings <&> \(L _ s) -> s) - x <- EitherT.EitherT $ liftIO $ dynCheck dflags1 - EitherT.hoistEither - $ either (\(span, err) -> Left $ show span ++ ": " ++ err) - (\(a, m) -> Right (a, m, x)) + x <- ExceptT.ExceptT $ liftIO $ dynCheck dflags1 + either (\(span, err) -> ExceptT.throwE $ show span ++ ": " ++ err) + (\(a, m) -> pure (a, m, x)) $ ExactPrint.parseWith dflags1 fp GHC.parseModule str ----------- diff --git a/srcinc/prelude.inc b/srcinc/prelude.inc index 805b941..81ca53a 100644 --- a/srcinc/prelude.inc +++ b/srcinc/prelude.inc @@ -136,7 +136,7 @@ import qualified Data.Text.Lazy.IO as TextL.IO import qualified Control.Monad.Trans.State as State import qualified Control.Monad.Trans.State.Lazy as StateL import qualified Control.Monad.Trans.State.Strict as StateS -import qualified Control.Monad.Trans.Either as EitherT +import qualified Control.Monad.Trans.Except as ExceptT import qualified Data.Strict.Maybe as Strict