Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

9.6 support #54

Merged
merged 4 commits into from
Mar 24, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
9 changes: 9 additions & 0 deletions Retrie/CPP.hs
Original file line number Diff line number Diff line change
Expand Up @@ -325,8 +325,13 @@ isPragma = Text.isPrefixOf "{-#"
insertImports
:: Monad m
=> [AnnotatedImports] -- ^ imports and their annotations
#if __GLASGOW_HASKELL__ < 906
-> Located HsModule -- ^ target module
-> TransformT m (Located HsModule)
#else
-> Located (HsModule GhcPs) -- ^ target module
-> TransformT m (Located (HsModule GhcPs))
#endif
insertImports is (L l m) = do
imps <- graftA $ filterAndFlatten (unLoc <$> hsmodName m) is
let
Expand All @@ -346,7 +351,11 @@ eqImportDecl x y =
((==) `on` unLoc . ideclName) x y
&& ((==) `on` ideclQualified) x y
&& ((==) `on` ideclAs) x y
#if __GLASGOW_HASKELL__ <= 904
&& ((==) `on` ideclHiding) x y
#else
&& ((==) `on` ideclImportList) x y
#endif
#if __GLASGOW_HASKELL__ < 904
&& ((==) `on` ideclPkgQual) x y
#else
Expand Down
2 changes: 1 addition & 1 deletion Retrie/Elaborate.hs
Original file line number Diff line number Diff line change
Expand Up @@ -103,7 +103,7 @@ allMatches _ [] = return []
allMatches ctxt matchResults = do
results <-
forM matchResults $ \(sub, RewriterResult{..}) -> do
result <- lift $ liftIO $ rrTransformer ctxt $ MatchResult sub rrTemplate
result <- TransformT $ lift $ liftIO $ rrTransformer ctxt $ MatchResult sub rrTemplate
return (rrQuantifiers, result)
return
[ project <$> result
Expand Down
1 change: 1 addition & 0 deletions Retrie/ExactPrint.hs
Original file line number Diff line number Diff line change
Expand Up @@ -49,6 +49,7 @@ module Retrie.ExactPrint
) where

import Control.Exception
import Control.Monad
import Control.Monad.State.Lazy hiding (fix)
-- import Data.Function (on)
import Data.List (transpose)
Expand Down
6 changes: 6 additions & 0 deletions Retrie/ExactPrint/Annotated.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE CPP #-}
module Retrie.ExactPrint.Annotated
( -- * Annotated
Annotated
Expand Down Expand Up @@ -37,6 +38,7 @@ module Retrie.ExactPrint.Annotated

import Control.Monad.State.Lazy hiding (fix)
import Data.Default as D

import Data.Functor.Identity

import Language.Haskell.GHC.ExactPrint hiding
Expand All @@ -59,7 +61,11 @@ type AnnotatedHsExpr = Annotated (LHsExpr GhcPs)
type AnnotatedHsType = Annotated (LHsType GhcPs)
type AnnotatedImport = Annotated (LImportDecl GhcPs)
type AnnotatedImports = Annotated [LImportDecl GhcPs]
#if __GLASGOW_HASKELL__ >= 906
type AnnotatedModule = Annotated (Located (HsModule GhcPs))
#else
type AnnotatedModule = Annotated (Located HsModule)
#endif
type AnnotatedPat = Annotated (LPat GhcPs)
type AnnotatedStmt = Annotated (LStmt GhcPs (LHsExpr GhcPs))

Expand Down
1 change: 1 addition & 0 deletions Retrie/Expr.hs
Original file line number Diff line number Diff line change
Expand Up @@ -35,6 +35,7 @@ module Retrie.Expr
, wildSupply
) where

import Control.Monad
import Control.Monad.State.Lazy
import Data.Functor.Identity
-- import qualified Data.Map as M
Expand Down
12 changes: 12 additions & 0 deletions Retrie/GHC.hs
Original file line number Diff line number Diff line change
Expand Up @@ -53,7 +53,11 @@ import GHC.Types.SrcLoc
import GHC.Types.Unique
import GHC.Types.Unique.FM
import GHC.Types.Unique.Set
#if __GLASGOW_HASKELL__ >= 906
import Language.Haskell.Syntax.Basic as GHC.Unit.Module.Name
#else
import GHC.Unit.Module.Name
#endif
import GHC.Utils.Outputable (Outputable (ppr))

