From 40fcc7e3f39d16735511cbfac7bce868642e032f Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Wed, 22 May 2024 17:01:29 +0530 Subject: [PATCH] exactprint cabal compat --- Retrie/ExactPrint.hs | 6 ++- Retrie/Expr.hs | 70 +++++++++++++++++++++++++++++----- Retrie/PatternMap/Instances.hs | 8 ++++ Retrie/Rewrites/Function.hs | 20 ++++++++-- Retrie/Subst.hs | 2 +- retrie.cabal | 2 +- 6 files changed, 92 insertions(+), 16 deletions(-) diff --git a/Retrie/ExactPrint.hs b/Retrie/ExactPrint.hs index 227d681..25dd265 100644 --- a/Retrie/ExactPrint.hs +++ b/Retrie/ExactPrint.hs @@ -406,7 +406,11 @@ transferEntryDPT _a _b = error "transferEntryDPT" -- maybeAnns addAllAnnsT - :: (HasCallStack, Data a, Data b, MonadIO m, Typeable an) + :: (HasCallStack +#if __GLASGOW_HASKELL__ < 910 + , Monoid an +#endif + , Data a, Data b, MonadIO m, Typeable an) => LocatedAn an a -> LocatedAn an b -> TransformT m (LocatedAn an b) addAllAnnsT a b = do -- AZ: to start with, just transfer the entry DP from a to b diff --git a/Retrie/Expr.hs b/Retrie/Expr.hs index 759b2fe..47c0306 100644 --- a/Retrie/Expr.hs +++ b/Retrie/Expr.hs @@ -100,9 +100,21 @@ mkLoc e = do L <$> uniqueSrcSpanT <*> pure e -- ++AZ++:TODO: move to ghc-exactprint -mkLocA :: (Data e, Monad m, NoAnn an) +mkLocA :: (Data e, Monad m +#if __GLASGOW_HASKELL__ >= 910 + , NoAnn an +#else + , Monoid an +#endif + ) => DeltaPos -> e -> TransformT m (LocatedAn an e) -mkLocA dp e = mkLocAA dp noAnn e +mkLocA dp e = mkLocAA dp +#if __GLASGOW_HASKELL__ >= 910 + noAnn +#else + mempty +#endif + e -- ++AZ++:TODO: move to ghc-exactprint mkLocAA :: (Data e, Monad m) => DeltaPos -> an -> e -> TransformT m (LocatedAn an e) @@ -209,7 +221,13 @@ mkApps :: MonadIO m => LHsExpr GhcPs -> [LHsExpr GhcPs] -> TransformT m (LHsExpr mkApps e [] = return e mkApps f (a:as) = do -- lift $ liftIO $ debugPrint Loud "mkApps:f=" [showAst f] - f' <- mkLocA (SameLine 0) (HsApp NoExtField f a) + f' <- mkLocA (SameLine 0) (HsApp +#if __GLASGOW_HASKELL__ >= 910 + NoExtField +#else + noAnn +#endif + f a) mkApps f' as -- GHC never generates HsAppTy in the parser, using HsAppsTy to keep a list @@ -315,10 +333,22 @@ patToExpr orig = case dLPat orig of return el go (LitPat _ lit) = lift $ do -- lit' <- cloneT lit - mkLocA (SameLine 1) $ HsLit NoExtField lit + mkLocA (SameLine 1) $ HsLit +#if __GLASGOW_HASKELL__ >= 910 + NoExtField +#else + noAnn +#endif + lit go (NPat _ llit mbNeg _) = lift $ do -- L _ lit <- cloneT llit - e <- mkLocA (SameLine 1) $ HsOverLit NoExtField (unLoc llit) + e <- mkLocA (SameLine 1) $ HsOverLit +#if __GLASGOW_HASKELL__ >= 910 + NoExtField +#else + noAnn +#endif + (unLoc llit) negE <- maybe (return e) (mkLocA (SameLine 0) . NegApp noAnn e) mbNeg -- addAllAnnsT llit negE return negE @@ -343,7 +373,13 @@ patToExpr orig = case dLPat orig of go (TuplePat an ps boxity) = do es <- forM ps $ \pat -> do e <- patToExpr pat - return $ Present NoExtField e + return $ Present +#if __GLASGOW_HASKELL__ >= 910 + NoExtField +#else + noAnn +#endif + e lift $ mkLocA (SameLine 1) $ ExplicitTuple an es boxity go (VarPat _ i) = lift $ mkLocatedHsVar i go AsPat{} = error "patToExpr AsPat" @@ -429,7 +465,13 @@ unparen e = e needsParens :: HsExpr GhcPs -> Bool needsParens = hsExprNeedsParens (PprPrec 10) -mkParen :: (Data x, Monad m, NoAnn an, Typeable an) +mkParen :: (Data x, Monad m +#if __GLASGOW_HASKELL__ >= 910 + , NoAnn an +#else + , Monoid an +#endif + , Typeable an) => (LocatedAn an x -> x) -> LocatedAn an x -> TransformT m (LocatedAn an x) mkParen k e = do pe <- mkLocA (SameLine 1) (k e) @@ -447,7 +489,12 @@ mkParen' dp k = do pe <- mkLocA dp (k (EpAnn anc an emptyComments)) return pe #else -mkParen' :: (Data x, Monad m, NoAnn an) +mkParen' :: (Data x, Monad m +#if __GLASGOW_HASKELL__ >= 910 + , NoAnn an) +#else + , Monoid an) +#endif => DeltaPos -> (EpAnn NoEpAnns -> x) -> TransformT m (LocatedAn an x) mkParen' dp k = do let an = NoEpAnns @@ -460,7 +507,12 @@ mkParen' dp k = do pe <- mkLocA dp (k (EpAnn anc an emptyComments)) return pe -mkParenTy :: (Data x, Monad m, NoAnn an) +mkParenTy :: (Data x, Monad m +#if __GLASGOW_HASKELL__ >= 910 + , NoAnn an) +#else + , Monoid an) +#endif => DeltaPos -> (EpAnn AnnParen -> x) -> TransformT m (LocatedAn an x) mkParenTy dp k = do let an = AnnParen AnnParens d0 d0 diff --git a/Retrie/PatternMap/Instances.hs b/Retrie/PatternMap/Instances.hs index f86ab8d..a4d2b44 100644 --- a/Retrie/PatternMap/Instances.hs +++ b/Retrie/PatternMap/Instances.hs @@ -363,7 +363,11 @@ instance PatternMap EMap where (toA (mAlter env vs fl f)))) (emIf m) } go (HsIPVar _ (HsIPName ip)) = m { emIPVar = mAlter env vs ip f (emIPVar m) } go (HsLit _ l) = m { emLit = mAlter env vs l f (emLit m) } +#if __GLASGOW_HASKELL__ >= 910 go (HsLam _ variant mg) = m { emLam = mAlter env vs mg f (emLam m) } +#else + go (HsLam _ mg) = m { emLam = mAlter env vs mg f (emLam m) } +#endif go (HsOverLit _ ol) = m { emOverLit = mAlter env vs (ol_val ol) f (emOverLit m) } go (NegApp _ e' _) = m { emNegApp = mAlter env vs e' f (emNegApp m) } #if __GLASGOW_HASKELL__ < 904 || __GLASGOW_HASKELL__ >= 910 @@ -468,7 +472,11 @@ instance PatternMap EMap where #endif mapFor emIf >=> mMatch env c >=> mMatch env tr >=> mMatch env fl go (HsIPVar _ (HsIPName ip)) = mapFor emIPVar >=> mMatch env ip +#if __GLASGOW_HASKELL__ >= 910 go (HsLam _ variant mg) = mapFor emLam >=> mMatch env mg +#else + go (HsLam _ mg) = mapFor emLam >=> mMatch env mg +#endif go (HsLit _ l) = mapFor emLit >=> mMatch env l go (HsOverLit _ ol) = mapFor emOverLit >=> mMatch env (ol_val ol) #if __GLASGOW_HASKELL__ < 904 || __GLASGOW_HASKELL__ >= 910 diff --git a/Retrie/Rewrites/Function.hs b/Retrie/Rewrites/Function.hs index 34a3ae8..51542a6 100644 --- a/Retrie/Rewrites/Function.hs +++ b/Retrie/Rewrites/Function.hs @@ -81,12 +81,12 @@ irrefutablePat = go . unLoc go WildPat{} = True go VarPat{} = True go (LazyPat _ p) = irrefutablePat p -#if __GLASGOW_HASKELL__ <= 904 || __GLASGOW_HASKELL__ <= 910 +#if __GLASGOW_HASKELL__ <= 904 || __GLASGOW_HASKELL__ >= 910 go (AsPat _ _ p) = irrefutablePat p #else go (AsPat _ _ _ p) = irrefutablePat p #endif -#if __GLASGOW_HASKELL__ < 904 || __GLASGOW_HASKELL__ <= 910 +#if __GLASGOW_HASKELL__ < 904 || __GLASGOW_HASKELL__ >= 910 go (ParPat _ p) = irrefutablePat p #else go (ParPat _ _ p _) = irrefutablePat p @@ -137,10 +137,22 @@ backtickRules e imps dir@LeftToRight grhss ps@[p1, p2] = do both op [l, r] = mkLocA (SameLine 1) (OpApp noAnn l op r) both _ _ = fail "backtickRules - both: impossible!" - left op [l] = mkLocA (SameLine 1) (SectionL NoExtField l op) + left op [l] = mkLocA (SameLine 1) (SectionL +#if __GLASGOW_HASKELL__ >= 910 + NoExtField +#else + noAnn +#endif + l op) left _ _ = fail "backtickRules - left: impossible!" - right op [r] = mkLocA (SameLine 1) (SectionR NoExtField op r) + right op [r] = mkLocA (SameLine 1) (SectionR +#if __GLASGOW_HASKELL__ >= 910 + NoExtField +#else + noAnn +#endif + op r) right _ _ = fail "backtickRules - right: impossible!" qs <- makeFunctionQuery e imps dir grhss both (ps, []) qsl <- makeFunctionQuery e imps dir grhss left ([p1], [p2]) diff --git a/Retrie/Subst.hs b/Retrie/Subst.hs index fa78402..d1d87cb 100644 --- a/Retrie/Subst.hs +++ b/Retrie/Subst.hs @@ -117,7 +117,7 @@ substHsMatchContext #if __GLASGOW_HASKELL__ < 900 -> HsMatchContext RdrName -> TransformT m (HsMatchContext RdrName) -#elif__GLASGOW_HASKELL__ < 910 +#elif __GLASGOW_HASKELL__ < 910 -> HsMatchContext GhcPs -> TransformT m (HsMatchContext GhcPs) #else diff --git a/retrie.cabal b/retrie.cabal index b3985e6..a7d9e9d 100644 --- a/retrie.cabal +++ b/retrie.cabal @@ -84,7 +84,7 @@ library directory >= 1.3.1 && < 1.4, filepath >= 1.4.2 && < 1.6, ghc >= 9.2 && < 9.11, - ghc-exactprint >= 1.5.0 && < 1.11, + ghc-exactprint >= 1.5.0 && < 1.10, list-t >= 1.0.4 && < 1.1, mtl >= 2.2.2 && < 2.4, optparse-applicative >= 0.15.1 && < 0.19,