Start making datadecls work with ghc-8.4

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

@@ -16,10 +16,11 @@ import           Language.Haskell.Brittany.Internal.LayouterBasics
 import           Language.Haskell.Brittany.Internal.Config.Types
 
 import           RdrName ( RdrName(..) )
-import           GHC ( Located, runGhc, GenLocated(L), moduleNameString, DerivStrategy(..) )
+import           GHC ( Located, runGhc, GenLocated(L), moduleNameString )
 import qualified GHC
 import           HsSyn
 import           Name
+import           BasicTypes
 import           Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey )
 
 import           Language.Haskell.Brittany.Internal.Layouters.Type
@@ -38,10 +39,19 @@ layoutDataDecl
   -> LHsQTyVars GhcPs
   -> HsDataDefn GhcPs
   -> ToBriDocM BriDocNumbered
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
 layoutDataDecl _ _ (XLHsQTyVars ext) _ = absurdExt ext
 layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
+#else
+layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of
+#endif
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
   HsDataDefn _ext NewType (L _ []) _ctype Nothing [cons] mDerivs -> case cons of
     (L _ (ConDeclH98 _ext consName (L _ False) _qvars (Just (L _ [])) details _conDoc)) ->
+#else
+  HsDataDefn NewType (L _ []) _ctype Nothing [cons] mDerivs -> case cons of
+    (L _ (ConDeclH98 consName Nothing (Just (L _ [])) details _conDoc)) ->
+#endif
       docWrapNode ltycl $ do
         nameStr     <- lrdrNameToTextAnn name
         consNameStr <- lrdrNameToTextAnn consName
@@ -61,9 +71,13 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
           , docSeparator
           , rhsDoc
           ]
-    _ -> briDocByExact ltycl
+    _ -> briDocByExactNoComment ltycl
 
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
   HsDataDefn _ext DataType (L _ lhsContext) _ctype Nothing [] mDerivs ->
+#else
+  HsDataDefn DataType (L _ lhsContext) _ctype Nothing [] mDerivs ->
+#endif
     docWrapNode ltycl $ do
       lhsContextDoc <- docSharedWrapper createContextDoc lhsContext
       nameStr       <- lrdrNameToTextAnn name
@@ -75,9 +89,17 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
         , appSep tyVarLine
         ]
 
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
   HsDataDefn _ext DataType (L _ lhsContext) _ctype Nothing [cons] mDerivs ->
+#else
+  HsDataDefn DataType (L _ lhsContext) _ctype Nothing [cons] mDerivs ->
+#endif
     case cons of
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
       (L _ (ConDeclH98 _ext consName (L _ _hasExt) qvars mRhsContext details _conDoc)) ->
+#else
+      (L _ (ConDeclH98 consName (Just (HsQTvs _ qvars _)) mRhsContext details _conDoc)) ->
+#endif
         docWrapNode ltycl $ do
           lhsContextDoc <- docSharedWrapper createContextDoc lhsContext
           nameStr       <- lrdrNameToTextAnn name
@@ -100,7 +122,7 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
             , rhsContextDoc
             , rhsDoc
             ]
-      _ -> briDocByExact ltycl
+      _ -> briDocByExactNoComment ltycl
 
   _ -> briDocByExactNoComment ltycl
 
@@ -118,11 +140,18 @@ createContextDoc ts = docSeq
 createBndrDoc :: [LHsTyVarBndr GhcPs] -> ToBriDocM BriDocNumbered
 createBndrDoc bs = do
   tyVarDocs <- bs `forM` \case
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
     (L _ (UserTyVar _ext vname)) -> return $ (lrdrNameToText vname, Nothing)
     (L _ (KindedTyVar _ext lrdrName kind)) -> do
+#else
+    (L _ (UserTyVar vname)) -> return $ (lrdrNameToText vname, Nothing)
+    (L _ (KindedTyVar lrdrName kind)) -> do
+#endif
       d <- docSharedWrapper layoutType kind
       return $ (lrdrNameToText lrdrName, Just $ d)
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
     (L _ (XTyVarBndr ext)) -> absurdExt ext
+#endif
   docSeq
     $   List.intersperse docSeparator
     $   tyVarDocs
@@ -151,8 +180,12 @@ createDerivingPar derivs mainDoc = do
         <$> types
 
 derivingClauseDoc :: LHsDerivingClause GhcPs -> ToBriDocM BriDocNumbered
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
 derivingClauseDoc (L _ (XHsDerivingClause ext)) = absurdExt ext
 derivingClauseDoc (L _ (HsDerivingClause _ext mStrategy types)) = case types of
+#else
+derivingClauseDoc (L _ (HsDerivingClause mStrategy types)) = case types of
+#endif
   (L _ []) -> docSeq []
   (L _ ts) ->
     let
@@ -166,8 +199,13 @@ derivingClauseDoc (L _ (HsDerivingClause _ext mStrategy types)) = case types of
         , lhsStrategy
         , docSeparator
         , whenMoreThan1Type "("
-        , docSeq $ List.intersperse docCommaSep $ ts <&> \(HsIB _ t) ->
+        , docSeq $ List.intersperse docCommaSep $ ts <&> \case
-          layoutType t
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+            HsIB _ t -> layoutType t
+            XHsImplicitBndrs x -> absurdExt x
+#else
+            HsIB _ t _ -> layoutType t
+#endif
         , whenMoreThan1Type ")"
         , rhsStrategy
         ]
