hexagoxel
/
brittany
1
0
Fork 0
Code Issues 117 Pull Requests 5 Packages Projects Releases 5 Wiki Activity

Fix --ghc-options handling

pull/8/head
Lennart Spitzner 2016-09-06 15:05:29 +02:00
parent 65fee7694d
commit 1b7576dcd1
2 changed files with 6 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Language/Haskell/Brittany/Config.hs
View File

@ -62,7 +62,7 @@ configParser = do
"STRING" "STRING"
( flagHelp ( flagHelp
$ parDoc $ parDoc
"allows to define default language extensions. The parameter is forwarded to ghc. Note that currently these options are applied _after_ the pragmas read in from the input." "allows to define default language extensions. The parameter is forwarded to ghc."
) )
return $ Config return $ Config

8
src/Language/Haskell/Brittany/ExactPrintUtils.hs
View File

@ -57,10 +57,12 @@ parseModuleWithCpp
-> 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 $ EitherT.runEitherT $ do
dflags0 <- lift $ ExactPrint.initDynFlags fp dflags0 <- lift $ GHC.getSessionDynFlags
(dflags1, leftover, warnings) <- lift $ GHC.parseDynamicFlagsCmdLine (dflags1, leftover, warnings) <- lift $ GHC.parseDynamicFlagsCmdLine
dflags0 dflags0
(GHC.noLoc <$> args) (GHC.noLoc <$> args)
void $ lift $ GHC.setSessionDynFlags dflags1
dflags2 <- lift $ ExactPrint.initDynFlags fp
when (not $ null leftover) when (not $ null leftover)
$ EitherT.left $ EitherT.left
$ "when parsing ghc flags: leftover flags: " $ "when parsing ghc flags: leftover flags: "
@ -69,8 +71,8 @@ parseModuleWithCpp cpp opts args fp dynCheck =
$ EitherT.left $ EitherT.left
$ "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 <- EitherT.EitherT $ liftIO $ dynCheck dflags2
res <- lift $ ExactPrint.parseModuleApiAnnsWithCppInternal cpp dflags1 fp res <- lift $ ExactPrint.parseModuleApiAnnsWithCppInternal cpp dflags2 fp
EitherT.hoistEither EitherT.hoistEither
$ either (\(span, err) -> Left $ show span ++ ": " ++ err) $ either (\(span, err) -> Left $ show span ++ ": " ++ err)
(\(a, m) -> Right (a, m, x)) (\(a, m) -> Right (a, m, x))