git-fmt 0.2.2.1 → 0.3.0.0

raw patch · 16 files changed

+671/−715 lines, 16 filesdep +pipesdep +pipes-concurrencydep −directorydep −processdep −transformersPVP ok

version bump matches the API change (PVP)

Dependencies added: pipes, pipes-concurrency

Dependencies removed: directory, process, transformers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +0/−100
• README.md +0/−86
• app/Git/Fmt/Options.hs +118/−0
• app/Git/Fmt/Version.hs +20/−0
• app/Main.hs +102/−27
• git-fmt.cabal +19/−19
• src/Git/Fmt.hs +0/−166
• src/Git/Fmt/Config.hs +0/−103
• src/Git/Fmt/Exit.hs +0/−39
• src/Git/Fmt/Options/Applicative/Parser.hs +0/−84
• src/Git/Fmt/Process.hs +0/−71
• src/Git/Fmt/Version.hs +0/−20
• src/Omnifmt/Config.hs +137/−0
• src/Omnifmt/Exit.hs +43/−0
• src/Omnifmt/Pipes.hs +158/−0
• src/Omnifmt/Process.hs +74/−0

@@ -1,100 +0,0 @@-## Changelog--#### Upcoming--#### v0.2.2.1--*Revisions*--* Fixed a bug causing prettifying to fail across filesystem boundaries. ([#72](https://github.com/hjwylde/git-fmt/issues/72))--#### v0.2.2.0--*Minor*--* Added `--threads` option to change the number of threads for parallelisation. ([#54](https://github.com/hjwylde/git-fmt/issues/54))--*Revisions*--* Added quoting to the command variables during substitution. ([#59](https://github.com/hjwylde/git-fmt/issues/59))-* Changed parallelisation to use the number of capabilities (and processors) for the number of-  threads by default. ([#54](https://github.com/hjwylde/git-fmt/issues/54))--#### v0.2.1.2--*Revisions*--* Fixed a bug causing prettifying to fail across filesystem boundaries. ([#72](https://github.com/hjwylde/git-fmt/issues/72))--#### v0.2.1.1--*Revisions*--* Fixed a bug where passing arguments would only work when running in the git directory. ([#57](https://github.com/hjwylde/git-fmt/issues/57))--#### v0.2.1.0--*Minor*--* Added default use of stdin and stdout when variables not specified in a program command. ([#49](https://github.com/hjwylde/git-fmt/issues/49))--#### v0.2.0.2--*Revisions*--* Fixed a bug causing prettifying to fail across filesystem boundaries. ([#72](https://github.com/hjwylde/git-fmt/issues/72))--#### v0.2.0.1--*Revisions*--* Fixed a bug where passing arguments would only work when running in the git directory. ([#57](https://github.com/hjwylde/git-fmt/issues/57))--#### v0.2.0.0--*Major*--* Removed `--list-ugly` and `--dry-run` options. ([#29](https://github.com/hjwylde/git-fmt/issues/29))-* Restricted use of `--quiet` and `--verbose` at the same time. ([#35](https://github.com/hjwylde/git-fmt/issues/35))-* Updated project structure to delegate pretty printing to other binaries. ([#38](https://github.com/hjwylde/git-fmt/issues/38))-* Added a `.omniyaml.yaml` config file. ([#38](https://github.com/hjwylde/git-fmt/issues/38))--*Minor*--* Added `--mode` option (either `normal` or `dry-run`). ([#29](https://github.com/hjwylde/git-fmt/issues/29))-* Added `--null` option (use the null terminator as the delimiter for inputs). ([#27](https://github.com/hjwylde/git-fmt/issues/27))-* Added support for directories as arguments (directories include all files within recursively). ([#30](https://github.com/hjwylde/git-fmt/issues/30))-* Added parallelisation. ([#48](https://github.com/hjwylde/git-fmt/issues/48))--*Revisions*--* Added a warning for when files aren't found. ([#29](https://github.com/hjwylde/git-fmt/issues/29))-* Updated internal use of `git ls-files` to use the null terminator option. ([#27](https://github.com/hjwylde/git-fmt/issues/27))-* Fixed debug log messages to have timestamp and log level on all lines. ([#33](https://github.com/hjwylde/git-fmt/issues/33))-* Tidied up error messages from git. ([#40](https://github.com/hjwylde/git-fmt/issues/40))-* Tidied up error messages from parsing the config. ([#43](https://github.com/hjwylde/git-fmt/issues/43))--#### v0.1.0.3--*Revisions*--* Fixed a bug where passing arguments would only work when running in the git directory. ([#57](https://github.com/hjwylde/git-fmt/issues/57))--#### v0.1.0.2--*Revisions*--* Fixed a bug where UTF-8 characters in strings weren't printed properly. ([#26](https://github.com/hjwylde/git-fmt/issues/26))--#### v0.1.0.1--*Revisions*--* Fixed a bug where integers were printed as rationals. ([#25](https://github.com/hjwylde/git-fmt/issues/25))--#### v0.1.0.0--This is first release of the `git-fmt` binary!-It provides a basic syntax for formatting files in a git repository.-Currently only JSON is supported.-

