-- 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.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 :: (Options -> IO (Retrie ())) -> IO ()
runScript :: (Options -> IO (Retrie ())) -> IO ()
runScript Options -> IO (Retrie ())
f = (Options -> IO (Options, Retrie ())) -> IO ()
runScriptWithModifiedOptions (\Options
opts -> (Options
opts,) (Retrie () -> (Options, Retrie ()))
-> IO (Retrie ()) -> IO (Options, 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 :: (Options -> IO (Options, Retrie ())) -> IO ()
runScriptWithModifiedOptions :: (Options -> IO (Options, Retrie ())) -> IO ()
runScriptWithModifiedOptions Options -> IO (Options, Retrie ())
f = do
  Options
opts <- FixityEnv -> IO Options
parseOptions FixityEnv
forall a. Monoid a => a
mempty
  (Options
opts', Retrie ()
retrie) <- Options -> IO (Options, Retrie ())
f Options
opts
  Options -> Retrie () -> IO ()
execute Options
opts' Retrie ()
retrie

-- | Implements retrie's iteration and execution modes.
execute :: Options -> Retrie () -> IO ()
execute :: Options -> Retrie () -> IO ()
execute opts :: Options
opts@Options{Bool
Int
FilePath
[FilePath]
[Rewrite Universe]
[RoundTrip]
FixityEnv
AnnotatedImports
Verbosity
ExecutionMode
ColoriseFun
verbosity :: forall rewrites imports. Options_ rewrites imports -> Verbosity
targetFiles :: forall rewrites imports. Options_ rewrites imports -> [FilePath]
targetDir :: forall rewrites imports. Options_ rewrites imports -> FilePath
singleThreaded :: forall rewrites imports. Options_ rewrites imports -> Bool
roundtrips :: forall rewrites imports. Options_ rewrites imports -> [RoundTrip]
rewrites :: forall rewrites imports. Options_ rewrites imports -> rewrites
randomOrder :: forall rewrites imports. Options_ rewrites imports -> Bool
noDefaultElaborations :: forall rewrites imports. Options_ rewrites imports -> Bool
iterateN :: forall rewrites imports. Options_ rewrites imports -> Int
fixityEnv :: forall rewrites imports. Options_ rewrites imports -> FixityEnv
extraIgnores :: forall rewrites imports. Options_ rewrites imports -> [FilePath]
executionMode :: forall rewrites imports. Options_ rewrites imports -> ExecutionMode
elaborations :: forall rewrites imports. Options_ rewrites imports -> rewrites
colorise :: forall rewrites imports. Options_ rewrites imports -> ColoriseFun
additionalImports :: forall rewrites imports. Options_ rewrites imports -> imports
verbosity :: Verbosity
targetFiles :: [FilePath]
targetDir :: FilePath
singleThreaded :: Bool
roundtrips :: [RoundTrip]
rewrites :: [Rewrite Universe]
randomOrder :: Bool
noDefaultElaborations :: Bool
iterateN :: Int
fixityEnv :: FixityEnv
extraIgnores :: [FilePath]
executionMode :: ExecutionMode
elaborations :: [Rewrite Universe]
colorise :: ColoriseFun
additionalImports :: AnnotatedImports
..} 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
$ (FilePath -> WriteFn () (Sum Int))
-> (IO (Sum Int) -> IO (Sum Int))
-> Options
-> Retrie ()
-> IO [Sum Int]
forall b a c.
Monoid b =>
(FilePath -> WriteFn a b)
-> (IO b -> IO c) -> Options -> Retrie a -> IO [c]
run (Options -> FilePath -> WriteFn () (Sum Int)
forall a. Options -> FilePath -> 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
$ (FilePath -> WriteFn () ())
-> (IO () -> IO ()) -> Options -> Retrie () -> IO [()]
forall b a c.
Monoid b =>
(FilePath -> WriteFn a b)
-> (IO b -> IO c) -> Options -> Retrie a -> IO [c]
run (Options -> FilePath -> WriteFn () ()
forall a. Options -> FilePath -> 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
<$> (FilePath -> WriteFn () (Sum Int))
-> (IO (Sum Int) -> IO (Sum Int))
-> Options
-> Retrie ()
-> IO [Sum Int]
forall b a c.
Monoid b =>
(FilePath -> WriteFn a b)
-> (IO b -> IO c) -> Options -> Retrie a -> IO [c]
run FilePath -> WriteFn () (Sum Int)
forall a. FilePath -> 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
$
        FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Done! " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (Sum Int -> Int
forall a. Sum a -> a
getSum Sum Int
s) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" 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
$ (FilePath -> WriteFn () ())
-> (IO () -> IO ()) -> Options -> Retrie () -> IO [()]
forall b a c.
Monoid b =>
(FilePath -> WriteFn a b)
-> (IO b -> IO c) -> Options -> Retrie a -> IO [c]
run (Options -> FilePath -> WriteFn () ()
forall a. Options -> FilePath -> 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 -> a -> IO b

-- | Primitive means of running a 'Retrie' computation.
run
  :: Monoid b
  => (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 :: (FilePath -> WriteFn a b)
-> (IO b -> IO c) -> Options -> Retrie a -> IO [c]
run FilePath -> WriteFn a b
writeFn IO b -> IO c
wrapper opts :: Options
opts@Options{Bool
Int
FilePath
[FilePath]
[Rewrite Universe]
[RoundTrip]
FixityEnv
AnnotatedImports
Verbosity
ExecutionMode
ColoriseFun
verbosity :: Verbosity
targetFiles :: [FilePath]
targetDir :: FilePath
singleThreaded :: Bool
roundtrips :: [RoundTrip]
rewrites :: [Rewrite Universe]
randomOrder :: Bool
noDefaultElaborations :: Bool
iterateN :: Int
fixityEnv :: FixityEnv
extraIgnores :: [FilePath]
executionMode :: ExecutionMode
elaborations :: [Rewrite Universe]
colorise :: ColoriseFun
additionalImports :: AnnotatedImports
verbosity :: forall rewrites imports. Options_ rewrites imports -> Verbosity
targetFiles :: forall rewrites imports. Options_ rewrites imports -> [FilePath]
targetDir :: forall rewrites imports. Options_ rewrites imports -> FilePath
singleThreaded :: forall rewrites imports. Options_ rewrites imports -> Bool
roundtrips :: forall rewrites imports. Options_ rewrites imports -> [RoundTrip]
rewrites :: forall rewrites imports. Options_ rewrites imports -> rewrites
randomOrder :: forall rewrites imports. Options_ rewrites imports -> Bool
noDefaultElaborations :: forall rewrites imports. Options_ rewrites imports -> Bool
iterateN :: forall rewrites imports. Options_ rewrites imports -> Int
fixityEnv :: forall rewrites imports. Options_ rewrites imports -> FixityEnv
extraIgnores :: forall rewrites imports. Options_ rewrites imports -> [FilePath]
executionMode :: forall rewrites imports. Options_ rewrites imports -> ExecutionMode
elaborations :: forall rewrites imports. Options_ rewrites imports -> rewrites
colorise :: forall rewrites imports. Options_ rewrites imports -> ColoriseFun
additionalImports :: forall rewrites imports. Options_ rewrites imports -> imports
..} Retrie a
r = do
  [FilePath]
fps <- Options -> [GroundTerms] -> IO [FilePath]
forall a b. Options_ a b -> [GroundTerms] -> IO [FilePath]
getTargetFiles Options
opts (Retrie a -> [GroundTerms]
forall a. Retrie a -> [GroundTerms]
getGroundTerms Retrie a
r)
  Options -> [FilePath] -> (FilePath -> IO c) -> IO [c]
forall x y a b. Options_ x y -> [a] -> (a -> IO b) -> IO [b]
forFn Options
opts [FilePath]
fps ((FilePath -> IO c) -> IO [c]) -> (FilePath -> IO c) -> IO [c]
forall a b. (a -> b) -> a -> b
$ \ FilePath
fp -> IO b -> IO c
wrapper (IO b -> IO c) -> IO b -> IO c
forall a b. (a -> b) -> a -> b
$ do
    Verbosity -> FilePath -> [FilePath] -> IO ()
debugPrint Verbosity
verbosity FilePath
"Processing:" [FilePath
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
$ (FilePath -> FilePath -> IO AnnotatedModule)
-> FilePath -> IO (CPP AnnotatedModule)
parseCPPFile (FixityEnv -> FilePath -> FilePath -> IO AnnotatedModule
parseContent FixityEnv
fixityEnv) FilePath
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 (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 (FilePath -> WriteFn a b
writeFn FilePath
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 :: WriteFn a b -> Options -> Retrie a -> CPP AnnotatedModule -> IO b
runOneModule WriteFn a b
writeFn Options{Bool
Int
FilePath
[FilePath]
[Rewrite Universe]
[RoundTrip]
FixityEnv
AnnotatedImports
Verbosity
ExecutionMode
ColoriseFun
verbosity :: Verbosity
targetFiles :: [FilePath]
targetDir :: FilePath
singleThreaded :: Bool
roundtrips :: [RoundTrip]
rewrites :: [Rewrite Universe]
randomOrder :: Bool
noDefaultElaborations :: Bool
iterateN :: Int
fixityEnv :: FixityEnv
extraIgnores :: [FilePath]
executionMode :: ExecutionMode
elaborations :: [Rewrite Universe]
colorise :: ColoriseFun
additionalImports :: AnnotatedImports
verbosity :: forall rewrites imports. Options_ rewrites imports -> Verbosity
targetFiles :: forall rewrites imports. Options_ rewrites imports -> [FilePath]
targetDir :: forall rewrites imports. Options_ rewrites imports -> FilePath
singleThreaded :: forall rewrites imports. Options_ rewrites imports -> Bool
roundtrips :: forall rewrites imports. Options_ rewrites imports -> [RoundTrip]
rewrites :: forall rewrites imports. Options_ rewrites imports -> rewrites
randomOrder :: forall rewrites imports. Options_ rewrites imports -> Bool
noDefaultElaborations :: forall rewrites imports. Options_ rewrites imports -> Bool
iterateN :: forall rewrites imports. Options_ rewrites imports -> Int
fixityEnv :: forall rewrites imports. Options_ rewrites imports -> FixityEnv
extraIgnores :: forall rewrites imports. Options_ rewrites imports -> [FilePath]
executionMode :: forall rewrites imports. Options_ rewrites imports -> ExecutionMode
elaborations :: forall rewrites imports. Options_ rewrites imports -> rewrites
colorise :: forall rewrites imports. Options_ rewrites imports -> ColoriseFun
additionalImports :: forall rewrites imports. Options_ rewrites imports -> imports
..} Retrie a
r CPP AnnotatedModule
cpp = do
  (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 (m :: * -> *) a. Monad m => a -> m a
return b
forall a. Monoid a => a
mempty
    Change [Replacement]
repls [AnnotatedImports]
imports -> do
      let cpp'' :: CPP AnnotatedModule
cpp'' = [AnnotatedImports] -> CPP AnnotatedModule -> CPP AnnotatedModule
addImportsCPP (AnnotatedImports
additionalImportsAnnotatedImports -> [AnnotatedImports] -> [AnnotatedImports]
forall a. a -> [a] -> [a]
:[AnnotatedImports]
imports) CPP AnnotatedModule
cpp'
      WriteFn a b
writeFn [Replacement]
repls ([Replacement] -> CPP AnnotatedModule -> FilePath
printCPP [Replacement]
repls CPP AnnotatedModule
cpp'') a
x

-- | Write action which counts changed lines using 'diff'
writeCountLines :: FilePath -> WriteFn a (Sum Int)
writeCountLines :: FilePath -> WriteFn a (Sum Int)
writeCountLines FilePath
fp [Replacement]
reps FilePath
str 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
  FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Writing: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" (" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
lc FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" lines changed)"
  FilePath -> FilePath -> IO ()
writeFile FilePath
fp FilePath
str
  Sum Int -> IO (Sum Int)
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 :: Options -> FilePath -> WriteFn a (Sum Int)
writeDiff Options{Bool
Int
FilePath
[FilePath]
[Rewrite Universe]
[RoundTrip]
FixityEnv
AnnotatedImports
Verbosity
ExecutionMode
ColoriseFun
verbosity :: Verbosity
targetFiles :: [FilePath]
targetDir :: FilePath
singleThreaded :: Bool
roundtrips :: [RoundTrip]
rewrites :: [Rewrite Universe]
randomOrder :: Bool
noDefaultElaborations :: Bool
iterateN :: Int
fixityEnv :: FixityEnv
extraIgnores :: [FilePath]
executionMode :: ExecutionMode
elaborations :: [Rewrite Universe]
colorise :: ColoriseFun
additionalImports :: AnnotatedImports
verbosity :: forall rewrites imports. Options_ rewrites imports -> Verbosity
targetFiles :: forall rewrites imports. Options_ rewrites imports -> [FilePath]
targetDir :: forall rewrites imports. Options_ rewrites imports -> FilePath
singleThreaded :: forall rewrites imports. Options_ rewrites imports -> Bool
roundtrips :: forall rewrites imports. Options_ rewrites imports -> [RoundTrip]
rewrites :: forall rewrites imports. Options_ rewrites imports -> rewrites
randomOrder :: forall rewrites imports. Options_ rewrites imports -> Bool
noDefaultElaborations :: forall rewrites imports. Options_ rewrites imports -> Bool
iterateN :: forall rewrites imports. Options_ rewrites imports -> Int
fixityEnv :: forall rewrites imports. Options_ rewrites imports -> FixityEnv
extraIgnores :: forall rewrites imports. Options_ rewrites imports -> [FilePath]
executionMode :: forall rewrites imports. Options_ rewrites imports -> ExecutionMode
elaborations :: forall rewrites imports. Options_ rewrites imports -> rewrites
colorise :: forall rewrites imports. Options_ rewrites imports -> ColoriseFun
additionalImports :: forall rewrites imports. Options_ rewrites imports -> imports
..} FilePath
fp [Replacement]
repls FilePath
_ a
_ = do
  HashMap Int FilePath
fl <- FilePath -> IO (HashMap Int FilePath)
linesMap FilePath
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{FilePath
SrcSpan
replReplacement :: Replacement -> FilePath
replOriginal :: Replacement -> FilePath
replReplacement :: FilePath
replOriginal :: FilePath
replLocation :: SrcSpan
replLocation :: Replacement -> SrcSpan
..} -> do
    let ppLines :: FilePath -> Color -> FilePath -> FilePath
ppLines FilePath
lineStart Color
color = [FilePath] -> FilePath
unlines
          ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
lineStart FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++)
          ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Int FilePath -> SrcSpan -> FilePath -> [FilePath]
ppRepl HashMap Int FilePath
fl SrcSpan
replLocation
          (FilePath -> [FilePath])
-> (FilePath -> FilePath) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColoriseFun
colorise ColorIntensity
Vivid Color
color
    FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat
      [ ColoriseFun -> SrcSpan -> FilePath
ppSrcSpan ColoriseFun
colorise SrcSpan
replLocation
      , FilePath
"\n"
      , FilePath -> Color -> FilePath -> FilePath
ppLines FilePath
"- " Color
Red FilePath
replOriginal
      , FilePath -> Color -> FilePath -> FilePath
ppLines FilePath
"+ " Color
Green FilePath
replReplacement
      ]
  Sum Int -> IO (Sum Int)
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 :: Options -> FilePath -> WriteFn a ()
writeSearch Options{Bool
Int
FilePath
[FilePath]
[Rewrite Universe]
[RoundTrip]
FixityEnv
AnnotatedImports
Verbosity
ExecutionMode
ColoriseFun
verbosity :: Verbosity
targetFiles :: [FilePath]
targetDir :: FilePath
singleThreaded :: Bool
roundtrips :: [RoundTrip]
rewrites :: [Rewrite Universe]
randomOrder :: Bool
noDefaultElaborations :: Bool
iterateN :: Int
fixityEnv :: FixityEnv
extraIgnores :: [FilePath]
executionMode :: ExecutionMode
elaborations :: [Rewrite Universe]
colorise :: ColoriseFun
additionalImports :: AnnotatedImports
verbosity :: forall rewrites imports. Options_ rewrites imports -> Verbosity
targetFiles :: forall rewrites imports. Options_ rewrites imports -> [FilePath]
targetDir :: forall rewrites imports. Options_ rewrites imports -> FilePath
singleThreaded :: forall rewrites imports. Options_ rewrites imports -> Bool
roundtrips :: forall rewrites imports. Options_ rewrites imports -> [RoundTrip]
rewrites :: forall rewrites imports. Options_ rewrites imports -> rewrites
randomOrder :: forall rewrites imports. Options_ rewrites imports -> Bool
noDefaultElaborations :: forall rewrites imports. Options_ rewrites imports -> Bool
iterateN :: forall rewrites imports. Options_ rewrites imports -> Int
fixityEnv :: forall rewrites imports. Options_ rewrites imports -> FixityEnv
extraIgnores :: forall rewrites imports. Options_ rewrites imports -> [FilePath]
executionMode :: forall rewrites imports. Options_ rewrites imports -> ExecutionMode
elaborations :: forall rewrites imports. Options_ rewrites imports -> rewrites
colorise :: forall rewrites imports. Options_ rewrites imports -> ColoriseFun
additionalImports :: forall rewrites imports. Options_ rewrites imports -> imports
..} FilePath
fp [Replacement]
repls FilePath
_ a
_ = do
  HashMap Int FilePath
fl <- FilePath -> IO (HashMap Int FilePath)
linesMap FilePath
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{FilePath
SrcSpan
replReplacement :: FilePath
replOriginal :: FilePath
replLocation :: SrcSpan
replReplacement :: Replacement -> FilePath
replOriginal :: Replacement -> FilePath
replLocation :: Replacement -> SrcSpan
..} ->
    FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat
      [ ColoriseFun -> SrcSpan -> FilePath
ppSrcSpan ColoriseFun
colorise SrcSpan
replLocation
      , [FilePath] -> FilePath
ppLine
        ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ HashMap Int FilePath -> SrcSpan -> FilePath -> [FilePath]
ppRepl HashMap Int FilePath
fl SrcSpan
replLocation
        (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ColoriseFun
colorise ColorIntensity
Vivid Color
Red FilePath
replOriginal
      ]
  where
    ppLine :: [FilePath] -> FilePath
ppLine [] = FilePath
""
    ppLine [FilePath
x] = FilePath -> FilePath
strip FilePath
x
    ppLine [FilePath]
xs = Char
'\n'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace ([FilePath] -> FilePath
unlines [FilePath]
xs)

-- | Print only replacement.
writeExtract :: Options -> FilePath -> WriteFn a ()
writeExtract :: Options -> FilePath -> WriteFn a ()
writeExtract Options{Bool
Int
FilePath
[FilePath]
[Rewrite Universe]
[RoundTrip]
FixityEnv
AnnotatedImports
Verbosity
ExecutionMode
ColoriseFun
verbosity :: Verbosity
targetFiles :: [FilePath]
targetDir :: FilePath
singleThreaded :: Bool
roundtrips :: [RoundTrip]
rewrites :: [Rewrite Universe]
randomOrder :: Bool
noDefaultElaborations :: Bool
iterateN :: Int
fixityEnv :: FixityEnv
extraIgnores :: [FilePath]
executionMode :: ExecutionMode
elaborations :: [Rewrite Universe]
colorise :: ColoriseFun
additionalImports :: AnnotatedImports
verbosity :: forall rewrites imports. Options_ rewrites imports -> Verbosity
targetFiles :: forall rewrites imports. Options_ rewrites imports -> [FilePath]
targetDir :: forall rewrites imports. Options_ rewrites imports -> FilePath
singleThreaded :: forall rewrites imports. Options_ rewrites imports -> Bool
roundtrips :: forall rewrites imports. Options_ rewrites imports -> [RoundTrip]
rewrites :: forall rewrites imports. Options_ rewrites imports -> rewrites
randomOrder :: forall rewrites imports. Options_ rewrites imports -> Bool
noDefaultElaborations :: forall rewrites imports. Options_ rewrites imports -> Bool
iterateN :: forall rewrites imports. Options_ rewrites imports -> Int
fixityEnv :: forall rewrites imports. Options_ rewrites imports -> FixityEnv
extraIgnores :: forall rewrites imports. Options_ rewrites imports -> [FilePath]
executionMode :: forall rewrites imports. Options_ rewrites imports -> ExecutionMode
elaborations :: forall rewrites imports. Options_ rewrites imports -> rewrites
colorise :: forall rewrites imports. Options_ rewrites imports -> ColoriseFun
additionalImports :: forall rewrites imports. Options_ rewrites imports -> imports
..} FilePath
_ [Replacement]
repls FilePath
_ 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{FilePath
SrcSpan
replReplacement :: FilePath
replOriginal :: FilePath
replLocation :: SrcSpan
replReplacement :: Replacement -> FilePath
replOriginal :: Replacement -> FilePath
replLocation :: Replacement -> SrcSpan
..} -> do
    FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat
      [ ColoriseFun -> SrcSpan -> FilePath
ppSrcSpan ColoriseFun
colorise SrcSpan
replLocation
      , FilePath -> FilePath
strip FilePath
replReplacement
      ]