-- 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 ApplicativeDo #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
module Retrie.Options
  ( -- * Options
    Options
  , Options_(..)
  , ExecutionMode(..)
  , defaultOptions
  , parseOptions
    -- * Internal
  , buildGrepChain
  , forFn
  , getOptionsParser
  , getTargetFiles
  , parseRewritesInternal
  , parseVerbosity
  , ProtoOptions
  , resolveOptions
  , GrepCommands(..)
  ) where

import Control.Concurrent.Async (mapConcurrently)
import Control.Monad (when, foldM)
import Data.Bool
import Data.Char (isAlphaNum, isSpace)
import Data.Default as D
import Data.Foldable (toList)
import Data.Functor.Identity
import Data.List
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Data.Traversable
import Options.Applicative
import System.Directory
import System.FilePath
import System.Process
import System.Random.Shuffle

import Retrie.CPP
import Retrie.Debug
import Retrie.Elaborate
import Retrie.ExactPrint
import Retrie.Fixity
import Retrie.GroundTerms
import Retrie.GHC
import Retrie.Pretty
import Retrie.Rewrites
import Retrie.Types
import Retrie.Universe
import Retrie.Util

-- | Command-line options.
type Options = Options_ [Rewrite Universe] AnnotatedImports

-- | Parse options using the given 'FixityEnv'.
parseOptions :: FixityEnv -> IO Options
parseOptions :: FixityEnv -> IO Options
parseOptions FixityEnv
fixityEnv = do
  Parser ProtoOptions
p <- FixityEnv -> IO (Parser ProtoOptions)
getOptionsParser FixityEnv
fixityEnv
  ProtoOptions
opts <- ParserInfo ProtoOptions -> IO ProtoOptions
forall a. ParserInfo a -> IO a
execParser (Parser ProtoOptions
-> InfoMod ProtoOptions -> ParserInfo ProtoOptions
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser ProtoOptions
p Parser ProtoOptions
-> Parser (ProtoOptions -> ProtoOptions) -> Parser ProtoOptions
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (ProtoOptions -> ProtoOptions)
forall a. Parser (a -> a)
helper) InfoMod ProtoOptions
forall a. InfoMod a
fullDesc)
  ProtoOptions -> IO Options
resolveOptions ProtoOptions
opts

-- | Create 'Rewrite's from string specifications of rewrites.
-- We expose this from "Retrie" with a nicer type signature as
-- 'Retrie.Options.parseRewrites'. We have it here so we can use it with
-- 'ProtoOptions'.
parseRewritesInternal :: Options_ a b -> [RewriteSpec] -> IO [Rewrite Universe]
parseRewritesInternal :: Options_ a b -> [RewriteSpec] -> IO [Rewrite Universe]
parseRewritesInternal Options{a
b
Bool
Int
FilePath
[FilePath]
[RoundTrip]
FixityEnv
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 :: a
randomOrder :: Bool
noDefaultElaborations :: Bool
iterateN :: Int
fixityEnv :: FixityEnv
extraIgnores :: [FilePath]
executionMode :: ExecutionMode
elaborations :: a
colorise :: ColoriseFun
additionalImports :: b
..} = (FilePath -> IO (CPP AnnotatedModule))
-> FixityEnv -> [RewriteSpec] -> IO [Rewrite Universe]
parseRewriteSpecs FilePath -> IO (CPP AnnotatedModule)
parser FixityEnv
fixityEnv
  where
    parser :: FilePath -> IO (CPP AnnotatedModule)
parser FilePath
fp = (FilePath -> FilePath -> IO AnnotatedModule)
-> FilePath -> IO (CPP AnnotatedModule)
parseCPPFile (FixityEnv -> FilePath -> FilePath -> IO AnnotatedModule
parseContent FixityEnv
fixityEnv) (FilePath
targetDir FilePath -> FilePath -> FilePath
</> FilePath
fp)

-- | Controls the ultimate action taken by 'apply'. The default action is
-- 'ExecRewrite'.
data ExecutionMode
  = ExecDryRun -- ^ Pretend to do rewrites, show diff.
  | ExecRewrite -- ^ Perform rewrites.
  | ExecExtract -- ^ Print the resulting expression for each match.
  | ExecSearch -- ^ Print the matched expressions.
  deriving (Int -> ExecutionMode -> FilePath -> FilePath
[ExecutionMode] -> FilePath -> FilePath
ExecutionMode -> FilePath
(Int -> ExecutionMode -> FilePath -> FilePath)
-> (ExecutionMode -> FilePath)
-> ([ExecutionMode] -> FilePath -> FilePath)
-> Show ExecutionMode
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [ExecutionMode] -> FilePath -> FilePath
$cshowList :: [ExecutionMode] -> FilePath -> FilePath
show :: ExecutionMode -> FilePath
$cshow :: ExecutionMode -> FilePath
showsPrec :: Int -> ExecutionMode -> FilePath -> FilePath
$cshowsPrec :: Int -> ExecutionMode -> FilePath -> FilePath
Show)

data Options_ rewrites imports = Options
  { Options_ rewrites imports -> imports
additionalImports :: imports
    -- ^ Imports specified by the command-line flag '--import'.
  , Options_ rewrites imports -> ColoriseFun
colorise :: ColoriseFun
    -- ^ Function used to colorize results of certain execution modes.
  , Options_ rewrites imports -> rewrites
elaborations :: rewrites
    -- ^ Rewrites which are applied to the left-hand side of the actual rewrites.
  , Options_ rewrites imports -> ExecutionMode
executionMode :: ExecutionMode
    -- ^ Controls behavior of 'apply'. See 'ExecutionMode'.
  , Options_ rewrites imports -> [FilePath]
extraIgnores :: [FilePath]
    -- ^ Specific files that should be ignored. Paths should be relative to
    -- 'targetDir'.
  , Options_ rewrites imports -> FixityEnv
fixityEnv :: FixityEnv
    -- ^ Fixity information for operators used during parsing (of rewrites and
    -- target modules). Defaults to base fixities.
  , Options_ rewrites imports -> Int
iterateN :: Int
    -- ^ Iterate the given rewrites or 'Retrie' computation up to this many
    -- times. Iteration may stop before the limit if no changes are made during
    -- a given iteration.
  , Options_ rewrites imports -> Bool
noDefaultElaborations :: Bool
    -- ^ Do not apply any of the built in elaborations in 'defaultElaborations'.
  , Options_ rewrites imports -> Bool
randomOrder :: Bool
    -- ^ Whether to randomize the order of target modules before rewriting them.
  , Options_ rewrites imports -> rewrites
rewrites :: rewrites
    -- ^ Rewrites specified by command-line flags such as '--adhoc'.
  , Options_ rewrites imports -> [RoundTrip]
roundtrips :: [RoundTrip]
    -- ^ Paths that should be roundtripped through ghc-exactprint to debug.
    -- Specified by the '--roundtrip' command-line flag.
  , Options_ rewrites imports -> Bool
singleThreaded :: Bool
    -- ^ Whether to concurrently rewrite target modules.
    -- Mostly useful for viewing debugging output without interleaving it.
  , Options_ rewrites imports -> FilePath
targetDir :: FilePath
    -- ^ Directory that contains the code being targeted for rewriting.
  , Options_ rewrites imports -> [FilePath]
targetFiles :: [FilePath]
    -- ^ Instead of targeting all Haskell files in 'targetDir', only target
    -- specific files. Paths should be relative to 'targetDir'.
  , Options_ rewrites imports -> Verbosity
verbosity :: Verbosity
    -- ^ How much should be output on 'stdout'.
  }

