module Git.Vogue.PluginDiscoverer.Libexec
(
libExecDiscoverer
) where
import Control.Applicative
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.String
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as T
import Data.Traversable
import System.Directory
import System.Environment
import System.Exit
import System.FilePath
import System.Process
import Git.Vogue.Types
import Git.Vogue.VCS.Git (git)
libExecDiscoverer :: (Functor m, Applicative m, MonadIO m)
=> FilePath
-> PluginDiscoverer m
libExecDiscoverer libexec_dir =
PluginDiscoverer (discover libexec_dir) disable enable
discover
:: (Functor m, Applicative m, MonadIO m)
=> FilePath
-> m [Plugin m]
discover libexec_dir = do
let libexec_plugins = libexec_dir </> "git-vogue"
is_dir <- liftIO $ doesDirectoryExist libexec_plugins
unless is_dir . liftIO .
putStrLn $ "Could not find libexec plugins: " <> libexec_plugins
<> "\nThis could be caused by installing with a buggy cabal, \
\see:\n\thttps://github.com/anchor/git-vogue/issues/80"
path <- fromMaybe "" <$> liftIO (lookupEnv "GIT_VOGUE_PATH")
let directories = splitOn ":" path <> [libexec_plugins]
disabled <- gitDisabled
ps <- (concat <$> traverse ls directories) >>= traverse (load disabled)
return $ sort ps
where
load :: (Functor m, MonadIO m) => [Text] -> FilePath -> m (Plugin m)
load disabled fp = do
is_x <- executable <$> liftIO (getPermissions fp)
if is_x
then do
name <- T.strip . T.pack <$> run fp "name"
if name `elem` disabled
then return $ disabledPlugin name
else return $ enabledPlugin fp name
else
return . disabledPlugin $ "(non-executable) " <> T.pack fp
run :: MonadIO m => FilePath -> String -> m String
run fp cmd = liftIO $ readProcess fp [cmd] ""
enabledPlugin :: MonadIO m => FilePath -> Text -> Plugin m
enabledPlugin fp name =
Plugin { pluginName = PluginName name
, enabled = True
, runCheck = runPlugin fp "check"
, runFix = runPlugin fp "fix"
}
disabledPlugin :: Text -> Plugin m
disabledPlugin txt =
Plugin { pluginName = PluginName txt
, enabled = False
, runCheck = error "disabled plugin ran check"
, runFix = error "disabled plugin ran fix"
}
ls :: (Functor m, MonadIO m) => FilePath -> m [FilePath]
ls p = do
exists <- liftIO $ doesDirectoryExist p
if exists
then (fmap . fmap) (p </>) (liftIO $ getDirectoryContents p)
>>= liftIO . filterM doesFileExist
else return []
runPlugin
:: MonadIO m
=> FilePath
-> String
-> [FilePath]
-> [FilePath]
-> m Result
runPlugin plugin cmd check_fs all_fs = liftIO $ do
(status, out, err) <- readProcessWithExitCode plugin [ cmd
, unlines check_fs
, unlines all_fs] ""
let glommed = fromString $ out <> err
return $ case status of
ExitSuccess -> Success glommed
ExitFailure 1 -> Failure glommed
ExitFailure n -> Catastrophe n glommed
gitDisabled
:: (Monad m, Functor m, MonadIO m)
=> m [Text]
gitDisabled = T.lines . T.pack <$> liftIO (readConfig `catch` none)
where
readConfig = git ["config", "--get-all", "vogue.disable"]
none (SomeException _) = return []
disable
:: (Functor m, MonadIO m)
=> PluginName
-> m ()
disable (PluginName name) =
void $ git ["config", "--add", "vogue.disable", T.unpack name]
enable
:: (Functor m, MonadIO m)
=> PluginName
-> m ()
enable (PluginName name) =
void $ git ["config", "--unset", "vogue.disable", T.unpack name]