From 91d6e18abaabcd71dbd45b9b89ee6bd3ecbd516f Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Sat, 31 Aug 2019 23:19:59 +0200 Subject: [PATCH] Adapt to ghc-8.8 (deps are not ready though) --- brittany.cabal | 8 +- src-literatetests/10-tests.blt | 2 + src-literatetests/15-regressions.blt | 2 +- .../Haskell/Brittany/Internal/Backend.hs | 10 +- .../Brittany/Internal/ExactPrintUtils.hs | 5 +- .../Brittany/Internal/Layouters/Decl.hs | 45 ++++++- .../Brittany/Internal/Layouters/Expr.hs | 14 ++- .../Brittany/Internal/Layouters/Pattern.hs | 27 +++-- .../Brittany/Internal/Layouters/Type.hs | 110 +++++++++--------- .../Haskell/Brittany/Internal/Prelude.hs | 14 ++- 10 files changed, 155 insertions(+), 82 deletions(-) diff --git a/brittany.cabal b/brittany.cabal index cf8c054..7eb6e46 100644 --- a/brittany.cabal +++ b/brittany.cabal @@ -84,10 +84,10 @@ library { -fno-warn-redundant-constraints } build-depends: - { base >=4.9 && <4.13 - , ghc >=8.0.1 && <8.7 + { base >=4.9 && <4.14 + , ghc >=8.0.1 && <8.9 , ghc-paths >=0.1.0.9 && <0.2 - , ghc-exactprint >=0.5.8 && <0.6.2 + , ghc-exactprint >=0.5.8 && <0.6.3 , transformers >=0.5.2.0 && <0.6 , containers >=0.5.7.1 && <0.7 , mtl >=2.2.1 && <2.3 @@ -112,7 +112,7 @@ library { , semigroups >=0.18.2 && <0.19 , cmdargs >=0.10.14 && <0.11 , czipwith >=1.0.1.0 && <1.1 - , ghc-boot-th >=8.0.1 && <8.7 + , ghc-boot-th >=8.0.1 && <8.9 , filepath >=1.4.1.0 && <1.5 , random >= 1.1 && <1.2 } diff --git a/src-literatetests/10-tests.blt b/src-literatetests/10-tests.blt index 11724ac..f833847 100644 --- a/src-literatetests/10-tests.blt +++ b/src-literatetests/10-tests.blt @@ -1220,6 +1220,7 @@ type instance MyFam Bool = String type instance MyFam (Maybe a) = a -> Bool #test simple-typefam-instance-parens +#pending the parens cause problems since ghc-8.8 type instance (MyFam (String -> Int)) = String @@ -1237,6 +1238,7 @@ type instance MyFam Bool -- This is an odd one = AnotherType -- Here's another #test simple-typefam-instance-parens-comment +#pending the parens cause problems since ghc-8.8 -- | A happy family type instance (MyFam Bool) -- This is an odd one diff --git a/src-literatetests/15-regressions.blt b/src-literatetests/15-regressions.blt index be4bc55..0d40271 100644 --- a/src-literatetests/15-regressions.blt +++ b/src-literatetests/15-regressions.blt @@ -607,7 +607,7 @@ go _ ((IRTypeError ps t1 t2, _) : _) = Left $ makeError ps t1 t2 go _ ((_, IRTypeError ps t1 t2) : _) = Left $ makeError ps t1 t2 #test issue 89 - type-family-instance -type instance (XPure StageParse) = () +type instance XPure StageParse = () type Pair a = (a, a) #test issue 144 diff --git a/src/Language/Haskell/Brittany/Internal/Backend.hs b/src/Language/Haskell/Brittany/Internal/Backend.hs index 8f97171..e4872f2 100644 --- a/src/Language/Haskell/Brittany/Internal/Backend.hs +++ b/src/Language/Haskell/Brittany/Internal/Backend.hs @@ -173,14 +173,10 @@ layoutBriDocM = \case -- layoutResetSepSpace priors `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) -> - do + when (not $ comment == "(" || comment == ")") $ do case comment of ('#':_) -> layoutMoveToCommentPos y (-999) -- ^ evil hack for CPP - "(" -> pure () - ")" -> pure () - -- ^ these two fix the formatting of parens - -- on the lhs of type alias defs _ -> layoutMoveToCommentPos y x -- fixedX <- fixMoveToLineByIsNewline x -- replicateM_ fixedX layoutWriteNewline @@ -217,7 +213,7 @@ layoutBriDocM = \case Nothing -> pure () Just comments -> do comments `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) -> - do + when (not $ comment == "(" || comment == ")") $ do -- evil hack for CPP: case comment of ('#':_) -> layoutMoveToCommentPos y (-999) @@ -251,7 +247,7 @@ layoutBriDocM = \case Nothing -> pure () Just comments -> do comments `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) -> - do + when (not $ comment == "(" || comment == ")") $ do case comment of ('#':_) -> layoutMoveToCommentPos y (-999) -- ^ evil hack for CPP diff --git a/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs b/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs index 0c4f901..1fabf9c 100644 --- a/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs +++ b/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs @@ -276,7 +276,10 @@ foldedAnnKeys ast = SYB.everything Set.singleton [ SYB.gmapQi 1 (\t -> ExactPrint.mkAnnKey $ L l t) x | locTyCon == SYB.typeRepTyCon (SYB.typeOf x) - , l <- SYB.gmapQi 0 SYB.cast x + , l :: SrcSpan <- SYB.gmapQi 0 SYB.cast x + -- for some reason, ghc-8.8 has forgotten how to infer the type of l, + -- even though it is passed to mkAnnKey above, which only accepts + -- SrcSpan. ] ) ast diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs index c2cbbae..67e9000 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs @@ -20,6 +20,7 @@ where import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.LayouterBasics import Language.Haskell.Brittany.Internal.Config.Types +import Language.Haskell.Brittany.Internal.Layouters.Type import qualified Language.Haskell.GHC.ExactPrint as ExactPrint import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint @@ -743,7 +744,7 @@ layoutSynDecl isInfix wrapNodeRest name vars typ = do let (a : b : rest) = vars hasOwnParens <- hasAnnKeywordComment a AnnOpenP -- This isn't quite right, but does give syntactically valid results - let needsParens = not $ null rest || hasOwnParens + let needsParens = not (null rest) || hasOwnParens docSeq $ [ docLit $ Text.pack "type" , docSeparator @@ -800,24 +801,36 @@ layoutTyVarBndr needsSep lbndr@(L _ bndr) = do -- TyFamInstDecl -------------------------------------------------------------------------------- + + layoutTyFamInstDecl :: Bool -> ToBriDoc TyFamInstDecl layoutTyFamInstDecl inClass (L loc tfid) = do let -#if MIN_VERSION_ghc(8,6,0) +#if MIN_VERSION_ghc(8,8,0) + linst = L loc (TyFamInstD NoExt tfid) + feqn@(FamEqn _ name bndrsMay pats _fixity typ) = hsib_body $ tfid_eqn tfid + -- bndrsMay isJust e.g. with + -- type instance forall a . MyType (Maybe a) = Either () a + lfeqn = L loc feqn +#elif MIN_VERSION_ghc(8,6,0) linst = L loc (TyFamInstD NoExt tfid) feqn@(FamEqn _ name pats _fixity typ) = hsib_body $ tfid_eqn tfid + bndrsMay = Nothing lfeqn = L loc feqn #elif MIN_VERSION_ghc(8,4,0) linst = L loc (TyFamInstD tfid) feqn@(FamEqn name pats _fixity typ) = hsib_body $ tfid_eqn tfid + bndrsMay = Nothing lfeqn = L loc feqn #elif MIN_VERSION_ghc(8,2,0) linst = L loc (TyFamInstD tfid) lfeqn@(L _ (TyFamEqn name boundPats _fixity typ)) = tfid_eqn tfid + bndrsMay = Nothing pats = hsib_body boundPats #else linst = L loc (TyFamInstD tfid) lfeqn@(L _ (TyFamEqn name boundPats typ)) = tfid_eqn tfid + bndrsMay = Nothing pats = hsib_body boundPats #endif docWrapNodePrior linst $ do @@ -828,15 +841,23 @@ layoutTyFamInstDecl inClass (L loc tfid) = do then docLit $ Text.pack "type" else docSeq [appSep . docLit $ Text.pack "type", docLit $ Text.pack "instance"] + makeForallDoc :: [LHsTyVarBndr GhcPs] -> ToBriDocM BriDocNumbered + makeForallDoc bndrs = do + bndrDocs <- layoutTyVarBndrs bndrs + docSeq + ( [docLit (Text.pack "forall")] + ++ processTyVarBndrsSingleline bndrDocs + ) lhs = docWrapNode lfeqn . appSep . docWrapNodeRest linst . docSeq - $ (appSep instanceDoc :) - $ [ docParenL | needsParens ] + $ [appSep instanceDoc] + ++ [ makeForallDoc foralls | Just foralls <- [bndrsMay] ] + ++ [ docParenL | needsParens ] ++ [appSep $ docWrapNode name $ docLit nameStr] - ++ intersperse docSeparator (layoutType <$> pats) + ++ intersperse docSeparator (layoutHsTyPats pats) ++ [ docParenR | needsParens ] hasComments <- (||) <$> hasAnyRegularCommentsConnected lfeqn @@ -845,6 +866,20 @@ layoutTyFamInstDecl inClass (L loc tfid) = do layoutLhsAndType hasComments lhs "=" typeDoc +#if MIN_VERSION_ghc(8,8,0) +layoutHsTyPats :: [HsArg (LHsType GhcPs) (LHsKind GhcPs)] -> [ToBriDocM BriDocNumbered] +layoutHsTyPats pats = pats <&> \case + HsValArg tm -> layoutType tm + HsTypeArg _l ty -> docSeq [docLit $ Text.pack "@", layoutType ty] + -- we ignore the SourceLoc here.. this LPat not being (L _ Pat{}) change + -- is a bit strange. Hopefully this does not ignore any important + -- annotations. + HsArgPar _l -> error "brittany internal error: HsArgPar{}" +#else +layoutHsTyPats :: [LHsType GhcPs] -> [ToBriDocM BriDocNumbered] +layoutHsTyPats pats = layoutType <$> pats +#endif + -------------------------------------------------------------------------------- -- ClsInstDecl -------------------------------------------------------------------------------- diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index 43797cd..6fad40b 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -278,7 +278,11 @@ layoutExpr lexpr@(L _ expr) = do expDoc1 expDoc2 ] -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ +#if MIN_VERSION_ghc(8,8,0) /* ghc-8.8 */ + HsAppType _ _ XHsWildCardBndrs{} -> + error "brittany internal error: HsAppType XHsWildCardBndrs" + HsAppType _ exp1 (HsWC _ ty1) -> do +#elif MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ HsAppType XHsWildCardBndrs{} _ -> error "brittany internal error: HsAppType XHsWildCardBndrs" HsAppType (HsWC _ ty1) exp1 -> do @@ -1034,7 +1038,13 @@ layoutExpr lexpr@(L _ expr) = do Ambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) #endif recordExpression indentPolicy lexpr rExprDoc rFs -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ +#if MIN_VERSION_ghc(8,8,0) /* ghc-8.6 */ + ExprWithTySig _ _ (HsWC _ XHsImplicitBndrs{}) -> + error "brittany internal error: ExprWithTySig HsWC XHsImplicitBndrs" + ExprWithTySig _ _ XHsWildCardBndrs{} -> + error "brittany internal error: ExprWithTySig XHsWildCardBndrs" + ExprWithTySig _ exp1 (HsWC _ (HsIB _ typ1)) -> do +#elif MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ ExprWithTySig (HsWC _ XHsImplicitBndrs{}) _ -> error "brittany internal error: ExprWithTySig HsWC XHsImplicitBndrs" ExprWithTySig XHsWildCardBndrs{} _ -> diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs index e77856c..234dac7 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE ViewPatterns #-} module Language.Haskell.Brittany.Internal.Layouters.Pattern ( layoutPat @@ -13,7 +14,13 @@ where import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.LayouterBasics -import GHC ( Located, runGhc, GenLocated(L), moduleNameString, ol_val ) +import GHC ( Located + , runGhc + , GenLocated(L) + , moduleNameString + , ol_val + ) +import qualified GHC import HsSyn import Name import BasicTypes @@ -33,8 +40,8 @@ import Language.Haskell.Brittany.Internal.Layouters.Type -- ^^^^^^^^^^ this part -- We will use `case .. of` as the imagined prefix to the examples used in -- the different cases below. -layoutPat :: ToBriDocC (Pat GhcPs) (Seq BriDocNumbered) -layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of +layoutPat :: LPat GhcPs -> ToBriDocM (Seq BriDocNumbered) +layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of WildPat _ -> fmap Seq.singleton $ docLit $ Text.pack "_" -- _ -> expr #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ @@ -51,7 +58,9 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of #endif fmap Seq.singleton $ allocateNode $ litBriDoc lit -- 0 -> expr -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ +#if MIN_VERSION_ghc(8,8,0) /* ghc-8.8 */ + ParPat _ inner -> do +#elif MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ ParPat _ inner -> do #else /* ghc-8.0 8.2 8.4 */ ParPat inner -> do @@ -177,7 +186,9 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of #endif -- bind@nestedpat -> expr wrapPatPrepend asPat (docLit $ lrdrNameToText asName <> Text.pack "@") -#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ +#if MIN_VERSION_ghc(8,8,0) /* ghc-8.8 */ + SigPat _ pat1 (HsWC _ (HsIB _ ty1)) -> do +#elif MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ SigPat (HsWC _ (HsIB _ ty1)) pat1 -> do #elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4 */ SigPatIn pat1 (HsWC _ (HsIB _ ty1 _)) -> do @@ -242,13 +253,13 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of -- else -- VarPat n -> return $ stringLayouter lpat $ rdrNameToText n -- endif - _ -> return <$> briDocByExactInlineOnly "some unknown pattern" lpat + _ -> return <$> briDocByExactInlineOnly "some unknown pattern" (ghcDL lpat) colsWrapPat :: Seq BriDocNumbered -> ToBriDocM BriDocNumbered colsWrapPat = docCols ColPatterns . fmap return . Foldable.toList wrapPatPrepend - :: Located (Pat GhcPs) + :: LPat GhcPs -> ToBriDocM BriDocNumbered -> ToBriDocM (Seq BriDocNumbered) wrapPatPrepend pat prepElem = do @@ -260,7 +271,7 @@ wrapPatPrepend pat prepElem = do return $ x1' Seq.<| xR wrapPatListy - :: [Located (Pat GhcPs)] + :: [LPat GhcPs] -> String -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs index 5bbbc4c..ef34942 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs @@ -2,6 +2,8 @@ module Language.Haskell.Brittany.Internal.Layouters.Type ( layoutType + , layoutTyVarBndrs + , processTyVarBndrsSingleline ) where @@ -32,21 +34,19 @@ import DataTreePrint layoutType :: ToBriDoc HsType layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of -- _ | traceShow (ExactPrint.Types.mkAnnKey ltype) False -> error "impossible" +#if MIN_VERSION_ghc(8,2,0) #if MIN_VERSION_ghc(8,6,0) HsTyVar _ promoted name -> do - t <- lrdrNameToTextAnn name - case promoted of - Promoted -> docSeq - [ docSeparator - , docTick - , docWrapNode name $ docLit t - ] - NotPromoted -> docWrapNode name $ docLit t -#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ +#else /* ghc-8.2 ghc-8.4 */ HsTyVar promoted name -> do +#endif t <- lrdrNameToTextAnn name case promoted of +#if MIN_VERSION_ghc(8,8,0) + IsPromoted -> docSeq +#else /* ghc-8.2 8.4 8.6 */ Promoted -> docSeq +#endif [ docSeparator , docTick , docWrapNode name $ docLit t @@ -63,32 +63,13 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of HsForAllTy bndrs (L _ (HsQualTy (L _ cntxts) typ2)) -> do #endif typeDoc <- docSharedWrapper layoutType typ2 - tyVarDocs <- bndrs `forM` \case -#if MIN_VERSION_ghc(8,6,0) - (L _ (UserTyVar _ name)) -> return $ (lrdrNameToText name, Nothing) - (L _ (KindedTyVar _ lrdrName kind)) -> do - d <- docSharedWrapper layoutType kind - return $ (lrdrNameToText lrdrName, Just $ d) - (L _ (XTyVarBndr{})) -> error "brittany internal error: XTyVarBndr" -#else - (L _ (UserTyVar name)) -> return $ (lrdrNameToText name, Nothing) - (L _ (KindedTyVar lrdrName kind)) -> do - d <- docSharedWrapper layoutType kind - return $ (lrdrNameToText lrdrName, Just $ d) -#endif + tyVarDocs <- layoutTyVarBndrs bndrs cntxtDocs <- cntxts `forM` docSharedWrapper layoutType let maybeForceML = case typ2 of (L _ HsFunTy{}) -> docForceMultiline _ -> id let - tyVarDocLineList = tyVarDocs >>= \case - (tname, Nothing) -> [docLit $ Text.pack " " <> tname] - (tname, Just doc) -> [ docLit $ Text.pack " (" - <> tname - <> Text.pack " :: " - , docForceSingleline $ doc - , docLit $ Text.pack ")" - ] + tyVarDocLineList = processTyVarBndrsSingleline tyVarDocs forallDoc = docAlt [ let open = docLit $ Text.pack "forall" @@ -142,7 +123,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of else let open = docLit $ Text.pack "forall" close = docLit $ Text.pack " . " - in docSeq ([open]++tyVarDocLineList++[close]) + in docSeq ([open, docSeparator]++tyVarDocLineList++[close]) , docForceSingleline contextDoc , docLit $ Text.pack " => " , docForceSingleline typeDoc @@ -172,31 +153,11 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of HsForAllTy bndrs typ2 -> do #endif typeDoc <- layoutType typ2 - tyVarDocs <- bndrs `forM` \case -#if MIN_VERSION_ghc(8,6,0) - (L _ (UserTyVar _ name)) -> return $ (lrdrNameToText name, Nothing) - (L _ (KindedTyVar _ lrdrName kind)) -> do - d <- layoutType kind - return $ (lrdrNameToText lrdrName, Just $ return d) - (L _ (XTyVarBndr{})) -> error "brittany internal error: XTyVarBndr" -#else - (L _ (UserTyVar name)) -> return $ (lrdrNameToText name, Nothing) - (L _ (KindedTyVar lrdrName kind)) -> do - d <- layoutType kind - return $ (lrdrNameToText lrdrName, Just $ return d) -#endif + tyVarDocs <- layoutTyVarBndrs bndrs let maybeForceML = case typ2 of (L _ HsFunTy{}) -> docForceMultiline _ -> id - let - tyVarDocLineList = tyVarDocs >>= \case - (tname, Nothing) -> [docLit $ Text.pack " " <> tname] - (tname, Just doc) -> [ docLit $ Text.pack " (" - <> tname - <> Text.pack " :: " - , docForceSingleline doc - , docLit $ Text.pack ")" - ] + let tyVarDocLineList = processTyVarBndrsSingleline tyVarDocs docAlt -- forall x . x [ docSeq @@ -771,3 +732,46 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of else docLit $ Text.pack "*" XHsType{} -> error "brittany internal error: XHsType" #endif +#if MIN_VERSION_ghc(8,8,0) + HsAppKindTy _ ty kind -> do + t <- docSharedWrapper layoutType ty + k <- docSharedWrapper layoutType kind + docAlt + [ docSeq + [ docForceSingleline t + , docSeparator + , docLit $ Text.pack "@" + , docForceSingleline k + ] + , docPar + t + (docSeq [docLit $ Text.pack "@", k ]) + ] +#endif + +layoutTyVarBndrs + :: [LHsTyVarBndr GhcPs] + -> ToBriDocM [(Text, Maybe (ToBriDocM BriDocNumbered))] +layoutTyVarBndrs = mapM $ \case +#if MIN_VERSION_ghc(8,6,0) + (L _ (UserTyVar _ name)) -> return $ (lrdrNameToText name, Nothing) + (L _ (KindedTyVar _ lrdrName kind)) -> do + d <- docSharedWrapper layoutType kind + return $ (lrdrNameToText lrdrName, Just $ d) + (L _ (XTyVarBndr{})) -> error "brittany internal error: XTyVarBndr" +#else + (L _ (UserTyVar name)) -> return $ (lrdrNameToText name, Nothing) + (L _ (KindedTyVar lrdrName kind)) -> do + d <- docSharedWrapper layoutType kind + return $ (lrdrNameToText lrdrName, Just $ d) +#endif + +processTyVarBndrsSingleline + :: [(Text, Maybe (ToBriDocM BriDocNumbered))] -> [ToBriDocM BriDocNumbered] +processTyVarBndrsSingleline bndrDocs = bndrDocs >>= \case + (tname, Nothing) -> [docLit $ Text.pack " " <> tname] + (tname, Just doc) -> + [ docLit $ Text.pack " (" <> tname <> Text.pack " :: " + , docForceSingleline $ doc + , docLit $ Text.pack ")" + ] diff --git a/src/Language/Haskell/Brittany/Internal/Prelude.hs b/src/Language/Haskell/Brittany/Internal/Prelude.hs index 6b93bf0..453f076 100644 --- a/src/Language/Haskell/Brittany/Internal/Prelude.hs +++ b/src/Language/Haskell/Brittany/Internal/Prelude.hs @@ -18,7 +18,10 @@ import HsExtension as E ( GhcPs ) #endif import RdrName as E ( RdrName ) - +#if MIN_VERSION_ghc(8,8,0) +import qualified GHC ( dL, HasSrcSpan, SrcSpanLess ) +#endif +import qualified GHC ( Located ) -- more general: @@ -410,3 +413,12 @@ type instance IdP GhcPs = RdrName type GhcPs = RdrName #endif + + +#if MIN_VERSION_ghc(8,8,0) +ghcDL :: GHC.HasSrcSpan a => a -> GHC.Located (GHC.SrcSpanLess a) +ghcDL = GHC.dL +#else /* ghc-8.0 8.2 8.4 8.6 */ +ghcDL :: GHC.Located a -> GHC.Located a +ghcDL x = x +#endif