-- | Construct default options for the given target directory.
defaultOptions
  :: (Default rewrites, Default imports)
  => FilePath -> Options_ rewrites imports
defaultOptions :: FilePath -> Options_ rewrites imports
defaultOptions FilePath
fp = Options :: forall rewrites imports.
imports
-> ColoriseFun
-> rewrites
-> ExecutionMode
-> [FilePath]
-> FixityEnv
-> Int
-> Bool
-> Bool
-> rewrites
-> [RoundTrip]
-> Bool
-> FilePath
-> [FilePath]
-> Verbosity
-> Options_ rewrites imports
Options
  { additionalImports :: imports
additionalImports = imports
forall a. Default a => a
D.def
  , colorise :: ColoriseFun
colorise = ColoriseFun
noColor
  , elaborations :: rewrites
elaborations = rewrites
forall a. Default a => a
D.def
  , executionMode :: ExecutionMode
executionMode = ExecutionMode
ExecRewrite
  , extraIgnores :: [FilePath]
extraIgnores = []
  , fixityEnv :: FixityEnv
fixityEnv = FixityEnv
forall a. Monoid a => a
mempty
  , iterateN :: Int
iterateN = Int
1
  , noDefaultElaborations :: Bool
noDefaultElaborations = Bool
False
  , randomOrder :: Bool
randomOrder = Bool
False
  , rewrites :: rewrites
rewrites = rewrites
forall a. Default a => a
D.def
  , roundtrips :: [RoundTrip]
roundtrips = []
  , singleThreaded :: Bool
singleThreaded = Bool
False
  , targetDir :: FilePath
targetDir = FilePath
fp
  , targetFiles :: [FilePath]
targetFiles = []
  , verbosity :: Verbosity
verbosity = Verbosity
Normal
  }

-- | Get the options parser. The returned 'ProtoOptions' should be passed
-- to 'resolveOptions' to get final 'Options'.
getOptionsParser :: FixityEnv -> IO (Parser ProtoOptions)
getOptionsParser :: FixityEnv -> IO (Parser ProtoOptions)
getOptionsParser FixityEnv
fEnv = do
  ProtoOptions
dOpts <- FilePath -> ProtoOptions
forall rewrites imports.
(Default rewrites, Default imports) =>
FilePath -> Options_ rewrites imports
defaultOptions (FilePath -> ProtoOptions) -> IO FilePath -> IO ProtoOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getCurrentDirectory
  return $ ProtoOptions -> Parser ProtoOptions
buildParser ProtoOptions
dOpts { fixityEnv :: FixityEnv
fixityEnv = FixityEnv
fEnv }

buildParser :: ProtoOptions -> Parser ProtoOptions
buildParser :: ProtoOptions -> Parser ProtoOptions
buildParser ProtoOptions
dOpts = do
  Bool
singleThreaded <- Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Bool] -> Mod FlagFields Bool
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"single-threaded"
    , Mod FlagFields Bool
forall a (f :: * -> *). Show a => Mod f a
showDefault
    , FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Don't try to parallelize things (for debugging)."
    ]
  FilePath
targetDir <- ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FilePath
forall s. IsString s => ReadM s
str (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"target"
    , Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
't'
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PATH"
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
action FilePath
"directory" -- complete with directory
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (ProtoOptions -> FilePath
forall rewrites imports. Options_ rewrites imports -> FilePath
targetDir ProtoOptions
dOpts)
    , Mod OptionFields FilePath
forall a (f :: * -> *). Show a => Mod f a
showDefault
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Path to target with rewrites."
    ]
  [FilePath]
targetFiles <- Parser FilePath -> Parser [FilePath]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser FilePath -> Parser [FilePath])
-> Parser FilePath -> Parser [FilePath]
forall a b. (a -> b) -> a -> b
$ ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FilePath
forall s. IsString s => ReadM s
str (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"target-file"
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PATH"
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
action FilePath
"file" -- complete with filenames
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Target specific file for rewriting."
    ]
  Verbosity
verbosity <- Verbosity -> Parser Verbosity
parseVerbosity (ProtoOptions -> Verbosity
forall rewrites imports. Options_ rewrites imports -> Verbosity
verbosity ProtoOptions
dOpts)
  [FilePath]
additionalImports <- Parser FilePath -> Parser [FilePath]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser FilePath -> Parser [FilePath])
-> Parser FilePath -> Parser [FilePath]
forall a b. (a -> b) -> a -> b
$ ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FilePath
forall s. IsString s => ReadM s
str (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"import"
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"IMPORT"
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help
        FilePath
"Add given import statement to modules that are modified by a rewrite."
    ]
  [FilePath]
extraIgnores <- Parser FilePath -> Parser [FilePath]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser FilePath -> Parser [FilePath])
-> Parser FilePath -> Parser [FilePath]
forall a b. (a -> b) -> a -> b
$ ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FilePath
forall s. IsString s => ReadM s
str (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"ignore"
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PATH"
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
action FilePath
"file" -- complete with filenames
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Ignore specific file while rewriting."
    ]
  ColoriseFun
colorise <- (Bool -> ColoriseFun) -> Parser Bool -> Parser ColoriseFun
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ColoriseFun -> ColoriseFun -> Bool -> ColoriseFun
forall a. a -> a -> Bool -> a
bool ColoriseFun
noColor ColoriseFun
addColor) (Parser Bool -> Parser ColoriseFun)
-> Parser Bool -> Parser ColoriseFun
forall a b. (a -> b) -> a -> b
$ Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Bool] -> Mod FlagFields Bool
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"color"
    , FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Highlight matches with color."
    ]
  Bool