@@ -1,86 +0,0 @@-# git-fmt--[![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)--(Side note: the formatting component of this project will eventually be split out and named omnifmt.)--`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.--Formatted code is:--* Easier to write: never worry about minor formatting concerns while hacking away.-* Easier to read: when all code looks the same you need not mentally convert others' formatting-  style into something you can understand.-* Easier to maintain: mechanical changes to the source don't cause unrelated changes to the file's-  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.)--### Installing--Installing `git-fmt` is easiest done using either-    [stack](https://github.com/commercialhaskell/stack) (recommended) or-    [Cabal](https://github.com/haskell/cabal).--**Using stack:**--```bash-stack install git-fmt-export PATH=$PATH:~/.local/bin-```--**Using Cabal:**--```bash-cabal-install git-fmt-export PATH=$PATH:~/.cabal/bin-```--### Usage--The `git-fmt` binary wraps external pretty-printers and provides an interface for selecting files-    to prettify and performing dry-runs.-Rather than repeating it here, have a read of `git fmt -h` for how to call it.--#### 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.-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.-

@@ -0,0 +1,118 @@++{-|+Module      : Git.Fmt.Options+Description : Optparse utilities.++Copyright   : (c) Henry J. Wylde, 2015+License     : BSD3+Maintainer  : public@hjwylde.com++Optparse utilities.+-}++module Git.Fmt.Options (+    -- * Options+    Options(..), Chatty(..), Mode(..), Reference,++    -- * Optparse+    gitFmtPrefs, gitFmtInfo, gitFmt,+) where++import Data.Char    (isDigit)+import Data.Version (showVersion)++import Options.Applicative+import Options.Applicative.Types (readerAsk)++import Git.Fmt.Version as This++-- | Options.+data Options = Options {+        optChatty           :: Chatty,+        optNull             :: Bool,+        optMode             :: Mode,+        optOperateOnTracked :: Bool,+        optOperateOn        :: Reference,+        optThreads          :: Maybe Int,+        argPaths            :: [FilePath]+    }+    deriving (Eq, Show)++-- | Chattyness level.+data Chatty = Default | Quiet | Verbose+    deriving (Eq, Show)++-- | Run mode.+data Mode = Normal | DryRun+    deriving (Eq, Show)++-- | Git reference.+type Reference = String++-- | The default preferences.+--   Limits the help output to 100 columns.+gitFmtPrefs :: ParserPrefs+gitFmtPrefs = prefs $ columns 100++-- | An optparse parser of a git-fmt command.+gitFmtInfo :: ParserInfo Options+gitFmtInfo = info (infoOptions <*> gitFmt) fullDesc+    where+        infoOptions = helper <*> version <*> numericVersion+        version = infoOption ("Version " ++ showVersion This.version) $ mconcat [+            long "version", short 'V', hidden,+            help "Show this binary's version"+            ]+        numericVersion = infoOption (showVersion This.version) $ mconcat [+            long "numeric-version", hidden,+            help "Show this binary's version (without the prefix)"+            ]++-- | An options parser.+gitFmt :: Parser Options+gitFmt = Options+    <$> (+        flag' Quiet (mconcat [+            long "quiet", short 'q', hidden,+            help "Be quiet"+            ])+        <|> flag Default Verbose (mconcat [+            long "verbose", short 'v', hidden,+            help "Be verbose"+            ])+        )+    <*> switch (mconcat [+        long "null", short '0',+        help "Input files are delimited by a null terminator instead of white space"+        ])+    <*> modeOption (mconcat [+        long "mode", short 'm', metavar "MODE",+        value Normal, showDefaultWith $ const "normal",+        help "Specify the mode as either `normal' or `dry-run'"+        ])+    <*> switch (mconcat [+        long "operate-on-tracked",+        help "Operate on all tracked files (i.e., `git ls-files')"+        ])+    <*> strOption (mconcat [+        long "operate-on", metavar "REF",+        value "head", showDefault,+        help "Operate on all files in the reference (i.e., `git diff REF --name-only')"+        ])+    <*> natOption (mconcat [+        long "threads", metavar "INT",+        value Nothing, showDefaultWith $ const "number of processors",+        help "Specify the number of threads to use"+        ])+    <*> many (strArgument $ mconcat [+        metavar "-- PATHS..."+        ])+    where+        natOption   = option $ readerAsk >>= \opt -> if all isDigit opt+            then return $ Just (read opt :: Int)+            else readerError $ "not a natural number `" ++ opt ++ "'"+        modeOption  = option $ readerAsk >>= \opt -> case opt of+            "normal"    -> return Normal+            "dry-run"   -> return DryRun+            _           -> readerError $ "unrecognised mode `" ++ opt ++ "'"+