import Data.Bifunctor (second)
Expand Down Expand Up @@ -92,15 +96,23 @@ tyvarRdrName (HsTyVar _ _ n) = Just n
tyvarRdrName _ = Nothing

-- fixityDecls :: HsModule -> [(LIdP p, Fixity)]
#if __GLASGOW_HASKELL__ >= 906
fixityDecls :: HsModule GhcPs -> [(LocatedN RdrName, Fixity)]
#else
fixityDecls :: HsModule -> [(LocatedN RdrName, Fixity)]
#endif
fixityDecls m =
[ (nm, fixity)
| L _ (SigD _ (FixSig _ (FixitySig _ nms fixity))) <- hsmodDecls m
, nm <- nms
]

ruleInfo :: RuleDecl GhcPs -> [RuleInfo]
#if __GLASGOW_HASKELL__ >= 906
ruleInfo (HsRule _ (L _ riName) _ tyBs valBs riLHS riRHS) =
#else
ruleInfo (HsRule _ (L _ (_, riName)) _ tyBs valBs riLHS riRHS) =
#endif
let
riQuantifiers =
map unLoc (tyBindersToLocatedRdrNames (fromMaybe [] tyBs)) ++
Expand Down
1 change: 1 addition & 0 deletions Retrie/Monad.hs
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,7 @@ module Retrie.Monad
, runRetrie
) where

import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.State.Strict
import Control.Monad.RWS
Expand Down
15 changes: 9 additions & 6 deletions Retrie/PatternMap/Instances.hs
Original file line number Diff line number Diff line change
Expand Up @@ -422,8 +422,10 @@ instance PatternMap EMap where
#else
go HsTypedBracket{} = missingSyntax "HsTypedBracket"
go HsUntypedBracket{} = missingSyntax "HsUntypedBracket"
#if __GLASGOW_HASKELL__ < 906
go HsSpliceE{} = missingSyntax "HsSpliceE"
#endif
#endif
#if __GLASGOW_HASKELL__ < 810
go HsArrApp{} = missingSyntax "HsArrApp"
go HsArrForm{} = missingSyntax "HsArrForm"
Expand Down Expand Up @@ -676,11 +678,12 @@ emptyCDMapWrapper = CDMap mEmpty mEmpty
instance PatternMap CDMap where
#if __GLASGOW_HASKELL__ < 810
type Key CDMap = HsConDetails (LPat GhcPs) (HsRecFields GhcPs (LPat GhcPs))
#else
#elif __GLASGOW_HASKELL__ < 906
-- We must manually expand 'LPat' to avoid UndecidableInstances in GHC 8.10+
type Key CDMap = HsConDetails (HsPatSigType GhcPs) (LocatedA (Pat GhcPs)) (HsRecFields GhcPs (LocatedA (Pat GhcPs)))
-- type HsConPatDetails p = HsConDetails (HsPatSigType (NoGhcTc p)) (LPat p) (HsRecFields p (LPat p))

#else
type Key CDMap = HsConDetails (HsConPatTyArg GhcPs) (LocatedA (Pat GhcPs)) (HsRecFields GhcPs (LocatedA (Pat GhcPs)))
#endif

mEmpty :: CDMap a
Expand Down Expand Up @@ -1035,10 +1038,10 @@ instance PatternMap BMap where
go (FunBind _ _ mg _ _) = m { bmFunBind = mAlter env vs mg f (bmFunBind m) }
go (VarBind _ _ e _) = m { bmVarBind = mAlter env vs e f (bmVarBind m) }
#else
go (FunBind _ _ mg _) = m { bmFunBind = mAlter env vs mg f (bmFunBind m) }
go (FunBind{fun_matches = mg}) = m { bmFunBind = mAlter env vs mg f (bmFunBind m) }
go (VarBind _ _ e) = m { bmVarBind = mAlter env vs e f (bmVarBind m) }
#endif
go (PatBind _ lhs rhs _) =
go (PatBind{pat_lhs=lhs, pat_rhs=rhs}) =
m { bmPatBind = mAlter env vs lhs
(toA $ mAlter env vs rhs f) (bmPatBind m) }
#if __GLASGOW_HASKELL__ < 904
Expand All @@ -1054,10 +1057,10 @@ instance PatternMap BMap where
go (FunBind _ _ mg _ _) = mapFor bmFunBind >=> mMatch env mg
go (VarBind _ _ e _) = mapFor bmVarBind >=> mMatch env e
#else
go (FunBind _ _ mg _) = mapFor bmFunBind >=> mMatch env mg
go (FunBind{fun_matches = mg}) = mapFor bmFunBind >=> mMatch env mg
go (VarBind _ _ e) = mapFor bmVarBind >=> mMatch env e
#endif
go (PatBind _ lhs rhs _)
go (PatBind{pat_lhs=lhs, pat_rhs=rhs})
= mapFor bmPatBind >=> mMatch env lhs >=> mMatch env rhs
go _ = const [] -- TODO