noDefaultElaborations <- Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Bool] -> Mod FlagFields Bool
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"no-default-elaborations"
    , Mod FlagFields Bool
forall a (f :: * -> *). Show a => Mod f a
showDefault
    , FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Don't apply any of the default elaborations to rewrites."
    ]
  Bool
randomOrder <- Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Bool] -> Mod FlagFields Bool
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"random-order"
    , FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Randomize the order of targeted modules."
    ]
  Int
iterateN <- ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields Int] -> Mod OptionFields Int
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"iterate"
    , Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'i'
    , FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"N"
    , Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
1
    , FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Iterate rewrites up to N times."
    ]

  ExecutionMode
executionMode <- Parser ExecutionMode
parseMode
  [RewriteSpec]
rewrites <- Parser [RewriteSpec]
parseRewriteSpecOptions
  [RewriteSpec]
elaborations <- Parser [RewriteSpec]
parseElaborations
  [RoundTrip]
roundtrips <- Parser [RoundTrip]
parseRoundtrips
  return Options :: forall rewrites imports.
imports
-> ColoriseFun
-> rewrites
-> ExecutionMode
-> [FilePath]
-> FixityEnv
-> Int
-> Bool
-> Bool
-> rewrites
-> [RoundTrip]
-> Bool
-> FilePath
-> [FilePath]
-> Verbosity
-> Options_ rewrites imports
Options{ fixityEnv :: FixityEnv
fixityEnv = ProtoOptions -> FixityEnv
forall rewrites imports. Options_ rewrites imports -> FixityEnv
fixityEnv ProtoOptions
dOpts, Bool
Int
FilePath
[FilePath]
[RewriteSpec]
[RoundTrip]
Verbosity
ExecutionMode
ColoriseFun
roundtrips :: [RoundTrip]
elaborations :: [RewriteSpec]
rewrites :: [RewriteSpec]
executionMode :: ExecutionMode
iterateN :: Int
randomOrder :: Bool
noDefaultElaborations :: Bool
colorise :: ColoriseFun
extraIgnores :: [FilePath]
additionalImports :: [FilePath]
verbosity :: Verbosity
targetFiles :: [FilePath]
targetDir :: FilePath
singleThreaded :: Bool
verbosity :: Verbosity
targetFiles :: [FilePath]
targetDir :: FilePath
singleThreaded :: Bool
roundtrips :: [RoundTrip]
rewrites :: [RewriteSpec]
randomOrder :: Bool
noDefaultElaborations :: Bool
iterateN :: Int
extraIgnores :: [FilePath]
executionMode :: ExecutionMode
elaborations :: [RewriteSpec]
colorise :: ColoriseFun
additionalImports :: [FilePath]
..}

