omnifmt (empty) → 0.1.0.0
raw patch · 12 files changed
+919/−0 lines, 12 filesdep +aesondep +basedep +exceptionssetup-changed
Dependencies added: aeson, base, exceptions, extra, fast-logger, filepath, monad-logger, monad-parallel, mtl, omnifmt, optparse-applicative, pipes, pipes-concurrency, temporary, text, time, unordered-containers, yaml
Files
- CHANGELOG.md +14/−0
- LICENSE +27/−0
- README.md +107/−0
- Setup.hs +2/−0
- app/Main.hs +141/−0
- app/Omnifmt/Options.hs +106/−0
- app/Omnifmt/Version.hs +20/−0
- omnifmt.cabal +81/−0
- src/Omnifmt/Config.hs +137/−0
- src/Omnifmt/Exit.hs +41/−0
- src/Omnifmt/Pipes.hs +158/−0
- src/Omnifmt/Process.hs +85/−0
+ CHANGELOG.md view
@@ -0,0 +1,14 @@+## Changelog++#### Upcoming++#### v0.1.0.0++*Major*+* Extracted omnifmt out from git@github.com:hjwylde/git-fmt. ([#1](https://github.com/hjwylde/omnifmt/issues/1))++*Revisions*+* Fixed a bug causing the program to hang when not in the root directory. ([#7](https://github.com/hjwylde/omnifmt/issues/7))+* Fixed a bug where output files could be created outside of the temp directory. ([#11](https://github.com/hjwylde/omnifmt/issues/11))+* Fixed a bug that omitted searching the drive for a config file. ([#8](https://github.com/hjwylde/omnifmt/issues/8))+
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2015, Henry J. Wylde+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++* Neither the name of omnifmt nor the names of its+ contributors may be used to endorse or promote products derived from+ this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,107 @@+# omnifmt++[](http://www.repostatus.org/#wip)+[](https://travis-ci.org/hjwylde/omnifmt)+[](https://github.com/hjwylde/omnifmt/releases/latest)+[](https://www.stackage.org/lts/package/omnifmt)+[](https://www.stackage.org/nightly/package/omnifmt)++A pretty-printer wrapper to faciliate ease of formatting during development.+omnifmt automatically formats code via external pretty-printers.+The idea was taken from gofmt, just with a bit of expansion to more languages.++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](https://blog.golang.org/go-fmt-your-code).)++### Installing++Installing omnifmt is easiest done using either+ [stack](https://github.com/commercialhaskell/stack) (recommended) or+ [Cabal](https://github.com/haskell/cabal).++**Using stack:**++```bash+stack install omnifmt+export PATH=$PATH:~/.local/bin+```++**Using Cabal:**++```bash+cabal-install omnifmt+export PATH=$PATH:~/.cabal/bin+```++### Usage++The omnifmt binary provides an interface for selecting files and piping them through external+ pretty-printers.+It supports both prettifying the files immediately and performing dry-runs to see which files are+ ugly.++**The basics:**++By default omnifmt formats on all files found from the root directory;+ the root directory is the first parent directory with an '.omnifmt.yaml' config file.++Passing arguments to omnifmt will override this and only operate on the given files and directories.++**Modes:**++omnifmt 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.++#### Configuration++Configuration is done via an '.omnifmt.yaml' file in the root directory.+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/omnifmt/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.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,141 @@++{-|+Module : Main++Copyright : (c) Henry J. Wylde, 2015+License : BSD3+Maintainer : public@hjwylde.com+-}++{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_HADDOCK hide, prune #-}++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}++module Main (+ main,+) where++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, linesBy, lower)+import Data.Maybe (fromJust, fromMaybe, isNothing)+import Data.Text (Text)+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 Omnifmt.Config as Config+import Omnifmt.Exit+import Omnifmt.Options hiding (omnifmt)+import Omnifmt.Pipes++import Options.Applicative++import Pipes+import Pipes.Concurrent+import qualified Pipes.Prelude as Pipes+import Prelude hiding (filter, log)++import System.Directory.Extra+import System.FilePath+import System.IO+import System.IO.Temp+import System.Log.FastLogger++instance MonadParallel m => MonadParallel (LoggingT m) where+ bindM2 f ma mb = LoggingT $ \g -> bindM2 (f' g) (runLoggingT ma g) (runLoggingT mb g)+ where+ f' g a b = runLoggingT (f a b) g++main :: IO ()+main = do+ options <- customExecParser omnifmtPrefs omnifmtInfo+ let chatty = if optMode options == Diff then Quiet else optChatty options++ flip runLoggingT (log $ optChatty options) . filter chatty $ do+ 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)++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 ask >>= expandDirectory . takeDirectory . fromJust . source+ else providedFilePaths options+ absFilePaths <- forM filePaths $ \filePath -> ifM (liftIO $ doesFileExist filePath)+ (liftIO $ canonicalizePath filePath) (return filePath)++ numThreads <- liftIO getNumCapabilities >>= \numCapabilities ->+ return $ fromMaybe numCapabilities (optThreads options)++ (output, input) <- liftIO $ spawn unbounded++ withSystemTempDirectory "omnifmt" $ \tmpDir -> do+ runEffect $ each (map (\filePath -> omnifmt (makeRelative rootDir filePath) (tmpDir </> dropDrive filePath)) absFilePaths) >-> toOutput output++ liftIO performGC++ Parallel.forM_ [1..numThreads] $ \_ ->+ runEffect (fromInput input >-> pipeline >-> runner (optMode options)) >>+ liftIO performGC++providedFilePaths :: MonadIO m => Options -> m [FilePath]+providedFilePaths options = concatMapM expandDirectory $ concatMap splitter (argPaths options)+ where+ splitter = if optNull options then linesBy (== '\0') else (:[])++expandDirectory :: MonadIO m => FilePath -> m [FilePath]+expandDirectory path = ifM (liftIO $ doesDirectoryExist path) (liftIO $ listFilesRecursive path) (return [path])++pipeline :: (MonadIO m, MonadLogger m, MonadReader Config m) => Pipe (Status, FilePath, FilePath) (Status, FilePath, FilePath) m ()+pipeline = checkFileSupported >-> checkFileExists >-> createPrettyFile >-> runProgram >-> checkFilePretty+ where+ createPrettyFile = select [Unknown] $ \item@(_, _, prettyFilePath) -> do+ liftIO $ createDirectoryIfMissing True (takeDirectory prettyFilePath)++ return item++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++logFunction :: MonadLogger m => Status -> Text -> m ()+logFunction status+ | status `elem` [Unknown, Error, Timeout] = logWarnN+ | status `elem` [Unsupported, NotFound, Pretty] = logDebugN+ | otherwise = logInfoN++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 $ if chatty == Verbose+ then T.unwords [T.pack $ "[" ++ dropEnd 6 timestamp ++ "]", formattedLevel, line]+ else line+ where+ h = if level == LevelError then stderr else stdout+ formattedLevel = T.justifyLeft 6 ' ' . T.drop 5 . T.pack . lower $ show level+
+ app/Omnifmt/Options.hs view
@@ -0,0 +1,106 @@++{-|+Module : Omnifmt.Options+Description : Optparse utilities.++Copyright : (c) Henry J. Wylde, 2015+License : BSD3+Maintainer : public@hjwylde.com++Optparse utilities.+-}++module Omnifmt.Options (+ -- * Options+ Options(..), Chatty(..), Mode(..),++ -- * Optparse+ omnifmtPrefs, omnifmtInfo, omnifmt,+) where++import Data.Char (isDigit)+import Data.Version (showVersion)++import Omnifmt.Version as This++import Options.Applicative+import Options.Applicative.Types (readerAsk)+++-- | Options.+data Options = Options {+ optChatty :: Chatty,+ optNull :: Bool,+ optMode :: Mode,+ optThreads :: Maybe Int,+ argPaths :: [FilePath]+ }+ deriving (Eq, Show)++-- | Chattyness level.+data Chatty = Default | Quiet | Verbose+ deriving (Eq, Show)++-- | Run mode.+data Mode = Normal | DryRun | Diff+ deriving (Eq, Show)++-- | The default preferences.+-- Limits the help output to 100 columns.+omnifmtPrefs :: ParserPrefs+omnifmtPrefs = prefs $ columns 100++-- | An optparse parser of a omnifmt command.+omnifmtInfo :: ParserInfo Options+omnifmtInfo = info (infoOptions <*> omnifmt) 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.+omnifmt :: Parser Options+omnifmt = 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', `dry-run' or `diff'"+ ])+ <*> 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+ "diff" -> return Diff+ _ -> readerError $ "unrecognised mode `" ++ opt ++ "'"+
+ app/Omnifmt/Version.hs view
@@ -0,0 +1,20 @@++{-|+Module : Omnifmt.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 Omnifmt.Version (+ -- * Version+ -- | The binary version.+ version,+) where++import Paths_omnifmt (version)+
+ omnifmt.cabal view
@@ -0,0 +1,81 @@+name: omnifmt+version: 0.1.0.0++author: Henry J. Wylde+maintainer: public@hjwylde.com+homepage: https://github.com/hjwylde/omnifmt++synopsis: A pretty-printer wrapper to faciliate ease of formatting during development.+description: omnifmt automatically formats code via external pretty-printers.+ The idea was taken from gofmt, just with a bit of expansion to more languages.++license: BSD3+license-file: LICENSE++cabal-version: >= 1.10+category: Development+build-type: Simple++extra-source-files: CHANGELOG.md README.md++source-repository head+ type: git+ location: git@github.com:hjwylde/omnifmt++executable omnifmt+ main-is: Main.hs+ hs-source-dirs: app/+ ghc-options: -threaded -with-rtsopts=-N+ other-modules:+ Omnifmt.Options,+ Omnifmt.Version,+ Paths_omnifmt++ default-language: Haskell2010+ other-extensions:+ FlexibleContexts+ MultiParamTypeClasses+ OverloadedStrings+ build-depends:+ base >= 4.8 && < 5,+ exceptions >= 0.8,+ extra >= 1.4,+ fast-logger >= 2.4,+ filepath >= 1.4,+ omnifmt,+ 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:+ 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 view
@@ -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.+-- Optionally may include a source attribute of the file the config was created from.+data Config = Config {+ source :: Maybe FilePath,+ programs :: [Program]+ }+ deriving (Eq, Show)++instance FromJSON Config where+ parseJSON (Object obj) = Config Nothing <$> mapM (\(key, value) ->+ parseJSON value >>= \program -> return program { name = key }+ ) (toList obj)+ parseJSON value = typeMismatch "Config" value++-- | An empty config (no source or programs).+emptyConfig :: Config+emptyConfig = Config Nothing []++-- | 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 { source = Just filePath }++-- | 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 view
@@ -0,0 +1,41 @@++{-|+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 view
@@ -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, 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 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.+ | 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+ liftIO $ renameFile prettyFilePath uglyFilePath++ 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 "diff" [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 view
@@ -0,0 +1,85 @@++{-|+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+