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

more GHC 8.10.1 fixes

pull/312/head
Ximin Luo 2020-05-29 23:26:51 +01:00 committed by Luke Lau
parent 97ffe0c3d2
commit d0e64cf00f
14 changed files with 121 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/Language/Haskell/Brittany/Internal.hs
View File

@ -61,7 +61,12 @@ import GHC ( Located
)
import RdrName ( RdrName(..) )
import SrcLoc ( SrcSpan )
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
import Bag
#else
import HsSyn
#endif
import qualified DynFlags as GHC
import qualified GHC.LanguageExtensions.Type as GHC
@ -380,7 +385,11 @@ parsePrintModuleTests conf filename input = do
let inputStr = Text.unpack input
parseResult <- ExactPrint.Parsers.parseModuleFromString filename inputStr
case parseResult of
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
Left err -> return $ Left $ "parsing error: " ++ show (bagToList (show <$> err))
#else
Left (_ , s ) -> return $ Left $ "parsing error: " ++ s
#endif
Right (anns, parsedModule) -> runExceptT $ do
(inlineConf, perItemConf) <-
case extractCommentConfigs anns (getTopLevelDeclNameMap parsedModule) of

11
src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs
View File

@ -36,6 +36,7 @@ import qualified CmdLineParser as GHC
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
import Bag
#else
import HsSyn
#endif
@ -96,7 +97,11 @@ parseModuleWithCpp cpp opts args fp dynCheck =
++ show (warnings <&> warnExtractorCompat)
x <- ExceptT.ExceptT $ liftIO $ dynCheck dflags2
res <- lift $ ExactPrint.parseModuleApiAnnsWithCppInternal cpp dflags2 fp
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
either (\err -> ExceptT.throwE $ "transform error: " ++ show (bagToList (show <$> err)))
#else
either (\(span, err) -> ExceptT.throwE $ show span ++ ": " ++ err)
#endif
(\(a, m) -> pure (a, m, x))
$ ExactPrint.postParseTransform res opts
@ -129,7 +134,11 @@ parseModuleFromString args fp dynCheck str =
dynCheckRes <- ExceptT.ExceptT $ liftIO $ dynCheck dflags1
let res = ExactPrint.parseModuleFromStringInternal dflags1 fp str
case res of
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
Left err -> ExceptT.throwE $ "parse error: " ++ show (bagToList (show <$> err))
#else
Left (span, err) -> ExceptT.throwE $ showOutputable span ++ ": " ++ err
#endif
Right (a , m ) -> pure (a, m, dynCheckRes)
@ -193,7 +202,7 @@ commentAnnFixTransformGlob ast = do
, ExactPrint.annsDP = assocs'
}
ExactPrint.modifyAnnsT $ \anns -> Map.insert annKey1 ann1' anns
commentAnnFixTransform :: GHC.ParsedSource -> ExactPrint.Transform ()

4
src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs
View File

@ -19,7 +19,11 @@ import Language.Haskell.Brittany.Internal.Config.Types
import RdrName ( RdrName(..) )
import GHC ( Located, runGhc, GenLocated(L), moduleNameString )
import qualified GHC
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn
#endif
import Name
import BasicTypes
import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey )

15
src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs
View File

@ -37,8 +37,10 @@ import GHC ( runGhc
)
import SrcLoc ( SrcSpan, noSrcSpan, Located , getLoc, unLoc )
import qualified FastString
import HsSyn
#if MIN_VERSION_ghc(8,6,0)
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
import GHC.Hs.Extension (NoExtField (..))
#elif MIN_VERSION_ghc(8,6,0)
import HsExtension (NoExt (..))
#endif
import Name
@ -1040,7 +1042,14 @@ layoutClsInst lcid@(L _ cid) = docLines
]
where
layoutInstanceHead :: ToBriDocM BriDocNumbered
#if MIN_VERSION_ghc(8,6,0) /* 8.6 */
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
layoutInstanceHead =
briDocByExactNoComment
$ InstD NoExtField
. ClsInstD NoExtField
. removeChildren
<$> lcid
#elif MIN_VERSION_ghc(8,6,0) /* 8.6 */
layoutInstanceHead =
briDocByExactNoComment
$ InstD NoExt

25
src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs
View File