parseElaborations :: Parser [RewriteSpec]
parseElaborations :: Parser [RewriteSpec]
parseElaborations = [[RewriteSpec]] -> [RewriteSpec]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[RewriteSpec]] -> [RewriteSpec])
-> Parser [[RewriteSpec]] -> Parser [RewriteSpec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser RewriteSpec -> Parser [RewriteSpec])
-> [Parser RewriteSpec] -> Parser [[RewriteSpec]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Parser RewriteSpec -> Parser [RewriteSpec]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
  [ (FilePath -> RewriteSpec) -> Parser FilePath -> Parser RewriteSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> RewriteSpec
Adhoc (Parser FilePath -> Parser RewriteSpec)
-> Parser FilePath -> Parser RewriteSpec
forall a b. (a -> b) -> a -> b
$ ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FilePath
forall s. IsString s => ReadM s
str (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"elaborate"
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"EQUATION"
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Elaborate the left-hand side of rewrites using the given equation."
    ]
  , (FilePath -> RewriteSpec) -> Parser FilePath -> Parser RewriteSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> RewriteSpec
AdhocType (Parser FilePath -> Parser RewriteSpec)
-> Parser FilePath -> Parser RewriteSpec
forall a b. (a -> b) -> a -> b
$ ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FilePath
forall s. IsString s => ReadM s
str (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"elaborate-type"
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"EQUATION"
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Elaborate the left-hand side of rewrites using the given equation."
    ]
  , (FilePath -> RewriteSpec) -> Parser FilePath -> Parser RewriteSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> RewriteSpec
AdhocPattern (Parser FilePath -> Parser RewriteSpec)
-> Parser FilePath -> Parser RewriteSpec
forall a b. (a -> b) -> a -> b
$ ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FilePath
forall s. IsString s => ReadM s
str (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"elaborate-pattern"
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"EQUATION"
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Elaborate the left-hand side of rewrites using the given equation."
    ]
  ]

parseRewriteSpecOptions :: Parser [RewriteSpec]
parseRewriteSpecOptions :: Parser [RewriteSpec]
parseRewriteSpecOptions = [[RewriteSpec]] -> [RewriteSpec]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[RewriteSpec]] -> [RewriteSpec])
-> Parser [[RewriteSpec]] -> Parser [RewriteSpec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser RewriteSpec -> Parser [RewriteSpec])
-> [Parser RewriteSpec] -> Parser [[RewriteSpec]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Parser RewriteSpec -> Parser [RewriteSpec]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
  [ (FilePath -> RewriteSpec) -> Parser FilePath -> Parser RewriteSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> RewriteSpec
Unfold (Parser FilePath -> Parser RewriteSpec)
-> Parser FilePath -> Parser RewriteSpec
forall a b. (a -> b) -> a -> b
$ ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FilePath
forall s. IsString s => ReadM s
str (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"unfold"
      , Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'u'
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NAME"
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Unfold given fully-qualified name."
      ]
  , (FilePath -> RewriteSpec) -> Parser FilePath -> Parser RewriteSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> RewriteSpec
Fold (Parser FilePath -> Parser RewriteSpec)
-> Parser FilePath -> Parser RewriteSpec
forall a b. (a -> b) -> a -> b
$ ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FilePath
forall s. IsString s => ReadM s
str (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"fold"
      , Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f'
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NAME"
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Fold given fully-qualified name."
      ]
  , (FilePath -> RewriteSpec) -> Parser FilePath -> Parser RewriteSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> RewriteSpec
RuleForward (Parser FilePath -> Parser RewriteSpec)
-> Parser FilePath -> Parser RewriteSpec
forall a b. (a -> b) -> a -> b
$ ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FilePath
forall s. IsString s => ReadM s
str (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"rule-forward"
      , Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'l'
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NAME"
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Apply fully-qualified RULE name left-to-right."
      ]
  , (FilePath -> RewriteSpec) -> Parser FilePath -> Parser RewriteSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> RewriteSpec
RuleBackward (Parser FilePath -> Parser RewriteSpec)
-> Parser FilePath -> Parser RewriteSpec
forall a b. (a -> b) -> a -> b
$ ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FilePath
forall s. IsString s => ReadM s
str (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"rule-backward"
      , Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'r'
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NAME"
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Apply fully-qualified RULE name right-to-left."
      ]
  , (FilePath -> RewriteSpec) -> Parser FilePath -> Parser RewriteSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> RewriteSpec
TypeForward (Parser FilePath -> Parser RewriteSpec)
-> Parser FilePath -> Parser RewriteSpec
forall a b. (a -> b) -> a -> b
$ ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FilePath
forall s. IsString s => ReadM s
str (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"type-forward"
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NAME"
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Apply fully-qualified type synonym name left-to-right."
      ]
  , (FilePath -> RewriteSpec) -> Parser FilePath -> Parser RewriteSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> RewriteSpec
TypeBackward (Parser FilePath -> Parser RewriteSpec)
-> Parser FilePath -> Parser RewriteSpec
forall a b. (a -> b) -> a -> b
$ ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FilePath
forall s. IsString s => ReadM s
str (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"type-backward"
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NAME"
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Apply fully-qualified type synonym name right-to-left."
      ]
  , (FilePath -> RewriteSpec) -> Parser FilePath -> Parser RewriteSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> RewriteSpec
Adhoc (Parser FilePath -> Parser RewriteSpec)
-> Parser FilePath -> Parser RewriteSpec
forall a b. (a -> b) -> a -> b
$ ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FilePath
forall s. IsString s => ReadM s
str (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"adhoc"
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"EQUATION"
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Apply an adhoc equation of the form: forall vs. lhs = rhs"
      ]
  , (FilePath -> RewriteSpec) -> Parser FilePath -> Parser RewriteSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> RewriteSpec
AdhocType (Parser FilePath -> Parser RewriteSpec)
-> Parser FilePath -> Parser RewriteSpec
forall a b. (a -> b) -> a -> b
$ ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FilePath
forall s. IsString s => ReadM s
str (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"adhoc-type"
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"EQUATION"
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Apply an adhoc type equation of the form: lhs = rhs"
      ]
  , (FilePath -> RewriteSpec) -> Parser FilePath -> Parser RewriteSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> RewriteSpec
PatternForward (Parser FilePath -> Parser RewriteSpec)
-> Parser FilePath -> Parser RewriteSpec
forall a b. (a -> b) -> a -> b
$ ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FilePath
forall s. IsString s => ReadM s
str (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"pattern-forward"
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NAME"
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Apply fully-qualified pattern synonym name left-to-right."
      ]
  , (FilePath -> RewriteSpec) -> Parser FilePath -> Parser RewriteSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> RewriteSpec
PatternBackward (Parser FilePath -> Parser RewriteSpec)
-> Parser FilePath -> Parser RewriteSpec
forall a b. (a -> b) -> a -> b
$ ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FilePath
forall s. IsString s => ReadM s
str (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"pattern-backward"
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NAME"
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Apply fully-qualified pattern synonym name right-to-left."
      ]
  , (FilePath -> RewriteSpec) -> Parser FilePath -> Parser RewriteSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> RewriteSpec
AdhocPattern (Parser FilePath -> Parser RewriteSpec)
-> Parser FilePath -> Parser RewriteSpec
forall a b. (a -> b) -> a -> b
$ ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FilePath
forall s. IsString s => ReadM s
str (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"adhoc-pattern"
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"EQUATION"
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Apply an adhoc pattern equation of the form: lhs = rhs"
      ]
  ]

parseMode :: Parser ExecutionMode
parseMode :: Parser ExecutionMode
parseMode =
  Parser ExecutionMode
parseDryRun Parser ExecutionMode
-> Parser ExecutionMode -> Parser ExecutionMode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parser ExecutionMode
parseExtract Parser ExecutionMode
-> Parser ExecutionMode -> Parser ExecutionMode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parser ExecutionMode
parseSearch Parser ExecutionMode
-> Parser ExecutionMode -> Parser ExecutionMode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ExecutionMode -> Parser ExecutionMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExecutionMode
ExecRewrite

parseDryRun :: Parser ExecutionMode
parseDryRun :: Parser ExecutionMode
parseDryRun = ExecutionMode
-> Mod FlagFields ExecutionMode -> Parser ExecutionMode
forall a. a -> Mod FlagFields a -> Parser a
flag' ExecutionMode
ExecDryRun (Mod FlagFields ExecutionMode -> Parser ExecutionMode)
-> Mod FlagFields ExecutionMode -> Parser ExecutionMode
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields ExecutionMode] -> Mod FlagFields ExecutionMode
forall a. Monoid a => [a] -> a
mconcat
  [ FilePath -> Mod FlagFields ExecutionMode
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"dry-run"
  , FilePath -> Mod FlagFields ExecutionMode
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Don't overwrite files. Print rewrite results."
  ]

parseExtract :: Parser ExecutionMode
parseExtract :: Parser ExecutionMode
parseExtract = ExecutionMode
-> Mod FlagFields ExecutionMode -> Parser ExecutionMode
forall a. a -> Mod FlagFields a -> Parser a
flag' ExecutionMode
ExecExtract (Mod FlagFields ExecutionMode -> Parser ExecutionMode)
-> Mod FlagFields ExecutionMode -> Parser ExecutionMode
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields ExecutionMode] -> Mod FlagFields ExecutionMode
forall a. Monoid a => [a] -> a
mconcat
  [ FilePath -> Mod FlagFields ExecutionMode
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"extract"
  , FilePath -> Mod FlagFields ExecutionMode
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Find the left-hand side, display the instantiated right-hand side."
  ]

parseSearch :: Parser ExecutionMode
parseSearch :: Parser ExecutionMode
parseSearch = ExecutionMode
-> Mod FlagFields ExecutionMode -> Parser ExecutionMode
forall a. a -> Mod FlagFields a -> Parser a
flag' ExecutionMode
ExecSearch (Mod FlagFields ExecutionMode -> Parser ExecutionMode)
-> Mod FlagFields ExecutionMode -> Parser ExecutionMode
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields ExecutionMode] -> Mod FlagFields ExecutionMode
forall a. Monoid a => [a] -> a
mconcat
  [ FilePath -> Mod FlagFields ExecutionMode
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"search"
  , FilePath -> Mod FlagFields ExecutionMode
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Search for left-hand side of the rewrite and show matches."
  ]

