-- 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.
--
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Retrie.Run
  ( runScript
  , runScriptWithModifiedOptions
  , execute
  , run
  , WriteFn
  , writeCountLines
  , writeDiff
  , writeSearch
  , writeExtract
  ) where

import Control.Monad
import Control.Monad.State.Strict
import Data.Char
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
import Retrie.Replace
import Retrie.Util

-- | Define a custom refactoring script.
-- A script is an 'IO' action that defines a 'Retrie' computation. The 'IO'
-- action is run once, and the resulting 'Retrie' computation is run once
-- for each target file. Typically, rewrite parsing/construction is done in
-- the 'IO' action, so it is performed only once. Example:
--
-- > module Main where
-- >
-- > main :: IO ()
-- > main = runScript $ \opts -> do
-- >   rr <- parseRewrites opts ["forall f g xs. map f (map g xs) = map (f . g) xs"]
-- >   return $ apply rr
--
-- To run the script, compile the program and execute it.
runScript :: LibDir -> (Options -> IO (Retrie ())) -> IO ()
runScript :: LibDir -> (Options -> IO (Retrie ())) -> IO ()
runScript LibDir
libdir Options -> IO (Retrie ())
f = LibDir -> (Options -> IO (Options, Retrie ())) -> IO ()
runScriptWithModifiedOptions LibDir
libdir (\Options
opts -> (Options
Options_
  [Query
     Universe
     (Template Universe,
      Context -> MatchResult Universe -> IO (MatchResult Universe))]
  (Annotated [GenLocated SrcSpanAnnA (ImportDecl (GhcPass 'Parsed))])
opts,) (Retrie ()
 -> (Options_
       [Query
          Universe
          (Template Universe,
           Context -> MatchResult Universe -> IO (MatchResult Universe))]
       (Annotated
          [GenLocated SrcSpanAnnA (ImportDecl (GhcPass 'Parsed))]),
     Retrie ()))
-> IO (Retrie ())
-> IO
     (Options_
        [Query
           Universe
           (Template Universe,
            Context -> MatchResult Universe -> IO (MatchResult Universe))]
        (Annotated
           [GenLocated SrcSpanAnnA (ImportDecl (GhcPass 'Parsed))]),
      Retrie ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Options -> IO (Retrie ())
f Options
opts)

-- | Define a custom refactoring script and run it with modified options.
-- This is the same as 'runScript', but the returned 'Options' will be used
-- during rewriting.
runScriptWithModifiedOptions :: LibDir -> (Options -> IO (Options, Retrie ())) -> IO ()
runScriptWithModifiedOptions :: LibDir -> (Options -> IO (Options, Retrie ())) -> IO ()
runScriptWithModifiedOptions LibDir
libdir Options -> IO (Options, Retrie ())
f = do
  Options_
  [Query
     Universe
     (Template Universe,
      Context -> MatchResult Universe -> IO (MatchResult Universe))]
  (Annotated [GenLocated SrcSpanAnnA (ImportDecl (GhcPass 'Parsed))])
opts <- LibDir -> FixityEnv -> IO Options
parseOptions LibDir
libdir FixityEnv
forall a. Monoid a => a
mempty
  (Options_
  [Query
     Universe
     (Template Universe,
      Context -> MatchResult Universe -> IO (MatchResult Universe))]
  (Annotated [GenLocated SrcSpanAnnA (ImportDecl (GhcPass 'Parsed))])
opts', Retrie ()
retrie) <- Options -> IO (Options, Retrie ())
f Options
Options_
  [Query
     Universe
     (Template Universe,
      Context -> MatchResult Universe -> IO (MatchResult Universe))]
  (Annotated [GenLocated SrcSpanAnnA (ImportDecl (GhcPass 'Parsed))])
opts
  LibDir -> Options -> Retrie () -> IO ()
execute LibDir
libdir Options
Options_
  [Query
     Universe
     (Template Universe,
      Context -> MatchResult Universe -> IO (MatchResult Universe))]
  (Annotated [GenLocated SrcSpanAnnA (ImportDecl (GhcPass 'Parsed))])
opts' Retrie ()
retrie

-- | Implements retrie's iteration and execution modes.
execute :: LibDir -> Options -> Retrie () -> IO ()
execute :: LibDir -> Options -> Retrie () -> IO ()
execute LibDir
libdir opts :: Options
opts@Options{Bool
Int
LibDir
[LibDir]
[Query
   Universe
   (Template Universe,
    Context -> MatchResult Universe -> IO (MatchResult Universe))]
[RoundTrip]
FixityEnv
AnnotatedImports
Verbosity
ExecutionMode
ColoriseFun
additionalImports :: AnnotatedImports
colorise :: ColoriseFun
elaborations :: [Query
   Universe
   (Template Universe,
    Context -> MatchResult Universe -> IO (MatchResult Universe))]
executionMode :: ExecutionMode
extraIgnores :: [LibDir]
fixityEnv :: FixityEnv
iterateN :: Int
noDefaultElaborations :: Bool
randomOrder :: Bool
rewrites :: [Query
   Universe
   (Template Universe,
    Context -> MatchResult Universe -> IO (MatchResult Universe))]
roundtrips :: [RoundTrip]
singleThreaded :: Bool
targetDir :: LibDir
targetFiles :: [LibDir]
verbosity :: Verbosity
additionalImports :: forall rewrites imports. Options_ rewrites imports -> imports
colorise :: forall rewrites imports. Options_ rewrites imports -> ColoriseFun
elaborations :: forall rewrites imports. Options_ rewrites imports -> rewrites
executionMode :: forall rewrites imports. Options_ rewrites imports -> ExecutionMode
extraIgnores :: forall rewrites imports. Options_ rewrites imports -> [LibDir]
fixityEnv :: forall rewrites imports. Options_ rewrites imports -> FixityEnv
iterateN :: forall rewrites imports. Options_ rewrites imports -> Int
noDefaultElaborations :: forall rewrites imports. Options_ rewrites imports -> Bool
randomOrder :: forall rewrites imports. Options_ rewrites imports -> Bool
rewrites :: forall rewrites imports. Options_ rewrites imports -> rewrites
roundtrips :: forall rewrites imports. Options_ rewrites imports -> [RoundTrip]
singleThreaded :: forall rewrites imports. Options_ rewrites imports -> Bool
targetDir :: forall rewrites imports. Options_ rewrites imports -> LibDir
targetFiles :: forall rewrites imports. Options_ rewrites imports -> [LibDir]
verbosity :: forall rewrites imports. Options_ rewrites imports -> Verbosity
..} Retrie ()
retrie0 = do
  let retrie :: Retrie ()
retrie = Int -> Retrie () -> Retrie ()
iterateR Int
iterateN Retrie ()
retrie0
  case ExecutionMode
executionMode of
    ExecutionMode
ExecDryRun -> IO [Sum Int] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [Sum Int] -> IO ()) -> IO [Sum Int] -> IO ()
forall a b. (a -> b) -> a -> b
$ LibDir
-> (LibDir -> WriteFn () (Sum Int))
-> (IO (Sum Int) -> IO (Sum Int))
-> Options
-> Retrie ()
-> IO [Sum Int]
forall b a c.
Monoid b =>
LibDir
-> (LibDir -> WriteFn a b)
-> (IO b -> IO c)
-> Options
-> Retrie a
-> IO [c]
run LibDir
libdir (Options -> LibDir -> WriteFn () (Sum Int)
forall a. Options -> LibDir -> WriteFn a (Sum Int)
writeDiff Options
opts) IO (Sum Int) -> IO (Sum Int)
forall a. a -> a
id Options
opts Retrie ()
retrie
    ExecutionMode
ExecExtract -> IO [()] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [()] -> IO ()) -> IO [()] -> IO ()
forall a b. (a -> b) -> a -> b
$ LibDir
-> (LibDir -> WriteFn () ())
-> (IO () -> IO ())
-> Options
-> Retrie ()
-> IO [()]
forall b a c.
Monoid b =>
LibDir
-> (LibDir -> WriteFn a b)
-> (IO b -> IO c)
-> Options
-> Retrie a
-> IO [c]
run LibDir
libdir (Options -> LibDir -> WriteFn () ()
forall a. Options -> LibDir -> WriteFn a ()
writeExtract Options
opts) IO () -> IO ()
forall a. a -> a
id Options
opts Retrie ()
retrie
    ExecutionMode
ExecRewrite -> do
      Sum Int
s <- [Sum Int] -> Sum Int
forall a. Monoid a => [a] -> a
mconcat ([Sum Int] -> Sum Int) -> IO [Sum Int] -> IO (Sum Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LibDir
-> (LibDir -> WriteFn () (Sum Int))
-> (IO (Sum Int) -> IO (Sum Int))
-> Options
-> Retrie ()
-> IO [Sum Int]
forall b a c.
Monoid b =>
LibDir
-> (LibDir -> WriteFn a b)
-> (IO b -> IO c)
-> Options
-> Retrie a
-> IO [c]
run LibDir
libdir LibDir -> WriteFn () (Sum Int)
forall a. LibDir -> WriteFn a (Sum Int)
writeCountLines IO (Sum Int) -> IO (Sum Int)
forall a. a -> a
id Options
opts Retrie ()
retrie
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
> Verbosity
Silent) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        LibDir -> IO ()
putStrLn (LibDir -> IO ()) -> LibDir -> IO ()
forall a b. (a -> b) -> a -> b
$ LibDir
"Done! " LibDir -> LibDir -> LibDir
forall a. [a] -> [a] -> [a]
++ Int -> LibDir
forall a. Show a => a -> LibDir
show (Sum Int -> Int
forall a. Sum a -> a
getSum Sum Int
s) LibDir -> LibDir -> LibDir
forall a. [a] -> [a] -> [a]
++ LibDir
" lines changed."
    ExecutionMode
ExecSearch -> IO [()] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [()] -> IO ()) -> IO [()] -> IO ()
forall a b. (a -> b) -> a -> b
$ LibDir
-> (LibDir -> WriteFn () ())
-> (IO () -> IO ())
-> Options
-> Retrie ()
-> IO [()]
forall b a c.
Monoid b =>
LibDir
-> (LibDir -> WriteFn a b)
-> (IO b -> IO c)
-> Options
-> Retrie a
-> IO [c]
run LibDir
libdir (Options -> LibDir -> WriteFn () ()
forall a. Options -> LibDir -> WriteFn a ()
writeSearch Options
opts) IO () -> IO ()
forall a. a -> a
id Options
opts Retrie ()
retrie

-- | Callback function to actually write the resulting file back out.
-- Is given list of changed spans, module contents, and user-defined data.
type WriteFn a b = [Replacement] -> String -> CPP AnnotatedModule -> a -> IO b

-- | Primitive means of running a 'Retrie' computation.
run
  :: Monoid b
  => LibDir
  -> (FilePath -> WriteFn a b)
     -- ^ write action when a file changes, unchanged files result in 'mempty'
  -> (IO b -> IO c)            -- ^ wrap per-file rewrite action
  -> Options -> Retrie a -> IO [c]
run :: forall b a c.
Monoid b =>
LibDir
-> (LibDir -> WriteFn a b)
-> (IO b -> IO c)
-> Options
-> Retrie a
-> IO [c]
run LibDir
libdir LibDir -> WriteFn a b
writeFn IO b -> IO c
wrapper opts :: Options
opts@Options{Bool
Int
LibDir
[LibDir]
[Query
   Universe
   (Template Universe,
    Context -> MatchResult Universe -> IO (MatchResult Universe))]
[RoundTrip]
FixityEnv
AnnotatedImports
Verbosity
ExecutionMode
ColoriseFun
additionalImports :: forall rewrites imports. Options_ rewrites imports -> imports
colorise :: forall rewrites imports. Options_ rewrites imports -> ColoriseFun
elaborations :: forall rewrites imports. Options_ rewrites imports -> rewrites
executionMode :: forall rewrites imports. Options_ rewrites imports -> ExecutionMode
extraIgnores :: forall rewrites imports. Options_ rewrites imports -> [LibDir]
fixityEnv :: forall rewrites imports. Options_ rewrites imports -> FixityEnv
iterateN :: forall rewrites imports. Options_ rewrites imports -> Int
noDefaultElaborations :: forall rewrites imports. Options_ rewrites imports -> Bool
randomOrder :: forall rewrites imports. Options_ rewrites imports -> Bool
rewrites :: forall rewrites imports. Options_ rewrites imports -> rewrites
roundtrips :: forall rewrites imports. Options_ rewrites imports -> [RoundTrip]
singleThreaded :: forall rewrites imports. Options_ rewrites imports -> Bool
targetDir :: forall rewrites imports. Options_ rewrites imports -> LibDir
targetFiles :: forall rewrites imports. Options_ rewrites imports -> [LibDir]
verbosity :: forall rewrites imports. Options_ rewrites imports -> Verbosity
additionalImports :: AnnotatedImports
colorise :: ColoriseFun
elaborations :: [Query
   Universe
   (Template Universe,
    Context -> MatchResult Universe -> IO (MatchResult Universe))]
executionMode :: ExecutionMode
extraIgnores :: [LibDir]
fixityEnv :: FixityEnv
iterateN :: Int
noDefaultElaborations :: Bool
randomOrder :: Bool
rewrites :: [Query
   Universe
   (Template Universe,
    Context -> MatchResult Universe -> IO (MatchResult Universe))]
roundtrips :: [RoundTrip]
singleThreaded :: Bool
targetDir :: LibDir
targetFiles :: [LibDir]
verbosity :: Verbosity
..} Retrie a
r = do
  [LibDir]
fps <- Options_
  [Query
     Universe
     (Template Universe,
      Context -> MatchResult Universe -> IO (MatchResult Universe))]
  (Annotated [GenLocated SrcSpanAnnA (ImportDecl (GhcPass 'Parsed))])
-> [GroundTerms] -> IO [LibDir]
forall a b. Options_ a b -> [GroundTerms] -> IO [LibDir]
getTargetFiles Options
Options_
  [Query
     Universe
     (Template Universe,
      Context -> MatchResult Universe -> IO (MatchResult Universe))]
  (Annotated [GenLocated SrcSpanAnnA (ImportDecl (GhcPass 'Parsed))])
opts (Retrie a -> [GroundTerms]
forall a. Retrie a -> [GroundTerms]
getGroundTerms Retrie a
r)
  Options_
  [Query
     Universe
     (Template Universe,
      Context -> MatchResult Universe -> IO (MatchResult Universe))]
  (Annotated [GenLocated SrcSpanAnnA (ImportDecl (GhcPass 'Parsed))])
-> [LibDir] -> (LibDir -> IO c) -> IO [c]
forall x y a b. Options_ x y -> [a] -> (a -> IO b) -> IO [b]
forFn Options
Options_
  [Query
     Universe
     (Template Universe,
      Context -> MatchResult Universe -> IO (MatchResult Universe))]
  (Annotated [GenLocated SrcSpanAnnA (ImportDecl (GhcPass 'Parsed))])
opts [LibDir]
fps ((LibDir -> IO c) -> IO [c]) -> (LibDir -> IO c) -> IO [c]
forall a b. (a -> b) -> a -> b
$ \ LibDir
fp -> IO b -> IO c
wrapper (IO b -> IO c) -> IO b -> IO c
forall a b. (a -> b) -> a -> b
$ do
    Verbosity -> LibDir -> [LibDir] -> IO ()
debugPrint Verbosity
verbosity LibDir
"Processing:" [LibDir
fp]
    Either SomeException (CPP AnnotatedModule)
p <- IO (CPP AnnotatedModule)
-> IO (Either SomeException (CPP AnnotatedModule))
forall a. IO a -> IO (Either SomeException a)
trySync (IO (CPP AnnotatedModule)
 -> IO (Either SomeException (CPP AnnotatedModule)))
-> IO (CPP AnnotatedModule)
-> IO (Either SomeException (CPP AnnotatedModule))
forall a b. (a -> b) -> a -> b
$ (LibDir -> LibDir -> IO AnnotatedModule)
-> LibDir -> IO (CPP AnnotatedModule)
parseCPPFile (LibDir -> FixityEnv -> LibDir -> LibDir -> IO AnnotatedModule
parseContent LibDir
libdir FixityEnv
fixityEnv) LibDir
fp
    case Either SomeException (CPP AnnotatedModule)
p of
      Left SomeException
ex -> do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
> Verbosity
Silent) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException -> IO ()
forall a. Show a => a -> IO ()
print SomeException
ex
        b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
forall a. Monoid a => a
mempty
      Right CPP AnnotatedModule
cpp -> WriteFn a b -> Options -> Retrie a -> CPP AnnotatedModule -> IO b
forall b a.
Monoid b =>
WriteFn a b -> Options -> Retrie a -> CPP AnnotatedModule -> IO b
runOneModule (LibDir -> WriteFn a b
writeFn LibDir
fp) Options
opts Retrie a
r CPP AnnotatedModule
cpp

-- | Run a 'Retrie' computation on the given parsed module, writing
-- changes with the given write action.
runOneModule
  :: Monoid b
  => WriteFn a b
     -- ^ write action if the module changes, unchanged module returns 'mempty'
  -> Options
  -> Retrie a
  -> CPP AnnotatedModule
  -> IO b
runOneModule :: forall b a.
Monoid b =>
WriteFn a b -> Options -> Retrie a -> CPP AnnotatedModule -> IO b
runOneModule WriteFn a b
writeFn Options{Bool
Int
LibDir
[LibDir]
[Query
   Universe
   (Template Universe,
    Context -> MatchResult Universe -> IO (MatchResult Universe))]
[RoundTrip]
FixityEnv
AnnotatedImports
Verbosity
ExecutionMode
ColoriseFun
additionalImports :: forall rewrites imports. Options_ rewrites imports -> imports
colorise :: forall rewrites imports. Options_ rewrites imports -> ColoriseFun
elaborations :: forall rewrites imports. Options_ rewrites imports -> rewrites
executionMode :: forall rewrites imports. Options_ rewrites imports -> ExecutionMode
extraIgnores :: forall rewrites imports. Options_ rewrites imports -> [LibDir]
fixityEnv :: forall rewrites imports. Options_ rewrites imports -> FixityEnv
iterateN :: forall rewrites imports. Options_ rewrites imports -> Int
noDefaultElaborations :: forall rewrites imports. Options_ rewrites imports -> Bool
randomOrder :: forall rewrites imports. Options_ rewrites imports -> Bool
rewrites :: forall rewrites imports. Options_ rewrites imports -> rewrites
roundtrips :: forall rewrites imports. Options_ rewrites imports -> [RoundTrip]
singleThreaded :: forall rewrites imports. Options_ rewrites imports -> Bool
targetDir :: forall rewrites imports. Options_ rewrites imports -> LibDir
targetFiles :: forall rewrites imports. Options_ rewrites imports -> [LibDir]
verbosity :: forall rewrites imports. Options_ rewrites imports -> Verbosity
additionalImports :: AnnotatedImports
colorise :: ColoriseFun
elaborations :: [Query
   Universe
   (Template Universe,
    Context -> MatchResult Universe -> IO (MatchResult Universe))]
executionMode :: ExecutionMode
extraIgnores :: [LibDir]
fixityEnv :: FixityEnv
iterateN :: Int
noDefaultElaborations :: Bool
randomOrder :: Bool
rewrites :: [Query
   Universe
   (Template Universe,
    Context -> MatchResult Universe -> IO (MatchResult Universe))]
roundtrips :: [RoundTrip]
singleThreaded :: Bool
targetDir :: LibDir
targetFiles :: [LibDir]
verbosity :: Verbosity
..} Retrie a
r CPP AnnotatedModule
cpp = do
  -- debugPrint Loud "runOneModule" ["enter"]
  (a
x, CPP AnnotatedModule
cpp', Change
changed) <- FixityEnv
-> Retrie a
-> CPP AnnotatedModule
-> IO (a, CPP AnnotatedModule, Change)
forall a.
FixityEnv
-> Retrie a
-> CPP AnnotatedModule
-> IO (a, CPP AnnotatedModule, Change)
runRetrie FixityEnv
fixityEnv Retrie a
r CPP AnnotatedModule
cpp
  case Change
changed of
    Change
NoChange -> b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
forall a. Monoid a => a
mempty
    Change [Replacement]
repls [AnnotatedImports]
imports -> do
      -- debugPrint Loud "runOneModule" ["change", show repls]
      let cpp'' :: CPP AnnotatedModule
cpp'' = [AnnotatedImports] -> CPP AnnotatedModule -> CPP AnnotatedModule
addImportsCPP (AnnotatedImports
Annotated [GenLocated SrcSpanAnnA (ImportDecl (GhcPass 'Parsed))]
additionalImportsAnnotated [GenLocated SrcSpanAnnA (ImportDecl (GhcPass 'Parsed))]
-> [Annotated
      [GenLocated SrcSpanAnnA (ImportDecl (GhcPass 'Parsed))]]
-> [Annotated
      [GenLocated SrcSpanAnnA (ImportDecl (GhcPass 'Parsed))]]
forall a. a -> [a] -> [a]
:[AnnotatedImports]
[Annotated [GenLocated SrcSpanAnnA (ImportDecl (GhcPass 'Parsed))]]
imports) CPP AnnotatedModule
cpp'
      WriteFn a b
writeFn [Replacement]
repls ([Replacement] -> CPP AnnotatedModule -> LibDir
printCPP [Replacement]
repls CPP AnnotatedModule
cpp'') CPP AnnotatedModule
cpp'' a
x

-- isCpp :: CPP AnnotatedModule -> String
-- isCpp (NoCPP m) = "NoCPP:" ++ showAstA m
-- isCpp (CPP{}) = "CPP"

-- | Write action which counts changed lines using 'diff'
writeCountLines :: FilePath -> WriteFn a (Sum Int)
writeCountLines :: forall a. LibDir -> WriteFn a (Sum Int)
writeCountLines LibDir
fp [Replacement]
reps LibDir
str CPP AnnotatedModule
_ a
_ = do
  let lc :: Int
lc = [SrcSpan] -> Int
lineCount ([SrcSpan] -> Int) -> [SrcSpan] -> Int
forall a b. (a -> b) -> a -> b
$ (Replacement -> SrcSpan) -> [Replacement] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map Replacement -> SrcSpan
replLocation [Replacement]
reps
  LibDir -> IO ()
putStrLn (LibDir -> IO ()) -> LibDir -> IO ()
forall a b. (a -> b) -> a -> b
$ LibDir
"Writing: " LibDir -> LibDir -> LibDir
forall a. [a] -> [a] -> [a]
++ LibDir
fp LibDir -> LibDir -> LibDir
forall a. [a] -> [a] -> [a]
++ LibDir
" (" LibDir -> LibDir -> LibDir
forall a. [a] -> [a] -> [a]
++ Int -> LibDir
forall a. Show a => a -> LibDir
show Int
lc LibDir -> LibDir -> LibDir
forall a. [a] -> [a] -> [a]
++ LibDir
" lines changed)"
  LibDir -> LibDir -> IO ()
writeFile LibDir
fp LibDir
str
  Sum Int -> IO (Sum Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sum Int -> IO (Sum Int)) -> Sum Int -> IO (Sum Int)
forall a b. (a -> b) -> a -> b
$ Int -> Sum Int
forall a. a -> Sum a
Sum Int
lc

-- | Print the lines before replacement and after replacement.
writeDiff :: Options -> FilePath -> WriteFn a (Sum Int)
writeDiff :: forall a. Options -> LibDir -> WriteFn a (Sum Int)
writeDiff Options{Bool
Int
LibDir
[LibDir]
[Query
   Universe
   (Template Universe,
    Context -> MatchResult Universe -> IO (MatchResult Universe))]
[RoundTrip]
FixityEnv
AnnotatedImports
Verbosity
ExecutionMode
ColoriseFun
additionalImports :: forall rewrites imports. Options_ rewrites imports -> imports
colorise :: forall rewrites imports. Options_ rewrites imports -> ColoriseFun
elaborations :: forall rewrites imports. Options_ rewrites imports -> rewrites
executionMode :: forall rewrites imports. Options_ rewrites imports -> ExecutionMode
extraIgnores :: forall rewrites imports. Options_ rewrites imports -> [LibDir]
fixityEnv :: forall rewrites imports. Options_ rewrites imports -> FixityEnv
iterateN :: forall rewrites imports. Options_ rewrites imports -> Int
noDefaultElaborations :: forall rewrites imports. Options_ rewrites imports -> Bool
randomOrder :: forall rewrites imports. Options_ rewrites imports -> Bool
rewrites :: forall rewrites imports. Options_ rewrites imports -> rewrites
roundtrips :: forall rewrites imports. Options_ rewrites imports -> [RoundTrip]
singleThreaded :: forall rewrites imports. Options_ rewrites imports -> Bool
targetDir :: forall rewrites imports. Options_ rewrites imports -> LibDir
targetFiles :: forall rewrites imports. Options_ rewrites imports -> [LibDir]
verbosity :: forall rewrites imports. Options_ rewrites imports -> Verbosity
additionalImports :: AnnotatedImports
colorise :: ColoriseFun
elaborations :: [Query
   Universe
   (Template Universe,
    Context -> MatchResult Universe -> IO (MatchResult Universe))]
executionMode :: ExecutionMode
extraIgnores :: [LibDir]
fixityEnv :: FixityEnv
iterateN :: Int
noDefaultElaborations :: Bool
randomOrder :: Bool
rewrites :: [Query
   Universe
   (Template Universe,
    Context -> MatchResult Universe -> IO (MatchResult Universe))]
roundtrips :: [RoundTrip]
singleThreaded :: Bool
targetDir :: LibDir
targetFiles :: [LibDir]
verbosity :: Verbosity
..} LibDir
fp [Replacement]
repls LibDir
_ CPP AnnotatedModule
_ a
_ = do
  HashMap Int LibDir
fl <- LibDir -> IO (HashMap Int LibDir)
linesMap LibDir
fp
  [Replacement] -> (Replacement -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Replacement]
repls ((Replacement -> IO ()) -> IO ())
-> (Replacement -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Replacement{LibDir
SrcSpan
replLocation :: Replacement -> SrcSpan
replLocation :: SrcSpan
replOriginal :: LibDir
replReplacement :: LibDir
replOriginal :: Replacement -> LibDir
replReplacement :: Replacement -> LibDir
..} -> do
    let ppLines :: LibDir -> Color -> LibDir -> LibDir
ppLines LibDir
lineStart Color
color = [LibDir] -> LibDir
unlines
          ([LibDir] -> LibDir) -> (LibDir -> [LibDir]) -> LibDir -> LibDir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LibDir -> LibDir) -> [LibDir] -> [LibDir]
forall a b. (a -> b) -> [a] -> [b]
map (LibDir
lineStart LibDir -> LibDir -> LibDir
forall a. [a] -> [a] -> [a]
++)
          ([LibDir] -> [LibDir])
-> (LibDir -> [LibDir]) -> LibDir -> [LibDir]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Int LibDir -> SrcSpan -> LibDir -> [LibDir]
ppRepl HashMap Int LibDir
fl SrcSpan
replLocation
          (LibDir -> [LibDir]) -> (LibDir -> LibDir) -> LibDir -> [LibDir]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColoriseFun
colorise ColorIntensity
Vivid Color
color
    LibDir -> IO ()
putStrLn (LibDir -> IO ()) -> LibDir -> IO ()
forall a b. (a -> b) -> a -> b
$ [LibDir] -> LibDir
forall a. Monoid a => [a] -> a
mconcat
      [ ColoriseFun -> SrcSpan -> LibDir
ppSrcSpan ColoriseFun
colorise SrcSpan
replLocation
      , LibDir
"\n"
      , LibDir -> Color -> LibDir -> LibDir
ppLines LibDir
"- " Color
Red LibDir
replOriginal
      , LibDir -> Color -> LibDir -> LibDir
ppLines LibDir
"+ " Color
Green LibDir
replReplacement
      ]
  Sum Int -> IO (Sum Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sum Int -> IO (Sum Int)) -> Sum Int -> IO (Sum Int)
forall a b. (a -> b) -> a -> b
$ Int -> Sum Int
forall a. a -> Sum a
Sum (Int -> Sum Int) -> Int -> Sum Int
forall a b. (a -> b) -> a -> b
$ [SrcSpan] -> Int
lineCount ([SrcSpan] -> Int) -> [SrcSpan] -> Int
forall a b. (a -> b) -> a -> b
$ (Replacement -> SrcSpan) -> [Replacement] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map Replacement -> SrcSpan
replLocation [Replacement]
repls

-- | Print lines that match the query and highligh the matched string.
writeSearch :: Options -> FilePath -> WriteFn a ()
writeSearch :: forall a. Options -> LibDir -> WriteFn a ()
writeSearch Options{Bool
Int
LibDir
[LibDir]
[Query
   Universe
   (Template Universe,
    Context -> MatchResult Universe -> IO (MatchResult Universe))]
[RoundTrip]
FixityEnv
AnnotatedImports
Verbosity
ExecutionMode
ColoriseFun
additionalImports :: forall rewrites imports. Options_ rewrites imports -> imports
colorise :: forall rewrites imports. Options_ rewrites imports -> ColoriseFun
elaborations :: forall rewrites imports. Options_ rewrites imports -> rewrites
executionMode :: forall rewrites imports. Options_ rewrites imports -> ExecutionMode
extraIgnores :: forall rewrites imports. Options_ rewrites imports -> [LibDir]
fixityEnv :: forall rewrites imports. Options_ rewrites imports -> FixityEnv
iterateN :: forall rewrites imports. Options_ rewrites imports -> Int
noDefaultElaborations :: forall rewrites imports. Options_ rewrites imports -> Bool
randomOrder :: forall rewrites imports. Options_ rewrites imports -> Bool
rewrites :: forall rewrites imports. Options_ rewrites imports -> rewrites
roundtrips :: forall rewrites imports. Options_ rewrites imports -> [RoundTrip]
singleThreaded :: forall rewrites imports. Options_ rewrites imports -> Bool
targetDir :: forall rewrites imports. Options_ rewrites imports -> LibDir
targetFiles :: forall rewrites imports. Options_ rewrites imports -> [LibDir]
verbosity :: forall rewrites imports. Options_ rewrites imports -> Verbosity
additionalImports :: AnnotatedImports
colorise :: ColoriseFun
elaborations :: [Query
   Universe
   (Template Universe,
    Context -> MatchResult Universe -> IO (MatchResult Universe))]
executionMode :: ExecutionMode
extraIgnores :: [LibDir]
fixityEnv :: FixityEnv
iterateN :: Int
noDefaultElaborations :: Bool
randomOrder :: Bool
rewrites :: [Query
   Universe
   (Template Universe,
    Context -> MatchResult Universe -> IO (MatchResult Universe))]
roundtrips :: [RoundTrip]
singleThreaded :: Bool
targetDir :: LibDir
targetFiles :: [LibDir]
verbosity :: Verbosity
..} LibDir
fp [Replacement]
repls LibDir
_ CPP AnnotatedModule
_ a
_ = do
  HashMap Int LibDir
fl <- LibDir -> IO (HashMap Int LibDir)
linesMap LibDir
fp
  [Replacement] -> (Replacement -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Replacement]
repls ((Replacement -> IO ()) -> IO ())
-> (Replacement -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Replacement{LibDir
SrcSpan
replLocation :: Replacement -> SrcSpan
replOriginal :: Replacement -> LibDir
replReplacement :: Replacement -> LibDir
replLocation :: SrcSpan
replOriginal :: LibDir
replReplacement :: LibDir
..} ->
    LibDir -> IO ()
putStrLn (LibDir -> IO ()) -> LibDir -> IO ()
forall a b. (a -> b) -> a -> b
$ [LibDir] -> LibDir
forall a. Monoid a => [a] -> a
mconcat
      [ ColoriseFun -> SrcSpan -> LibDir
ppSrcSpan ColoriseFun
colorise SrcSpan
replLocation
      , [LibDir] -> LibDir
ppLine
        ([LibDir] -> LibDir) -> [LibDir] -> LibDir
forall a b. (a -> b) -> a -> b
$ HashMap Int LibDir -> SrcSpan -> LibDir -> [LibDir]
ppRepl HashMap Int LibDir
fl SrcSpan
replLocation
        (LibDir -> [LibDir]) -> LibDir -> [LibDir]
forall a b. (a -> b) -> a -> b
$ ColoriseFun
colorise ColorIntensity
Vivid Color
Red LibDir
replOriginal
      ]
  where
    ppLine :: [LibDir] -> LibDir
ppLine [] = LibDir
""
    ppLine [LibDir
x] = LibDir -> LibDir
strip LibDir
x
    ppLine [LibDir]
xs = Char
'\n'Char -> LibDir -> LibDir
forall a. a -> [a] -> [a]
: (Char -> Bool) -> LibDir -> LibDir
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace ([LibDir] -> LibDir
unlines [LibDir]
xs)

-- | Print only replacement.
writeExtract :: Options -> FilePath -> WriteFn a ()
writeExtract :: forall a. Options -> LibDir -> WriteFn a ()
writeExtract Options{Bool
Int
LibDir
[LibDir]
[Query
   Universe
   (Template Universe,
    Context -> MatchResult Universe -> IO (MatchResult Universe))]
[RoundTrip]
FixityEnv
AnnotatedImports
Verbosity
ExecutionMode
ColoriseFun
additionalImports :: forall rewrites imports. Options_ rewrites imports -> imports
colorise :: forall rewrites imports. Options_ rewrites imports -> ColoriseFun
elaborations :: forall rewrites imports. Options_ rewrites imports -> rewrites
executionMode :: forall rewrites imports. Options_ rewrites imports -> ExecutionMode
extraIgnores :: forall rewrites imports. Options_ rewrites imports -> [LibDir]
fixityEnv :: forall rewrites imports. Options_ rewrites imports -> FixityEnv
iterateN :: forall rewrites imports. Options_ rewrites imports -> Int
noDefaultElaborations :: forall rewrites imports. Options_ rewrites imports -> Bool
randomOrder :: forall rewrites imports. Options_ rewrites imports -> Bool
rewrites :: forall rewrites imports. Options_ rewrites imports -> rewrites
roundtrips :: forall rewrites imports. Options_ rewrites imports -> [RoundTrip]
singleThreaded :: forall rewrites imports. Options_ rewrites imports -> Bool
targetDir :: forall rewrites imports. Options_ rewrites imports -> LibDir
targetFiles :: forall rewrites imports. Options_ rewrites imports -> [LibDir]
verbosity :: forall rewrites imports. Options_ rewrites imports -> Verbosity
additionalImports :: AnnotatedImports
colorise :: ColoriseFun
elaborations :: [Query
   Universe
   (Template Universe,
    Context -> MatchResult Universe -> IO (MatchResult Universe))]
executionMode :: ExecutionMode
extraIgnores :: [LibDir]
fixityEnv :: FixityEnv
iterateN :: Int
noDefaultElaborations :: Bool
randomOrder :: Bool
rewrites :: [Query
   Universe
   (Template Universe,
    Context -> MatchResult Universe -> IO (MatchResult Universe))]
roundtrips :: [RoundTrip]
singleThreaded :: Bool
targetDir :: LibDir
targetFiles :: [LibDir]
verbosity :: Verbosity
..} LibDir
_ [Replacement]
repls LibDir
_ CPP AnnotatedModule
_ a
_ = do
  [Replacement] -> (Replacement -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Replacement]
repls ((Replacement -> IO ()) -> IO ())
-> (Replacement -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Replacement{LibDir
SrcSpan
replLocation :: Replacement -> SrcSpan
replOriginal :: Replacement -> LibDir
replReplacement :: Replacement -> LibDir
replLocation :: SrcSpan
replOriginal :: LibDir
replReplacement :: LibDir
..} -> do
    LibDir -> IO ()
putStrLn (LibDir -> IO ()) -> LibDir -> IO ()
forall a b. (a -> b) -> a -> b
$ [LibDir] -> LibDir
forall a. Monoid a => [a] -> a
mconcat
      [ ColoriseFun -> SrcSpan -> LibDir
ppSrcSpan ColoriseFun
colorise SrcSpan
replLocation
      , LibDir -> LibDir
strip LibDir
replReplacement
      ]