retrie 0.1.1.0 → 0.1.1.1

raw patch · 24 files changed

+294/−159 lines, 24 filesdep ~data-defaultPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: data-default

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• Retrie/Context.hs +0/−7
• Retrie/ExactPrint.hs +6/−5
• Retrie/Expr.hs +38/−11
• Retrie/Fixity.hs +2/−42
• Retrie/FreeVars.hs +8/−13
• Retrie/GHC.hs +32/−1
• Retrie/Options.hs +7/−5
• Retrie/Replace.hs +2/−2
• Retrie/Rewrites/Function.hs +39/−20
• Retrie/Rewrites/Rules.hs +0/−1
• Retrie/Rewrites/Types.hs +0/−1
• Retrie/Run.hs +2/−2
• Retrie/Util.hs +0/−29
• bin/Main.hs +2/−2
• hse/Fixity.hs +47/−0
• retrie.cabal +23/−9
• tests/AllTests.hs +2/−2
• tests/Exclude.hs +5/−1
• tests/GroundTerms.hs +5/−5
• tests/inputs/Foo.test +37/−0
• tests/inputs/PartialU.test +8/−0
• tests/inputs/Qualified.test +17/−0
• tests/inputs/Recursion.test +3/−1

@@ -1,3 +1,12 @@+0.1.1.1 (June 1, 2020)++* Remove dependency on haskell-src-exts from library (#9)+* Support additional pattern syntax when generating fold/unfold rewrites (#8)+* Limit partial-application rewrite variants to irrefutible patterns (#7)+* Fix handling of qualified names during substitution (#5)+* Fix self-recursion check for do-syntax binds (#5)+* Fix bug in grep invocation for relative target paths (#5)+ 0.1.1.0 (May 8, 2020)  * Support GHC 8.10.1

@@ -110,13 +110,6 @@         bs = collectLStmtsBinders gs      updStmt :: Stmt GhcPs (LHsExpr GhcPs) -> Context-#if __GLASGOW_HASKELL__ < 806-    updStmt (BindStmt p _body _ _ _)-#else-    updStmt (BindStmt _ p _body _ _)-#endif-      -- i > firstChild == 'for the body'-      | i > firstChild = addBinders neverParen (collectPatBinders p)     updStmt _ = neverParen      updStmtList :: [LStmt GhcPs (LHsExpr GhcPs)] -> TransformT m Context

@@ -45,7 +45,6 @@  import Control.Exception import Control.Monad.State.Lazy hiding (fix)-import Data.Default as D import Data.Function (on) import Data.List (transpose) import Data.Maybe@@ -394,8 +393,10 @@               (c,_):cs -> ann { annPriorComments = (c,dp):cs }  -- Useful for figuring out what annotations should be on something.-debugParse :: String -> IO ()-debugParse s = do+-- If you don't care about fixities, pass 'mempty' as the FixityEnv.+-- String should be the entire module contents.+debugParse :: FixityEnv -> String -> IO ()+debugParse fixityEnv s = do   writeFile "debug.txt" s   r <- parseModule "debug.txt"   case r of@@ -407,8 +408,8 @@       void $ transformDebug m   where     transformDebug =-      run "fixOneExpr D.def" (fixOneExpr D.def)-        >=> run "fixOnePat D.def" (fixOnePat D.def)+      run "fixOneExpr D.def" (fixOneExpr fixityEnv)+        >=> run "fixOnePat D.def" (fixOnePat fixityEnv)         >=> run "fixOneEntryExpr" fixOneEntryExpr         >=> run "fixOneEntryPat" fixOneEntryPat 

@@ -202,41 +202,68 @@   return e   where     go WildPat{} = newWildVar >>= lift . mkLocatedHsVar . noLoc-    go LazyPat{} = error "patToExpr LazyPat"-    go AsPat{} = error "patToExpr AsPat"-    go BangPat{} = error "patToExpr BangPat"-    go TuplePat{} = error "patToExpr TuplePat"     go (ConPatIn con ds) = conPatHelper con ds-    go ConPatOut{} = error "patToExpr ConPatOut"-    go ViewPat{} = error "patToExpr ViewPat"-    go SplicePat{} = error "patToExpr SplicePat"-    go LitPat{} = error "patToExpr LitPat"-    go NPat{} = error "patToExpr NPat"-    go NPlusKPat{} = error "patToExpr NPlusKPat" #if __GLASGOW_HASKELL__ < 806+    go (LazyPat pat) = patToExpr pat+    go (BangPat pat) = patToExpr pat     go (ListPat ps ty mb) = do       ps' <- mapM patToExpr ps       lift $ do         el <- mkLoc $ ExplicitList ty (snd <$> mb) ps'         setAnnsFor el [(G AnnOpenS, DP (0,0)), (G AnnCloseS, DP (0,0))]+    go (LitPat lit) = lift $ do+      lit' <- cloneT lit+      mkLoc $ HsLit lit'+    go (NPat llit mbNeg _ _) = lift $ do+      L _ lit <- cloneT llit+      e <- mkLoc $ HsOverLit lit+      negE <- maybe (return e) (mkLoc . NegApp e) mbNeg+      addAllAnnsT llit negE+      return negE     go PArrPat{} = error "patToExpr PArrPat"     go (ParPat p') = lift . mkParen HsPar =<< patToExpr p'     go SigPatIn{} = error "patToExpr SigPatIn"     go SigPatOut{} = error "patToExpr SigPatOut"+    go (TuplePat ps boxity _) = do+      es <- forM ps $ \pat -> do+        e <- patToExpr pat+        lift $ mkLoc $ Present e+      lift $ mkLoc $ ExplicitTuple es boxity     go (VarPat i) = lift $ mkLocatedHsVar i #else+    go (LazyPat _ pat) = patToExpr pat+    go (BangPat _ pat) = patToExpr pat     go (ListPat _ ps) = do       ps' <- mapM patToExpr ps       lift $ do         el <- mkLoc $ ExplicitList noExtField Nothing ps'         setAnnsFor el [(G AnnOpenS, DP (0,0)), (G AnnCloseS, DP (0,0))]+    go (LitPat _ lit) = lift $ do+      lit' <- cloneT lit+      mkLoc $ HsLit noExtField lit'+    go (NPat _ llit mbNeg _) = lift $ do+      L _ lit <- cloneT llit+      e <- mkLoc $ HsOverLit noExtField lit+      negE <- maybe (return e) (mkLoc . NegApp noExtField e) mbNeg+      addAllAnnsT llit negE+      return negE     go (ParPat _ p') = lift . mkParen (HsPar noExtField) =<< patToExpr p'-    go (VarPat _ i) = lift $ mkLocatedHsVar i     go SigPat{} = error "patToExpr SigPat"+    go (TuplePat _ ps boxity) = do+      es <- forM ps $ \pat -> do+        e <- patToExpr pat+        lift $ mkLoc $ Present noExtField e+      lift $ mkLoc $ ExplicitTuple noExtField es boxity+    go (VarPat _ i) = lift $ mkLocatedHsVar i     go XPat{} = error "patToExpr XPat" #endif+    go AsPat{} = error "patToExpr AsPat"+    go ConPatOut{} = error "patToExpr ConPatOut" -- only exists post-tc     go CoPat{} = error "patToExpr CoPat"+    go NPlusKPat{} = error "patToExpr NPlusKPat"+    go SplicePat{} = error "patToExpr SplicePat"     go SumPat{} = error "patToExpr SumPat"+    go ViewPat{} = error "patToExpr ViewPat"  conPatHelper :: Monad m              => Located RdrName

@@ -11,38 +11,15 @@   , lookupOpRdrName   , Fixity(..)   , FixityDirection(..)-  , defaultFixityEnv   , extendFixityEnv   , ppFixityEnv   ) where --- Note [HSE]--- GHC's parser parses all operator applications left-associatived,--- then fixes up the associativity in the renamer, since fixity info isn't--- known until after name resolution.------ Ideally, we'd run the module through the renamer and let it do its thing,--- but ghc-exactprint cannot roundtrip renamed modules.------ The next best thing we can do is reassociate the operators ourselves, but--- we need fixity info. Ideally (#2) we'd rename the module and then extract--- the info from the FixityEnv. That is a TODO. For now, lets just reuse the--- list of base package fixities in HSE.-import qualified Language.Haskell.Exts as HSE--import Data.Default- import Retrie.GHC  newtype FixityEnv = FixityEnv   { unFixityEnv :: FastStringEnv (FastString, Fixity) } -instance Default FixityEnv where-  def = defaultFixityEnv--defaultFixityEnv :: FixityEnv-defaultFixityEnv = mkFixityEnv HSE.baseFixities- instance Semigroup FixityEnv where   -- | 'mappend' for 'FixityEnv' is right-biased   (<>) = mappend@@ -60,8 +37,8 @@ lookupOpRdrName (L _ n) (FixityEnv env) =   maybe defaultFixity snd $ lookupFsEnv env (occNameFS $ occName n) -mkFixityEnv :: [HSE.Fixity] -> FixityEnv-mkFixityEnv = FixityEnv . mkFsEnv . map hseToGHC+mkFixityEnv :: [(FastString, (FastString, Fixity))] -> FixityEnv+mkFixityEnv = FixityEnv . mkFsEnv  extendFixityEnv :: [(FastString, Fixity)] -> FixityEnv -> FixityEnv extendFixityEnv l (FixityEnv env) =@@ -78,20 +55,3 @@       , show p       , unpackFS fs       ]--hseToGHC :: HSE.Fixity -> (FastString, (FastString, Fixity))-hseToGHC (HSE.Fixity assoc p nm) = (fs, (fs, Fixity (SourceText nm') p (dir assoc)))-  where-    dir (HSE.AssocNone _)  = InfixN-    dir (HSE.AssocLeft _)  = InfixL-    dir (HSE.AssocRight _) = InfixR--    nm' = case nm of-      HSE.Qual _ _ n -> nameStr n-      HSE.UnQual _ n -> nameStr n-      _             -> "SpecialCon"--    fs = mkFastString nm'--    nameStr (HSE.Ident _ s)  = s-    nameStr (HSE.Symbol _ s) = s

@@ -5,9 +5,9 @@ -- module Retrie.FreeVars   ( FreeVars-  , substFVs   , elemFVs-  , capturesFVs+  , freeVars+  , substFVs   ) where  import Data.Generics hiding (Fixity)@@ -19,20 +19,20 @@  -------------------------------------------------------------------------------- -newtype FreeVars = FreeVars (OccEnv FastString)+newtype FreeVars = FreeVars (UniqSet FastString)  emptyFVs :: FreeVars-emptyFVs = FreeVars emptyOccEnv+emptyFVs = FreeVars emptyUniqSet  instance Semigroup FreeVars where   (<>) = mappend  instance Monoid FreeVars where   mempty = emptyFVs-  mappend (FreeVars m1) (FreeVars m2) = FreeVars $ plusOccEnv m2 m1+  mappend (FreeVars s1) (FreeVars s2) = FreeVars $ s1 <> s2  instance Show FreeVars where-  show (FreeVars m) = show (occEnvElts m)+  show (FreeVars m) = show (nonDetEltsUniqSet m)  substFVs :: Substitution -> FreeVars substFVs = foldSubst (f . snd) emptyFVs@@ -41,11 +41,6 @@     f (HoleRdr rdr) fvs = rdrFV rdr <> fvs     f _ fvs = fvs -- TODO(anfarmer) types? -capturesFVs :: (Data a, Typeable a) => Quantifiers -> [RdrName] -> a -> Bool-capturesFVs qs binders thing = any (`elemOccEnv` fvEnv) $ map occName binders-  where-    FreeVars fvEnv = freeVars qs thing- -- | This is an over-approximation, but that is fine for our purposes. freeVars :: (Data a, Typeable a) => Quantifiers -> a -> FreeVars freeVars qs = everything (<>) (mkQ emptyFVs fvsExpr `extQ` fvsType)@@ -63,7 +58,7 @@     fvsType _ = emptyFVs  elemFVs :: RdrName -> FreeVars -> Bool-elemFVs rdr (FreeVars m) = elemOccEnv (occName rdr) m+elemFVs rdr (FreeVars m) = elementOfUniqSet (rdrFS rdr) m  rdrFV :: RdrName -> FreeVars-rdrFV rdr = FreeVars $ unitOccEnv (occName rdr) (rdrFS rdr)+rdrFV = FreeVars . unitUniqSet . rdrFS

@@ -56,11 +56,16 @@ import UniqFM import UniqSet +import Data.Bifunctor (second) import Data.Maybe  rdrFS :: RdrName -> FastString-rdrFS = occNameFS . occName+rdrFS (Qual m n) = mconcat [moduleNameFS m, fsDot, occNameFS n]+rdrFS rdr = occNameFS (occName rdr) +fsDot :: FastString+fsDot = mkFastString "."+ varRdrName :: HsExpr p -> Maybe (Located (IdP p)) #if __GLASGOW_HASKELL__ < 806 varRdrName (HsVar n) = Just n@@ -148,3 +153,29 @@ noExtField :: NoExt noExtField = noExt #endif++overlaps :: SrcSpan -> SrcSpan -> Bool+overlaps (RealSrcSpan s1) (RealSrcSpan s2) =+     srcSpanFile s1 == srcSpanFile s2 &&+     ((srcSpanStartLine s1, srcSpanStartCol s1) `within` s2 ||+      (srcSpanEndLine s1, srcSpanEndCol s1) `within` s2)+overlaps _ _ = False++within :: (Int, Int) -> RealSrcSpan -> Bool+within (l,p) s =+  srcSpanStartLine s <= l &&+  srcSpanStartCol s <= p  &&+  srcSpanEndLine s >= l   &&+  srcSpanEndCol s >= p++lineCount :: [SrcSpan] -> Int+lineCount ss = sum+  [ srcSpanEndLine s - srcSpanStartLine s + 1+  | RealSrcSpan s <- ss+  ]++showRdrs :: [RdrName] -> String+showRdrs = show . map (occNameString . occName)++uniqBag :: Uniquable a => [(a,b)] -> UniqFM [b]+uniqBag = listToUFM_C (++) . map (second pure)

@@ -127,7 +127,7 @@   , colorise = noColor   , executionMode = ExecRewrite   , extraIgnores = []-  , fixityEnv = D.def+  , fixityEnv = mempty   , iterateN = 1   , randomOrder = False   , rewrites = D.def@@ -299,7 +299,9 @@ -- declared fixities in the target directory. resolveOptions :: ProtoOptions -> IO Options resolveOptions protoOpts = do-  opts@Options{..} <- addLocalFixities protoOpts+  absoluteTargetDir <- makeAbsolute (targetDir protoOpts)+  opts@Options{..} <-+    addLocalFixities protoOpts { targetDir = absoluteTargetDir }   parsedImports <- parseImports additionalImports   debugPrint verbosity "Imports:" $     runIdentity $ fmap astA $ transformA parsedImports $ \ imps -> do@@ -307,9 +309,9 @@       return $ map (`exactPrint` anns) imps   rrs <- parseRewritesInternal opts rewrites   return Options-    { rewrites          = rrs-    , additionalImports = parsedImports-    , singleThreaded    = singleThreaded || verbosity == Loud+    { additionalImports = parsedImports+    , rewrites = rrs+    , singleThreaded = singleThreaded || verbosity == Loud     , ..     } 

@@ -26,7 +26,6 @@ import Retrie.Subst import Retrie.Types import Retrie.Universe-import Retrie.Util  ------------------------------------------------------------------------ @@ -55,7 +54,8 @@     check origin quantifiers match       | getLoc e `overlaps` origin = NoMatch       | MatchResult _ Template{..} <- match-      , capturesFVs quantifiers (ctxtBinders c) (astA tTemplate) = NoMatch+      , fvs <- freeVars quantifiers (astA tTemplate)+      , any (`elemFVs` fvs) (ctxtBinders c) = NoMatch       | otherwise = match    match <- runRewriter f c (ctxtRewriter c) (getUnparened e)

@@ -18,7 +18,6 @@ import Retrie.GHC import Retrie.Quantifiers import Retrie.Types-import Retrie.Util  dfnsToRewrites   :: [(FastString, Direction)]@@ -72,6 +71,24 @@ type AppBuilder =   LHsExpr GhcPs -> [LHsExpr GhcPs] -> TransformT IO (LHsExpr GhcPs) +irrefutablePat :: LPat GhcPs -> Bool+irrefutablePat = go . unLoc+  where+    go WildPat{} = True+    go VarPat{} = True+#if __GLASGOW_HASKELL__ < 806+    go (LazyPat p) = irrefutablePat p+    go (AsPat _ p) = irrefutablePat p+    go (ParPat p) = irrefutablePat p+    go (BangPat p) = irrefutablePat p+#else+    go (LazyPat _ p) = irrefutablePat p+    go (AsPat _ _ p) = irrefutablePat p+    go (ParPat _ p) = irrefutablePat p+    go (BangPat _ p) = irrefutablePat p+#endif+    go _ = False+ makeFunctionQuery   :: LHsExpr GhcPs   -> AnnotatedImports@@ -80,28 +97,30 @@   -> AppBuilder   -> ([LPat GhcPs], [LPat GhcPs])   -> TransformT IO [Rewrite (LHsExpr GhcPs)]-makeFunctionQuery e imps dir grhss mkAppFn (argpats, bndpats) = do-  let+makeFunctionQuery e imps dir grhss mkAppFn (argpats, bndpats)+  | any (not . irrefutablePat) bndpats = return []+  | otherwise = do+    let #if __GLASGOW_HASKELL__ < 806-    GRHSs rhss lbs = grhss+      GRHSs rhss lbs = grhss #else-    GRHSs _ rhss lbs = grhss+      GRHSs _ rhss lbs = grhss #endif-    bs = collectPatsBinders argpats-  -- See Note [Wildcards]-  (es,(_,bs')) <- runStateT (mapM patToExpr argpats) (wildSupply bs, bs)-  lhs <- mkAppFn e es-  for rhss $ \ grhs -> do-    le <- mkLet (unLoc lbs) (grhsToExpr grhs)-    rhs <- mkLams bndpats le-    let-      (pat, temp) =-        case dir of-          LeftToRight -> (lhs,rhs)-          RightToLeft -> (rhs,lhs)-    p <- pruneA pat-    t <- pruneA temp-    return $ addRewriteImports imps $ mkRewrite (mkQs bs') p t+      bs = collectPatsBinders argpats+    -- See Note [Wildcards]+    (es,(_,bs')) <- runStateT (mapM patToExpr argpats) (wildSupply bs, bs)+    lhs <- mkAppFn e es+    for rhss $ \ grhs -> do+      le <- mkLet (unLoc lbs) (grhsToExpr grhs)+      rhs <- mkLams bndpats le+      let+        (pat, temp) =+          case dir of+            LeftToRight -> (lhs,rhs)+            RightToLeft -> (rhs,lhs)+      p <- pruneA pat+      t <- pruneA temp+      return $ addRewriteImports imps $ mkRewrite (mkQs bs') p t  backtickRules   :: LHsExpr GhcPs

@@ -13,7 +13,6 @@ import Retrie.GHC import Retrie.Quantifiers import Retrie.Types-import Retrie.Util  rulesToRewrites   :: [(FastString, Direction)]

@@ -17,7 +17,6 @@ import Retrie.GHC import Retrie.Quantifiers import Retrie.Types-import Retrie.Util  typeSynonymsToRewrites   :: [(FastString, Direction)]

@@ -20,13 +20,13 @@  import Control.Monad.State.Strict import Data.Char-import Data.Default import Data.List import Data.Monoid import System.Console.ANSI  import Retrie.CPP import Retrie.ExactPrint+import Retrie.GHC import Retrie.Monad import Retrie.Options import Retrie.Pretty@@ -55,7 +55,7 @@ -- during rewriting. runScriptWithModifiedOptions :: (Options -> IO (Options, Retrie ())) -> IO () runScriptWithModifiedOptions f = do-  opts <- parseOptions def+  opts <- parseOptions mempty   (opts', retrie) <- f opts   execute opts' retrie 

@@ -10,37 +10,11 @@ import Control.Concurrent.Async import Control.Exception import Control.Monad-import Data.Bifunctor (second) import Data.List import System.Exit import System.FilePath import System.Process -import Retrie.GHC--overlaps :: SrcSpan -> SrcSpan -> Bool-overlaps (RealSrcSpan s1) (RealSrcSpan s2) =-     srcSpanFile s1 == srcSpanFile s2 &&-     ((srcSpanStartLine s1, srcSpanStartCol s1) `within` s2 ||-      (srcSpanEndLine s1, srcSpanEndCol s1) `within` s2)-overlaps _ _ = False--within :: (Int, Int) -> RealSrcSpan -> Bool-within (l,p) s =-  srcSpanStartLine s <= l &&-  srcSpanStartCol s <= p  &&-  srcSpanEndLine s >= l   &&-  srcSpanEndCol s >= p--lineCount :: [SrcSpan] -> Int-lineCount ss = sum-  [ srcSpanEndLine s - srcSpanStartLine s + 1-  | RealSrcSpan s <- ss-  ]--showRdrs :: [RdrName] -> String-showRdrs = show . map (occNameString . occName)- data Verbosity = Silent | Normal | Loud   deriving (Eq, Ord, Show) @@ -121,6 +95,3 @@   case fromException e of     Just (_ :: SomeAsyncException) -> throwIO e     Nothing -> return (Left e)--uniqBag :: Uniquable a => [(a,b)] -> UniqFM [b]-uniqBag = listToUFM_C (++) . map (second pure)

@@ -7,7 +7,7 @@ module Main (main) where  import Control.Monad-import Data.Default+import Fixity import Retrie import Retrie.Debug import Retrie.Options@@ -15,7 +15,7 @@  main :: IO () main = do-  opts@Options{..} <- parseOptions def+  opts@Options{..} <- parseOptions defaultFixityEnv   doRoundtrips fixityEnv targetDir roundtrips   unless (null rewrites) $ do     when (verbosity > Silent) $ do

@@ -0,0 +1,47 @@+-- Copyright (c) Facebook, Inc. and its affiliates.+--+-- This source code is licensed under the MIT license found in the+-- LICENSE file in the root directory of this source tree.+--+module Fixity+  ( defaultFixityEnv+  , hseToGHC+  ) where++-- Note [HSE]+-- GHC's parser parses all operator applications left-associatived,+-- then fixes up the associativity in the renamer, since fixity info isn't+-- known until after name resolution.+--+-- Ideally, we'd run the module through the renamer and let it do its thing,+-- but ghc-exactprint cannot roundtrip renamed modules.+--+-- The next best thing we can do is reassociate the operators ourselves, but+-- we need fixity info. Ideally (#2) we'd rename the module and then extract+-- the info from the FixityEnv. That is a TODO. For now, lets just reuse the+-- list of base package fixities in HSE.+import qualified Language.Haskell.Exts as HSE++import Retrie.Fixity+import Retrie.GHC++defaultFixityEnv :: FixityEnv+defaultFixityEnv = mkFixityEnv $ map hseToGHC HSE.baseFixities++hseToGHC :: HSE.Fixity -> (FastString, (FastString, Fixity))+hseToGHC (HSE.Fixity assoc p nm) =+  (fs, (fs, Fixity (SourceText nm') p (dir assoc)))+  where+    dir (HSE.AssocNone _)  = InfixN+    dir (HSE.AssocLeft _)  = InfixL+    dir (HSE.AssocRight _) = InfixR++    nm' = case nm of+      HSE.Qual _ _ n -> nameStr n+      HSE.UnQual _ n -> nameStr n+      _             -> "SpecialCon"++    fs = mkFastString nm'++    nameStr (HSE.Ident _ s)  = s+    nameStr (HSE.Symbol _ s) = s

@@ -4,7 +4,7 @@ -- LICENSE file in the root directory of this source tree. -- name: retrie-version: 0.1.1.0+version: 0.1.1.1 synopsis: A powerful, easy-to-use codemodding tool for Haskell. homepage: https://github.com/facebookincubator/retrie bug-reports: https://github.com/facebookincubator/retrie/issues@@ -83,7 +83,6 @@     filepath >= 1.4.2 && < 1.5,     ghc >= 8.4 && < 8.12,     ghc-exactprint >= 0.6.2 && < 0.7,-    haskell-src-exts >= 1.23.0 && < 1.24,     mtl >= 2.2.2 && < 2.3,     optparse-applicative >= 0.15.1 && < 0.16,     process >= 1.6.3 && < 1.7,@@ -94,27 +93,40 @@     unordered-containers >= 0.2.10 && < 0.3   default-language: Haskell2010 +Flag BuildExecutable+  Description: build the retrie executable+  Default: True+ executable retrie+  if flag(BuildExecutable)+    Buildable: True+  else+    Buildable: False   main-is:     Main.hs-  hs-source-dirs: bin-  other-modules:+  hs-source-dirs: bin hse+  other-modules: Fixity   GHC-Options: -Wall   build-depends:     retrie,     base >= 4.11 && < 4.15,-    data-default+    haskell-src-exts >= 1.23.0 && < 1.24   default-language: Haskell2010  executable demo+  if flag(BuildExecutable)+    Buildable: True+  else+    Buildable: False   main-is:     Main.hs-  hs-source-dirs: demo-  other-modules:+  hs-source-dirs: demo hse+  other-modules: Fixity   GHC-Options: -Wall   build-depends:     retrie,-    base >= 4.11 && < 4.15+    base >= 4.11 && < 4.15,+    haskell-src-exts >= 1.23.0 && < 1.24   default-language: Haskell2010  test-suite test@@ -127,13 +139,14 @@     Demo,     Dependent,     Exclude,+    Fixity,     Golden,     GroundTerms,     Ignore,     ParseQualified,     Targets,     Util-  hs-source-dirs: tests+  hs-source-dirs: tests hse   default-language: Haskell2010   GHC-Options: -Wall   build-depends:@@ -147,6 +160,7 @@     filepath,     ghc >= 8.4 && < 8.12,     ghc-paths,+    haskell-src-exts >= 1.23.0 && < 1.24,     mtl,     optparse-applicative,     process,

@@ -8,8 +8,8 @@ {-# LANGUAGE RecordWildCards #-} module AllTests (allTests) where -import Data.Default import Data.Maybe+import Fixity import Retrie import Retrie.Options import System.Environment@@ -29,7 +29,7 @@  allTests :: Verbosity -> IO Test allTests rtVerbosity = do-  p <- getOptionsParser def+  p <- getOptionsParser defaultFixityEnv   rtDir <-     fromMaybe (dropFileName __FILE__ </> "inputs")       <$> lookupEnv "RETRIEINPUTSDIR"

@@ -8,6 +8,7 @@ module Exclude (excludeTest) where  import Data.List (isPrefixOf, stripPrefix)+import Fixity import Retrie import Retrie.Options import System.FilePath@@ -30,7 +31,7 @@ excludeTest v = TestLabel "exclude path prefixes" $   TestCase $ do     withFakeHgRepo [] allFiles $ \dir -> do-      let opts = optionsWithExtraIgnores dir v+      let opts = optionsWithDefaultFixities $ optionsWithExtraIgnores dir v       filepaths <- getTargetFiles opts []       assertBool (unlines ["Expected ", show excludedPaths,         "to be excluded, these were included : ", show filepaths])@@ -47,6 +48,9 @@   { extraIgnores = excludedPaths   , verbosity = v   }++optionsWithDefaultFixities :: Options -> Options+optionsWithDefaultFixities opts = opts { fixityEnv = defaultFixityEnv }  -- Check that filepaths with prefixes in the excluded list are excluded excludedPathsAreExcluded :: [FilePath] -> Bool

@@ -11,9 +11,9 @@  import Control.Monad import Control.Monad.IO.Class-import Data.Default import qualified Data.HashSet as HashSet import Data.Text (Text)+import Fixity import Retrie.CPP import Retrie.ExactPrint import Retrie.GroundTerms@@ -62,8 +62,8 @@      rrs <-       parseRewriteSpecs-        (\_ -> parseCPP (parseContent def "Test") contents)-        def+        (\_ -> parseCPP (parseContent defaultFixityEnv "Test") contents)+        defaultFixityEnv         specs     let gtss = map groundTerms rrs @@ -81,8 +81,8 @@  getFocusTests :: IO [Test] getFocusTests = do-  rrs1 <- parseAdhocs def ["forall xs. or (map isSpace xs) = any isSpace xs"]-  rrs2 <- parseAdhocs def ["forall f g xs. map f (map g xs) = map (f . g) xs"]+  rrs1 <- parseAdhocs defaultFixityEnv ["forall xs. or (map isSpace xs) = any isSpace xs"]+  rrs2 <- parseAdhocs defaultFixityEnv ["forall f g xs. map f (map g xs) = map (f . g) xs"]   let     -- compare hashsets to avoid ordering issues     terms = HashSet.fromList $ map groundTerms rrs1

@@ -4,6 +4,10 @@ # LICENSE file in the root directory of this source tree. # -u Foo.foo+-u Foo.baz+-u Foo.str+-u Foo.tuple+-u Foo.list ===  module Foo where  @@ -13,3 +17,36 @@  bar :: [Int] -bar = foo [4,5,6] +bar = [4,5,6] ++ [1,2, 3]++ baz :: Int -> Int+ baz (-1) = 0+ baz 0 = 1+ baz n = n++ quux :: Int+-quux = baz 54 + baz 0 + baz (-1)++quux = 54 + 1 + 0++ str :: String -> Int+ str "foo" = 54+ str bar = 42++ str2 :: Int+-str2 = str "foo" - str "bar"++str2 = 54 - 42++ tuple :: (String, Int) -> Int+ tuple ("foo", x) = x + 1+ tuple (s, y) = y++ tuple2 :: Int+-tuple2 = tuple ("foo", 54) + tuple ("bar", 42)++tuple2 = 54 + 1 + 42++ list :: [String] -> Int+ list ["foo"] = 54+ list _ = 42++ list2 :: Int+-list2 = list ["foo"] + list ["bar"]++list2 = 54 + 42

@@ -4,6 +4,7 @@ # LICENSE file in the root directory of this source tree. # -u PartialU.foo+-u PartialU.bar ===  module PartialU where  @@ -19,3 +20,10 @@ +  print (6 + 7) +  print $ map (\ y -> 5 + y) [1..4] +  print $ zipWith (\ x y -> x + y) [1..3] [10..]+ + bar :: Int -> Bool -> Int+ bar x True = x+ bar y False = y + 1++ baz :: Bool -> Int+ baz b = bar 54 b

@@ -0,0 +1,17 @@+# Copyright (c) Facebook, Inc. and its affiliates.+#+# This source code is licensed under the MIT license found in the+# LICENSE file in the root directory of this source tree.+#+-u Qualified.foo+===+ module Qualified where++ import Bar (x)+ + foo :: Int -> Int+ foo x = x - Bar.x+ + bar :: Int -> Int+-bar x = foo x++bar x = x - Bar.x

@@ -48,7 +48,9 @@ -    dupa2 = blarg some otherargs +    dupa2 = dupa some otherargs -   dupa <- blarg "notok" "ok"+   -- this blarg should be rewritten, because do-binding is not recursive+-  dupa <- blarg "notok" "ok"++  dupa <- dupa "notok" "ok" -  dupa2 <- blarg "notok" "ok" +  dupa2 <- dupa "notok" "ok"