-- | Parser for 'Verbosity'.
parseVerbosity :: Verbosity -> Parser Verbosity
parseVerbosity :: Verbosity -> Parser Verbosity
parseVerbosity Verbosity
defaultV = ReadM Verbosity -> Mod OptionFields Verbosity -> Parser Verbosity
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((FilePath -> Either FilePath Verbosity) -> ReadM Verbosity
forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader FilePath -> Either FilePath Verbosity
verbosityReader) (Mod OptionFields Verbosity -> Parser Verbosity)
-> Mod OptionFields Verbosity -> Parser Verbosity
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields Verbosity] -> Mod OptionFields Verbosity
forall a. Monoid a => [a] -> a
mconcat
  [ FilePath -> Mod OptionFields Verbosity
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"verbosity"
  , Char -> Mod OptionFields Verbosity
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v'
  , Verbosity -> Mod OptionFields Verbosity
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Verbosity
defaultV
  , Mod OptionFields Verbosity
forall a (f :: * -> *). Show a => Mod f a
showDefault
  , FilePath -> Mod OptionFields Verbosity
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
verbosityHelp
  ]

verbosityReader :: String -> Either String Verbosity
verbosityReader :: FilePath -> Either FilePath Verbosity
verbosityReader FilePath
"0" = Verbosity -> Either FilePath Verbosity
forall a b. b -> Either a b
Right Verbosity
Silent
verbosityReader FilePath
"1" = Verbosity -> Either FilePath Verbosity
forall a b. b -> Either a b
Right Verbosity
Normal
verbosityReader FilePath
"2" = Verbosity -> Either FilePath Verbosity
forall a b. b -> Either a b
Right Verbosity
Loud
verbosityReader FilePath
_ =
  FilePath -> Either FilePath Verbosity
forall a b. a -> Either a b
Left (FilePath -> Either FilePath Verbosity)
-> FilePath -> Either FilePath Verbosity
forall a b. (a -> b) -> a -> b
$ FilePath
"invalid verbosity. Valid values: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
verbosityHelp

verbosityHelp :: String
verbosityHelp :: FilePath
verbosityHelp = FilePath
"0: silent, 1: normal, 2: loud (implies --single-threaded)"

-------------------------------------------------------------------------------

-- | Options that have been parsed, but not fully resolved.
type ProtoOptions = Options_ [RewriteSpec] [String]

-- | Resolve 'ProtoOptions' into 'Options'. Parses rewrites into 'Rewrite's,
-- parses imports, validates options, and extends 'fixityEnv' with any
-- declared fixities in the target directory.
resolveOptions :: ProtoOptions -> IO Options
resolveOptions :: ProtoOptions -> IO Options
resolveOptions ProtoOptions
protoOpts = do
  FilePath
absoluteTargetDir <- FilePath -> IO FilePath
makeAbsolute (ProtoOptions -> FilePath
forall rewrites imports. Options_ rewrites imports -> FilePath
targetDir ProtoOptions
protoOpts)
  opts :: ProtoOptions
opts@Options{Bool
Int
FilePath
[FilePath]
[RewriteSpec]
[RoundTrip]
FixityEnv
Verbosity
ExecutionMode
ColoriseFun
verbosity :: Verbosity
targetFiles :: [FilePath]
targetDir :: FilePath
singleThreaded :: Bool
roundtrips :: [RoundTrip]
rewrites :: [RewriteSpec]
randomOrder :: Bool
noDefaultElaborations :: Bool
iterateN :: Int
fixityEnv :: FixityEnv
extraIgnores :: [FilePath]
executionMode :: ExecutionMode
elaborations :: [RewriteSpec]
colorise :: ColoriseFun
additionalImports :: [FilePath]
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
..} <-
    ProtoOptions -> IO ProtoOptions
forall a b. Options_ a b -> IO (Options_ a b)
addLocalFixities ProtoOptions
protoOpts { targetDir :: FilePath
targetDir = FilePath
absoluteTargetDir }
  AnnotatedImports
parsedImports <- [FilePath] -> IO AnnotatedImports
parseImports [FilePath]
additionalImports
  Verbosity -> FilePath -> [FilePath] -> IO ()
debugPrint Verbosity
verbosity FilePath
"Imports:" ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$
    Identity [FilePath] -> [FilePath]
