exactprint cabal compat

facebookincubator · May 22, 2024 · 40fcc7e · 40fcc7e
1 parent 7bf5998
commit 40fcc7e
Show file tree

Hide file tree

Showing 6 changed files with 92 additions and 16 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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,