@@ -176,6 +214,7 @@ derivingClauseDoc (L _ (HsDerivingClause _ext mStrategy types)) = case types of
     (L _ StockStrategy          ) -> (docLit $ Text.pack " stock", docEmpty)
     (L _ AnyclassStrategy       ) -> (docLit $ Text.pack " anyclass", docEmpty)
     (L _ NewtypeStrategy        ) -> (docLit $ Text.pack " newtype", docEmpty)
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
     (L _ (ViaStrategy viaTypes) ) ->
       ( docEmpty
       , case viaTypes of
@@ -185,6 +224,7 @@ derivingClauseDoc (L _ (HsDerivingClause _ext mStrategy types)) = case types of
             ]
           XHsImplicitBndrs ext -> absurdExt ext
       )
+#endif
 
 docDeriving :: ToBriDocM BriDocNumbered
 docDeriving = docLit $ Text.pack "deriving"
@@ -198,7 +238,11 @@ createDetailsDoc consNameStr details = case details of
     , docSeq $ List.intersperse docSeparator $ args <&> layoutType
     ]
   RecCon (L _ []) -> docEmpty
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
   RecCon (L _ [L _ (ConDeclField _ext names t _)]) -> docSeq
+#else
+  RecCon (L _ [L _ (ConDeclField names t _)]) -> docSeq
+#endif
     [ docLit consNameStr
     , docSeparator
     , appSep $ docLit $ Text.pack "{"
@@ -206,18 +250,15 @@ createDetailsDoc consNameStr details = case details of
     , docSeparator
     , docLit $ Text.pack "}"
     ]
-  RecCon (L _ (fstField:fields)) ->
+  RecCon (L _ fields@(_:_)) -> do
+    let (fDoc1 : fDocR) = mkFieldDocs fields
     docAddBaseY BrIndentRegular $ docPar
       (docLit consNameStr)
       (docLines
         [ docCols ColRecDecl
           $ docLit (Text.pack "{ ")
-          : let L _ (ConDeclField _ext names t _) = fstField
+          : fDoc1
-              in createNamesAndTypeDoc names t
+        , docLines $ fDocR <&> \f -> docCols ColRecDecl $ docCommaSep : f
-        , docLines
-          $ (\(L _ (ConDeclField _ext names t _)) ->
-              docCols ColRecDecl $ docCommaSep : createNamesAndTypeDoc names t)
-          <$> fields
         , docLit $ Text.pack "}"
         ]
       )
@@ -228,6 +269,14 @@ createDetailsDoc consNameStr details = case details of
     , docSeparator
     , layoutType arg2
     ]
+ where
+  mkFieldDocs = fmap $ \case
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    L _ (ConDeclField _ext names t _) -> createNamesAndTypeDoc names t
+    L _ (XConDeclField x) -> absurdExt x
+#else
+    L _ (ConDeclField names t _) -> createNamesAndTypeDoc names t
+#endif
 
 createForallDoc :: [LHsTyVarBndr GhcPs] -> ToBriDocM BriDocNumbered
 createForallDoc []            = docEmpty
@@ -239,13 +288,21 @@ createForallDoc lhsTyVarBndrs =  docSeq
   ]
 
 createNamesAndTypeDoc
-  :: [GenLocated t (FieldOcc u)] -> Located (HsType GhcPs) -> [ToBriDocM BriDocNumbered]
+  :: [GenLocated t (FieldOcc GhcPs)]
+  -> Located (HsType GhcPs)
+  -> [ToBriDocM BriDocNumbered]
 createNamesAndTypeDoc names t =
   [ docSeq
     [ docSeq
       $   List.intersperse docCommaSep
       $   names
-      <&> \(L _ (FieldOcc _ fieldName)) ->
+      <&> \case
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+        L _ (XFieldOcc x) -> absurdExt x
+        L _ (FieldOcc _ fieldName) ->
+#else
+        L _ (FieldOcc fieldName _) ->
+#endif
             docLit =<< lrdrNameToTextAnn fieldName
     , docSeparator
     ]

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

@@ -741,7 +741,11 @@ layoutTyCl ltycl@(L _loc tycl) = case tycl of
     let wrapNodeRest = docWrapNodeRest ltycl
     docWrapNodePrior ltycl
       $ layoutSynDecl isInfix wrapNodeRest name (hsq_explicit vars) typ
+#if MIN_VERSION_ghc(8,6,0)
   DataDecl _ext name tyVars _ dataDefn ->
+#else
+  DataDecl name tyVars _ dataDefn _ _ ->
+#endif
     docWrapNodePrior ltycl $
       layoutDataDecl ltycl name tyVars dataDefn
   _ -> briDocByExactNoComment ltycl

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

@@ -58,7 +58,7 @@ import           Language.Haskell.Brittany.Internal.Config.Types
 import           Language.Haskell.Brittany.Internal.Types
 
 import qualified Data.Generics.Uniplate.Direct as Uniplate
-import           HsExtension (NoExt)
+import qualified HsExtension
 
 
 
@@ -296,6 +296,11 @@ lines' s = case break (== '\n') s of
   (s1, [_]) -> [s1, ""]
   (s1, (_:r)) -> s1 : lines' r
 
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
 -- | A method to dismiss NoExt patterns for total matches
-absurdExt :: NoExt -> a
+absurdExt :: HsExtension.NoExt -> a
 absurdExt = error "cannot construct NoExt"
+#else
+absurdExt :: ()
+absurdExt = ()
+#endif