diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,12 @@ #### Upcoming +#### v0.4.0.0 + +*Major* + +* Extracted omnifmt out to git@github.com:hjwylde/omnifmt. ([#41](https://github.com/hjwylde/git-fmt/issues/41)) + #### v0.3.1.2 *Revisions* diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,13 +3,13 @@ [![Project Status: Wip - Initial development is in progress, but there has not yet been a stable, usable release suitable for the public.](http://www.repostatus.org/badges/1.0.0/wip.svg)](http://www.repostatus.org/#wip) [![Build Status](https://travis-ci.org/hjwylde/git-fmt.svg?branch=master)](https://travis-ci.org/hjwylde/git-fmt) [![Release](https://img.shields.io/github/release/hjwylde/git-fmt.svg)](https://github.com/hjwylde/git-fmt/releases/latest) -[![git-fmt on Stackage LTS](http://stackage.org/package/git-fmt/badge/lts)](http://stackage.org/lts/package/git-fmt) -[![git-fmt on Stackage Nightly](http://stackage.org/package/git-fmt/badge/nightly)](http://stackage.org/nightly/package/git-fmt) - -(Side note: the formatting component of this project will eventually be split out and named omnifmt.) +[![git-fmt on Stackage LTS](https://www.stackage.org/package/git-fmt/badge/lts)](https://www.stackage.org/lts/package/git-fmt) +[![git-fmt on Stackage Nightly](https://www.stackage.org/package/git-fmt/badge/nightly)](https://www.stackage.org/nightly/package/git-fmt) -git-fmt was created to make prettifying code easy. -It adds a custom (easy to use) command to Git that formats code through external pretty-printers. +Custom git command for formatting code. +git-fmt provides a wrapper around [omnifmt](https://github.com/hjwylde/omnifmt), + an automatic code formatter. +It adds the ability to operate on specific tracked files in the repository. Formatted code is: @@ -20,7 +20,7 @@ formatting; diffs show only the real changes. * Uncontroversial: never have a debate about spacing or brace position ever again. -(Bullet points taken from https://blog.golang.org/go-fmt-your-code.) +(Bullet points taken from [https://blog.golang.org/go-fmt-your-code](https://blog.golang.org/go-fmt-your-code).) ### Installing @@ -48,6 +48,10 @@ pretty-printers. It supports both prettifying the files immediately and performing dry-runs to see which files are ugly. +Given that it uses the [omnifmt](https://github.com/hjwylde/omnifmt) library underneath, the syntax + and features are quite similar. +The main difference is that git-fmt restricts files to being tracked by the git repository and that + by default it only operates on files in the index. **The basics:** @@ -66,54 +70,16 @@ git-fmt can run in three different modes, *normal*, *dry-run* and *diff*. -Normal mode writes to (prettifies) all ugly files immediately and outputs the prettified file paths - to *stdout*. - -Dry-run mode outputs the ugly file paths to stdout. - -Diff mode outputs a diff of all ugly files with their prettified version. +The normal and dry-run modes act the same as omnifmt. +Diff mode however uses `git diff` as opposed to `diff`. By default the diff isn't paged, so to get output similar to `git diff` or `git log` it is - recommended to use `[-p|--paginate]` with this mode, e.g., `git -p fmt -m diff`. + recommended to use `[-p|--paginate]`, e.g., `git -p fmt -m diff`. **NB:** it isn't possible to pipe the diff into `git apply` due to the destination file path header. #### Configuration -Configuration is done via an '.omnifmt.yaml' file in the git repository. -The file contains a list of *programs* that link *extensions* to a prettifying *command*, e.g., -```yaml -haskell: - extensions: ["hs", "lhs"] - command: "stylish-haskell {{input}} > {{output}}" - -javascript: - extensions: ["js"] - command: "js-beautify -f {{input}}" - -json: - extensions: ["json"] - command: "json_pp" - -ruby: - extensions: ["rb"] - command: "ruby-beautify" -``` - -Each command declares how to read the *input file* and how to write to the *output file*. -If the input variable is omitted, the file contents are fed to the command through *stdin*. -Likewise if the output variable is omitted, the pretty contents are read from stdout. -The output file is used to compare whether the original was pretty or ugly before writing to it. - -The extensions field is pretty self explanatory, but if you use the same extension more than once - then precedence goes to the program defined first. - -#### Examples - -See the [docs/example-configs/](https://github.com/hjwylde/git-fmt/tree/master/docs/example-configs/) - directory for some common pretty-printers and their corresponding omnifmt config (pull requests - are welcome for adding more). -Just don't forget to actually call the config file .omnifmt.yaml! - -**NB:** I haven't tested them fully, be careful in case one is buggy. +git-fmt delegates to omnifmt for configuration, see + [here](https://github.com/hjwylde/git-fmt#configuration) for documentation and examples. diff --git a/app/Git/Fmt/Pipes.hs b/app/Git/Fmt/Pipes.hs new file mode 100644 --- /dev/null +++ b/app/Git/Fmt/Pipes.hs @@ -0,0 +1,38 @@ + +{-| +Module : Git.Fmt.Pipes +Description : Pipeline for formatting files. + +Copyright : (c) Henry J. Wylde, 2015 +License : BSD3 +Maintainer : public@hjwylde.com + +Pipeline for formatting files. +-} + +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TupleSections #-} + +module Git.Fmt.Pipes ( + -- * Transformers + gitDiff, +) where + +import Control.Monad.Except +import Control.Monad.Logger + +import Omnifmt.Pipes +import Omnifmt.Process + +import Pipes + +-- | Prints out the git diff of all ugly files to standard output. +gitDiff :: (MonadIO m, MonadLogger m) => Pipe (Status, FilePath, FilePath) (Status, FilePath, FilePath) m () +gitDiff = select [Ugly] $ \item@(_, uglyFilePath, prettyFilePath) -> do + (_, stdout, _) <- runProcess "git" ["diff", "--no-index", "--", uglyFilePath, prettyFilePath] + + liftIO $ putStr stdout + + return item + diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -37,6 +37,7 @@ import Data.Tuple.Extra (fst3) import Git.Fmt.Options +import Git.Fmt.Pipes import Omnifmt.Config as Config import Omnifmt.Exit @@ -68,7 +69,8 @@ let chatty = if optMode options == Diff then Quiet else optChatty options flip runLoggingT (log $ optChatty options) . filter chatty $ do - checkGitRepository + exitCode <- fst3 <$> runProcess "git" ["rev-parse", "--show-toplevel"] + when (exitCode /= ExitSuccess) $ panic_ ".git/: not found" mFilePath <- Config.nearestConfigFile "." when (isNothing mFilePath) . panic_ $ Config.defaultFileName ++ ": not found" @@ -78,20 +80,13 @@ runReaderT (handle options) (fromJust mConfig) -checkGitRepository :: (MonadIO m, MonadLogger m) => m () -checkGitRepository = do - exitCode <- fst3 <$> runProcess "git" ["rev-parse", "--show-toplevel"] - - when (exitCode /= ExitSuccess) $ panic_ ".git/: not found" - handle :: (MonadIO m, MonadLogger m, MonadMask m, MonadParallel m, MonadReader Config m) => Options -> m () handle options = do rootDir <- liftIO getCurrentDirectory filePaths <- runPanic $ if null (argPaths options) then initialFilePaths options else liftM2 intersect (initialFilePaths options) (providedFilePaths options) - absFilePaths <- forM filePaths $ \filePath -> ifM (liftIO $ doesFileExist filePath) - (liftIO $ canonicalizePath filePath) (return filePath) + absFilePaths <- filterM (liftIO . doesFileExist) filePaths >>= mapM (liftIO . canonicalizePath) numThreads <- liftIO getNumCapabilities >>= \numCapabilities -> return $ fromMaybe numCapabilities (optThreads options) @@ -119,7 +114,7 @@ Reference ref -> runProcess_ "git" ["diff", ref, "--name-only", "-z"] pipeline :: (MonadIO m, MonadLogger m, MonadReader Config m) => Pipe (Status, FilePath, FilePath) (Status, FilePath, FilePath) m () -pipeline = checkFileSupported >-> checkFileExists >-> createPrettyFile >-> runProgram >-> checkFilePretty +pipeline = checkFileSupported >-> createPrettyFile >-> runProgram >-> checkFilePretty where createPrettyFile = select [Unknown] $ \item@(_, _, prettyFilePath) -> do liftIO $ createDirectoryIfMissing True (takeDirectory prettyFilePath) @@ -129,13 +124,13 @@ runner :: (MonadIO m, MonadLogger m) => Mode -> Consumer (Status, FilePath, FilePath) m () runner Normal = commit >-> printFileStatus logFunction >-> Pipes.drain runner DryRun = cat >-> printFileStatus logFunction >-> Pipes.drain -runner Diff = diff >-> Pipes.drain +runner Diff = gitDiff >-> Pipes.drain logFunction :: MonadLogger m => Status -> Text -> m () logFunction status - | status `elem` [Unknown, Error, Timeout] = logWarnN - | status `elem` [Unsupported, NotFound, Pretty] = logDebugN - | otherwise = logInfoN + | status `elem` [Unknown, Error, Timeout] = logWarnN + | status `elem` [Unsupported, Pretty] = logDebugN + | otherwise = logInfoN filter :: Chatty -> LoggingT m a -> LoggingT m a filter Quiet = filterLogger (\_ level -> level >= LevelError) diff --git a/git-fmt.cabal b/git-fmt.cabal --- a/git-fmt.cabal +++ b/git-fmt.cabal @@ -1,14 +1,13 @@ name: git-fmt -version: 0.3.1.2 +version: 0.4.0.0 author: Henry J. Wylde maintainer: public@hjwylde.com homepage: https://github.com/hjwylde/git-fmt synopsis: Custom git command for formatting code. -description: git-fmt adds a custom command to Git that automatically formats code by using - external pretty-printers. - The idea was taken from gofmt, just with a bit of expansion to more languages. +description: git-fmt provides a wrapper around omnifmt, an automatic code formatter. + It adds the ability to operate on specific tracked files in the repository. license: BSD3 license-file: LICENSE @@ -29,6 +28,7 @@ ghc-options: -threaded -with-rtsopts=-N other-modules: Git.Fmt.Options, + Git.Fmt.Pipes, Git.Fmt.Version, Paths_git_fmt @@ -43,7 +43,7 @@ extra >= 1.4, fast-logger >= 2.4, filepath >= 1.4, - git-fmt, + omnifmt >= 0.1, mtl >= 2.2, monad-logger >= 0.3, monad-parallel >= 0.7, @@ -53,30 +53,4 @@ temporary >= 1.2, text >= 1.2, time >= 1.5 - -library - hs-source-dirs: src/ - exposed-modules: - Omnifmt.Config, - Omnifmt.Exit, - Omnifmt.Pipes, - Omnifmt.Process - - default-language: Haskell2010 - other-extensions: - FlexibleContexts - MultiParamTypeClasses - OverloadedStrings - TupleSections - build-depends: - aeson >= 0.8, - base >= 4.8 && < 5, - extra >= 1.4, - filepath >= 1.4, - monad-logger >= 0.3, - mtl >= 2.2, - pipes >= 4.1, - text >= 1.2, - unordered-containers >= 0.2, - yaml >= 0.8 diff --git a/src/Omnifmt/Config.hs b/src/Omnifmt/Config.hs deleted file mode 100644 --- a/src/Omnifmt/Config.hs +++ /dev/null @@ -1,135 +0,0 @@ - -{-| -Module : Omnifmt.Config -Description : Configuration data structures. - -Copyright : (c) Henry J. Wylde, 2015 -License : BSD3 -Maintainer : public@hjwylde.com - -Configuration data structures. --} - -{-# LANGUAGE OverloadedStrings #-} - -module Omnifmt.Config ( - -- * Config - Config(..), - emptyConfig, readConfig, nearestConfigFile, defaultFileName, programFor, unsafeProgramFor, - supported, - - -- * Program - Program(..), - emptyProgram, substitute, usesInputVariable, usesOutputVariable, inputVariableName, - outputVariableName, -) where - -import Control.Arrow (second) -import Control.Monad.Except -import Control.Monad.Extra -import Control.Monad.Logger - -import Data.Aeson.Types -import Data.HashMap.Lazy (toList) -import Data.List (find) -import Data.Maybe (fromJust, isJust) -import Data.Text (Text, cons, isInfixOf, pack, replace, snoc) -import Data.Yaml (prettyPrintParseException) -import Data.Yaml.Include (decodeFileEither) - -import System.Directory.Extra -import System.FilePath - --- | A collection of 'Program's. -data Config = Config { - programs :: [Program] - } - deriving (Eq, Show) - -instance FromJSON Config where - parseJSON (Object obj) = Config <$> mapM (\(key, value) -> - parseJSON value >>= \program -> return program { name = key } - ) (toList obj) - parseJSON value = typeMismatch "Config" value - --- | An empty config (no programs). -emptyConfig :: Config -emptyConfig = Config [] - --- | Reads a config from the given file path if possible. --- If an error occurs it is logged using 'logDebugN'. -readConfig :: (MonadIO m, MonadLogger m) => FilePath -> m (Maybe Config) -readConfig filePath = liftIO (decodeFileEither filePath) >>= \ethr -> case ethr of - Left error -> do - logDebugN . pack $ filePath ++ ": error\n" ++ prettyPrintParseException error - return Nothing - Right config -> return $ Just config - --- | Finds the nearest config file by searching from the given directory upwards. -nearestConfigFile :: MonadIO m => FilePath -> m (Maybe FilePath) -nearestConfigFile dir = liftIO (canonicalizePath dir) >>= \dir' -> findM (liftIO . doesFileExist) $ map ( defaultFileName) (parents dir') - where - parents = reverse . scanl1 combine . splitDirectories - --- | The file name of the default config, '.omnifmt.yaml'. -defaultFileName :: FilePath -defaultFileName = ".omnifmt.yaml" - --- | Attempts to find a 'Program' for the given extension. --- Programs are searched in order as provided by the 'Config' and the first match will be --- returned. -programFor :: Config -> Text -> Maybe Program -programFor config ext = find (\program -> ext `elem` extensions program) (programs config) - --- | @fromJust . programFor@ -unsafeProgramFor :: Config -> Text -> Program -unsafeProgramFor config = fromJust . programFor config - --- | Checks if the given extension is supported (i.e., there is a 'Program' for it). -supported :: Config -> Text -> Bool -supported config = isJust . programFor config - --- | A program has a semantic name, associated extensions and formatting command. --- The command string may contain variables, denoted by strings surrounded with '{{..}}'. --- The command should return a 0 exit code for success, or a non-0 exit code for failure. -data Program = Program { - name :: Text, -- ^ A semantic name (has no impact on formatting). - extensions :: [Text], -- ^ A list of extensions, without a period prefix. - command :: Text -- ^ A command to run in a shell that prettifies an input file and - -- writes to an output file. - } - deriving (Eq, Show) - -instance FromJSON Program where - parseJSON (Object obj) = Program "" <$> obj .: "extensions" <*> obj .: "command" - parseJSON value = typeMismatch "Program" value - --- | The empty program (no extensions and the command always fails). -emptyProgram :: Program -emptyProgram = Program "" [] "false" - --- | Substitutes the mapping throughout the command. --- The mapping is a tuple of @(variable, value)@. --- Values given are quoted and have any backslashes and double quotaiton marks escaped. -substitute :: Text -> [(Text, Text)] -> Text -substitute = foldr (uncurry replace . second (quote . escape)) - where - quote = cons '"' . (`snoc` '"') - escape = replace (pack "\"") (pack "\\\"") . replace (pack "\\") (pack "\\\\") - --- | Checks whether the text uses the input variable ('inputVariableName'). -usesInputVariable :: Text -> Bool -usesInputVariable = isInfixOf inputVariableName - --- | Checks whether the text uses the output variable ('outputVariableName'). -usesOutputVariable :: Text -> Bool -usesOutputVariable = isInfixOf outputVariableName - --- | The input variable name, '{{input}}'. -inputVariableName :: Text -inputVariableName = "{{input}}" - --- | The output variable name, '{{output}}'. -outputVariableName :: Text -outputVariableName = "{{output}}" - diff --git a/src/Omnifmt/Exit.hs b/src/Omnifmt/Exit.hs deleted file mode 100644 --- a/src/Omnifmt/Exit.hs +++ /dev/null @@ -1,41 +0,0 @@ - -{-| -Module : Omnifmt.Exit -Description : Extra exit utilities. - -Copyright : (c) Henry J. Wylde, 2015 -License : BSD3 -Maintainer : public@hjwylde.com - -Extra exit utilities. --} - -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MultiParamTypeClasses #-} - -module Omnifmt.Exit ( - -- * Exiting - panic, panic_, runPanic, -) where - -import Control.Monad.Except -import Control.Monad.Logger - -import Data.Text (pack) - -import System.Exit - --- | Panics, logging the error to stderr and exiting fast with 128. -panic :: (MonadError ExitCode m, MonadIO m, MonadLogger m) => String -> m a -panic error = logErrorN (pack error) >> throwError (ExitFailure 128) - --- | Panics, logging the error to stderr and exiting fast with 128. --- Rather than exiting fast using a 'MonadError', this method uses 'exitWith' --- (@panic_ = runPanic . panic@). -panic_ :: (MonadIO m, MonadLogger m) => String -> m a -panic_ = runPanic . panic - --- | Runs the panic, calling 'exitWith' if the 'ExceptT' had an error thrown. -runPanic :: MonadIO m => ExceptT ExitCode m a -> m a -runPanic = runExceptT >=> either (liftIO . exitWith) return - diff --git a/src/Omnifmt/Pipes.hs b/src/Omnifmt/Pipes.hs deleted file mode 100644 --- a/src/Omnifmt/Pipes.hs +++ /dev/null @@ -1,165 +0,0 @@ - -{-| -Module : Omnifmt.Pipes -Description : Pipeline for formatting files. - -Copyright : (c) Henry J. Wylde, 2015 -License : BSD3 -Maintainer : public@hjwylde.com - -Pipeline for formatting files. -The functions listed here are in order of the recommended chain, but it is possible to mix and match - them or add custom functions inbetween. --} - -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TupleSections #-} - -module Omnifmt.Pipes ( - -- * Status - Status(..), - - -- * Producers - omnifmt, - - -- * Transformers - select, checkFileSupported, checkFileExists, runProgram, checkFilePretty, commit, diff, - printFileStatus, -) where - -import Control.Monad.Except -import Control.Monad.Extra -import Control.Monad.Logger -import Control.Monad.Reader - -import Data.List.Extra (lower) -import Data.Text (Text) -import qualified Data.Text as T -import Data.Tuple.Extra (fst3) - -import GHC.IO.Exception (IOErrorType (..)) - -import Omnifmt.Config -import Omnifmt.Process - -import Pipes -import qualified Pipes.Prelude as Pipes - -import System.Directory.Extra -import System.Exit -import System.FilePath -import System.IO.Error - --- | A status for a file going through the omnifmt pipeline. -data Status = Unknown -- ^ The file has not been processed. - | Error -- ^ An error occurred somewhere. - | Unsupported -- ^ The file type is unsupported (i.e., no applicable 'Program'). - | NotFound -- ^ The file could not be found. - | Timeout -- ^ A command timed out. - | Pretty -- ^ The file is pretty. - | Ugly -- ^ The file is ugly. - | Prettified -- ^ The file is now pretty. - deriving (Eq, Show) - --- | Takes an input (ugly) file path and an empty output file path and prepends the 'Unknown' status --- to them. -omnifmt :: FilePath -> FilePath -> (Status, FilePath, FilePath) -omnifmt = (Unknown,,) - --- | Utility method for applying a function to files that match certain statuses. --- Any files that don't match the given statuses will be passed through unmodified. -select :: Monad m => [Status] -> ((Status, FilePath, FilePath) -> m (Status, FilePath, FilePath)) -> Pipe (Status, FilePath, FilePath) (Status, FilePath, FilePath) m () -select states action = Pipes.mapM (\item -> if fst3 item `elem` states then action item else return item) - --- | Checks all 'Unknown' files to see if they're 'supported'. -checkFileSupported :: MonadReader Config m => Pipe (Status, FilePath, FilePath) (Status, FilePath, FilePath) m () -checkFileSupported = select [Unknown] $ \item@(_, uglyFilePath, prettyFilePath) -> - ask >>= \config -> if supported config . T.toLower . T.pack . drop 1 $ takeExtension uglyFilePath - then return item - else return (Unsupported, uglyFilePath, prettyFilePath) - --- | Checks all 'Unknown' ugly file paths to see if they exist. -checkFileExists :: MonadIO m => Pipe (Status, FilePath, FilePath) (Status, FilePath, FilePath) m () -checkFileExists = select [Unknown] $ \item@(_, uglyFilePath, prettyFilePath) -> - ifM (liftIO $ doesFileExist uglyFilePath) - (return item) - (return (NotFound, uglyFilePath, prettyFilePath)) - --- | Runs the applicable 'Program''s command on all 'Unknown' files. --- This reads in the ugly file path and writes out to the pretty file path. --- --- Note that this function assumes that the file is supported, so make sure the file has been --- piped through 'checkFileSupported' first. --- --- Any errors that occur are logged using 'logDebugN'. -runProgram :: (MonadIO m, MonadLogger m, MonadReader Config m) => Pipe (Status, FilePath, FilePath) (Status, FilePath, FilePath) m () -runProgram = select [Unknown] $ \item@(_, uglyFilePath, prettyFilePath) -> do - config <- ask - let program = unsafeProgramFor config (T.pack . drop 1 $ takeExtension uglyFilePath) - - (exitCode, _, stderr) <- runTimedCommand 5 . T.unpack $ substitute (T.concat [command program, inputSuffix program, outputSuffix program]) [ - (inputVariableName, T.pack uglyFilePath), - (outputVariableName, T.pack prettyFilePath) - ] - - case exitCode of - ExitSuccess -> return item - ExitFailure 124 -> return (Timeout, uglyFilePath, prettyFilePath) - ExitFailure 137 -> return (Timeout, uglyFilePath, prettyFilePath) - _ -> logDebugN (T.pack stderr) >> - return (Error, uglyFilePath, prettyFilePath) - where - inputSuffix program - | usesInputVariable (command program) = T.empty - | otherwise = T.pack " < " `T.append` inputVariableName - outputSuffix program - | usesOutputVariable (command program) = T.empty - | otherwise = T.pack " > " `T.append` outputVariableName - --- | Runs a diff over the two file paths for all 'Unknown' files. --- --- This function always updates the status to either 'Ugly', 'Pretty' or 'Error'. --- --- Any errors that occur are logged using 'logDebugN'. -checkFilePretty :: (MonadIO m, MonadLogger m) => Pipe (Status, FilePath, FilePath) (Status, FilePath, FilePath) m () -checkFilePretty = select [Unknown] $ \(_, uglyFilePath, prettyFilePath) -> do - (exitCode, _, stderr) <- runProcess "diff" [uglyFilePath, prettyFilePath] - - case exitCode of - ExitFailure 1 -> return (Ugly, uglyFilePath, prettyFilePath) - ExitSuccess -> return (Pretty, uglyFilePath, prettyFilePath) - _ -> logDebugN (T.pack stderr) >> - return (Error, uglyFilePath, prettyFilePath) - --- | Commits the result of 'runProgram'. --- I.e., writes over all 'Ugly' files with their corresponding pretty file. --- --- This function updates the status to 'Prettified'. -commit :: MonadIO m => Pipe (Status, FilePath, FilePath) (Status, FilePath, FilePath) m () -commit = select [Ugly] $ \(_, uglyFilePath, prettyFilePath) -> do - -- Try move the file, but if it's across a filesystem boundary then we may need to copy instead - liftIO $ renameFile prettyFilePath uglyFilePath `catchIOError` \e -> - if ioeGetErrorType e == UnsupportedOperation - then copyFile prettyFilePath uglyFilePath >> removeFile prettyFilePath - else ioError e - - return (Prettified, uglyFilePath, prettyFilePath) - --- | Prints out the diff of all ugly files to standard output. -diff :: (MonadIO m, MonadLogger m) => Pipe (Status, FilePath, FilePath) (Status, FilePath, FilePath) m () -diff = select [Ugly] $ \item@(_, uglyFilePath, prettyFilePath) -> do - (_, stdout, _) <- runProcess "git" ["diff", "--no-index", "--", uglyFilePath, prettyFilePath] - - liftIO $ putStr stdout - - return item - --- | Logs the status of each file using the given function. -printFileStatus :: MonadLogger m => (Status -> Text -> m ()) -> Pipe (Status, FilePath, FilePath) (Status, FilePath, FilePath) m () -printFileStatus f = Pipes.mapM_ $ \(status, uglyFilePath, _) -> - f status (T.pack $ uglyFilePath ++ ": " ++ showStatus status) - where - showStatus NotFound = "not found" - showStatus status = lower $ show status - diff --git a/src/Omnifmt/Process.hs b/src/Omnifmt/Process.hs deleted file mode 100644 --- a/src/Omnifmt/Process.hs +++ /dev/null @@ -1,85 +0,0 @@ - -{-| -Module : Omnifmt.Process -Description : System process utilities. - -Copyright : (c) Henry J. Wylde, 2015 -License : BSD3 -Maintainer : public@hjwylde.com - -System process utilities. --} - -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MultiParamTypeClasses #-} - -module Omnifmt.Process ( - -- * Run - runProcess, runProcess_, runTimedProcess, runCommand, runCommand_, runTimedCommand, - runCreateProcess, runCreateProcess_, -) where - -import Control.Monad.Except -import Control.Monad.Logger - -import Data.Text hiding (unwords) - -import Omnifmt.Exit - -import System.Exit -import System.Process.Extra (CmdSpec (..), CreateProcess) -import qualified System.Process.Extra as System - --- | Runs the given executable with the arguments. --- Returns the exit code, stdout and stderr. -runProcess :: (MonadIO m, MonadLogger m) => FilePath -> [String] -> m (ExitCode, String, String) -runProcess cmd args = runCreateProcess (System.proc cmd args) "" - --- | Runs the given executable with the arguments. --- Depending on the exit code, either logs the stderr and exits fast (128) or returns the stdout. -runProcess_ :: (MonadError ExitCode m, MonadIO m, MonadLogger m) => FilePath -> [String] -> m String -runProcess_ cmd args = runCreateProcess_ (System.proc cmd args) "" - --- | Runs the given executable with the arguments. --- Returns the exit code, stdout and stderr. --- The command is wrapped in a `timeout -k N*2 N` call. -runTimedProcess :: (MonadIO m, MonadLogger m) => Int -> FilePath -> [String] -> m (ExitCode, String, String) -runTimedProcess n cmd args = runCreateProcess (System.proc "timeout" $ "-k":show (n * 2):show n:cmd:args) "" - --- | Runs the given command. --- Returns the exit code, stdout and stderr. -runCommand :: (MonadIO m, MonadLogger m) => String -> m (ExitCode, String, String) -runCommand cmd = runCreateProcess (System.shell cmd) "" - --- | Runs the given command. --- Depending on the exit code, either logs the stderr and exits fast (128) or returns the stdout. -runCommand_ :: (MonadError ExitCode m, MonadIO m, MonadLogger m) => String -> m String -runCommand_ cmd = runCreateProcess_ (System.shell cmd) "" - --- | Runs the given command. --- Returns the exit code, stdout and stderr. --- The command is wrapped in a `timeout -k N*2 N` call. -runTimedCommand :: (MonadIO m, MonadLogger m) => Int -> String -> m (ExitCode, String, String) -runTimedCommand n cmd = runCreateProcess (System.shell $ unwords ["timeout -k", show $ n * 2, show n, cmd]) "" - --- | Runs the given 'CreateProcess'. --- Returns the exit code, stdout and stderr. -runCreateProcess :: (MonadIO m, MonadLogger m) => CreateProcess -> String -> m (ExitCode, String, String) -runCreateProcess process stdin = do - logDebugN $ pack (case System.cmdspec process of - ShellCommand cmd -> cmd - RawCommand cmd args -> unwords (cmd:args) - ) - - liftIO $ System.readCreateProcessWithExitCode process stdin - --- | Runs the given 'CreateProcess'. --- Depending on the exit code, either logs the stderr and exits fast (128) or returns the stdout. -runCreateProcess_ :: (MonadError ExitCode m, MonadIO m, MonadLogger m) => CreateProcess -> String -> m String -runCreateProcess_ process stdin = do - (exitCode, stdout, stderr) <- runCreateProcess process stdin - - if exitCode == ExitSuccess - then return stdout - else panic stderr -