diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs index bfbb025..082a5c4 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs +++ b/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) -> - layoutType t + , docSeq $ List.intersperse docCommaSep $ ts <&> \case +#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 - in createNamesAndTypeDoc names t - , docLines - $ (\(L _ (ConDeclField _ext names t _)) -> - docCols ColRecDecl $ docCommaSep : createNamesAndTypeDoc names t) - <$> fields + : fDoc1 + , docLines $ fDocR <&> \f -> docCols ColRecDecl $ docCommaSep : f , 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 ] diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs index 7b52383..153774f 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs +++ b/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 diff --git a/src/Language/Haskell/Brittany/Internal/Utils.hs b/src/Language/Haskell/Brittany/Internal/Utils.hs index ae7bed9..eee432e 100644 --- a/src/Language/Haskell/Brittany/Internal/Utils.hs +++ b/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