miv 0.3.0 → 0.4.2
raw patch · 8 files changed
+153/−85 lines, 8 filesdep +filepathdep +unix-compatdep +xdg-basedir
Dependencies added: filepath, unix-compat, xdg-basedir
Files
- LICENSE +1/−1
- miv.cabal +8/−3
- src/Command.hs +0/−1
- src/Git.hs +3/−2
- src/Main.hs +109/−59
- src/Mapping.hs +0/−1
- src/Plugin.hs +3/−0
- src/VimScript.hs +29/−18
LICENSE view
@@ -1,6 +1,6 @@ The MIT License (MIT) -Copyright (c) 2014-2016 itchyny <https://github.com/itchyny>+Copyright (c) 2014-2019 itchyny <https://github.com/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
miv.cabal view
@@ -1,19 +1,20 @@ name: miv-version: 0.3.0+version: 0.4.2 author: itchyny <https://github.com/itchyny> maintainer: itchyny <https://github.com/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
src/Command.hs view
@@ -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)
src/Git.hs view
@@ -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 <> "'"
src/Main.hs view
@@ -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
src/Mapping.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} module Mapping where -import Data.Monoid ((<>)) import Data.Text (Text, unwords, null) import Prelude hiding (show, unwords, null)
src/Plugin.hs view
@@ -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 {..}
src/VimScript.hs view
@@ -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