Remove dependency on either package
Following the deprecation and removal of the EitherT transformerpull/75/head
parent
ea1720f95e
commit
c709513209
|
@ -112,7 +112,6 @@ library {
|
||||||
, unsafe >=0.0 && <0.1
|
, unsafe >=0.0 && <0.1
|
||||||
, safe >=0.3.9 && <0.4
|
, safe >=0.3.9 && <0.4
|
||||||
, deepseq >=1.4.2.0 && <1.5
|
, deepseq >=1.4.2.0 && <1.5
|
||||||
, either >=4.4.1.1 && <4.5
|
|
||||||
, semigroups >=0.18.2 && <0.19
|
, semigroups >=0.18.2 && <0.19
|
||||||
, cmdargs >=0.10.14 && <0.11
|
, cmdargs >=0.10.14 && <0.11
|
||||||
, czipwith >=1.0.0.0 && <1.1
|
, czipwith >=1.0.0.0 && <1.1
|
||||||
|
@ -175,7 +174,6 @@ executable brittany
|
||||||
, unsafe
|
, unsafe
|
||||||
, safe
|
, safe
|
||||||
, deepseq
|
, deepseq
|
||||||
, either
|
|
||||||
, semigroups
|
, semigroups
|
||||||
, cmdargs
|
, cmdargs
|
||||||
, czipwith
|
, czipwith
|
||||||
|
@ -252,7 +250,6 @@ test-suite unittests
|
||||||
, unsafe
|
, unsafe
|
||||||
, safe
|
, safe
|
||||||
, deepseq
|
, deepseq
|
||||||
, either
|
|
||||||
, semigroups
|
, semigroups
|
||||||
, cmdargs
|
, cmdargs
|
||||||
, czipwith
|
, czipwith
|
||||||
|
@ -324,7 +321,6 @@ test-suite littests
|
||||||
, unsafe
|
, unsafe
|
||||||
, safe
|
, safe
|
||||||
, deepseq
|
, deepseq
|
||||||
, either
|
|
||||||
, semigroups
|
, semigroups
|
||||||
, cmdargs
|
, cmdargs
|
||||||
, czipwith
|
, czipwith
|
||||||
|
|
|
@ -193,8 +193,8 @@ coreIO
|
||||||
-> Maybe FilePath.FilePath -- ^ input filepath; stdin if Nothing.
|
-> Maybe FilePath.FilePath -- ^ input filepath; stdin if Nothing.
|
||||||
-> Maybe FilePath.FilePath -- ^ output filepath; stdout if Nothing.
|
-> Maybe FilePath.FilePath -- ^ output filepath; stdout if Nothing.
|
||||||
-> IO (Either Int ()) -- ^ Either an errorNo, or success.
|
-> IO (Either Int ()) -- ^ Either an errorNo, or success.
|
||||||
coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = EitherT.runEitherT $ do
|
coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = ExceptT.runExceptT $ do
|
||||||
let putErrorLn = liftIO . putErrorLnIO :: String -> EitherT.EitherT e IO ()
|
let putErrorLn = liftIO . putErrorLnIO :: String -> ExceptT.ExceptT e IO ()
|
||||||
let ghcOptions = config & _conf_forward & _options_ghc & runIdentity
|
let ghcOptions = config & _conf_forward & _options_ghc & runIdentity
|
||||||
-- there is a good of code duplication between the following code and the
|
-- there is a good of code duplication between the following code and the
|
||||||
-- `pureModuleTransform` function. Unfortunately, there are also a good
|
-- `pureModuleTransform` function. Unfortunately, there are also a good
|
||||||
|
@ -234,7 +234,7 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = EitherT.runEi
|
||||||
Left left -> do
|
Left left -> do
|
||||||
putErrorLn "parse error:"
|
putErrorLn "parse error:"
|
||||||
putErrorLn $ show left
|
putErrorLn $ show left
|
||||||
EitherT.left 60
|
ExceptT.throwE 60
|
||||||
Right (anns, parsedSource, hasCPP) -> do
|
Right (anns, parsedSource, hasCPP) -> do
|
||||||
when (config & _conf_debug .> _dconf_dump_ast_full .> confUnpack) $ do
|
when (config & _conf_debug .> _dconf_dump_ast_full .> confUnpack) $ do
|
||||||
let val = printTreeWithCustom 100 (customLayouterF anns) parsedSource
|
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
|
Nothing -> liftIO $ TextL.IO.putStr $ outLText
|
||||||
Just p -> liftIO $ TextL.IO.writeFile p $ outLText
|
Just p -> liftIO $ TextL.IO.writeFile p $ outLText
|
||||||
|
|
||||||
when hasErrors $ EitherT.left 70
|
when hasErrors $ ExceptT.throwE 70
|
||||||
where
|
where
|
||||||
addTraceSep conf =
|
addTraceSep conf =
|
||||||
if or
|
if or
|
||||||
|
|
|
@ -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 qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint.Parsers
|
||||||
|
|
||||||
import Data.Data
|
import Data.Data
|
||||||
import Control.Monad.Trans.Either
|
import Control.Monad.Trans.Except
|
||||||
import Data.HList.HList
|
import Data.HList.HList
|
||||||
import Data.CZipWith
|
import Data.CZipWith
|
||||||
|
|
||||||
|
@ -62,7 +62,7 @@ import qualified GHC.LanguageExtensions.Type as GHC
|
||||||
-- Note that this function ignores/resets all config values regarding
|
-- Note that this function ignores/resets all config values regarding
|
||||||
-- debugging, i.e. it will never use `trace`/write to stderr.
|
-- debugging, i.e. it will never use `trace`/write to stderr.
|
||||||
parsePrintModule :: Config -> Text -> IO (Either [BrittanyError] Text)
|
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 config = configRaw { _conf_debug = _conf_debug staticDefaultConfig }
|
||||||
let ghcOptions = config & _conf_forward & _options_ghc & runIdentity
|
let ghcOptions = config & _conf_forward & _options_ghc & runIdentity
|
||||||
let config_pp = config & _conf_preprocessor
|
let config_pp = config & _conf_preprocessor
|
||||||
|
@ -87,7 +87,7 @@ parsePrintModule configRaw inputText = runEitherT $ do
|
||||||
cppCheckFunc
|
cppCheckFunc
|
||||||
(hackTransform $ Text.unpack inputText)
|
(hackTransform $ Text.unpack inputText)
|
||||||
case parseResult of
|
case parseResult of
|
||||||
Left err -> left $ [ErrorInput err]
|
Left err -> throwE $ [ErrorInput err]
|
||||||
Right x -> pure $ x
|
Right x -> pure $ x
|
||||||
(errsWarns, outputTextL) <- do
|
(errsWarns, outputTextL) <- do
|
||||||
let omitCheck =
|
let omitCheck =
|
||||||
|
@ -117,7 +117,7 @@ parsePrintModule configRaw inputText = runEitherT $ do
|
||||||
case config & _conf_errorHandling & _econf_Werror & confUnpack of
|
case config & _conf_errorHandling & _econf_Werror & confUnpack of
|
||||||
False -> 0 < maximum (-1 : fmap customErrOrder errsWarns)
|
False -> 0 < maximum (-1 : fmap customErrOrder errsWarns)
|
||||||
True -> not $ null 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
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -58,26 +58,24 @@ parseModuleWithCpp
|
||||||
-> (GHC.DynFlags -> IO (Either String a))
|
-> (GHC.DynFlags -> IO (Either String a))
|
||||||
-> IO (Either String (ExactPrint.Anns, GHC.ParsedSource, a))
|
-> IO (Either String (ExactPrint.Anns, GHC.ParsedSource, a))
|
||||||
parseModuleWithCpp cpp opts args fp dynCheck =
|
parseModuleWithCpp cpp opts args fp dynCheck =
|
||||||
ExactPrint.ghcWrapper $ EitherT.runEitherT $ do
|
ExactPrint.ghcWrapper $ ExceptT.runExceptT $ do
|
||||||
dflags0 <- lift $ GHC.getSessionDynFlags
|
dflags0 <- lift $ GHC.getSessionDynFlags
|
||||||
(dflags1, leftover, warnings) <- lift $ GHC.parseDynamicFlagsCmdLine
|
(dflags1, leftover, warnings) <- lift
|
||||||
dflags0
|
$ GHC.parseDynamicFlagsCmdLine dflags0 (GHC.noLoc <$> args)
|
||||||
(GHC.noLoc <$> args)
|
|
||||||
void $ lift $ GHC.setSessionDynFlags dflags1
|
void $ lift $ GHC.setSessionDynFlags dflags1
|
||||||
dflags2 <- lift $ ExactPrint.initDynFlags fp
|
dflags2 <- lift $ ExactPrint.initDynFlags fp
|
||||||
when (not $ null leftover)
|
when (not $ null leftover)
|
||||||
$ EitherT.left
|
$ ExceptT.throwE
|
||||||
$ "when parsing ghc flags: leftover flags: "
|
$ "when parsing ghc flags: leftover flags: "
|
||||||
++ show (leftover <&> \(L _ s) -> s)
|
++ show (leftover <&> \(L _ s) -> s)
|
||||||
when (not $ null warnings)
|
when (not $ null warnings)
|
||||||
$ EitherT.left
|
$ ExceptT.throwE
|
||||||
$ "when parsing ghc flags: encountered warnings: "
|
$ "when parsing ghc flags: encountered warnings: "
|
||||||
++ show (warnings <&> \(L _ s) -> s)
|
++ show (warnings <&> \(L _ s) -> s)
|
||||||
x <- EitherT.EitherT $ liftIO $ dynCheck dflags2
|
x <- ExceptT.ExceptT $ liftIO $ dynCheck dflags2
|
||||||
res <- lift $ ExactPrint.parseModuleApiAnnsWithCppInternal cpp dflags2 fp
|
res <- lift $ ExactPrint.parseModuleApiAnnsWithCppInternal cpp dflags2 fp
|
||||||
EitherT.hoistEither
|
either (\(span, err) -> ExceptT.throwE $ show span ++ ": " ++ err)
|
||||||
$ either (\(span, err) -> Left $ show span ++ ": " ++ err)
|
(\(a, m) -> pure (a, m, x))
|
||||||
(\(a, m) -> Right (a, m, x))
|
|
||||||
$ ExactPrint.postParseTransform res opts
|
$ ExactPrint.postParseTransform res opts
|
||||||
|
|
||||||
parseModuleFromString
|
parseModuleFromString
|
||||||
|
@ -87,22 +85,21 @@ parseModuleFromString
|
||||||
-> String
|
-> String
|
||||||
-> IO (Either String (ExactPrint.Anns, GHC.ParsedSource, a))
|
-> IO (Either String (ExactPrint.Anns, GHC.ParsedSource, a))
|
||||||
parseModuleFromString args fp dynCheck str =
|
parseModuleFromString args fp dynCheck str =
|
||||||
ExactPrint.ghcWrapper $ EitherT.runEitherT $ do
|
ExactPrint.ghcWrapper $ ExceptT.runExceptT $ do
|
||||||
dflags0 <- lift $ ExactPrint.initDynFlagsPure fp str
|
dflags0 <- lift $ ExactPrint.initDynFlagsPure fp str
|
||||||
(dflags1, leftover, warnings) <-
|
(dflags1, leftover, warnings) <- lift
|
||||||
lift $ GHC.parseDynamicFlagsCmdLine dflags0 (GHC.noLoc <$> args)
|
$ GHC.parseDynamicFlagsCmdLine dflags0 (GHC.noLoc <$> args)
|
||||||
when (not $ null leftover)
|
when (not $ null leftover)
|
||||||
$ EitherT.left
|
$ ExceptT.throwE
|
||||||
$ "when parsing ghc flags: leftover flags: "
|
$ "when parsing ghc flags: leftover flags: "
|
||||||
++ show (leftover <&> \(L _ s) -> s)
|
++ show (leftover <&> \(L _ s) -> s)
|
||||||
when (not $ null warnings)
|
when (not $ null warnings)
|
||||||
$ EitherT.left
|
$ ExceptT.throwE
|
||||||
$ "when parsing ghc flags: encountered warnings: "
|
$ "when parsing ghc flags: encountered warnings: "
|
||||||
++ show (warnings <&> \(L _ s) -> s)
|
++ show (warnings <&> \(L _ s) -> s)
|
||||||
x <- EitherT.EitherT $ liftIO $ dynCheck dflags1
|
x <- ExceptT.ExceptT $ liftIO $ dynCheck dflags1
|
||||||
EitherT.hoistEither
|
either (\(span, err) -> ExceptT.throwE $ show span ++ ": " ++ err)
|
||||||
$ either (\(span, err) -> Left $ show span ++ ": " ++ err)
|
(\(a, m) -> pure (a, m, x))
|
||||||
(\(a, m) -> Right (a, m, x))
|
|
||||||
$ ExactPrint.parseWith dflags1 fp GHC.parseModule str
|
$ ExactPrint.parseWith dflags1 fp GHC.parseModule str
|
||||||
|
|
||||||
-----------
|
-----------
|
||||||
|
|
|
@ -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 as State
|
||||||
import qualified Control.Monad.Trans.State.Lazy as StateL
|
import qualified Control.Monad.Trans.State.Lazy as StateL
|
||||||
import qualified Control.Monad.Trans.State.Strict as StateS
|
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
|
import qualified Data.Strict.Maybe as Strict
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue