diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,6 +1,6 @@ The MIT License (MIT) -Copyright (c) 2014-2016 itchyny +Copyright (c) 2014-2019 itchyny Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal diff --git a/miv.cabal b/miv.cabal --- a/miv.cabal +++ b/miv.cabal @@ -1,19 +1,20 @@ name: miv -version: 0.3.0 +version: 0.4.2 author: itchyny maintainer: itchyny license: MIT license-file: LICENSE category: Compiler build-type: Simple -cabal-version: >=1.8 -synopsis: Manage Vim plugins with command +cabal-version: >=1.10 +synopsis: Vim plugin manager written in Haskell description: The miv command is a cli tool to manage Vim plugins. executable miv hs-source-dirs: src main-is: Main.hs ghc-options: -threaded -Wall + default-language: Haskell2010 other-modules: Plugin , Setting , Mode @@ -37,11 +38,15 @@ , text , unordered-containers , monad-parallel + , filepath + , unix-compat + , xdg-basedir test-suite spec hs-source-dirs: test main-is: Spec.hs type: exitcode-stdio-1.0 + default-language: Haskell2010 build-depends: base >= 4.9 && < 5 , ghc-prim , process diff --git a/src/Command.hs b/src/Command.hs --- a/src/Command.hs +++ b/src/Command.hs @@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} module Command where -import Data.Monoid ((<>)) import qualified Data.Text as T import Data.Text (Text, unwords) import Prelude hiding (show, unwords) diff --git a/src/Git.hs b/src/Git.hs --- a/src/Git.hs +++ b/src/Git.hs @@ -9,7 +9,7 @@ ) where -import Data.Monoid ((<>)) +import Data.List (isPrefixOf) import System.Exit (ExitCode(..)) import System.Process (system, readProcess) @@ -32,7 +32,8 @@ gitStatus path = system $ unwords ["sh", "-c", "\"git", "-C", singleQuote path, "status", ">/dev/null 2>&1\""] gitUrl :: String -> String -gitUrl = ("https://github.com/" <>) +gitUrl xs | "https://" `isPrefixOf` xs = xs +gitUrl xs = "https://github.com/" <> xs singleQuote :: String -> String singleQuote str = "'" <> str <> "'" diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,14 +1,15 @@ {-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} module Main where +import Control.Applicative import Control.Concurrent (threadDelay, newEmptyMVar, forkIO, putMVar, takeMVar) import Control.Concurrent.Async import Control.Exception import Control.Monad (filterM, forM_, unless, void, when, guard) import qualified Control.Monad.Parallel as P -import Data.List ((\\), foldl', isPrefixOf, nub, transpose, unfoldr) +import Data.Functor ((<&>)) +import Data.List (foldl', isPrefixOf, nub, sort, transpose, unfoldr, (\\)) import Data.Maybe (listToMaybe, fromMaybe, isNothing) -import Data.Monoid ((<>)) import Data.Text (Text, unlines, pack, unpack) import qualified Data.Text as T import Data.Text.IO (putStrLn, putStr, writeFile, hGetContents) @@ -21,10 +22,12 @@ import System.Console.Regions import System.Directory import System.Environment (getArgs) +import System.Environment.XDG.BaseDir (getUserConfigFile, getUserDataDir) import System.Exit (ExitCode(..)) -import System.Info (os) -import System.IO (openFile, IOMode(..), hClose, hFlush, stdout, hGetLine) +import System.FilePath (()) +import System.IO (openFile, IOMode(..), hClose, hFlush, stdout, stderr, hGetLine, hPutStrLn) import System.IO.Error (isDoesNotExistError, tryIOError, isEOFError) +import System.PosixCompat.Files (setFileTimes) import System.Process import Git @@ -32,47 +35,62 @@ import Plugin import Setting import ShowText -import VimScript +import VimScript hiding (singleQuote) nameversion :: Text nameversion = "miv " <> pack (showVersion version) expandHomeDirectory :: FilePath -> IO FilePath -expandHomeDirectory ('~':path) = (<>path) <$> getHomeDirectory +expandHomeDirectory ('~':'/':path) = getHomeDirectory <&> ( path) expandHomeDirectory path = return path +getSettingFileCandidates :: IO [FilePath] +getSettingFileCandidates = do + xdgConfig <- getUserConfigFile "miv" "config.yaml" + mapM expandHomeDirectory + ([ xdgConfig + , "~/.vimrc.yaml" + , "~/.vim/.vimrc.yaml" + , "~/vimrc.yaml" + , "~/.vim/vimrc.yaml" + , "~/_vimrc.yaml" + , "~/.vim/_vimrc.yaml" + , "~/_vim/_vimrc.yaml" + , "~/vimfiles/.vimrc.yaml" + , "~/vimfiles/vimrc.yaml" + , "~/vimfiles/_vimrc.yaml" + ]) + +getFirstExistingFile :: IO [FilePath] -> IO (Maybe FilePath) +getFirstExistingFile fs = fmap listToMaybe $ filterM doesFileExist =<< fs + getSettingFile :: IO (Maybe FilePath) -getSettingFile - = fmap listToMaybe $ filterM doesFileExist =<< mapM expandHomeDirectory - [ "~/.vimrc.yaml" - , "~/.vim/.vimrc.yaml" - , "~/vimrc.yaml" - , "~/.vim/vimrc.yaml" - , "~/_vimrc.yaml" - , "~/.vim/_vimrc.yaml" - , "~/_vim/_vimrc.yaml" - , "~/vimfiles/.vimrc.yaml" - , "~/vimfiles/vimrc.yaml" - , "~/vimfiles/_vimrc.yaml" - ] +getSettingFile = getFirstExistingFile $ getSettingFileCandidates getSetting :: IO Setting getSetting = do - maybeFile <- getSettingFile + candidates <- getSettingFileCandidates + maybeFile <- getFirstExistingFile $ return candidates case maybeFile of Just file -> do maybeSetting <- decodeFileEither file case maybeSetting of Right setting -> return setting Left err -> error $ prettyPrintParseException err - Nothing -> error "No setting file: ~/.vimrc.yaml" + Nothing -> error $ unpack $ unlines $ + "No setting file! Tried following locations:" : + map (\x -> " - " <> pack x) candidates pluginDirectory :: IO FilePath pluginDirectory = do - dir <- expandHomeDirectory "~/.vim/miv/" - windir <- expandHomeDirectory "~/vimfiles/miv/" - exists <- doesDirectoryExist dir - return (if exists then dir else (if os `elem` ["windows", "mingw"] then windir else dir)) + defaultDir <- expandHomeDirectory "~/.vim/miv" + xdgDir <- getUserDataDir "miv" + x <- return xdgDir <||> doesDirectoryExist + y <- return defaultDir <||> doesDirectoryExist + z <- expandHomeDirectory "~/vimfiles/miv" <||> doesDirectoryExist + return $ fromMaybe defaultDir $ x <|> y <|> z + where (<||>) :: IO a -> (a -> IO Bool) -> IO (Maybe a) + (<||>) f g = f >>= \x -> g x >>= \b -> return $ if b then Just x else Nothing createPluginDirectory :: IO () createPluginDirectory = @@ -209,17 +227,17 @@ time <- maximum <$> mapM' (lastUpdatePlugin dir) ps status <- fmap mconcat <$> displayConsoleRegions $ mapConcurrently (fmap mconcat . mapM (\p -> updateOnePlugin time dir update (specified p) p)) $ - transpose $ takeWhile (not . null) $ unfoldr (Just . splitAt 6) ps + transpose $ takeWhile (not . null) $ unfoldr (Just . splitAt 16) ps putStrLn $ (if null (failed status) then "Success" else "Error occured") <> " in " <> show update <> "." unless (null (installed status)) $ do putStrLn $ "Installed plugin" <> count (installed status) <> ": " - mapM_ (putStrLn . (" "<>) . name) (reverse (installed status)) + mapM_ (putStrLn . (" "<>) . name) (sort (installed status)) unless (null (updated status)) $ do putStrLn $ "Updated plugin" <> count (updated status) <> ": " - mapM_ (putStrLn . (" "<>) . name) (reverse (updated status)) + mapM_ (putStrLn . (" "<>) . name) (sort (updated status)) unless (null (failed status)) $ do putStrLn $ "Failed plugin" <> count (failed status) <> ": " - mapM_ (putStrLn . (" "<>) . name) (reverse (failed status)) + mapM_ (putStrLn . (" "<>) . name) (sort (failed status)) generatePluginCode setting gatherFtdetectScript setting generateHelpTags setting @@ -229,31 +247,38 @@ cleanAndCreateDirectory :: FilePath -> IO () cleanAndCreateDirectory dir = do - createDirectoryIfMissing True dir - removeDirectoryRecursive dir + removeDirectoryIfExists dir createDirectoryIfMissing True dir +removeDirectoryIfExists :: FilePath -> IO () +removeDirectoryIfExists dir = do + exists <- doesDirectoryExist dir + when exists $ removeDirectoryRecursive dir + generateHelpTags :: Setting -> IO () generateHelpTags setting = do dir <- pluginDirectory - let docdir = dir <> "miv/doc/" + let docdir = dir "miv" "doc" cleanAndCreateDirectory docdir - P.forM_ (map (\p -> dir <> rtpName p <> "/doc/") (plugins setting)) $ \path -> do + P.forM_ (map (\p -> dir rtpName p "doc") (plugins setting)) $ \path -> do exists <- doesDirectoryExist path when exists $ - void $ system $ unwords ["sh", "-c", "\"cd", "'" <> path <> "'", "&& cp *", "'" <> docdir <> "'", "2>/dev/null\""] + void $ do (_, _, _, ph) <- createProcess (proc "sh" ["-c", "cp -R * " <> singleQuote docdir]) { + cwd = Just path + } + waitForProcess ph _ <- system $ "vim -u NONE -i NONE -N -e -s -c 'helptags " <> docdir <> "' -c quit" putStrLn "Success in processing helptags." lastUpdatePlugin :: FilePath -> Plugin -> IO Integer lastUpdatePlugin dir plugin = do - let path = dir <> rtpName plugin <> "/.git" + let path = dir rtpName plugin ".git" exists <- doesDirectoryExist path if exists then lastUpdate path else return 0 updateOnePlugin :: Integer -> FilePath -> Update -> Bool -> Plugin -> IO UpdateStatus updateOnePlugin time dir update specified plugin = do - let path = dir <> rtpName plugin + let path = dir rtpName plugin repo = vimScriptRepo (name plugin) cloneCommand = if submodule plugin then cloneSubmodule else clone pullCommand = if submodule plugin then pullSubmodule else pull @@ -265,8 +290,11 @@ then withConsoleRegion Linear $ \region -> do putStrLn' region "Installing" when exists $ removeDirectoryRecursive path - cloneStatus <- execCommand (unpack $ name plugin) region $ cloneCommand repo path + cloneStatus <- execCommand (unpack $ name plugin) region dir $ cloneCommand repo path created <- doesDirectoryExist path + when created $ do + buildPlugin path region + changeModifiedTime path =<< lastUpdate path if cloneStatus /= ExitSuccess || not created then return mempty { failed = [plugin] } else return mempty { installed = [plugin] } @@ -280,17 +308,34 @@ return mempty { outdated = [plugin] } else do putStrLn' region "Pulling" - pullStatus <- execCommand (unpack $ name plugin) region $ pullCommand path + pullStatus <- execCommand (unpack $ name plugin) region dir $ pullCommand path newUpdateTime <- lastUpdate path - return $ if pullStatus /= ExitSuccess - then mempty { failed = [plugin] } - else if newUpdateTime <= lastUpdateTime - then mempty - else mempty { updated = [plugin] } + if pullStatus /= ExitSuccess + then return $ mempty { failed = [plugin] } + else if newUpdateTime <= lastUpdateTime + then return mempty + else do + buildPlugin path region + changeModifiedTime path newUpdateTime + return mempty { updated = [plugin] } + where changeModifiedTime path mtime = + when (mtime > 0) $ let ctime = fromInteger mtime + in setFileTimes path ctime ctime + buildPlugin path region = do + let command = build plugin + when (not (T.null command)) $ + void $ execCommand (unpack $ name plugin) region path (unpack command) -execCommand :: String -> ConsoleRegion -> String -> IO ExitCode -execCommand pluginName region command = do - (_, Just hout, Just herr, ph) <- createProcess (proc "sh" ["-c", command]) { std_out = CreatePipe, std_err = CreatePipe } +singleQuote :: String -> String +singleQuote str = "'" <> str <> "'" + +execCommand :: String -> ConsoleRegion -> String -> String -> IO ExitCode +execCommand pluginName region dir command = do + (_, Just hout, Just herr, ph) <- createProcess (proc "sh" ["-c", command]) { + cwd = Just dir, + std_out = CreatePipe, + std_err = CreatePipe + } outmvar <- newEmptyMVar errmvar <- newEmptyMVar _ <- forkIO $ go herr errmvar "" @@ -328,7 +373,7 @@ createDirectoryIfMissing True dir cnt <- getDirectoryContents dir let paths = "." : ".." : "miv" : map (unpack . show) (plugins setting) - delpath' = [ dir <> d | d <- cnt, d `notElem` paths ] + delpath' = [ dir d | d <- cnt, d `notElem` paths ] deldir <- filterM doesDirectoryExist delpath' delfile <- filterM doesFileExist delpath' let delpath = deldir <> delfile @@ -346,7 +391,7 @@ saveScript :: (FilePath, Place, [Text]) -> IO () saveScript (dir, place, code) = do let relname = show place - path = dir <> unpack relname + path = dir unpack relname isAllAscii = all (T.all (<='~')) code body = "" : (if isAllAscii then [] else [ "scriptencoding utf-8", "" ]) <> [ "let s:save_cpo = &cpo" @@ -376,12 +421,14 @@ generatePluginCode :: Setting -> IO () generatePluginCode setting = do - dir <- fmap (<>"miv/") pluginDirectory + dir <- fmap ("miv") pluginDirectory createDirectoryIfMissing True dir -- TODO: remove unused directories and files - createDirectoryIfMissing True (dir <> "plugin/") - createDirectoryIfMissing True (dir <> "autoload/miv/") - createDirectoryIfMissing True (dir <> "ftplugin/") + createDirectoryIfMissing True (dir "plugin") + createDirectoryIfMissing True (dir "autoload" "miv") + createDirectoryIfMissing True (dir "ftplugin") + when (any (not . null . dependedby) (plugins setting)) $ + hPutStrLn stderr "`dependedby` is deprecated in favor of `loadafter`" P.mapM_ (saveScript . (\(t, s) -> (dir, t, s))) (vimScriptToList (gatherScript setting)) putStrLn "Success in generating Vim scripts of miv." @@ -389,14 +436,14 @@ gatherFtdetectScript :: Setting -> IO () gatherFtdetectScript setting = do dir <- pluginDirectory - cleanAndCreateDirectory (dir <> "miv/ftdetect/") + cleanAndCreateDirectory (dir "miv" "ftdetect") forM_ (plugins setting) $ \plugin -> do let path = rtpName plugin - exists <- doesDirectoryExist (dir <> path <> "/ftdetect") + exists <- doesDirectoryExist (dir path "ftdetect") when exists $ do - files <- (\\ [".", ".."]) <$> getDirectoryContents (dir <> path <> "/ftdetect") + files <- getDirectoryContents (dir path "ftdetect") <&> (\\ [".", ".."]) forM_ files $ \file -> - copyFile (dir <> path <> "/ftdetect/" <> file) (dir <> "miv/ftdetect/" <> file) + copyFile (dir path "ftdetect" file) (dir "miv" "ftdetect" file) putStrLn "Success in gathering ftdetect scripts." data EachStatus = EachStatus { failed' :: [Plugin] } @@ -418,11 +465,14 @@ eachOnePlugin :: String -> FilePath -> Plugin -> IO EachStatus eachOnePlugin command dir plugin = do - let path = dir <> rtpName plugin + let path = dir rtpName plugin exists <- doesDirectoryExist path if not exists then return mempty - else do exitCode <- system (unwords ["cd", "'" <> path <> "'", "&&", command]) + else do (_, _, _, ph) <- createProcess (proc "sh" ["-c", command]) { + cwd = Just path + } + exitCode <- waitForProcess ph case exitCode of ExitSuccess -> return mempty _ -> return $ mempty { failed' = [plugin] } @@ -434,7 +484,7 @@ pathPlugin plugins' setting = do let ps = filter (\p -> rtpName p `elem` plugins' || null plugins') (plugins setting) dir <- pluginDirectory - forM_ ps (\plugin -> putStrLn (pack dir <> show plugin)) + forM_ ps (\plugin -> putStrLn $ pack (dir unpack (show plugin))) mainProgram :: [String] -> IO () mainProgram [] = printUsage diff --git a/src/Mapping.hs b/src/Mapping.hs --- a/src/Mapping.hs +++ b/src/Mapping.hs @@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} module Mapping where -import Data.Monoid ((<>)) import Data.Text (Text, unwords, null) import Prelude hiding (show, unwords, null) diff --git a/src/Plugin.hs b/src/Plugin.hs --- a/src/Plugin.hs +++ b/src/Plugin.hs @@ -26,12 +26,14 @@ , dependedby :: [Text] , loadafter :: [Text] , loadbefore :: [Text] + , build :: Text , submodule :: Bool } deriving (Eq, Ord) instance ShowText Plugin where show plg = subst (name plg) where subst s | T.any (=='/') s = subst (T.tail $ T.dropWhile (/='/') s) + | ".git" `T.isSuffixOf` s = subst $ T.take (T.length s - 4) s | ".vim" `T.isSuffixOf` s = T.take (T.length s - 4) s | "-vim" `T.isSuffixOf` s = T.take (T.length s - 4) s | "vim-" `T.isPrefixOf` s = T.drop 4 s @@ -59,5 +61,6 @@ dependedby <- o .: "dependedby" <|> (fmap return <$> o .:? "dependedby") .!= [] loadafter <- o .: "loadafter" <|> (fmap return <$> o .:? "loadafter") .!= [] loadbefore <- o .: "loadbefore" <|> (fmap return <$> o .:? "loadbefore") .!= [] + build <- o .:? "build" .!= "" submodule <- o .:? "submodule" .!= False return Plugin {..} diff --git a/src/VimScript.hs b/src/VimScript.hs --- a/src/VimScript.hs +++ b/src/VimScript.hs @@ -2,11 +2,11 @@ module VimScript where import Data.Char (isAlpha, isAlphaNum, toLower) +import Data.Function (on) import Data.Hashable import qualified Data.HashMap.Lazy as HM -import Data.List (foldl') +import Data.List (foldl', groupBy, sort, sortBy, nub) import Data.Maybe (mapMaybe) -import Data.Monoid ((<>)) import Data.Text (Text, unwords, singleton) import qualified Data.Text as T import GHC.Generics (Generic) @@ -44,10 +44,6 @@ autoloadSubdirName (Autoload s) = Just s autoloadSubdirName _ = Nothing -isFtplugin :: Place -> Bool -isFtplugin (Ftplugin _) = True -isFtplugin _ = False - vimScriptToList :: VimScript -> [(Place, [Text])] vimScriptToList (VimScript x) = HM.toList x @@ -68,8 +64,8 @@ gatherScript setting = addAutoloadNames $ beforeScript setting <> gatherBeforeAfterScript plugins - <> gather "dependon" P.dependon plugins - <> gather "dependedby" P.dependedby plugins + <> gather' "dependon" P.dependon P.loadbefore plugins + <> gather' "dependedby" P.dependedby P.loadafter plugins <> gather "mappings" P.mappings plugins <> gather "mapmodes" P.mapmodes plugins <> gatherFuncUndefined setting @@ -118,9 +114,26 @@ [ "let s:" <> name <> " = {" ] <> [ " \\ " <> singleQuote (show p) <> ": [ " <> T.intercalate ", " (map singleQuote (f p)) <> " ]," - | p <- plg, not (null (f p)) ] + | p <- plg, enabled p, not (null (f p)) ] <> [ " \\ }" ]) + where enabled p = P.enable p /= "0" +gather' :: Text -> (P.Plugin -> [Text]) -> (P.Plugin -> [Text]) -> [P.Plugin] -> VimScript +gather' name f g plg + = VimScript (HM.singleton (Autoload "") $ + [ "let s:" <> name <> " = {" ] + <> [ " \\ " <> singleQuote p + <> ": [ " <> T.intercalate ", " (map singleQuote $ sort $ nub q) <> " ]," + | (p, q) <- collectSndByFst $ [ (show p, q) | p <- plg, enabled p, q <- f p ] + <> [ (q, show p) | p <- plg, enabled p, q <- g p ] ] + <> [ " \\ }" ]) + where enabled p = P.enable p /= "0" + +collectSndByFst :: Ord a => [(a,b)] -> [(a,[b])] +collectSndByFst xs = [ (fst (ys !! 0), map snd ys) + | ys <- groupBy ((==) `on` fst) $ sortBy (compare `on'` fst) xs ] + where on' f g x y = g x `f` g y + pluginConfig :: P.Plugin -> VimScript pluginConfig plg = VimScript (HM.singleton Plugin $ wrapInfo $ @@ -187,13 +200,13 @@ : " setl ft=" : concat [wrapEnable b [ " call miv#load(" <> singleQuote (show b) <> ")"] | b <- plg] - <> [ " autocmd! MivFileTypeLoad" <> ft + <> [ " autocmd! miv-file-type-" <> ft , " setl ft=" <> ft , " silent! doautocmd FileType " <> ft , "endfunction" ])) <> VimScript (HM.singleton Plugin - [ "augroup MivFileTypeLoad" <> ft + [ "augroup miv-file-type-" <> ft , " autocmd!" , " autocmd FileType " <> ft <> " call " <> funcname <> "()" , "augroup END" @@ -213,15 +226,14 @@ f plgs = "\" InsertEnter" : "function! s:insertEnter() abort" : [ " call miv#load(" <> singleQuote (show p) <> ")" | p <- plgs :: [P.Plugin] ] - <> [ " autocmd! MivInsertEnter" + <> [ " autocmd! miv-insert-enter" , " silent! doautocmd InsertEnter" , "endfunction" , "" - , "augroup MivInsertEnter" + , "augroup miv-insert-enter" , " autocmd!" , " autocmd InsertEnter * call s:insertEnter()" - , "augroup END" - , "" ] + , "augroup END" ] gatherFuncUndefined :: S.Setting -> VimScript gatherFuncUndefined setting @@ -236,11 +248,10 @@ , " endif" ] | (p, q) <- concatMap (\q -> map ((,) q) (P.functions q)) plgs] <> [ "endfunction" , "" - , "augroup MivFuncUndefined" + , "augroup miv-func-undefined" , " autocmd!" , " autocmd FuncUndefined * call s:funcUndefined()" - , "augroup END" - , "" ] + , "augroup END" ] wrapEnable :: P.Plugin -> [Text] -> [Text] wrapEnable plg str