-- 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 :: 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
opts,) 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_
  [Rewrite Universe]
  (Annotated [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
opts <- LibDir -> FixityEnv -> IO Options
parseOptions LibDir
libdir forall a. Monoid a => a
mempty
  (Options_
  [Rewrite Universe]
  (Annotated [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
opts', Retrie ()
retrie) <- Options -> IO (Options, Retrie ())
f Options_
  [Rewrite Universe]
  (Annotated [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
opts
  LibDir -> Options -> Retrie () -> IO ()
execute LibDir
libdir Options_
  [Rewrite Universe]
  (Annotated [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
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]
[Rewrite Universe]
[RoundTrip]
FixityEnv
AnnotatedImports
Verbosity
ExecutionMode
ColoriseFun
verbosity :: forall rewrites imports. Options_ rewrites imports -> Verbosity
targetFiles :: forall rewrites imports. Options_ rewrites imports -> [LibDir]
targetDir :: forall rewrites imports. Options_ rewrites imports -> LibDir
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 -> [LibDir]
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 :: [LibDir]
targetDir :: LibDir
singleThreaded :: Bool
roundtrips :: [RoundTrip]
rewrites :: [Rewrite Universe]
randomOrder :: Bool
noDefaultElaborations :: Bool
iterateN :: Int
fixityEnv :: FixityEnv
extraIgnores :: [LibDir]
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 -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall b a c.
Monoid b =>
LibDir
-> (LibDir -> WriteFn a b)
-> (IO b -> IO c)
-> Options
-> Retrie a
-> IO [c]
run LibDir
libdir (forall a. Options -> LibDir -> WriteFn a (Sum Int)
writeDiff Options
opts) forall a. a -> a
id Options
opts Retrie ()
retrie
    ExecutionMode
ExecExtract -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall b a c.
Monoid b =>
LibDir
-> (LibDir -> WriteFn a b)
-> (IO b -> IO c)
-> Options
-> Retrie a
-> IO [c]
run LibDir
libdir (forall a. Options -> LibDir -> WriteFn a ()
writeExtract Options
opts) forall a. a -> a
id Options
opts Retrie ()
retrie
    ExecutionMode
ExecRewrite -> do
      Sum Int
s <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a c.
Monoid b =>
LibDir
-> (LibDir -> WriteFn a b)
-> (IO b -> IO c)
-> Options
-> Retrie a
-> IO [c]
run LibDir
libdir forall a. LibDir -> WriteFn a (Sum Int)
writeCountLines forall a. a -> a
id Options
opts Retrie ()
retrie
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verbosity forall a. Ord a => a -> a -> Bool
> Verbosity
Silent) forall a b. (a -> b) -> a -> b
$
        LibDir -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ LibDir
"Done! " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> LibDir
show (forall a. Sum a -> a
getSum Sum Int
s) forall a. [a] -> [a] -> [a]
++ LibDir
" lines changed."
    ExecutionMode
ExecSearch -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall b a c.
Monoid b =>
LibDir
-> (LibDir -> WriteFn a b)
-> (IO b -> IO c)
-> Options
-> Retrie a
-> IO [c]
run LibDir
libdir (forall a. Options -> LibDir -> WriteFn a ()
writeSearch Options
opts) 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]
[Rewrite Universe]
[RoundTrip]
FixityEnv
AnnotatedImports
Verbosity
ExecutionMode
ColoriseFun
verbosity :: Verbosity
targetFiles :: [LibDir]
targetDir :: LibDir
singleThreaded :: Bool
roundtrips :: [RoundTrip]
rewrites :: [Rewrite Universe]
randomOrder :: Bool
noDefaultElaborations :: Bool
iterateN :: Int
fixityEnv :: FixityEnv
extraIgnores :: [LibDir]
executionMode :: ExecutionMode
elaborations :: [Rewrite Universe]
colorise :: ColoriseFun
additionalImports :: AnnotatedImports
verbosity :: forall rewrites imports. Options_ rewrites imports -> Verbosity
targetFiles :: forall rewrites imports. Options_ rewrites imports -> [LibDir]
targetDir :: forall rewrites imports. Options_ rewrites imports -> LibDir
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 -> [LibDir]
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
  [LibDir]
fps <- forall a b. Options_ a b -> [GroundTerms] -> IO [LibDir]
getTargetFiles Options
opts (forall a. Retrie a -> [GroundTerms]
getGroundTerms Retrie a
r)
  forall x y a b. Options_ x y -> [a] -> (a -> IO b) -> IO [b]
forFn Options
opts [LibDir]
fps forall a b. (a -> b) -> a -> b
$ \ LibDir
fp -> IO b -> IO c
wrapper forall a b. (a -> b) -> a -> b
$ do
    Verbosity -> LibDir -> [LibDir] -> IO ()
debugPrint Verbosity
verbosity LibDir
"Processing:" [LibDir
fp]
    Either SomeException (CPP AnnotatedModule)
p <- forall a. IO a -> IO (Either SomeException a)
trySync 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
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verbosity forall a. Ord a => a -> a -> Bool
> Verbosity
Silent) forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> IO ()
print SomeException
ex
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
      Right CPP AnnotatedModule
cpp -> 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]
[Rewrite Universe]
[RoundTrip]
FixityEnv
AnnotatedImports
Verbosity
ExecutionMode
ColoriseFun
verbosity :: Verbosity
targetFiles :: [LibDir]
targetDir :: LibDir
singleThreaded :: Bool
roundtrips :: [RoundTrip]
rewrites :: [Rewrite Universe]
randomOrder :: Bool
noDefaultElaborations :: Bool
iterateN :: Int
fixityEnv :: FixityEnv
extraIgnores :: [LibDir]
executionMode :: ExecutionMode
elaborations :: [Rewrite Universe]
colorise :: ColoriseFun
additionalImports :: AnnotatedImports
verbosity :: forall rewrites imports. Options_ rewrites imports -> Verbosity
targetFiles :: forall rewrites imports. Options_ rewrites imports -> [LibDir]
targetDir :: forall rewrites imports. Options_ rewrites imports -> LibDir
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 -> [LibDir]
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
  -- debugPrint Loud "runOneModule" ["enter"]
  (a
x, CPP AnnotatedModule
cpp', Change
changed) <- 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return 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
additionalImportsforall a. a -> [a] -> [a]
:[AnnotatedImports]
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 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Replacement -> SrcSpan
replLocation [Replacement]
reps
  LibDir -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ LibDir
"Writing: " forall a. [a] -> [a] -> [a]
++ LibDir
fp forall a. [a] -> [a] -> [a]
++ LibDir
" (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> LibDir
show Int
lc forall a. [a] -> [a] -> [a]
++ LibDir
" lines changed)"
  LibDir -> LibDir -> IO ()
writeFile LibDir
fp LibDir
str
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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]
[Rewrite Universe]
[RoundTrip]
FixityEnv
AnnotatedImports
Verbosity
ExecutionMode
ColoriseFun
verbosity :: Verbosity
targetFiles :: [LibDir]
targetDir :: LibDir
singleThreaded :: Bool
roundtrips :: [RoundTrip]
rewrites :: [Rewrite Universe]
randomOrder :: Bool
noDefaultElaborations :: Bool
iterateN :: Int
fixityEnv :: FixityEnv
extraIgnores :: [LibDir]
executionMode :: ExecutionMode
elaborations :: [Rewrite Universe]
colorise :: ColoriseFun
additionalImports :: AnnotatedImports
verbosity :: forall rewrites imports. Options_ rewrites imports -> Verbosity
targetFiles :: forall rewrites imports. Options_ rewrites imports -> [LibDir]
targetDir :: forall rewrites imports. Options_ rewrites imports -> LibDir
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 -> [LibDir]
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
..} LibDir
fp [Replacement]
repls LibDir
_ CPP AnnotatedModule
_ a
_ = do
  HashMap Int LibDir
fl <- LibDir -> IO (HashMap Int LibDir)
linesMap LibDir
fp
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Replacement]
repls forall a b. (a -> b) -> a -> b
$ \Replacement{LibDir
SrcSpan
replReplacement :: Replacement -> LibDir
replOriginal :: Replacement -> LibDir
replReplacement :: LibDir
replOriginal :: LibDir
replLocation :: SrcSpan
replLocation :: Replacement -> SrcSpan
..} -> do
    let ppLines :: LibDir -> Color -> LibDir -> LibDir
