diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -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)) + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,107 @@ +# omnifmt + +[![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/omnifmt.svg?branch=master)](https://travis-ci.org/hjwylde/omnifmt) +[![Release](https://img.shields.io/github/release/hjwylde/omnifmt.svg)](https://github.com/hjwylde/omnifmt/releases/latest) +[![omnifmt on Stackage LTS](https://www.stackage.org/package/omnifmt/badge/lts)](https://www.stackage.org/lts/package/omnifmt) +[![omnifmt on Stackage Nightly](https://www.stackage.org/package/omnifmt/badge/nightly)](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. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -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 + diff --git a/app/Omnifmt/Options.hs b/app/Omnifmt/Options.hs new file mode 100644 --- /dev/null +++ b/app/Omnifmt/Options.hs @@ -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 ++ "'" + diff --git a/app/Omnifmt/Version.hs b/app/Omnifmt/Version.hs new file mode 100644 --- /dev/null +++ b/app/Omnifmt/Version.hs @@ -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) + diff --git a/omnifmt.cabal b/omnifmt.cabal new file mode 100644 --- /dev/null +++ b/omnifmt.cabal @@ -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 + diff --git a/src/Omnifmt/Config.hs b/src/Omnifmt/Config.hs new file mode 100644 --- /dev/null +++ b/src/Omnifmt/Config.hs @@ -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}}" + diff --git a/src/Omnifmt/Exit.hs b/src/Omnifmt/Exit.hs new file mode 100644 --- /dev/null +++ b/src/Omnifmt/Exit.hs @@ -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 + diff --git a/src/Omnifmt/Pipes.hs b/src/Omnifmt/Pipes.hs new file mode 100644 --- /dev/null +++ b/src/Omnifmt/Pipes.hs @@ -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 + diff --git a/src/Omnifmt/Process.hs b/src/Omnifmt/Process.hs new file mode 100644 --- /dev/null +++ b/src/Omnifmt/Process.hs @@ -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 +