git-fmt 0.3.1.2 → 0.4.0.0
raw patch · 9 files changed
+74/−521 lines, 9 filesdep +omnifmtdep −aesondep −git-fmtdep −unordered-containers
Dependencies added: omnifmt
Dependencies removed: aeson, git-fmt, unordered-containers, yaml
Files
- CHANGELOG.md +6/−0
- README.md +16/−50
- app/Git/Fmt/Pipes.hs +38/−0
- app/Main.hs +9/−14
- git-fmt.cabal +5/−31
- src/Omnifmt/Config.hs +0/−135
- src/Omnifmt/Exit.hs +0/−41
- src/Omnifmt/Pipes.hs +0/−165
- src/Omnifmt/Process.hs +0/−85
CHANGELOG.md view
@@ -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*
README.md view
@@ -3,13 +3,13 @@ [](http://www.repostatus.org/#wip) [](https://travis-ci.org/hjwylde/git-fmt) [](https://github.com/hjwylde/git-fmt/releases/latest)-[](http://stackage.org/lts/package/git-fmt)-[](http://stackage.org/nightly/package/git-fmt)--(Side note: the formatting component of this project will eventually be split out and named omnifmt.)+[](https://www.stackage.org/lts/package/git-fmt)+[](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.
+ app/Git/Fmt/Pipes.hs view
@@ -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+
app/Main.hs view
@@ -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)
git-fmt.cabal view
@@ -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
− src/Omnifmt/Config.hs
@@ -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}}"-
− src/Omnifmt/Exit.hs
@@ -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-
− src/Omnifmt/Pipes.hs
@@ -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-
− src/Omnifmt/Process.hs
@@ -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-