forall a. Identity a -> a
runIdentity (Identity [FilePath] -> [FilePath])
-> Identity [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Annotated [FilePath] -> [FilePath])
-> Identity (Annotated [FilePath]) -> Identity [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Annotated [FilePath] -> [FilePath]
forall ast. Annotated ast -> ast
astA (Identity (Annotated [FilePath]) -> Identity [FilePath])
-> Identity (Annotated [FilePath]) -> Identity [FilePath]
forall a b. (a -> b) -> a -> b
$ AnnotatedImports
-> ([LImportDecl GhcPs] -> TransformT Identity [FilePath])
-> Identity (Annotated [FilePath])
forall (m :: * -> *) ast1 ast2.
Monad m =>
Annotated ast1 -> (ast1 -> TransformT m ast2) -> m (Annotated ast2)
transformA AnnotatedImports
parsedImports (([LImportDecl GhcPs] -> TransformT Identity [FilePath])
 -> Identity (Annotated [FilePath]))
-> ([LImportDecl GhcPs] -> TransformT Identity [FilePath])
-> Identity (Annotated [FilePath])
forall a b. (a -> b) -> a -> b
$ \ [LImportDecl GhcPs]
imps -> do
      Anns
anns <- TransformT Identity Anns
forall (m :: * -> *). Monad m => TransformT m Anns
getAnnsT
      return $ (LImportDecl GhcPs -> FilePath)
-> [LImportDecl GhcPs] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (LImportDecl GhcPs -> Anns -> FilePath
forall ast. Annotate ast => Located ast -> Anns -> FilePath
`exactPrint` Anns
anns) [LImportDecl GhcPs]
imps
  [Rewrite Universe]
rrs <- ProtoOptions -> [RewriteSpec] -> IO [Rewrite Universe]
forall a b. Options_ a b -> [RewriteSpec] -> IO [Rewrite Universe]
parseRewritesInternal ProtoOptions
opts [RewriteSpec]
rewrites
  [Rewrite Universe]
es <- ProtoOptions -> [RewriteSpec] -> IO [Rewrite Universe]
forall a b. Options_ a b -> [RewriteSpec] -> IO [Rewrite Universe]
parseRewritesInternal ProtoOptions
opts ([RewriteSpec] -> IO [Rewrite Universe])
-> [RewriteSpec] -> IO [Rewrite Universe]
forall a b. (a -> b) -> a -> b
$
    (if Bool
noDefaultElaborations then [] else [RewriteSpec]
defaultElaborations) [RewriteSpec] -> [RewriteSpec] -> [RewriteSpec]
forall a. [a] -> [a] -> [a]
++
    [RewriteSpec]
elaborations
  [Rewrite Universe]
elaborated <- FixityEnv
-> [Rewrite Universe]
-> [Rewrite Universe]
-> IO [Rewrite Universe]
elaborateRewritesInternal FixityEnv
fixityEnv [Rewrite Universe]
es [Rewrite Universe]
rrs
  return Options :: forall rewrites imports.
imports
-> ColoriseFun
-> rewrites
-> ExecutionMode
-> [FilePath]
-> FixityEnv
-> Int
-> Bool
-> Bool
-> rewrites
-> [RoundTrip]
-> Bool
-> FilePath
-> [FilePath]
-> Verbosity
-> Options_ rewrites imports
Options
    { additionalImports :: AnnotatedImports
additionalImports = AnnotatedImports
parsedImports
    , elaborations :: [Rewrite Universe]
elaborations = [Rewrite Universe]
es
    , rewrites :: [Rewrite Universe]
rewrites = [Rewrite Universe]
elaborated
    , singleThreaded :: Bool
singleThreaded = Bool
singleThreaded Bool -> Bool -> Bool
|| Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
Loud
    , Bool
Int
FilePath
[FilePath]
[RoundTrip]
FixityEnv
Verbosity
ExecutionMode
ColoriseFun
verbosity :: Verbosity
targetFiles :: [FilePath]
targetDir :: FilePath
roundtrips :: [RoundTrip]
randomOrder :: Bool
noDefaultElaborations :: Bool
iterateN :: Int
fixityEnv :: FixityEnv
extraIgnores :: [FilePath]
executionMode :: ExecutionMode
colorise :: ColoriseFun
verbosity :: Verbosity
targetFiles :: [FilePath]
targetDir :: FilePath
roundtrips :: [RoundTrip]
randomOrder :: Bool
noDefaultElaborations :: Bool
iterateN :: Int
fixityEnv :: FixityEnv
extraIgnores :: [FilePath]
executionMode :: ExecutionMode
colorise :: ColoriseFun
..
    }

-- | Find all fixity declarations in targetDir and add them to fixity env.
addLocalFixities :: Options_ a b -> IO (Options_ a b)
addLocalFixities :: Options_ a b -> IO (Options_ a b)
addLocalFixities Options_ a b
opts = do
  -- do not limit search for infix decls to only targetFiles
  let opts' :: Options_ a b
opts' = Options_ a b
opts { targetFiles :: [FilePath]
targetFiles = [] }
  -- "infix" will find infixl and infixr as well
  [FilePath]
files <- Options_ a b -> [GroundTerms] -> IO [FilePath]
forall a b. Options_ a b -> [GroundTerms] -> IO [FilePath]
getTargetFiles Options_ a b
opts' [FilePath -> GroundTerms
forall a. Hashable a => a -> HashSet a
HashSet.singleton FilePath
"infix"]

  [FixityEnv -> FixityEnv]
fixFns <- Options_ a b
-> [FilePath]
-> (FilePath -> IO (FixityEnv -> FixityEnv))
-> IO [FixityEnv -> FixityEnv]
forall x y a b. Options_ x y -> [a] -> (a -> IO b) -> IO [b]
forFn Options_ a b
opts [FilePath]
files ((FilePath -> IO (FixityEnv -> FixityEnv))
 -> IO [FixityEnv -> FixityEnv])
-> (FilePath -> IO (FixityEnv -> FixityEnv))
-> IO [FixityEnv -> FixityEnv]
forall a b. (a -> b) -> a -> b
$ \ FilePath
fp -> do
    [AnnotatedModule]
ms <- CPP AnnotatedModule -> [AnnotatedModule]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (CPP AnnotatedModule -> [AnnotatedModule])
-> IO (CPP AnnotatedModule) -> IO [AnnotatedModule]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> FilePath -> IO AnnotatedModule)
-> FilePath -> IO (CPP AnnotatedModule)
parseCPPFile FilePath -> FilePath -> IO AnnotatedModule
parseContentNoFixity FilePath
fp
    return $ [(FastString, Fixity)] -> FixityEnv -> FixityEnv
extendFixityEnv
      [ (RdrName -> FastString
rdrFS RdrName
nm, Fixity
fixity)
      | AnnotatedModule
m <- [AnnotatedModule]
ms
      , (L SrcSpan
_ RdrName
nm, Fixity
fixity) <- HsModule -> [(Located RdrName, Fixity)]
fixityDecls (Located HsModule -> SrcSpanLess (Located HsModule)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (AnnotatedModule -> Located HsModule
forall ast. Annotated ast -> ast
astA AnnotatedModule
m))
      ]

  return Options_ a b
opts { fixityEnv :: FixityEnv
fixityEnv = ((FixityEnv -> FixityEnv) -> FixityEnv -> FixityEnv)
-> FixityEnv -> [FixityEnv -> FixityEnv] -> FixityEnv
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (FixityEnv -> FixityEnv) -> FixityEnv -> FixityEnv
forall a b. (a -> b) -> a -> b
($) (Options_ a b -> FixityEnv
forall rewrites imports. Options_ rewrites imports -> FixityEnv
fixityEnv Options_ a b
opts) [FixityEnv -> FixityEnv]
fixFns }

-- | 'forM', but concurrency and input order controled by 'Options'.
forFn :: Options_ x y -> [a] -> (a -> IO b) -> IO [b]
forFn :: Options_ x y -> [a] -> (a -> IO b) -> IO [b]
forFn Options{x
y
Bool
Int
FilePath
[FilePath]
[RoundTrip]
FixityEnv
Verbosity
ExecutionMode
ColoriseFun
verbosity :: Verbosity
targetFiles :: [FilePath]
targetDir :: FilePath
singleThreaded :: Bool
roundtrips :: [RoundTrip]
rewrites :: x
randomOrder :: Bool
noDefaultElaborations :: Bool
iterateN :: Int
fixityEnv :: FixityEnv
extraIgnores :: [FilePath]
executionMode :: ExecutionMode
elaborations :: x
colorise :: ColoriseFun
additionalImports :: y
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
..} [a]
c a -> IO b
f
  | Bool