@@ -0,0 +1,20 @@++{-|+Module      : Git.Fmt.Version+Description : Haskell constant of the binary version.++Copyright   : (c) Henry J. Wylde, 2015+License     : BSD3+Maintainer  : public@hjwylde.com++Haskell constant of the binary version.+-}++module Git.Fmt.Version (+    -- * Version+    -- | The binary version.+    version,+) where++import Paths_git_fmt (version)+

@@ -10,31 +10,49 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_HADDOCK hide, prune #-} -{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}  module Main (     main, ) where -import Control.Monad-import Control.Monad.Logger-import Control.Monad.Parallel (MonadParallel (..))+import           Control.Concurrent+import           Control.Monad.Catch    (MonadMask (..))+import           Control.Monad.Except+import           Control.Monad.Extra+import           Control.Monad.Logger+import           Control.Monad.Parallel (MonadParallel (..))+import qualified Control.Monad.Parallel as Parallel+import           Control.Monad.Reader -import           Data.List.Extra    (dropEnd, lower)-import           Data.Text          (Text)+import           Data.List.Extra    (dropEnd, linesBy, lower, (\\))+import           Data.Maybe         (fromJust, fromMaybe, isNothing) import qualified Data.Text          as T import qualified Data.Text.Encoding as T import qualified Data.Text.IO       as T import           Data.Time          (defaultTimeLocale, formatTime, getZonedTime)+import           Data.Tuple.Extra   (fst3) -import Git.Fmt-import Git.Fmt.Options.Applicative.Parser+import Git.Fmt.Options +import Omnifmt.Config  as Config+import Omnifmt.Exit+import Omnifmt.Pipes+import Omnifmt.Process+ import Options.Applicative -import Prelude hiding (filter, log)+import Pipes+import Pipes.Concurrent+import Prelude          hiding (filter, log) +import System.Directory.Extra+import System.Exit+import System.FilePath import System.IO+import System.IO.Temp import System.Log.FastLogger  instance MonadParallel m => MonadParallel (LoggingT m) where@@ -43,31 +61,88 @@             f' g a b = runLoggingT (f a b) g  main :: IO ()-main = customExecParser gitFmtPrefs gitFmtInfo >>= \options ->-    runLoggingT (filter options (handle options)) (if optChatty options == Verbose then verboseLog else log)+main = do+    options     <- customExecParser gitFmtPrefs gitFmtInfo+    let chatty  = optChatty options -filter :: Options -> LoggingT m a -> LoggingT m a-filter options = filterLogger (\_ level -> level >= minLevel)+    flip runLoggingT (log chatty) . filter chatty $ do+        checkGitRepository++        mFilePath <- Config.nearestConfigFile "."+        when (isNothing mFilePath) . panic_ $ Config.defaultFileName ++ ": not found"++        mConfig <- Config.readConfig $ fromJust mFilePath+        when (isNothing mConfig) . panic_ $ fromJust mFilePath ++ ": error"++        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+    filePaths <- runPanic $ liftM2 (\\) (initialFilePaths options) (providedFilePaths options)++    numThreads <- liftIO getNumCapabilities >>= \numCapabilities ->+        return $ fromMaybe numCapabilities (optThreads options)++    (output, input) <- liftIO $ spawn unbounded++    withSystemTempDirectory "git-fmt" $ \tmpDir -> do+        runEffect $ each (map (\filePath -> omnifmt filePath (tmpDir </> filePath)) filePaths) >-> toOutput output++        liftIO performGC++        Parallel.forM_ [1..numThreads] $ \_ ->+            runEffect (fromInput input >-> pipeline >-> runner (optMode options) >-> statusPrinter) >>+            liftIO performGC++providedFilePaths :: MonadIO m => Options -> m [FilePath]+providedFilePaths options = concatMapM expandDirectory $ concatMap splitter (argPaths options)     where-        minLevel = case optChatty options of-            Quiet   -> LevelError-            Default -> LevelInfo-            Verbose -> LevelDebug+        splitter = if optNull options then linesBy (== '\0') else (:[])+        expandDirectory path = ifM (liftIO $ doesDirectoryExist path) (liftIO $ listFilesRecursive path) (return [path]) -log :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()-log _ _ level msg = forM_ (T.lines . T.decodeUtf8 $ fromLogStr msg) (T.hPutStrLn h)+initialFilePaths :: (MonadError ExitCode m, MonadIO m, MonadLogger m) => Options -> m [FilePath]+initialFilePaths options+    | optOperateOnTracked options   = trackedFilePaths+    | otherwise                     = refFilePaths $ optOperateOn options++trackedFilePaths :: (MonadError ExitCode m, MonadIO m, MonadLogger m) => m [FilePath]+trackedFilePaths = linesBy (== '\0') <$> runProcess_ "git" ["ls-files", "-z"]++refFilePaths :: (MonadError ExitCode m, MonadIO m, MonadLogger m) => String -> m [FilePath]+refFilePaths ref = linesBy (== '\0') <$> 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     where-        h = if level == LevelError then stderr else stdout+        createPrettyFile = select [Unknown] $ \item@(_, _, prettyFilePath) -> do+            liftIO $ createDirectoryIfMissing True (takeDirectory prettyFilePath) -verboseLog :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()-verboseLog _ _ level msg = do+            return item++runner :: (MonadIO m, MonadLogger m) => Mode -> Pipe (Status, FilePath, FilePath) (Status, FilePath, FilePath) m ()+runner Normal = commit+runner DryRun = cat++filter :: Chatty -> LoggingT m a -> LoggingT m a+filter Quiet    = filterLogger (\_ level -> level >= LevelError)+filter Default  = filterLogger (\_ level -> level >= LevelInfo)+filter Verbose  = filterLogger (\_ level -> level >= LevelDebug)++log :: Chatty -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()+log chatty _ _ level msg = do     timestamp <- formatTime defaultTimeLocale "%F %T.%q" <$> getZonedTime      forM_ (T.lines . T.decodeUtf8 $ fromLogStr msg) $ \line ->-        T.hPutStrLn h (T.unwords [T.pack $ "[" ++ dropEnd 6 timestamp ++ "]", formatLevel level, line])+        T.hPutStrLn h $ if chatty == Verbose+            then T.unwords [T.pack $ "[" ++ dropEnd 6 timestamp ++ "]", formattedLevel, line]+            else line     where-        h = if level == LevelError then stderr else stdout--formatLevel :: LogLevel -> Text-formatLevel = T.take 6 . (`T.append` "  ") . T.drop 5 . T.pack . lower . show+        h               = if level == LevelError then stderr else stdout+        formattedLevel  = T.justifyLeft 6 ' ' . T.drop 5 . T.pack . lower $ show level 