ppLines LibDir
lineStart Color
color = [LibDir] -> LibDir
unlines
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (LibDir
lineStart forall a. [a] -> [a] -> [a]
++)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Int LibDir -> SrcSpan -> LibDir -> [LibDir]
ppRepl HashMap Int LibDir
fl SrcSpan
replLocation
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColoriseFun
colorise ColorIntensity
Vivid Color
color
    LibDir -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ 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
      ]
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Sum a
Sum forall a b. (a -> b) -> a -> b
$ [SrcSpan] -> Int
lineCount forall a b. (a -> b) -> a -> b
$ 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]
[Rewrite Universe]
[RoundTrip]
FixityEnv
AnnotatedImports
Verbosity
ExecutionMode
ColoriseFun
verbosity :: Verbosity
targetFiles :: [LibDir]
targetDir :: LibDir
singleThreaded :: Bool
roundtrips :: [RoundTrip]
rewrites :: [Rewrite Universe]
randomOrder :: Bool
noDefaultElaborations :: Bool
iterateN :: Int
fixityEnv :: FixityEnv
extraIgnores :: [LibDir]
executionMode :: ExecutionMode
elaborations :: [Rewrite Universe]
colorise :: ColoriseFun
additionalImports :: AnnotatedImports
verbosity :: forall rewrites imports. Options_ rewrites imports -> Verbosity
targetFiles :: forall rewrites imports. Options_ rewrites imports -> [LibDir]
targetDir :: forall rewrites imports. Options_ rewrites imports -> LibDir
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 -> [LibDir]
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
..} LibDir
fp [Replacement]
repls LibDir
_ CPP AnnotatedModule
_ a
_ = do
  HashMap Int LibDir