@ -19,7 +19,11 @@ import Language.Haskell.Brittany.Internal.Config.Types
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
import GHC ( runGhc, GenLocated(L), SrcSpan, moduleNameString, AnnKeywordId(..), RdrName(..) )
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn
#endif
import Name
import qualified FastString
import BasicTypes
@ -521,7 +525,12 @@ layoutExpr lexpr@(L _ expr) = do
#else
ExplicitTuple args boxity -> do
#endif
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
let argExprs = args <&> \arg -> case arg of
(L _ (Present _ e)) -> (arg, Just e);
(L _ (Missing NoExtField)) -> (arg, Nothing)
(L _ XTupArg{}) -> error "brittany internal error: XTupArg"
#elif MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
let argExprs = args <&> \arg -> case arg of
(L _ (Present _ e)) -> (arg, Just e);
(L _ (Missing NoExt)) -> (arg, Nothing)
@ -984,10 +993,18 @@ layoutExpr lexpr@(L _ expr) = do
else Just <$> docSharedWrapper layoutExpr rFExpr
return $ (lfield, lrdrNameToText lnameF, rFExpDoc)
recordExpression False indentPolicy lexpr nameDoc rFs
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
HsRecFields [] (Just (L _ 0)) -> do
#else
HsRecFields [] (Just 0) -> do
#endif
let t = lrdrNameToText lname
docWrapNode lname $ docLit $ t <> Text.pack " { .. }"
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
HsRecFields fs@(_:_) (Just (L _ dotdoti)) | dotdoti == length fs -> do
#else
HsRecFields fs@(_:_) (Just dotdoti) | dotdoti == length fs -> do
#endif
let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname
fieldDocs <- fs `forM` \fieldl@(L _ (HsRecField (L _ fieldOcc) fExpr pun)) -> do
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
@ -1137,12 +1154,15 @@ layoutExpr lexpr@(L _ expr) = do
HsStatic{} -> do
-- TODO
briDocByExactInlineOnly "HsStatic{}" lexpr
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
#else
HsArrApp{} -> do
-- TODO
briDocByExactInlineOnly "HsArrApp{}" lexpr
HsArrForm{} -> do
-- TODO
briDocByExactInlineOnly "HsArrForm{}" lexpr
#endif
HsTick{} -> do
-- TODO
briDocByExactInlineOnly "HsTick{}" lexpr
@ -1152,6 +1172,8 @@ layoutExpr lexpr@(L _ expr) = do
HsTickPragma{} -> do
-- TODO
briDocByExactInlineOnly "HsTickPragma{}" lexpr
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
#else
EWildPat{} -> do
docLit $ Text.pack "_"
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
@ -1169,6 +1191,7 @@ layoutExpr lexpr@(L _ expr) = do
ELazyPat{} -> do
-- TODO
briDocByExactInlineOnly "ELazyPat{}" lexpr
#endif
HsWrap{} -> do
-- TODO
briDocByExactInlineOnly "HsWrap{}" lexpr

4
src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs-boot
View File

@ -15,7 +15,11 @@ import Language.Haskell.Brittany.Internal.Types
import Language.Haskell.Brittany.Internal.LayouterBasics
import GHC ( runGhc, GenLocated(L), moduleNameString )
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn
#endif
import Name

7
src/Language/Haskell/Brittany/Internal/Layouters/IE.hs
View File

@ -18,9 +18,14 @@ import GHC ( unLoc
, AnnKeywordId(..)
, Located
)
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
import GHC.Hs.ImpExp
#else
import HsSyn
import Name
import HsImpExp
#endif
import Name
import FieldLabel
import qualified FastString
import BasicTypes

12
src/Language/Haskell/Brittany/Internal/Layouters/Import.hs
View File

@ -12,7 +12,11 @@ import GHC ( unLoc
, moduleNameString
, Located
)
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn
#endif
import Name
import FieldLabel
import qualified FastString
@ -59,7 +63,11 @@ layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of
hiding = maybe False fst mllies
minQLength = length "import qualified "
qLengthReal =
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
let qualifiedPart = if q /= NotQualified then length "qualified " else 0
#else
let qualifiedPart = if q then length "qualified " else 0
#endif
safePart = if safe then length "safe " else 0
pkgPart = maybe 0 ((+ 1) . Text.length) pkgNameT
srcPart = if src then length "{-# SOURCE #-} " else 0
@ -73,7 +81,11 @@ layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of
[ appSep $ docLit $ Text.pack "import"
, if src then appSep $ docLit $ Text.pack "{-# SOURCE #-}" else docEmpty
, if safe then appSep $ docLit $ Text.pack "safe" else docEmpty
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
, if q /= NotQualified then appSep $ docLit $ Text.pack "qualified" else docEmpty
#else
, if q then appSep $ docLit $ Text.pack "qualified" else docEmpty
#endif
, maybe docEmpty (appSep . docLit) pkgNameT
]
indentName =

