Merge pull request #1 from infinity0/ghc-8.10.1

more GHC 8.10.1 fixes

src/Language/Haskell/Brittany/Internal.hs

@@ -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

src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs

@@ -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)
 
 

src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs

@@ -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 )

src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs

@@ -37,8 +37,10 @@ import           GHC                            ( runGhc
                                                 )
 import           SrcLoc ( SrcSpan, noSrcSpan, Located , getLoc, unLoc )
 import qualified FastString
-import           HsSyn
+#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
-#if MIN_VERSION_ghc(8,6,0)
+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

src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs

@@ -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

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

@@ -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
 
 

src/Language/Haskell/Brittany/Internal/Layouters/IE.hs

@@ -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

src/Language/Haskell/Brittany/Internal/Layouters/Import.hs

@@ -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 =

src/Language/Haskell/Brittany/Internal/Layouters/Module.hs

@@ -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

src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs

@@ -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

src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs

@@ -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

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

@@ -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

src/Language/Haskell/Brittany/Internal/Layouters/Type.hs

@@ -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

src/Language/Haskell/Brittany/Internal/Utils.hs

@@ -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 :: HsExtension.NoExtCon -> a
-absurdExt = error "cannot construct NoExtField"
+absurdExt = HsExtension.noExtCon
-#else
+#elif MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
-#if 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
-#endif   /* ghc-8.10.1 */