fl <- LibDir -> IO (HashMap Int LibDir)
linesMap LibDir
fp
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Replacement]
repls forall a b. (a -> b) -> a -> b
$ \Replacement{LibDir
SrcSpan
replReplacement :: LibDir
replOriginal :: LibDir
replLocation :: SrcSpan
replReplacement :: Replacement -> LibDir
replOriginal :: Replacement -> LibDir
replLocation :: Replacement -> SrcSpan
..} ->
    LibDir -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
      [ ColoriseFun -> SrcSpan -> LibDir
ppSrcSpan ColoriseFun
colorise SrcSpan
replLocation
      , [LibDir] -> LibDir
ppLine
        forall a b. (a -> b) -> a -> b
$ HashMap Int LibDir -> SrcSpan -> LibDir -> [LibDir]
ppRepl HashMap Int LibDir
fl SrcSpan
replLocation
        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'forall a. a -> [a] -> [a]
: 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]
[Rewrite Universe]
[RoundTrip]
FixityEnv
AnnotatedImports
Verbosity
ExecutionMode
ColoriseFun
verbosity :: Verbosity
targetFiles :: [LibDir]
targetDir :: LibDir
singleThreaded :: Bool
roundtrips :: [RoundTrip]
rewrites :: [Rewrite Universe]
randomOrder :: Bool
noDefaultElaborations :: Bool
iterateN :: Int
fixityEnv :: FixityEnv
extraIgnores :: [LibDir]
executionMode :: ExecutionMode
elaborations :: [Rewrite Universe]
colorise :: ColoriseFun
additionalImports :: AnnotatedImports
verbosity :: forall rewrites imports. Options_ rewrites imports -> Verbosity
targetFiles :: forall rewrites imports. Options_ rewrites imports -> [LibDir]
targetDir :: forall rewrites imports. Options_ rewrites imports -> LibDir
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 -> [LibDir]
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
..} LibDir
_ [Replacement]
repls LibDir
_ CPP AnnotatedModule
_ a
_ = do
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Replacement]
repls forall a b. (a -> b) -> a -> b
$ \Replacement{LibDir
SrcSpan
replReplacement :: LibDir
replOriginal :: LibDir
replLocation :: SrcSpan
replReplacement :: Replacement -> LibDir
replOriginal :: Replacement -> LibDir
replLocation :: Replacement -> SrcSpan
..} -> do
    LibDir -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
      [ ColoriseFun -> SrcSpan -> LibDir
ppSrcSpan ColoriseFun
colorise SrcSpan
replLocation
      , LibDir -> LibDir
strip LibDir
replReplacement
      ]