7
src/Language/Haskell/Brittany/Internal/Layouters/Module.hs
View File

@ -9,9 +9,14 @@ import Language.Haskell.Brittany.Internal.Layouters.Import
import Language.Haskell.Brittany.Internal.Config.Types
import GHC (unLoc, runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..))
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
import GHC.Hs.ImpExp
#else
import HsSyn
import Name
import HsImpExp
#endif
import Name
import FieldLabel
import qualified FastString
import BasicTypes

12
src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs
View File

@ -21,7 +21,11 @@ import GHC ( Located
, ol_val
)
import qualified GHC
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn
#endif
import Name
import BasicTypes
@ -136,14 +140,22 @@ layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of
, docSeparator
, docLit $ Text.pack "}"
]
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
ConPatIn lname (RecCon (HsRecFields [] (Just (L _ 0)))) -> do
#else
ConPatIn lname (RecCon (HsRecFields [] (Just 0))) -> do
#endif
-- Abc { .. } -> expr
let t = lrdrNameToText lname
Seq.singleton <$> docSeq
[ appSep $ docLit t
, docLit $ Text.pack "{..}"
]
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
ConPatIn lname (RecCon (HsRecFields fs@(_:_) (Just (L _ dotdoti)))) | dotdoti == length fs -> do
#else
ConPatIn lname (RecCon (HsRecFields fs@(_:_) (Just dotdoti))) | dotdoti == length fs -> do
#endif
-- Abc { a = locA, .. }
let t = lrdrNameToText lname
fds <- fs `forM` \(L _ (HsRecField (L _ fieldOcc) fPat pun)) -> do

4
src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs
View File

@ -17,7 +17,11 @@ import GHC ( runGhc
, GenLocated(L)
, moduleNameString
)
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn
#endif
import Name
import qualified FastString
import BasicTypes

4
src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs-boot
View File

@ -13,7 +13,11 @@ import Language.Haskell.Brittany.Internal.Types
import Language.Haskell.Brittany.Internal.LayouterBasics
import GHC ( runGhc, GenLocated(L), moduleNameString )
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn
#endif
import Name
import qualified FastString
import BasicTypes

12
src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
View File

@ -25,7 +25,11 @@ import GHC ( runGhc
, AnnKeywordId (..)
)
import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey )
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn
#endif
import Name
import Outputable ( ftext, showSDocUnsafe )
import BasicTypes
@ -61,7 +65,9 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
t <- lrdrNameToTextAnnTypeEqualityIsSpecial name
docWrapNode name $ docLit t
#endif
#if MIN_VERSION_ghc(8,6,0)
#if MIN_VERSION_ghc(8,10,1)
HsForAllTy _ _ bndrs (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do
#elif MIN_VERSION_ghc(8,6,0)
HsForAllTy _ bndrs (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do
#else
HsForAllTy bndrs (L _ (HsQualTy (L _ cntxts) typ2)) -> do
@ -151,7 +157,9 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
]
)
]
#if MIN_VERSION_ghc(8,6,0)
#if MIN_VERSION_ghc(8,10,1)
HsForAllTy _ _ bndrs typ2 -> do
#elif MIN_VERSION_ghc(8,6,0)
HsForAllTy _ bndrs typ2 -> do
#else
HsForAllTy bndrs typ2 -> do

10
src/Language/Haskell/Brittany/Internal/Utils.hs
View File

@ -304,15 +304,13 @@ lines' s = case break (== '\n') s of
(s1, (_:r)) -> s1 : lines' r
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
absurdExt :: HsExtension.NoExtField -> a
absurdExt = error "cannot construct NoExtField"
#else
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
absurdExt :: HsExtension.NoExtCon -> a
absurdExt = HsExtension.noExtCon
#elif MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
-- | A method to dismiss NoExt patterns for total matches
absurdExt :: HsExtension.NoExt -> a
absurdExt = error "cannot construct NoExt"
#else
absurdExt :: ()
absurdExt = ()
#endif /* ghc-8.6 */
#endif /* ghc-8.10.1 */
#endif