Expand Down
6 changes: 5 additions & 1 deletion Retrie/Rewrites/Function.hs
Original file line number Diff line number Diff line change
Expand Up @@ -53,7 +53,7 @@ dfnsToRewrites libdir specs am = fmap astA $ transformA am $ \ (L _ m) -> do
getImports
:: LibDir -> Direction -> Maybe (LocatedA ModuleName) -> TransformT IO AnnotatedImports
getImports libdir RightToLeft (Just (L _ mn)) = -- See Note [fold only]
lift $ liftIO $ parseImports libdir ["import " ++ moduleNameString mn]
TransformT $ lift $ liftIO $ parseImports libdir ["import " ++ moduleNameString mn]
getImports _ _ _ = return mempty

matchToRewrites
Expand Down Expand Up @@ -81,7 +81,11 @@ irrefutablePat = go . unLoc
go WildPat{} = True
go VarPat{} = True
go (LazyPat _ p) = irrefutablePat p
#if __GLASGOW_HASKELL__ <= 904
go (AsPat _ _ p) = irrefutablePat p
#else
go (AsPat _ _ _ p) = irrefutablePat p
#endif
#if __GLASGOW_HASKELL__ < 904
go (ParPat _ p) = irrefutablePat p
#else
Expand Down
4 changes: 4 additions & 0 deletions Retrie/Rewrites/Patterns.hs
Original file line number Diff line number Diff line change
Expand Up @@ -86,7 +86,11 @@ asPat patName params = do
mkConPatIn patName params'
where

#if __GLASGOW_HASKELL__ <= 904
convertTyVars :: (Monad m) => [Void] -> TransformT m [HsPatSigType GhcPs]
#else
convertTyVars :: (Monad m) => [Void] -> TransformT m [HsConPatTyArg GhcPs]
#endif
convertTyVars _ = return []

convertFields :: (Monad m) => [RecordPatSynField GhcPs]
Expand Down
1 change: 1 addition & 0 deletions Retrie/Run.hs
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,7 @@ module Retrie.Run
, writeExtract
) where

import Control.Monad
import Control.Monad.State.Strict
import Data.Char
import Data.List
Expand Down
3 changes: 2 additions & 1 deletion Retrie/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -47,6 +47,7 @@ module Retrie.Types
, Context(..)
) where

import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.State
import Data.Bifunctor
Expand Down Expand Up @@ -328,7 +329,7 @@ firstMatch _ [] = return NoMatch
firstMatch ctxt ((sub, RewriterResult{..}):matchResults) = do
-- 'firstMatch' is lazy in 'rrTransformer', only running it enough
-- times to get the first valid MatchResult.
matchResult <- lift $ liftIO $ rrTransformer ctxt (MatchResult sub rrTemplate)
matchResult <- TransformT $ lift $ liftIO $ rrTransformer ctxt (MatchResult sub rrTemplate)
case matchResult of
MatchResult sub' _
-- Check that all quantifiers from the original rewrite have mappings
Expand Down
6 changes: 3 additions & 3 deletions retrie.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -77,14 +77,14 @@ library
build-depends:
ansi-terminal >= 0.10.3 && < 0.12,
async >= 2.2.2 && < 2.3,
base >= 4.11 && < 4.18,
base >= 4.11 && < 4.19,
bytestring >= 0.10.8 && < 0.12,
containers >= 0.5.11 && < 0.7,
data-default >= 0.7.1 && < 0.8,
directory >= 1.3.1 && < 1.4,
filepath >= 1.4.2 && < 1.5,
ghc >= 9.2 && < 9.5,
ghc-exactprint >= 1.5.0 && < 1.7,
ghc >= 9.2 && < 9.7,
ghc-exactprint >= 1.5.0 && < 1.8,
list-t >= 1.0.4 && < 1.1,
mtl >= 2.2.2 && < 2.3,
optparse-applicative >= 0.15.1 && < 0.18,
Expand Down