@@ -1,5 +1,5 @@ name:           git-fmt-version:        0.2.2.1+version:        0.3.0.0  author:         Henry J. Wylde maintainer:     public@hjwylde.com@@ -17,8 +17,6 @@ category:       Development build-type:     Simple -extra-source-files: CHANGELOG.md README.md- source-repository head     type:       git     location:   git@github.com:hjwylde/git-fmt@@ -27,54 +25,56 @@     main-is:        Main.hs     hs-source-dirs: app/     ghc-options:    -threaded -with-rtsopts=-N+    other-modules:+        Git.Fmt.Options,+        Git.Fmt.Version,+        Paths_git_fmt      default-language: Haskell2010     other-extensions:+        FlexibleContexts+        MultiParamTypeClasses         OverloadedStrings     build-depends:         base == 4.8.*,+        exceptions == 0.8.*,         extra == 1.4.*,         fast-logger == 2.4.*,+        filepath == 1.4.*,         git-fmt,+        mtl == 2.2.*,         monad-logger == 0.3.*,         monad-parallel == 0.7.*,         optparse-applicative == 0.11.*,+        pipes == 4.1.*,+        pipes-concurrency == 2.0.*,+        temporary == 1.2.*,         text == 1.2.*,         time == 1.5.*  library     hs-source-dirs: src/     exposed-modules:-        Git.Fmt,-        Git.Fmt.Options.Applicative.Parser-    other-modules:-        Git.Fmt.Config,-        Git.Fmt.Exit,-        Git.Fmt.Process,-        Git.Fmt.Version,-        Paths_git_fmt+        Omnifmt.Config,+        Omnifmt.Exit,+        Omnifmt.Pipes,+        Omnifmt.Process      default-language: Haskell2010     other-extensions:         FlexibleContexts         MultiParamTypeClasses         OverloadedStrings-        TemplateHaskell+        TupleSections     build-depends:         aeson >= 0.8 && < 0.10,         base == 4.8.*,-        directory == 1.2.*,-        exceptions == 0.8.*,         extra == 1.4.*,         filepath == 1.4.*,         monad-logger == 0.3.*,-        monad-parallel == 0.7.*,         mtl == 2.2.*,-        optparse-applicative == 0.11.*,-        process == 1.2.*,-        temporary == 1.2.*,+        pipes == 4.1.*,         text == 1.2.*,-        transformers == 0.4.*,         unordered-containers == 0.2.*,         yaml == 0.8.* 