randomOrder = (a -> IO b) -> [a] -> IO [b]
forall a b. (a -> IO b) -> [a] -> IO [b]
fn a -> IO b
f ([a] -> IO [b]) -> IO [a] -> IO [b]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [a] -> IO [a]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [a]
c
  | Bool
otherwise = (a -> IO b) -> [a] -> IO [b]
forall a b. (a -> IO b) -> [a] -> IO [b]
fn a -> IO b
f [a]
c
  where
    fn :: (a -> IO b) -> [a] -> IO [b]
fn
      | Bool
singleThreaded = (a -> IO b) -> [a] -> IO [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
      | Bool
otherwise = (a -> IO b) -> [a] -> IO [b]
forall (t :: * -> *) a b.
Traversable t =>
(a -> IO b) -> t a -> IO (t b)
mapConcurrently

-- | Find all files to target for rewriting.
getTargetFiles :: Options_ a b -> [GroundTerms] -> IO [FilePath]
-- Always include at least one set of ground terms
-- This selects all files if the list of rewrites is empty
getTargetFiles :: Options_ a b -> [GroundTerms] -> IO [FilePath]
getTargetFiles Options_ a b
opts [] = Options_ a b -> [GroundTerms] -> IO [FilePath]
forall a b. Options_ a b -> [GroundTerms] -> IO [FilePath]
getTargetFiles Options_ a b
opts [GroundTerms
forall a. Monoid a => a
mempty]
getTargetFiles Options{a
b
Bool
Int
FilePath
[FilePath]
[RoundTrip]
FixityEnv
Verbosity
ExecutionMode
ColoriseFun
verbosity :: Verbosity
targetFiles :: [FilePath]
targetDir :: FilePath
singleThreaded :: Bool
roundtrips :: [RoundTrip]
rewrites :: a
randomOrder :: Bool
noDefaultElaborations :: Bool
iterateN :: Int
fixityEnv :: FixityEnv
extraIgnores :: [FilePath]
executionMode :: ExecutionMode
elaborations :: a
colorise :: ColoriseFun
additionalImports :: b
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
..} [GroundTerms]
gtss = do
  FilePath -> Bool
ignorePred <- IO (FilePath -> Bool)
-> ((FilePath -> Bool) -> IO (FilePath -> Bool))
-> Maybe (FilePath -> Bool)
-> IO (FilePath -> Bool)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO (FilePath -> Bool)
forall b. IO (b -> Bool)
onIgnoreErr (FilePath -> Bool) -> IO (FilePath -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (FilePath -> Bool) -> IO (FilePath -> Bool))
-> IO (Maybe (FilePath -> Bool)) -> IO (FilePath -> Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Verbosity -> FilePath -> IO (Maybe (FilePath -> Bool))
vcsIgnorePred Verbosity
verbosity FilePath
targetDir
  let ignore :: FilePath -> Bool
ignore FilePath
fp = FilePath -> Bool
ignorePred FilePath
fp Bool -> Bool -> Bool
|| FilePath -> Bool
extraIgnorePred FilePath
fp
  [GroundTerms]
fpSets <- [GroundTerms]
-> (GroundTerms -> IO GroundTerms) -> IO [GroundTerms]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([GroundTerms] -> [GroundTerms]
dedup [GroundTerms]
gtss) ((GroundTerms -> IO GroundTerms) -> IO [GroundTerms])
-> (GroundTerms -> IO GroundTerms) -> IO [GroundTerms]
forall a b. (a -> b) -> a -> b
$ \ GroundTerms
gts -> do
    -- See Note [Ground Terms]
    [FilePath]
fps <- FilePath -> Verbosity -> GrepCommands -> IO [FilePath]
runGrepChain FilePath
targetDir Verbosity
verbosity (FilePath -> GroundTerms -> [FilePath] -> GrepCommands
buildGrepChain FilePath
targetDir GroundTerms
gts [FilePath]
targetFiles)

    let
      r :: [FilePath]
r = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
ignore)
        ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath
normalise (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
targetDir FilePath -> FilePath -> FilePath
</>)) [FilePath]
fps
    Verbosity -> FilePath -> [FilePath] -> IO ()
debugPrint Verbosity
verbosity FilePath
"Files:" [FilePath]
r
    return $ [FilePath] -> GroundTerms
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList [FilePath]
r

  return $ GroundTerms -> [FilePath]
forall a. HashSet a -> [a]
HashSet.toList (GroundTerms -> [FilePath]) -> GroundTerms -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [GroundTerms] -> GroundTerms
forall a. Monoid a => [a] -> a
mconcat [GroundTerms]
fpSets
  where
    dedup :: [GroundTerms] -> [GroundTerms]
dedup = HashSet GroundTerms -> [GroundTerms]
forall a. HashSet a -> [a]
HashSet.toList (HashSet GroundTerms -> [GroundTerms])
-> ([GroundTerms] -> HashSet GroundTerms)
-> [GroundTerms]
-> [GroundTerms]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GroundTerms] -> HashSet GroundTerms
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList
    extraIgnorePred :: FilePath -> Bool
extraIgnorePred =
      let fps :: [FilePath]
fps = [ FilePath -> FilePath
normalise (FilePath
targetDir FilePath -> FilePath -> FilePath
</> FilePath
f) | FilePath
f <- [FilePath]
extraIgnores ]
      in \FilePath
fp -> (FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
fp) [FilePath]
fps
    onIgnoreErr :: IO (b -> Bool)
onIgnoreErr = 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
$
        FilePath -> IO ()
putStrLn FilePath
"Reading VCS ignore failed! Continuing without ignoring."
      return $ Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
False

-- | Return a chain of grep commands to find files with relevant groundTerms
-- If filesGiven is empty, use all *.hs files under targetDir
buildGrepChain
  :: FilePath
  -> HashSet String
  -> [FilePath]
  -> GrepCommands
buildGrepChain :: FilePath -> GroundTerms -> [FilePath] -> GrepCommands
buildGrepChain FilePath
targetDir GroundTerms
gts [FilePath]
filesGiven = GrepCommands :: [FilePath] -> [FilePath] -> GrepCommands
GrepCommands {initialFileSet :: [FilePath]
initialFileSet=[FilePath]
filesGiven, commandChain :: [FilePath]
commandChain=[FilePath]
commands}
  where
    commands :: [FilePath]
