git-fmt 0.2.1.0 → 0.2.1.1
raw patch · 3 files changed
+13/−41 lines, 3 files
Files
- git-fmt.cabal +1/−2
- src/Git/Fmt.hs +12/−12
- src/System/Directory/Extra'.hs +0/−27
git-fmt.cabal view
@@ -1,5 +1,5 @@ name: git-fmt-version: 0.2.1.0+version: 0.2.1.1 author: Henry J. Wylde maintainer: public@hjwylde.com@@ -49,7 +49,6 @@ Git.Fmt.Process, Git.Fmt.Version, Paths_git_fmt,- System.Directory.Extra' System.IO.Extra' default-language: Haskell2010
src/Git/Fmt.hs view
@@ -39,8 +39,7 @@ import Prelude hiding (read) -import System.Directory.Extra hiding (withCurrentDirectory)-import System.Directory.Extra'+import System.Directory.Extra hiding (withCurrentDirectory) import System.Exit import System.FilePath import System.IO.Temp@@ -65,17 +64,18 @@ -- | Builds the files according to the options. handle :: (MonadIO m, MonadLogger m, MonadMask m, MonadParallel m) => Options -> m ()-handle options = findTopLevelGitDirectory >>= \dir -> withCurrentDirectory (init dir) $ do- filePaths <- fmap (nub . concat) $ paths >>= mapM+handle options = do+ gitDir <- findGitDirectory+ filePaths <- fmap (nub . concat) $ paths gitDir >>= mapM (\path -> ifM (liftIO $ doesDirectoryExist path) (liftIO $ listFilesRecursive path) (return [path]) ) - unlessM (liftIO $ doesFileExist Config.defaultFileName) $ panic (Config.defaultFileName ++ ": not found")+ unlessM (liftIO . doesFileExist $ gitDir </> Config.defaultFileName) $ panic (gitDir </> Config.defaultFileName ++ ": not found") - config <- liftIO (decodeFileEither Config.defaultFileName) >>= \ethr -> case ethr of- Left error -> panic $ Config.defaultFileName ++ ": error\n" ++ prettyPrintParseException error+ 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@@ -85,8 +85,8 @@ (fmt options filePath (tmpDir </> filePath)) ($(logWarn) $ T.pack (filePath ++ ": not found")) where- paths- | null (argPaths options) = linesBy (== '\0') <$> runProcess_ "git" ["ls-files", "-z"]+ 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@@ -123,12 +123,12 @@ dryRun :: (MonadIO m, MonadLogger m) => FilePath -> FilePath -> m () dryRun filePath _ = $(logInfo) $ T.pack (filePath ++ ": ugly") -findTopLevelGitDirectory :: (MonadIO m, MonadLogger m) => m String-findTopLevelGitDirectory = do+findGitDirectory :: (MonadIO m, MonadLogger m) => m String+findGitDirectory = do (exitCode, stdout, _) <- runProcess "git" ["rev-parse", "--show-toplevel"] if exitCode == ExitSuccess- then return stdout+ then return $ init stdout else panic ".git/: not found" runProgram :: (MonadIO m, MonadLogger m) => Program -> FilePath -> FilePath -> m (ExitCode, String, String)
− src/System/Directory/Extra'.hs
@@ -1,27 +0,0 @@--{-|-Module : System.Directory.Extra'-Description : Extra extra directory utilities.--Copyright : (c) Henry J. Wylde, 2015-License : BSD3-Maintainer : public@hjwylde.com--Extra extra directory utilities.--}--module System.Directory.Extra' (- -- * Changing directories- withCurrentDirectory,-) where--import Control.Monad.Catch (MonadMask, bracket)-import Control.Monad.IO.Class--import System.Directory---- | @withCurrentDirectory dir action@ performs @action@ with the current directory set to @dir@.--- The current directory is reset back to what it was afterwards.-withCurrentDirectory :: (MonadIO m, MonadMask m) => FilePath -> m a -> m a-withCurrentDirectory dir action = bracket (liftIO getCurrentDirectory) (liftIO . setCurrentDirectory) $ \_ -> liftIO (setCurrentDirectory dir) >> action-