@@ -1,166 +0,0 @@--{-|-Module      : Git.Fmt-Description : Options and handler for the git-fmt command.--Copyright   : (c) Henry J. Wylde, 2015-License     : BSD3-Maintainer  : public@hjwylde.com--Options and handler for the git-fmt command.--}--{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell       #-}--module Git.Fmt (-    -- * Options-    Options(..), Chatty(..), Mode(..),--    -- * Handle-    handle,-) where--import           Control.Applicative-import           Control.Concurrent-import           Control.Monad.Catch    (MonadMask)-import           Control.Monad.Extra-import           Control.Monad.IO.Class-import           Control.Monad.Logger-import           Control.Monad.Parallel (MonadParallel)-import qualified Control.Monad.Parallel as Parallel-import           Control.Monad.Reader--import           Data.List.Extra   (chunksOf, linesBy, lower, nub)-import           Data.Maybe        (fromMaybe)-import qualified Data.Text         as T-import           Data.Yaml         (prettyPrintParseException)-import           Data.Yaml.Include (decodeFileEither)--import GHC.IO.Exception (IOErrorType (..))-import Git.Fmt.Config   as Config-import Git.Fmt.Exit-import Git.Fmt.Process--import Prelude hiding (read)--import System.Directory.Extra hiding (withCurrentDirectory)-import System.Exit-import System.FilePath-import System.IO.Error-import System.IO.Temp---- | Options.-data Options = Options {-        optChatty     :: Chatty,-        optNull       :: Bool,-        optNumThreads :: Maybe Int,-        optMode       :: Mode,-        argPaths      :: [FilePath]-    }-    deriving (Eq, Show)---- | Chattyness level.-data Chatty = Default | Quiet | Verbose-    deriving (Eq, Show)---- | Run mode.-data Mode = Normal | DryRun-    deriving (Eq, Show)---- | Builds the files according to the options.-handle :: (MonadIO m, MonadLogger m, MonadMask m, MonadParallel m) => Options -> m ()-handle options = do-    gitDir      <- findGitDirectory-    filePaths   <- fmap (nub . concat) $ paths gitDir >>= mapM-        (\path -> ifM (liftIO $ doesDirectoryExist path)-            (liftIO $ listFilesRecursive path)-            (return [path])-            )-    numThreads  <- liftIO getNumCapabilities >>= \numCapabilities ->-        return $ fromMaybe numCapabilities (optNumThreads options)--    unlessM (liftIO . doesFileExist $ gitDir </> Config.defaultFileName) $ panic (gitDir </> Config.defaultFileName ++ ": not found")--    config <- liftIO (decodeFileEither $ gitDir </> Config.defaultFileName) >>= \ethr -> case ethr of-        Left error      -> panic $ gitDir </> Config.defaultFileName ++ ": error\n" ++ prettyPrintParseException error-        Right config    -> return config--    let supportedFilePaths = filter (supported config . T.pack . drop 1 . lower . takeExtension) filePaths--    flip runReaderT config . withSystemTempDirectory "git-fmt" $ \tmpDir ->-        Parallel.sequence_ . map sequence . nChunks numThreads . flip map supportedFilePaths $ \filePath -> ifM (liftIO $ doesFileExist filePath)-            (fmt options filePath (tmpDir </> filePath))-            ($(logWarn) $ T.pack (filePath ++ ": not found"))-    where-        paths gitDir-            | null (argPaths options)   = linesBy (== '\0') <$> runProcess_ "git" ["ls-files", "-z", gitDir]-            | optNull options           = return $ concatMap (linesBy (== '\0')) (argPaths options)-            | otherwise                 = return $ argPaths options-        nChunks n xs = chunksOf (maximum [1, length xs `div` n]) xs--fmt :: (MonadIO m, MonadLogger m, MonadReader Config m) => Options -> FilePath -> FilePath -> m ()-fmt options filePath tmpFilePath = do-    config <- ask-    let program = unsafeProgramFor config (T.pack . drop 1 $ takeExtension filePath)--    (exitCode, _, stderr) <- runProgram program filePath tmpFilePath-    if exitCode == ExitSuccess-        then diff options filePath tmpFilePath-        else $(logWarn) (T.pack $ filePath ++ ": error") >>-             $(logDebug) (T.pack stderr)--diff :: (MonadIO m, MonadLogger m) => Options -> FilePath -> FilePath -> m ()-diff options filePath tmpFilePath = do-    (exitCode, _, stderr) <- runProcess "diff" [filePath, tmpFilePath]-    case exitCode of-        ExitSuccess     -> $(logDebug) $ T.pack (filePath ++ ": pretty")-        ExitFailure 1   -> action filePath tmpFilePath-        _               -> $(logWarn) $ T.pack stderr-    where-        action = case optMode options of-            Normal -> normal-            DryRun -> dryRun--normal :: (MonadIO m, MonadLogger m) => FilePath -> FilePath -> m ()-normal filePath tmpFilePath = do-    $(logInfo) $ T.pack (filePath ++ ": prettified")--    -- Try move the file, but if it's across a filesystem boundary then we may need to copy instead-    liftIO $ renameFile tmpFilePath filePath `catchIOError` \e ->-        if ioeGetErrorType e == UnsupportedOperation-            then copyFile tmpFilePath filePath >> removeFile tmpFilePath-            else ioError e--dryRun :: (MonadIO m, MonadLogger m) => FilePath -> FilePath -> m ()-dryRun filePath _ = $(logInfo) $ T.pack (filePath ++ ": ugly")--findGitDirectory :: (MonadIO m, MonadLogger m) => m String-findGitDirectory = do-    (exitCode, stdout, _) <- runProcess "git" ["rev-parse", "--show-toplevel"]--    if exitCode == ExitSuccess-        then return $ init stdout-        else panic ".git/: not found"--runProgram :: (MonadIO m, MonadLogger m) => Program -> FilePath -> FilePath -> m (ExitCode, String, String)-runProgram program filePath tmpFilePath = do-    liftIO $ createDirectoryIfMissing True (takeDirectory tmpFilePath)--    runCommand . T.unpack $ substitute (T.concat [command program, inputSuffix, outputSuffix]) [-        (inputVariableName, quote filePath),-        (outputVariableName, quote tmpFilePath)-        ]-    where-        inputSuffix-            | usesInputVariable (command program)   = T.empty-            | otherwise                             = T.pack " < " `T.append` inputVariableName-        outputSuffix-            | usesOutputVariable (command program)  = T.empty-            | otherwise                             = T.pack " > " `T.append` outputVariableName-        quote str   = T.pack $ '"':concatMap escape str ++ "\""-        escape '\\' = "\\\\"-        escape '"'  = "\\\""-        escape c    = [c]-

@@ -1,103 +0,0 @@--{-|-Module      : Git.Fmt.Config-Description : Configuration data structures.--Copyright   : (c) Henry J. Wylde, 2015-License     : BSD3-Maintainer  : public@hjwylde.com--Configuration data structures.--}--{-# LANGUAGE OverloadedStrings #-}--module Git.Fmt.Config (-    -- * Config-    Config(..),-    emptyConfig, programFor, unsafeProgramFor, supported,--    -- * Program-    Program(..),-    emptyProgram, substitute, usesInputVariable, usesOutputVariable, inputVariableName,-    outputVariableName,--    -- * Helper functions-    defaultFileName,-) where--import Data.Aeson.Types-import Data.HashMap.Lazy (toList)-import Data.List.Extra   (find)-import Data.Maybe        (fromJust, isJust)-import Data.Text         (Text, isInfixOf, replace)---- | A list of programs.-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---- | The empty config (no programs).-emptyConfig :: Config-emptyConfig = Config []---- | Attempts to find a program for the given extension.-programFor :: Config -> Text -> Maybe Program-programFor config ext = find (\program -> ext `elem` extensions program) (programs config)---- | Finds a program for the given extension or errors.-unsafeProgramFor :: Config -> Text -> Program-unsafeProgramFor config = fromJust . programFor config---- | Checks if the given extension is supported (e.g., there is a program for it).-supported :: Config -> Text -> Bool-supported config = isJust . programFor config---- | A program has a semantic name, associated extensions and command.---   The command string may contain variables to be replaced by surrounding them with '{{..}}'.-data Program = Program {-    name       :: Text,-    extensions :: [Text],-    command    :: Text-    }-    deriving (Eq, Show)--instance FromJSON Program where-    parseJSON (Object obj)  = Program "" <$> obj .: "extensions" <*> obj .: "command"-    parseJSON value         = typeMismatch "Program" value---- | The empty program (the command fails).-emptyProgram :: Program-emptyProgram = Program "" [] "false"---- | Substitutes the mapping throughout the command.-substitute :: Text -> [(Text, Text)] -> Text-substitute = foldr (uncurry replace)---- | Checks whether the text uses the input variable.-usesInputVariable :: Text -> Bool-usesInputVariable = isInfixOf inputVariableName---- | Checks whether the text uses the output variable.-usesOutputVariable :: Text -> Bool-usesOutputVariable = isInfixOf outputVariableName---- | The input variable name.-inputVariableName :: Text-inputVariableName = "{{input}}"---- | The output variable name.-outputVariableName :: Text-outputVariableName = "{{output}}"---- | The file name of the default config.-defaultFileName :: FilePath-defaultFileName = ".omnifmt.yaml"-

@@ -1,39 +0,0 @@--{-|-Module      : Git.Fmt.Exit-Description : Extra exit utilities.--Copyright   : (c) Henry J. Wylde, 2015-License     : BSD3-Maintainer  : public@hjwylde.com--Extra exit utilities.--}--{-# LANGUAGE TemplateHaskell #-}--module Git.Fmt.Exit (-    -- * Exiting-    panicWith, panic, exitFast,-) where--import Control.Monad.IO.Class-import Control.Monad.Logger--import Data.Text (pack)--import System.Exit---- | Panics, logging the error to stderr and exiting fast with the code.-panicWith :: (MonadIO m, MonadLogger m) => String -> Int -> m a-panicWith error code = $(logError) (pack error) >> exitFast code---- | Panics, logging the error to stderr and exiting fast with 128.-panic :: (MonadIO m, MonadLogger m) => String -> m a-panic error = panicWith error 128---- | Exits fast with the given code (may be 0 for success!).-exitFast :: (MonadIO m) => Int -> m a-exitFast 0 = liftIO exitSuccess-exitFast code = liftIO $ exitWith (ExitFailure code)-

@@ -1,84 +0,0 @@--{-|-Module      : Git.Fmt.Options.Applicative.Parser-Description : Optparse utilities for the git-fmt command.--Copyright   : (c) Henry J. Wylde, 2015-License     : BSD3-Maintainer  : public@hjwylde.com--Optparse utilities for the git-fmt command.--}--module Git.Fmt.Options.Applicative.Parser (-    -- * Optparse for GitFmt-    gitFmtPrefs, gitFmtInfo, gitFmt,-) where--import Data.Char    (isDigit)-import Data.Version (showVersion)--import Options.Applicative-import Options.Applicative.Types (readerAsk)--import Git.Fmt-import Git.Fmt.Version as This---- | The default preferences.---   Limits the help output to 100 columns.-gitFmtPrefs :: ParserPrefs-gitFmtPrefs = prefs $ columns 100---- | An optparse parser of a git-fmt command.-gitFmtInfo :: ParserInfo Options-gitFmtInfo = info (infoOptions <*> gitFmt) fullDesc-    where-        infoOptions = helper <*> version <*> numericVersion-        version = infoOption ("Version " ++ showVersion This.version) $ mconcat [-            long "version", short 'V', hidden,-            help "Show this binary's version"-            ]-        numericVersion = infoOption (showVersion This.version) $ mconcat [-            long "numeric-version", hidden,-            help "Show this binary's version (without the prefix)"-            ]---- | An options parser.-gitFmt :: Parser Options-gitFmt = Options-    <$> (-        flag' Quiet (mconcat [-            long "quiet", short 'q', hidden,-            help "Be quiet"-            ])-        <|> flag Default Verbose (mconcat [-            long "verbose", short 'v', hidden,-            help "Be verbose"-            ])-        )-    <*> switch (mconcat [-        long "null", short '0',-        help "Input files are delimited by a null terminator instead of white space"-        ])-    <*> natOption (mconcat [-        long "threads", metavar "INT",-        value Nothing, showDefaultWith $ const "number of processors",-        help "Specify the number of threads to use"-        ])-    <*> modeOption (mconcat [-        long "mode", short 'm', metavar "MODE",-        value Normal, showDefaultWith $ const "normal",-        help "Specify the mode as either `normal' or `dry-run'"-        ])-    <*> many (strArgument $ mconcat [-        metavar "-- PATHS..."-        ])-    where-        natOption   = option $ readerAsk >>= \opt -> if all isDigit opt-            then return $ Just (read opt :: Int)-            else readerError $ "not a natural number `" ++ opt ++ "'"-        modeOption  = option $ readerAsk >>= \opt -> case opt of-            "normal"    -> return Normal-            "dry-run"   -> return DryRun-            _           -> readerError $ "unrecognised mode `" ++ opt ++ "'"-

@@ -1,71 +0,0 @@--{-|-Module      : Git.Fmt.Process-Description : System process utilities.--Copyright   : (c) Henry J. Wylde, 2015-License     : BSD3-Maintainer  : public@hjwylde.com--System process utilities.--}--{-# LANGUAGE TemplateHaskell #-}--module Git.Fmt.Process (-    -- * Run-    runProcess, runProcess_, runCommand, runCommand_, runCreateProcess, runCreateProcess_,-) where--import Control.Monad.IO.Class-import Control.Monad.Logger--import Data.Text hiding (unwords)--import Git.Fmt.Exit--import           System.Exit-import           System.Process (CmdSpec (..), CreateProcess)-import qualified System.Process 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_ :: (MonadIO m, MonadLogger m) => FilePath -> [String] -> m String-runProcess_ cmd args = runCreateProcess_ (System.proc 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_ :: (MonadIO m, MonadLogger m) => String -> m String-runCommand_ cmd = runCreateProcess_ (System.shell 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-    $(logDebug) $ 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_ :: (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-

@@ -1,20 +0,0 @@--{-|-Module      : Git.Fmt.Version-Description : Haskell constant of the binary version.--Copyright   : (c) Henry J. Wylde, 2015-License     : BSD3-Maintainer  : public@hjwylde.com--Haskell constant of the binary version.--}--module Git.Fmt.Version (-    -- * Version-    -- | The binary version.-    version,-) where--import Paths_git_fmt (version)-

@@ -0,0 +1,137 @@++{-|+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.+--+--   TODO (hjw): fix the bug where it won't search the root directory.+nearestConfigFile :: MonadIO m => FilePath -> m (Maybe FilePath)+nearestConfigFile dir = findM (liftIO . doesFileExist) $ map (</> defaultFileName) parents+    where+        parents = takeWhile (\dir -> dir /= takeDrive dir) (iterate takeDirectory dir)++-- | 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}}"+

@@ -0,0 +1,43 @@++{-|+Module      : Omnifmt.Exit+Description : Extra exit utilities.++Copyright   : (c) Henry J. Wylde, 2015+License     : BSD3+Maintainer  : public@hjwylde.com++Extra exit utilities.+-}++{-# OPTIONS_HADDOCK hide #-}++{-# 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+

@@ -0,0 +1,158 @@++{-|+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,++    -- * Consumers+    statusPrinter,+) where++import Control.Monad.Except+import Control.Monad.Extra+import Control.Monad.Logger+import Control.Monad.Reader++import           Data.List.Extra  (lower)+import qualified Data.Text        as T+import           Data.Tuple.Extra (fst3)++import Omnifmt.Config+import Omnifmt.Process++import           Pipes+import qualified Pipes.Prelude as Pipes++import System.Directory.Extra+import System.Exit+import System.FilePath++-- | 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.+            | 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) <- runCommand . T.unpack $ substitute (T.concat [command program, inputSuffix program, outputSuffix program]) [+        (inputVariableName, T.pack uglyFilePath),+        (outputVariableName, T.pack prettyFilePath)+        ]++    if exitCode == ExitSuccess+        then return item+        else 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+    liftIO $ renameFile prettyFilePath uglyFilePath++    return (Prettified, uglyFilePath, prettyFilePath)++-- | Logs the status of each file.+--   'Unsupported', 'NotFound' and 'Pretty' are logged using 'logDebugN'.+--   'Ugly' and 'Prettified' are logged using 'logInfoN'.+--   'Unknown' and 'Error' are logged using 'logErrorN'.+statusPrinter :: MonadLogger m => Consumer (Status, FilePath, FilePath) m ()+statusPrinter = Pipes.mapM_ $ \(status, uglyFilePath, _) ->+    logFunction status (T.pack $ uglyFilePath ++ ": " ++ showStatus status)+    where+        logFunction Unknown     = logWarnN+        logFunction Unsupported = logDebugN+        logFunction NotFound    = logDebugN+        logFunction Error       = logWarnN+        logFunction Pretty      = logDebugN+        logFunction Ugly        = logInfoN+        logFunction Prettified  = logInfoN++        showStatus NotFound = "not found"+        showStatus status   = lower $ show status+

@@ -0,0 +1,74 @@++{-|+Module      : Omnifmt.Process+Description : System process utilities.++Copyright   : (c) Henry J. Wylde, 2015+License     : BSD3+Maintainer  : public@hjwylde.com++System process utilities.+-}++{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Omnifmt.Process (+    -- * Run+    runProcess, runProcess_, runCommand, runCommand_, 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 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 '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+