{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Git.Vogue where
import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class
import Data.Foldable
import Data.Maybe
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy.IO as T
import Data.Traversable
import Formatting
import Prelude hiding (elem, maximum, notElem)
import System.Directory
import System.Exit
import Git.Vogue.Types
runCommand
:: forall m. (Applicative m, MonadIO m, Functor m)
=> VogueCommand
-> SearchMode
-> [PluginName]
-> VCS m
-> PluginDiscoverer m
-> m ()
runCommand cmd search_mode disabled_plugins VCS{..} PluginDiscoverer{..} =
go cmd
where
cd = getTopLevel >>= liftIO . setCurrentDirectory
go CmdInit = do
cd
already_there <- checkHook
if already_there
then success "Pre-commit hook is already installed"
else do
installHook
installed <- checkHook
if installed
then success "Successfully installed hook"
else failure "Hook failed to install"
go CmdVerify = do
cd
installed <- checkHook
if installed
then success "Pre-commit hook currently installed"
else failure "Pre-commit hook not installed"
go CmdPlugins = do
liftIO $ T.putStrLn "git-vogue knows about the following plugins:\n"
discoverPlugins >>= liftIO . traverse_ print
go (CmdDisable plugin) = do
plugins <- discoverPlugins
if plugin `elem` fmap pluginName (filter (not . enabled) plugins)
then success "Plugin already disabled"
else
if plugin `elem` fmap pluginName plugins
then do
disablePlugin plugin
success "Disabled plugin"
else
failure "Unknown plugin"
go (CmdEnable plugin) = do
ps <- discoverPlugins
if plugin `elem` fmap pluginName ps
then
if plugin `elem` (pluginName <$> filter (not . enabled) ps)
then do
enablePlugin plugin
success "Enabled plugin"
else
success "Plugin already enabled"
else
failure "Unknown plugin"
go CmdRunCheck = do
(check_fs, all_fs, plugins) <- things
rs <- for plugins $ \p -> do
r <- runCheck p check_fs all_fs
liftIO . T.putStrLn $ colorize p r
return r
exitWithWorst rs
go CmdRunFix = do
(check_fs, all_fs, plugins) <- things
rs <- for plugins $ \p -> do
r <- runCheck p check_fs all_fs
case r of
Failure{} -> do
r' <- runFix p check_fs all_fs
liftIO . T.putStrLn $ colorize p r'
return $ Just r'
_ -> return Nothing
exitWithWorst (catMaybes rs)
things = do
cd
check_fs <- getFiles search_mode
when (null check_fs) (success "Vacuous success - Nothing to check")
plugins <- filter ((`notElem` disabled_plugins) . pluginName)
. filter enabled
<$> discoverPlugins
when (null check_fs) (success "Vacuous success - No plugins enabled")
all_fs <- getFiles FindAll
return (check_fs, all_fs, plugins)
success, failure :: MonadIO m => Text -> m a
success msg = liftIO (T.putStrLn msg >> exitSuccess)
failure msg = liftIO (T.putStrLn msg >> exitFailure)
exitWithWorst
:: MonadIO m
=> [Result]
-> m ()
exitWithWorst [] = liftIO exitSuccess
exitWithWorst rs = liftIO $
case maximum rs of
Success{} -> exitSuccess
Failure{} -> exitWith $ ExitFailure 1
Catastrophe{} -> exitWith $ ExitFailure 2
colorize
:: Plugin a
-> Result
-> Text
colorize Plugin{..} (Success txt) =
format ("\x1b[32m"
% text
% " succeeded\x1b[0m with:\n"
% text) (unPluginName pluginName) txt
colorize Plugin{..} (Failure txt) =
format ("\x1b[31m"
% text
% " failed\x1b[0m with:\n"
% text) (unPluginName pluginName) txt
colorize Plugin{..} (Catastrophe txt ret) =
format ("\x1b[31m"
% text
% " exploded \x1b[0m with exit code "
% int
%":\n"
% text) (unPluginName pluginName) txt ret