commands = if [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
filesGiven
               then [FilePath]
commandsWithoutFiles
               else [FilePath]
commandsWithFiles

    commandsWithFiles :: [FilePath]
commandsWithFiles = case [FilePath]
terms of
        [] -> [] -- no processing
        [FilePath]
gs -> (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
normalGrep [FilePath]
gs
    commandsWithoutFiles :: [FilePath]
commandsWithoutFiles = case [FilePath]
terms of
        [] -> [FilePath
findCmd] -- all .hs files
        FilePath
g:[FilePath]
gs -> FilePath -> FilePath
recursiveGrep FilePath
g FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
normalGrep [FilePath]
gs -- start with recursive grep

    findCmd :: FilePath
findCmd = [FilePath] -> FilePath
unwords [FilePath
"find", FilePath -> FilePath
quotePath (FilePath -> FilePath
addTrailingPathSeparator FilePath
targetDir), FilePath
"-iname", FilePath
hsExtension]
    recursiveGrep :: FilePath -> FilePath
recursiveGrep FilePath
g = [FilePath] -> FilePath
unwords [FilePath
"grep", FilePath
"-R", FilePath
"--include=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
hsExtension, FilePath
"-l", FilePath -> FilePath
esc FilePath
g, FilePath -> FilePath
quotePath FilePath
targetDir]
    normalGrep :: FilePath -> FilePath
normalGrep FilePath
gt = [FilePath] -> FilePath
unwords [FilePath
"grep", FilePath
"-l", FilePath -> FilePath
esc FilePath
gt]

   -- Limit the number of the shell command we build by only selecting
   -- up to 10 ground terms. The goal is to filter file list down to
   -- a manageable size. It doesn't have to be exact.
    terms :: [FilePath]
terms = Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
take Int
10 ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
p ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ GroundTerms -> [FilePath]
forall a. HashSet a -> [a]
HashSet.toList GroundTerms
gts
    p :: FilePath -> Bool
p [] = Bool
False
    p (Char
c:FilePath
cs)
      | Char -> Bool
isSpace Char
c = FilePath -> Bool
p FilePath
cs
      | Bool
otherwise = Char -> Bool
isAlphaNum Char
c

    hsExtension :: FilePath
hsExtension = FilePath
"\"*.hs\""

    esc :: FilePath -> FilePath
esc FilePath
s = FilePath
"'" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"[[:space:]]\\+" (FilePath -> [FilePath]
words (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
escChars FilePath
s) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"'"
    escChars :: FilePath -> FilePath
escChars = (Char -> FilePath) -> FilePath -> FilePath
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> FilePath
escChar
    escChar :: Char -> FilePath
escChar Char
c
      | Char
c Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
magicChars = FilePath
"\\" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [Char
c]
      | Bool
otherwise  = [Char
c]
    magicChars :: [Char]
    magicChars :: FilePath
magicChars = FilePath
"*?[#˜=%\\"


type CommandLine = String
data GrepCommands = GrepCommands { GrepCommands -> [FilePath]
initialFileSet :: [FilePath], GrepCommands -> [FilePath]
commandChain :: [CommandLine] }
  deriving (GrepCommands -> GrepCommands -> Bool
(GrepCommands -> GrepCommands -> Bool)
-> (GrepCommands -> GrepCommands -> Bool) -> Eq GrepCommands
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GrepCommands -> GrepCommands -> Bool
$c/= :: GrepCommands -> GrepCommands -> Bool
== :: GrepCommands -> GrepCommands -> Bool
$c== :: GrepCommands -> GrepCommands -> Bool
Eq, Int -> GrepCommands -> FilePath -> FilePath
[GrepCommands] -> FilePath -> FilePath
GrepCommands -> FilePath
(Int -> GrepCommands -> FilePath -> FilePath)
-> (GrepCommands -> FilePath)
-> ([GrepCommands] -> FilePath -> FilePath)
-> Show GrepCommands
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [GrepCommands] -> FilePath -> FilePath
$cshowList :: [GrepCommands] -> FilePath -> FilePath
show :: GrepCommands -> FilePath
$cshow :: GrepCommands -> FilePath
showsPrec :: Int -> GrepCommands -> FilePath -> FilePath
$cshowsPrec :: Int -> GrepCommands -> FilePath -> FilePath
Show)

runGrepChain :: FilePath -> Verbosity -> GrepCommands -> IO [FilePath]
runGrepChain :: FilePath -> Verbosity -> GrepCommands -> IO [FilePath]
runGrepChain FilePath
targetDir Verbosity
verbosity GrepCommands{[FilePath]
commandChain :: [FilePath]
initialFileSet :: [FilePath]
commandChain :: GrepCommands -> [FilePath]
initialFileSet :: GrepCommands -> [FilePath]
..} = ([FilePath] -> FilePath -> IO [FilePath])
-> [FilePath] -> [FilePath] -> IO [FilePath]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (FilePath -> Verbosity -> [FilePath] -> FilePath -> IO [FilePath]
commandStep FilePath
targetDir Verbosity
verbosity)  [FilePath]
initialFileSet [FilePath]
commandChain

-- | run a command with a list of files as quoted arguments
commandStep :: FilePath -> Verbosity -> [FilePath]-> CommandLine -> IO [FilePath]
commandStep :: FilePath -> Verbosity -> [FilePath] -> FilePath -> IO [FilePath]
commandStep FilePath
targetDir Verbosity
verbosity [FilePath]
files FilePath
cmd = FilePath -> Verbosity -> FilePath -> IO [FilePath]
doCmd FilePath
targetDir Verbosity
verbosity (FilePath
cmd FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> FilePath
formatPaths [FilePath]
files)
 where
    formatPaths :: [FilePath] -> FilePath
formatPaths [] = FilePath
""
    formatPaths [FilePath]
xs = FilePath
" " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> FilePath
unwords ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
quotePath [FilePath]
xs)
quotePath :: FilePath -> FilePath
quotePath :: FilePath -> FilePath
quotePath FilePath
x = FilePath
"'" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
x FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"'"


doCmd :: FilePath -> Verbosity -> String -> IO [FilePath]
doCmd :: FilePath -> Verbosity -> FilePath -> IO [FilePath]
doCmd FilePath
targetDir Verbosity
verbosity FilePath
shellCmd = do
  Verbosity -> FilePath -> [FilePath] -> IO ()
debugPrint Verbosity
verbosity FilePath
"shellCmd:" [FilePath
shellCmd]
  let cmd :: CreateProcess
cmd = (FilePath -> CreateProcess
shell FilePath
shellCmd) { cwd :: Maybe FilePath
cwd = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
targetDir }
  (ExitCode
_ec, FilePath
fps, FilePath
_) <- CreateProcess -> FilePath -> IO (ExitCode, FilePath, FilePath)
readCreateProcessWithExitCode CreateProcess
cmd FilePath
""
  return $ FilePath -> [FilePath]
lines FilePath
fps