git-vogue 0.2.1.1 → 0.2.2.1

raw patch · 16 files changed

+244/−48 lines, 16 filesdep +extradep ~basedep ~ghc-moddep ~hlintnew-component:exe:git-vogue-packunusedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: extra

Dependency ranges changed: base, ghc-mod, hlint, optparse-applicative, stylish-haskell

API changes (from Hackage documentation)

Files

• README.md +2/−2
• changelog.txt +6/−0
• git-vogue.cabal +36/−14
• lib/Git/Vogue.hs +8/−5
• lib/Git/Vogue/PluginCommon.hs +5/−7
• lib/Git/Vogue/PluginDiscoverer/Libexec.hs +8/−3
• lib/Git/Vogue/Types.hs +5/−0
• lib/Git/Vogue/VCS/Git.hs +2/−2
• lib/Git/Vogue/VCS/Null.hs +56/−0
• src/git-vogue-cabal.hs +5/−2
• src/git-vogue-ghc-mod.hs +7/−5
• src/git-vogue-hlint.hs +4/−2
• src/git-vogue-packunused.hs +61/−0
• src/git-vogue-stylish.hs +4/−2
• src/git-vogue.hs +25/−1
• tests/unit.hs +10/−3

@@ -1,7 +1,7 @@ git-vogue - A framework for pre-commit checks  ========================================================= -[![Travis Status](http://travis-ci.org/anchor/git-vogue.png?branch=master)](https://travis-ci.org/anchor/git-vogue)+[![Travis Status](http://travis-ci.org/christian-marie/git-vogue.png?branch=master)](https://travis-ci.org/christian-marie/git-vogue)  Intended to be used as a git pre-commit hook, *git-vogue* encourages developers to keep their Haskell code ["en vogue"][1] by providing a framework for@@ -12,7 +12,7 @@ * [cabal][6] * [hlint][2] * [stylish-haskell][4] with automatic fixing-* [ghc-mod][5]+* [ghc-mod][5] (not with ghc8 , yet)  [1]: https://www.youtube.com/watch?v=GuJQSAiODqI [2]: http://hackage.haskell.org/package/hlint

@@ -1,3 +1,9 @@+2017-08-14 v0.2.0.1 Christian Marie <christian@ponies.io>+	* dependencies: Bump ghc-mod, hlint and stylish-haskell to be inline+	                with latest stack-9.0 lts+        * plugins: ghc-mod will only work with >=5.8 now due CPP allergy+	* plugins: packunused plugin now vacuously succeeds if binary not found+ 2015-01-30 v0.2.0.1 Christian Marie <christian@ponies.io> 	* dependencies: Drop list-tries dependency 

@@ -1,22 +1,27 @@ name:                git-vogue-version:             0.2.1.1+version:             0.2.2.1 synopsis:            A framework for pre-commit checks. description:         Make your Haskell git repositories fashionable.-homepage:            https://github.com/oswynb/git-vogue+homepage:            https://github.com/christian-marie/git-vogue license:             BSD3 license-file:        LICENSE-author:              Anchor Engineering <engineering@anchor.com.au>-maintainer:          Oswyn Brent <oztastic703@gmail.com>-copyright:           (c) 2015 Anchor Systems, Pty Ltd and Others+author:              Anchor Engineering (defunct)+maintainer:          Christian Marie <christian@ponies.io>, Oswyn Brent <oztastic703@gmail.com>+copyright:           (c) 2017 Christian Marie, Anchor Systems, Pty Ltd and Others category:            Development build-type:          Custom extra-source-files:  README.md, changelog.txt-cabal-version:       >=1.10+cabal-version:       >=1.23 data-files:          templates/pre-commit +custom-setup+  setup-depends: base+               , filepath+               , Cabal+ source-repository HEAD   type: git-  location: https://github.com/oswynb/git-vogue+  location: https://github.com/christian-marie/git-vogue  flag gpl     default: True@@ -28,15 +33,17 @@   exposed-modules:     Git.Vogue                        Git.Vogue.Types                        Git.Vogue.VCS.Git+                       Git.Vogue.VCS.Null                        Git.Vogue.PluginDiscoverer.Libexec                        Git.Vogue.PluginCommon   other-modules:       Paths_git_vogue-  build-depends:       base >=4.6 && <5+  build-depends:       base >=4.8 && <5                      , containers                      , directory+                     , extra >= 1.4 && < 1.6                      , filepath                      , formatting-                     , optparse-applicative >= 0.11+                     , optparse-applicative >= 0.11 && < 0.14                      , process                      , split                      , text@@ -70,11 +77,19 @@                      , directory                      , git-vogue                      , haskell-src-exts-                     , hlint           >= 1.9.27 && < 1.10+                     , hlint           >= 2                      , hscolour   if !flag(gpl)         cpp-options: -DGPL_SCARES_ME +executable git-vogue-packunused+  default-language:    Haskell2010+  hs-source-dirs:      src+  main-is:             git-vogue-packunused.hs+  build-depends:       base+                     , git-vogue+                     , process+ executable git-vogue-stylish   default-language:    Haskell2010   hs-source-dirs:      src@@ -83,15 +98,22 @@                      , Diff                      , git-vogue                      , strict-                     , stylish-haskell >= 0.5.16 && < 0.6+                     , stylish-haskell >= 0.7 +Flag ghc-mod+  Description: build ghc-mod plugin+  Default: True+ executable git-vogue-ghc-mod+  if flag(ghc-mod)+    build-depends:       base+                       , ghc-mod         >= 5.8+                       , git-vogue+  else+    buildable: False   default-language:    Haskell2010   hs-source-dirs:      src   main-is:             git-vogue-ghc-mod.hs-  build-depends:       base-                     , ghc-mod         >= 5.2    && < 5.6-                     , git-vogue  test-suite unit   type:                exitcode-stdio-1.0

@@ -9,12 +9,10 @@  {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE LambdaCase            #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings     #-} {-# LANGUAGE RecordWildCards       #-} {-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE TupleSections         #-} {-# LANGUAGE TypeFamilies          #-}  module Git.Vogue where@@ -28,7 +26,7 @@ import qualified Data.Text.Lazy.IO      as T import           Data.Traversable       hiding (sequence) import           Formatting-import           Prelude                hiding (elem, maximum)+import           Prelude                hiding (elem, maximum, notElem) import           System.Directory import           System.Exit @@ -39,10 +37,13 @@     :: forall m. (Applicative m, MonadIO m, Functor m)     => VogueCommand     -> SearchMode+    -> [PluginName]+    -- ^ Disabled plugins     -> VCS m     -> PluginDiscoverer m     -> m ()-runCommand cmd search_mode VCS{..} PluginDiscoverer{..} = go cmd+runCommand cmd search_mode disabled_plugins VCS{..} PluginDiscoverer{..} =+    go cmd   where     cd = getTopLevel >>= liftIO . setCurrentDirectory     go CmdInit = do@@ -121,7 +122,9 @@         check_fs <- getFiles search_mode         when (null check_fs) (success "Vacuous success - Nothing to check") -        plugins <- filter enabled <$> discoverPlugins+        plugins <- filter ((`notElem` disabled_plugins) . pluginName)+                 . filter enabled+               <$> discoverPlugins         when (null check_fs) (success "Vacuous success - No plugins enabled")          all_fs <- getFiles FindAll

@@ -7,8 +7,6 @@ -- the 3-clause BSD licence. -- -{-# LANGUAGE TupleSections #-}- -- | Common helpers for git vogue plugins module Git.Vogue.PluginCommon (@@ -175,13 +173,13 @@ -- Helper for plugin commands that take [FilePath]s fpCommand     :: String-    -> ([FilePath] -> [FilePath] -> a)+    -> (FilePath -> FilePath -> a)     -> String     -> Mod CommandFields a fpCommand name ctor desc = command name (info parser (progDesc desc))   where-    parser = ctor <$> argument (lines <$> str) (metavar "CHECKABLE_FILES")-                  <*> argument (lines <$> str) (metavar "ALL_FILES")+    parser = ctor <$> argument str (metavar "CHECKABLE_FILES_LIST")+                  <*> argument str (metavar "ALL_FILES_LIST")  -- | Sub-command helper pureSubCommand :: String -> a -> String -> Mod CommandFields a@@ -199,9 +197,9 @@ -- | Arguments to the plugin data PluginCommand     -- | Check the project for problems.-    = CmdCheck [FilePath] [FilePath]+    = CmdCheck FilePath FilePath     -- | Fix problems in the project.-    | CmdFix [FilePath] [FilePath]+    | CmdFix FilePath FilePath     -- | Report details.     | CmdName 

@@ -26,6 +26,7 @@ import           Data.Text.Lazy         (Text) import qualified Data.Text.Lazy         as T import           Data.Traversable+import           Extra                  (withTempFile) import           System.Directory import           System.Environment import           System.Exit@@ -133,9 +134,13 @@     -> [FilePath]     -> m Result runPlugin plugin cmd check_fs all_fs = liftIO $ do-    (status, out, err) <- readProcessWithExitCode plugin [ cmd-                                                         , unlines check_fs-                                                         , unlines all_fs] ""+    (status, out, err) <- withTempFile (\checkFileListPath ->+        withTempFile (\allFileListPath -> do+          writeFile checkFileListPath (show check_fs)+          writeFile allFileListPath (show all_fs)+          readProcessWithExitCode plugin [cmd, checkFileListPath, allFileListPath] ""+        )+      )     let glommed = fromString $ out <> err     return $ case status of         ExitSuccess   -> Success glommed

@@ -24,7 +24,12 @@ data VogueOptions = Options     { optSearch  :: SearchMode     , optCommand :: VogueCommand+    , optDisable :: [PluginName]+    , optVCS     :: VCSType     }+  deriving (Eq, Show)++data VCSType = Git | Null   deriving (Eq, Show)  -- | Commands, with parameters, to be executed.

@@ -42,8 +42,8 @@     => SearchMode     -> m [FilePath] gitGetFiles mode = liftIO . existantFiles $-    case mode of FindChanged -> git ["diff", "--cached", "--name-only"]-                 FindAll     -> git ["ls-files"]+    case mode of FindChanged     -> git ["diff", "--cached", "--name-only"]+                 FindAll         -> git ["ls-files"]                  FindSpecific fs -> pure $ unlines fs   where     existantFiles f = lines <$> f >>= filterM doesFileExist

@@ -0,0 +1,56 @@+-- | Provide a VCS implementation for directories not under version control+module Git.Vogue.VCS.Null+( nullVCS,+) where++import           Control.Monad          (filterM)+import           Control.Monad.IO.Class+import           Git.Vogue.Types+import           System.Directory+import           System.FilePath++nullVCS :: MonadIO m => VCS m+nullVCS = VCS+  { getFiles    = nullGetFiles+  , installHook = nullInstallHook+  , removeHook  = nullRemoveHook+  , checkHook   = nullCheckHook+  , getTopLevel = nullGetTopLevel+  }++nullGetFiles :: MonadIO m => SearchMode -> m [FilePath]+nullGetFiles mode = case mode of+  FindSpecific fs -> existantFiles fs+  _               -> liftIO getAllFiles+  where+    existantFiles = filterM (liftIO . doesFileExist)++nullInstallHook :: MonadIO m => m ()+nullInstallHook =+  liftIO $ putStrLn "Warning, hooks can't be installed with the null VCS backend"++nullRemoveHook :: MonadIO m => m ()+nullRemoveHook =+  liftIO $ putStrLn "Warning, hooks can't be removed with the null VCS backend"++nullCheckHook :: Applicative m => m Bool+nullCheckHook = pure False++nullGetTopLevel :: MonadIO m => m FilePath+nullGetTopLevel = liftIO getCurrentDirectory++getAllFiles :: IO [FilePath]+getAllFiles = do+    currentDirectory <- getCurrentDirectory+    fs <- go currentDirectory+    pure (makeRelative currentDirectory <$> fs)+  where+    go dir = do+      (dirs, files) <- getFilesAndDirectories dir+      (files ++) . concat <$> mapM go dirs++getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])+getFilesAndDirectories dir = do+  c <- fmap (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir+  (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c+

@@ -33,7 +33,9 @@   where     f CmdName  = putStrLn "cabal" -    f (CmdCheck check_fs all_fs) = do+    f (CmdCheck check_fs_list all_fs_list) = do+        check_fs <- read <$> readFile check_fs_list+        all_fs <- read <$> readFile all_fs_list         -- Grab all the projects dirs we want to traverse through         rs <- forProjects (hsProjects check_fs all_fs) (const check)         unless (and rs) exitFailure@@ -71,8 +73,9 @@     let isDistError PackageDistSuspicious {} = False         isDistError _                        = True         errors = filter isDistError packageChecks-    unless (null errors) $+    unless (null errors) $ do         outputBad "Hackage would reject this package."+        printCheckMessages errors     when (null packageChecks) $         outputGood "Checked cabal file"     return (null packageChecks)

@@ -14,14 +14,14 @@ import           Control.Monad import           Data.Char import           Data.Foldable-import           Data.List                     hiding (and, notElem)+import           Data.List              hiding (and, notElem) import           Data.Maybe import           Data.Monoid import           Data.Traversable+import           GhcMod+import           GhcMod.Monad import           Git.Vogue.PluginCommon-import           Language.Haskell.GhcMod-import           Language.Haskell.GhcMod.Monad-import           Prelude                       hiding (and, notElem)+import           Prelude                hiding (and, notElem) import           System.Exit  main :: IO ()@@ -31,7 +31,9 @@             "git-vogue-ghc-mod - check for ghc-mod problems"   where     f CmdName  = putStrLn "ghc-mod"-    f (CmdCheck check_fs all_fs) = do+    f (CmdCheck check_fs_list all_fs_list) = do+        check_fs <- read <$> readFile check_fs_list+        all_fs <- read <$> readFile all_fs_list         -- Have to change to the project directory for each ghc-mod run or it         -- will be sad.         --

@@ -40,7 +40,9 @@             "git-vogue-hlint - check for hlint problems"   where     f CmdName  = putStrLn "hlint"-    f (CmdCheck check_fs all_fs) = do+    f (CmdCheck check_fs_list all_fs_list) = do+        check_fs <- read <$> readFile check_fs_list+        all_fs <- read <$> readFile all_fs_list         -- Traverse the files, parsing and processing as we go for efficiency         rs <- forProjects (hsProjects check_fs all_fs) $ \fs -> do             let hss = filter (isSuffixOf ".hs") fs@@ -119,5 +121,5 @@ showNotes :: [Note] -> String showNotes = intercalate ", " . fmap show . filter use     where use ValidInstance{} = False -- Not important enough to tell an end user-          use _ = True+          use _               = True 

@@ -0,0 +1,61 @@+--+-- Copyright © 2013-2015 Anchor Systems, Pty Ltd and Others+--+-- The code in this file, and the program it is a part of, is+-- made available to you by its authors as open source software:+-- you can redistribute it and/or modify it under the terms of+-- the 3-clause BSD licence.+--++{-# LANGUAGE ViewPatterns #-}++-- | Description: Check with "packunused".+module Main where++import           Control.Exception+import           Control.Monad          (unless)+import           Data.Foldable+import           Data.Monoid+import           Git.Vogue.PluginCommon+import           Prelude                hiding (and, mapM_)+import           System.Exit+import           System.IO.Error+import           System.Process++main :: IO ()+main = f =<< getPluginCommand+                "Check your Haskell project for redundant dependencies."+                "git-vogue-packunused - check for redundant dependencies"+  where+    f CmdName  = putStrLn "packunused"++    f (CmdCheck check_fs_list all_fs_list) = do+        check_fs <- read <$> readFile check_fs_list+        all_fs <- read <$> readFile all_fs_list+        -- Grab all the projects dirs we want to traverse through+        rs <- forProjects (hsProjects check_fs all_fs) (const check)+        unless (and rs) exitFailure++    f CmdFix{} = do+        outputBad $ "There are redundant dependencies, you need to fix these "+                <> "manually and then re-run check"+        exitFailure++-- | Runs the @packunused@ command, assuming that the build is current.+check :: IO Bool+check = do+    r <- try $ readProcessWithExitCode "packunused"+        [ "--ignore-empty-imports"+        , "--ignore-package", "base"+        ] ""+    case r of+        Right (ExitSuccess, _, _) -> do+            outputGood "No unused dependencies. "+            return True+        Right (ExitFailure e, sout, _serr) -> do+            outputBad sout+            return False+        Left (isDoesNotExistError -> True) -> do+            outputUnfortunate "Could not find packunused, vacuously succeeding."+            return True+        Left e -> throwIO e

@@ -34,7 +34,8 @@   where     hsFiles = filter (isSuffixOf ".hs")     f _ CmdName  = putStrLn "stylish"-    f cfg (CmdCheck files _) = do+    f cfg (CmdCheck check_fs_list _) = do+        files <- read <$> readFile check_fs_list         rs <- traverse (stylishCheckFile cfg) (hsFiles files)         if and rs             then do@@ -43,7 +44,8 @@             else                 exitFailure -    f cfg (CmdFix files _) = do+    f cfg (CmdFix check_fs_list _) = do+        files <- read <$> readFile check_fs_list         let files' = hsFiles files         -- Fix all of the things first         traverse_ (stylishRunFile cfg) files'

@@ -11,9 +11,12 @@  module Main where +import           Data.Monoid                        ((<>))+import           Data.String                        (fromString) import qualified Data.Text.Lazy                     as T import           Git.Vogue.PluginDiscoverer.Libexec import           Git.Vogue.VCS.Git+import           Git.Vogue.VCS.Null import           Options.Applicative  import           Git.Vogue@@ -27,6 +30,8 @@ optionsParser = flip Options     <$> commandParser     <*> searchP+    <*> many disableP+    <*> vcsP   where     searchP :: Parser SearchMode     searchP = fileList <|> allFlag@@ -34,9 +39,24 @@     allFlag = flag FindChanged FindAll         (  long "all"         <> short 'A'+        <> short 'a'         <> help "Apply to all files, not just changed files."         )+    vcsP :: Parser VCSType+    vcsP = flag Git Null+        (  long "nogit"+        <> help "Don't require a .git directory. Some functionality is disabled"+        ) ++    disableP :: Parser PluginName+    disableP = fromString <$> strOption+        (  long "disable"+        <> short 'd'+        <> help "Disable the plugin"+        <> metavar "PLUGIN_NAME"+        )+ commandParser :: Parser VogueCommand commandParser = subparser     (  pureSubCommand  "init"@@ -68,10 +88,14 @@ main :: IO () main = do   opt <- execParser opts+  let vcs = case optVCS opt of+              Git  -> gitVCS+              Null -> nullVCS   libexec_path <- getLibexecDir   runCommand (optCommand opt)              (optSearch opt)-             gitVCS+             (optDisable opt)+             vcs              (libExecDiscoverer libexec_path)   where     opts = info (helper <*> optionsParser)

@@ -18,6 +18,7 @@  import           Control.Applicative import           Control.Monad+import           Data.Foldable                      (traverse_) import           Data.Map                           (fromList) import           System.Directory import           System.FilePath@@ -142,8 +143,14 @@     withSystemTempDirectory "git-setup-test." $ \temp_dir -> do         -- For some unknown reason, setting the current directory appears to do         -- strange things with a bracket, so we don't bracket.+        canonical_dir <- canonicalizePath temp_dir         before_dir <- getCurrentDirectory-        void $ git ["init", temp_dir]-        setCurrentDirectory temp_dir-        f temp_dir+        let setup = [ ["init", canonical_dir]+                      , ["config", "--local", "user.email", "test"]+                      , ["config", "--local", "user.name", "test2"]+                    ] :: [[String]]++        setCurrentDirectory canonical_dir+        traverse_ git setup+        f canonical_dir         setCurrentDirectory before_dir