miv 0.4.8 → 0.4.9
raw patch · 14 files changed
+743/−526 lines, 14 filesdep +MissingHdep +data-defaultdep +extradep −ghc-primdep −unordered-containersdep ~HsYAMLdep ~SafeSemaphoredep ~async
Dependencies added: MissingH, data-default, extra, text-builder-linear, text-display
Dependencies removed: ghc-prim, unordered-containers
Dependency ranges changed: HsYAML, SafeSemaphore, async, base, bytestring, concurrent-output, containers, directory, filepath, filepattern, monad-parallel, process, text, time, unix-compat, xdg-basedir
Files
- LICENSE +1/−1
- README.md +253/−0
- _miv +26/−0
- miv.cabal +56/−51
- src/Cmdline.hs +8/−9
- src/Command.hs +60/−92
- src/Git.hs +1/−1
- src/Main.hs +142/−144
- src/Mapping.hs +28/−40
- src/Mode.hs +13/−13
- src/Plugin.hs +28/−27
- src/Setting.hs +11/−14
- src/ShowText.hs +0/−10
- src/VimScript.hs +116/−124
LICENSE view
@@ -1,6 +1,6 @@ The MIT License (MIT) -Copyright (c) 2014-2021 itchyny <https://github.com/itchyny>+Copyright (c) 2014-2025 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
+ README.md view
@@ -0,0 +1,253 @@+# miv+[](https://github.com/itchyny/miv/actions?query=branch:main)+[](https://hackage.haskell.org/package/miv)+[](https://github.com/itchyny/miv/releases)+[](https://github.com/itchyny/miv/blob/main/LICENSE)++### Vim plugin manager written in Haskell+The `miv` is a command line tool for managing Vim plugins with a single YAML+configuration file. The motivation of this tool is++- to generate a Vim plugin loader files in Vim script+ - A plugin manager written in Vim script build script code and evaluates it+ on editor startup. But the executed commands do not change unless the+ user's configurations do not change. Instead of building the commands on+ editor startup, `miv` generates static plugin loader scripts after plugin+ installation.+- to provide a declarative way to manage Vim plugins+ - Various loading triggers, script configurations and loading dependency can+ be defined.+- to provide a command line tool which is friendly to interact with other tools+ - You can easily update the Vim plugins in cron schedule or from shell script.++## Installation+### Homebrew+```sh+brew install itchyny/tap/miv+```++### Build with stack+```sh+stack install miv+```++## User guide+1. Add the miv plugin path to `runtimepath` in your `.vimrc`.+2. Create miv configuration file at `~/.vimrc.yaml`. (or `~/.vim/.vimrc.yaml`, `$XDG_CONFIG_HOME/miv/config.yaml`)+3. Execute `miv install`.++Example vimrc:+```vim+filetype off+if has('vim_starting')+ set rtp^=~/.vim/miv/miv+ " or when you set $XDG_DATA_HOME,+ " set rtp^=$XDG_DATA_HOME/miv/miv+endif+filetype plugin indent on+```++Example miv configuration file (refer to [.vimrc.yaml](https://github.com/itchyny/dotfiles/blob/main/.vimrc.yaml) for how the author configures):+```yaml+plugin:++ Align:+ command: Align++ itchyny/lightline.vim:+ before: |+ let g:lightline = {+ \ 'colorscheme': 'wombat',+ \ }++ itchyny/calendar.vim:+ mapleader: ","+ command: Calendar+ mapping: <Plug>(calendar)+ script: |+ nmap <Leader>z <Plug>(calendar)+ before: |+ let g:calendar_views = [ 'year', 'month', 'day_3', 'clock' ]++ prabirshrestha/vim-lsp:+ before: |+ let g:lsp_async_completion = 1+ let g:lsp_text_edit_enabled = 0+ let g:lsp_signs_enabled = 0+ augroup lsp_install+ autocmd!+ autocmd User lsp_buffer_enabled setlocal omnifunc=lsp#complete+ augroup END++ prabirshrestha/asyncomplete.vim: {}++ prabirshrestha/asyncomplete-lsp.vim:+ dependon: asyncomplete++ prabirshrestha/asyncomplete-buffer.vim:+ dependon: asyncomplete+ after: |+ call asyncomplete#register_source(asyncomplete#sources#buffer#get_source_options({+ \ 'name': 'buffer',+ \ 'whitelist': ['*'],+ \ 'completor': function('asyncomplete#sources#buffer#completor'),+ \ 'config': {+ \ 'max_buffer_size': 100000,+ \ },+ \ }))++ prabirshrestha/asyncomplete-file.vim:+ dependon: asyncomplete+ after: |+ call asyncomplete#register_source(asyncomplete#sources#file#get_source_options({+ \ 'name': 'file',+ \ 'whitelist': ['*'],+ \ 'completor': function('asyncomplete#sources#file#completor'),+ \ }))++ mattn/vim-lsp-settings:+ dependon: lsp++ mattn/emmet-vim:+ filetype:+ - html+ - css+ before: |+ let g:user_emmet_settings = { 'indentation' : ' ' }+ after: |+ autocmd FileType html,css imap <buffer> <tab> <plug>(emmet-expand-abbr)++ elzr/vim-json:+ filetype: json++ cespare/vim-toml:+ filetype: toml++ groenewege/vim-less:+ filetype: less++ tpope/vim-haml:+ filetype: haml++ jade.vim:+ filetype: jade++ kana/vim-textobj-user: {}++ kana/vim-textobj-entire:+ dependon: textobj-user+ mapmode:+ - o+ - v+ mapping:+ - <Plug>(textobj-entire-a)+ - <Plug>(textobj-entire-i)+ - ie+ - ae++ kana/vim-textobj-line:+ dependon: textobj-user+ mapmode:+ - o+ - v+ mapping:+ - <Plug>(textobj-line-a)+ - <Plug>(textobj-line-i)+ - il+ - al++before: |+ let g:is_bash = 1+ let g:loaded_2html_plugin = 1+ let g:loaded_rrhelper = 1++after: |+ let g:mapleader = ','++filetype:+ vim: |+ setlocal foldmethod=marker+ css: |+ setlocal iskeyword=37,45,48-57,95,a-z,A-Z,192-255+ make: |+ setlocal noexpandtab+ sh: |+ setlocal iskeyword=36,45,48-57,64,95,a-z,A-Z,192-255+```++## `miv` subcommands+The `miv` command has the following subcommands.++|command|description|+|:--|:--|+|`install`|Installs all the plugins.|+|`update`|Updates the plugins (outdated plugins are skipped).|+|`update!`|Updates all the plugins.|+|`update [plugins]`|Updates the specified plugins.|+|`clean`|Removes unused directories and files.|+|`generate`|Generates the miv plugin files. (`miv install` and `miv update` automatically do this task)|+|`ftdetect`|Gather ftdetect scripts. (`miv install` and `miv update` automatically do this task)|+|`helptags`|Generates the helptags file. (`miv install` and `miv update` automatically do this task)|+|`list`|Lists all the plugins.|+|`edit`|Edits the miv config file.|+|`command`|Lists the subcommands of `miv`.|+|`path [plugins]`|Prints the paths of the plugins.|+|`each [commands]`|Executes the commands each directory of the plugins. For example, you can execute `miv each pwd` or `miv each git gc`.|+|`help`|Shows the help of `miv`.|+|`version`|Shows the version of `miv`.|++Commands to execute when you want to++|do what|command|+|:--|:--|+|install a new plugin|`miv edit`, update the configuration file, save, exit the editor and `miv install`|+|update the installed plugins but skip outdated plugins|`miv update`|+|update all the installed plugins|`miv update!`|+|update specific plugins|`miv update [plugin1] [plugin2]..`|+|uninstall a plugin|`miv edit`, remove the related configurations, `miv generate` (and `miv clean` if you want)|+|list all the plugins|`miv list`|+|count the number of plugins|<code>miv list | wc -l</code>|+|change the current working directory to a plugin directory|`cd "$(miv path [plugin])"`|+|want a help|`miv help`|++## Plugin configuration+### Loading triggers for the plugin+|key|type|description|+|:--|:--|:--|+|`filetype`|<code>string | string[]</code>|load the plugin on setting the filetype|+|`command`|<code>string | string[]</code>|load the plugin on invoking the command|+|`function`|<code>string | string[]</code>|load the plugin on calling a function matching the value in regex|+|`mapping`|<code>string | string[]</code>|load the plugin on the mapping|+|`mapmode`|<code>'n' | 'v' | 'x' | 's' | 'i' | 'c' | 'l' | 'o' | 't'</code>|specify the `map-modes` for the `mapping` configuration|+|`cmdline`|<code>':' | '/' | '?' | '@'</code>|the command-line character to load the plugin|+|`insert`|`boolean`|load the plugin on entering the insert mode for the first time|++### Configurations for the plugin+|key|type|description|+|:--|:--|:--|+|`script`|`string`|script run on startup, specify some configurations or mappings to load the plugin|+|`after`|`string`|script run after the plugin is loaded|+|`before`|`string`|script run just before the plugin is loaded|+|`mapleader`|`string`|the `mapleader` (`<Leader>`) for the `script`|++### Dependency configurations+|key|type|description|+|:--|:--|:--|+|`dependon`|<code>string | string[]</code>|plugins on which the plugin depends; they are loaded just before the plugin is loaded|+|`dependedby`|<code>string | string[]</code>|(deprecated in favor of `loadafter`) plugins loaded just after the plugin is loaded|+|`loadbefore`|<code>string | string[]</code>|indicates lazy loading, the plugin is loaded just before any of the configured plugins|+|`loadafter`|<code>string | string[]</code>|indicates lazy loading, the plugin is loaded just after any of the configured plugins|++### Other miscellaneous configurations+|key|type|description|+|:--|:--|:--|+|`enable`|`string`|enable the plugin when the expression (in Vim script) is truthy|+|`submodule`|`boolean`|pull the submodules of the repository|+|`build`|`string`|build shell script to execute after installing and updating|+|`sync`|`boolean`|skip pulling the repository if the value is `false`|++## Author+itchyny (<https://github.com/itchyny>)++## License+This software is released under the MIT License, see LICENSE.
+ _miv view
@@ -0,0 +1,26 @@+#compdef miv++_miv()+{+ local -i ret=1++ _arguments ': :->cmds' '*:: :->args' && ret=0++ case $state in+ (cmds)+ local -a commands=("${(*)${(f)$(miv command)}[@]/ ##/:}")+ _describe -t commands 'command' commands && ret=0+ ;;+ (args)+ case $words[1] in+ (install|update|path)+ local -a args=("${words[@]:1}")+ local -a plugins=("${${${(f)$(miv list)}[@]%% *}[@]:|args}")+ _describe -t plugins 'plugin' plugins && ret=0+ ;;+ esac+ ;;+ esac++ return ret+}
miv.cabal view
@@ -1,67 +1,72 @@+cabal-version: 3.0 name: miv-version: 0.4.8-author: itchyny <https://github.com/itchyny>-maintainer: itchyny <https://github.com/itchyny>-license: MIT-license-file: LICENSE+version: 0.4.9 category: Compiler-build-type: Simple-cabal-version: >=1.10 synopsis: Vim plugin manager written in Haskell description: The miv command is a cli tool to manage Vim plugins.+author: itchyny <itchyny@cybozu.co.jp>+maintainer: itchyny <itchyny@cybozu.co.jp>+homepage: https://github.com/itchyny/miv+bug-reports: https://github.com/itchyny/miv/issues+license: MIT+license-file: LICENSE+extra-source-files: README.md _miv +common base+ default-language: GHC2021+ default-extensions: BlockArguments+ LambdaCase+ NoFieldSelectors+ OverloadedRecordDot+ build-depends: base >= 4.18 && < 5+ ghc-options: -Wdefault -Wall -Wunused-packages+ executable miv+ import: base+ default-extensions: OverloadedStrings+ RecordWildCards+ ghc-options: -threaded hs-source-dirs: src main-is: Main.hs- ghc-options: -threaded -Wall- default-language: Haskell2010 other-modules: Plugin- , Setting- , Mode- , Command- , Cmdline- , Mapping- , ShowText- , VimScript- , Git- , Paths_miv- build-depends: base >= 4.9 && < 5- , ghc-prim- , process- , async- , concurrent-output- , SafeSemaphore- , time- , directory- , containers- , HsYAML- , bytestring- , text- , unordered-containers- , monad-parallel- , filepath- , filepattern- , unix-compat- , xdg-basedir+ Setting+ Mode+ Command+ Cmdline+ Mapping+ VimScript+ Git+ Paths_miv+ autogen-modules: Paths_miv+ build-depends: HsYAML >= 0.2 && < 0.3+ , MissingH >= 1.6 && < 1.7+ , SafeSemaphore >= 0.10 && < 0.11+ , async >= 2.2 && < 2.3+ , bytestring >= 0.11 && < 0.13+ , concurrent-output >= 1.10 && < 1.11+ , containers >= 0.6 && < 0.8+ , data-default >= 0.7 && < 0.9+ , directory >= 1.3 && < 1.4+ , extra >= 1.7 && < 1.9+ , filepath >= 1.4 && < 1.6+ , filepattern >= 0.1 && < 0.2+ , monad-parallel >= 0.8 && < 0.9+ , process >= 1.6 && < 1.7+ , text >= 2.0 && < 2.2+ , text-builder-linear >= 0.1 && < 0.2+ , text-display >= 1.0 && < 1.1+ , time >= 1.12 && < 1.15+ , unix-compat >= 0.7 && < 0.8+ , xdg-basedir >= 0.2 && < 0.3 test-suite spec+ import: base+ type: exitcode-stdio-1.0 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- , time- , directory- , containers- , hspec- , HsYAML- , bytestring- , text- , unordered-containers- , monad-parallel+ build-depends: hspec+ ghc-options: -Wno-unused-packages source-repository head type: git- location: git@github.com:itchyny/miv.git+ location: https://github.com/itchyny/miv.git
src/Cmdline.hs view
@@ -1,23 +1,22 @@-{-# LANGUAGE BlockArguments, LambdaCase, OverloadedStrings #-} module Cmdline where import Data.Text (Text, unpack)+import Data.Text.Builder.Linear qualified as Builder+import Data.Text.Display (Display(..)) import Data.YAML-import Prelude hiding (show) -import ShowText- data Cmdline = CmdlineExCommand | CmdlineForwardSearch | CmdlineBackwardSearch | CmdlineInput deriving (Eq, Ord) -instance ShowText Cmdline where- show CmdlineExCommand = ":"- show CmdlineForwardSearch = "/"- show CmdlineBackwardSearch = "?"- show CmdlineInput = "@"+instance Display Cmdline where+ displayBuilder = Builder.fromText . \case+ CmdlineExCommand -> ":"+ CmdlineForwardSearch -> "/"+ CmdlineBackwardSearch -> "?"+ CmdlineInput -> "@" instance FromYAML Cmdline where parseYAML = withStr "!!str" \case
src/Command.hs view
@@ -1,56 +1,63 @@-{-# LANGUAGE OverloadedStrings #-} module Command where -import qualified Data.Text as T-import Data.Text (Text, unwords)-import Prelude hiding (show, unwords)-import ShowText--data CmdBang = CmdBang- | CmdNoBang- deriving Eq--instance ShowText CmdBang where- show CmdBang = "-bang"- show CmdNoBang = ""--data CmdBar = CmdBar- | CmdNoBar- deriving Eq--instance ShowText CmdBar where- show CmdBar = "-bar"- show CmdNoBar = ""--data CmdRegister = CmdRegister- | CmdNoRegister- deriving Eq+import Data.Default (Default(..))+import Data.Text (Text, null, unwords)+import Data.Text.Builder.Linear qualified as Builder+import Data.Text.Display (Display(..), display)+import Prelude hiding (null, unwords) -instance ShowText CmdRegister where- show CmdRegister = "-register"- show CmdNoRegister = ""+data Command =+ Command {+ name :: Text,+ repl :: Text,+ bang :: Bool,+ bar :: Bool,+ register :: Bool,+ buffer :: Bool,+ range :: Maybe CmdRange,+ arg :: CmdArg,+ complete :: Maybe CmdComplete+ } deriving Eq -data CmdBuffer = CmdBuffer- | CmdNoBuffer- deriving Eq+instance Display Command where+ displayBuilder cmd =+ Builder.fromText $ unwords $ filter (not . null)+ [ "command!",+ if cmd.bang then "-bang" else "",+ if cmd.bar then "-bar" else "",+ if cmd.register then "-register" else "",+ if cmd.buffer then "-buffer" else "",+ maybe "" display cmd.range,+ display cmd.arg,+ maybe "" display cmd.complete,+ cmd.name,+ cmd.repl ] -instance ShowText CmdBuffer where- show CmdBuffer = "-buffer"- show CmdNoBuffer = ""+instance Default Command where+ def = Command {+ name = "",+ repl = "",+ bang = True,+ bar = False,+ register = False,+ buffer = False,+ range = Just CmdRange,+ arg = CmdNonNegArg,+ complete = Nothing+ } data CmdRange = CmdRange | CmdRangeWhole | CmdRangeN Int | CmdRangeCount Int- | CmdNoRange deriving Eq -instance ShowText CmdRange where- show CmdRange = "-range"- show CmdRangeWhole = "-range=%"- show (CmdRangeN n) = "-range=" <> show n- show (CmdRangeCount n) = "-count=" <> show n- show CmdNoRange = ""+instance Display CmdRange where+ displayBuilder = Builder.fromText . \case+ CmdRange -> "-range"+ CmdRangeWhole -> "-range=%"+ CmdRangeN n -> "-range=" <> display n+ CmdRangeCount n -> "-count=" <> display n data CmdArg = CmdNonNegArg | CmdZeroOneArg@@ -59,56 +66,17 @@ | CmdNoArg deriving Eq -instance ShowText CmdArg where- show CmdNonNegArg = "-nargs=*"- show CmdZeroOneArg = "-nargs=?"- show CmdPositiveArg = "-nargs=+"- show CmdOneArg = "-nargs=1"- show CmdNoArg = "-nargs=0"--data CmdComplete = CmdComplete Text- deriving Eq--instance ShowText CmdComplete where- show (CmdComplete "") = ""- show (CmdComplete complete) = "-complete=" <> complete--data Command =- Command { cmdName :: Text- , cmdRepText :: Text- , cmdBang :: CmdBang- , cmdBar :: CmdBar- , cmdRegister :: CmdRegister- , cmdBuffer :: CmdBuffer- , cmdRange :: CmdRange- , cmdArg :: CmdArg- , cmdComplete :: CmdComplete- } deriving Eq--instance ShowText Command where- show cmd = unwords (filter (not . T.null)- [ "command!"- , show (cmdBang cmd)- , show (cmdBar cmd)- , show (cmdRegister cmd)- , show (cmdBuffer cmd)- , show (cmdRange cmd)- , show (cmdArg cmd)- , show (cmdComplete cmd)- , cmdName cmd- , cmdRepText cmd- ])+instance Display CmdArg where+ displayBuilder = Builder.fromText . \case+ CmdNonNegArg -> "-nargs=*"+ CmdZeroOneArg -> "-nargs=?"+ CmdPositiveArg -> "-nargs=+"+ CmdOneArg -> "-nargs=1"+ CmdNoArg -> "-nargs=0" -defaultCommand :: Command-defaultCommand- = Command { cmdName = ""- , cmdRepText = ""- , cmdBang = CmdBang- , cmdBar = CmdNoBar- , cmdRegister = CmdNoRegister- , cmdBuffer = CmdNoBuffer- , cmdRange = CmdRange- , cmdArg = CmdNonNegArg- , cmdComplete = CmdComplete ""- }+newtype CmdComplete = CmdComplete Text+ deriving Eq +instance Display CmdComplete where+ displayBuilder (CmdComplete complete) =+ Builder.fromText $ "-complete=" <> complete
src/Git.hs view
@@ -11,7 +11,7 @@ import Data.List (isPrefixOf) import System.Exit (ExitCode(..))-import System.Process (system, readProcess)+import System.Process (readProcess, system) clone :: String -> FilePath -> String clone repo path = unwords ["git", "clone", gitUrl repo, singleQuote path]
src/Main.hs view
@@ -1,26 +1,25 @@-{-# LANGUAGE BlockArguments, OverloadedStrings, ScopedTypeVariables #-} module Main where -import Control.Applicative-import Control.Concurrent (threadDelay, newEmptyMVar, forkIO, putMVar, takeMVar)+import Control.Concurrent (forkIO, newEmptyMVar, putMVar, takeMVar, threadDelay) import Control.Concurrent.Async-import qualified Control.Concurrent.MSem as MSem-import Control.Exception-import Control.Monad (filterM, forM_, unless, void, when, guard)-import qualified Control.Monad.Parallel as P-import qualified Data.ByteString.Lazy as BS+import Control.Concurrent.MSem qualified as MSem+import Control.Exception (tryJust)+import Control.Monad (filterM, forM_, guard, unless, void, when)+import Control.Monad.Parallel qualified as P+import Data.ByteString.Lazy qualified as BS import Data.Functor ((<&>)) import Data.List (foldl', isPrefixOf, nub, sort, (\\))-import Data.Maybe (listToMaybe, fromMaybe, isNothing)-import Data.Text (Text, unlines, pack, unpack)-import qualified Data.Text as T-import Data.Text.IO (putStrLn, putStr, writeFile, hGetContents)+import Data.Maybe (fromMaybe, isNothing, listToMaybe)+import Data.Text (Text, pack, unlines, unpack)+import Data.Text qualified as T+import Data.Text.Builder.Linear qualified as Builder+import Data.Text.Display (Display(..), display)+import Data.Text.IO (hGetContents, putStr, putStrLn, writeFile) import Data.Time (getZonedTime)+import Data.Tuple.Utils (fst3, snd3) import Data.Version (showVersion)-import qualified Data.YAML as YAML+import Data.YAML qualified as YAML import GHC.Conc (getNumProcessors, setNumCapabilities)-import Prelude hiding (readFile, writeFile, unlines, putStrLn, putStr, show)-import System.Console.Concurrent () import System.Console.Regions import System.Directory import System.Environment (getArgs)@@ -28,16 +27,17 @@ import System.Exit (ExitCode(..)) import System.FilePath ((</>)) import System.FilePattern.Directory (getDirectoryFiles)-import System.IO (openFile, IOMode(..), hClose, hFlush, stdout, stderr, hGetLine, hPutStrLn)-import System.IO.Error (isDoesNotExistError, tryIOError, isEOFError)+import System.IO (IOMode(..), hClose, hFlush, hGetLine, hPutStrLn, openFile,+ stderr, stdout)+import System.IO.Error (isDoesNotExistError, isEOFError, tryIOError) import System.PosixCompat.Files (setFileTimes) import System.Process+import Prelude hiding (putStr, putStrLn, readFile, unlines, writeFile) import Git import Paths_miv (version) import Plugin import Setting-import ShowText import VimScript hiding (singleQuote) nameversion :: Text@@ -45,55 +45,53 @@ expandHomeDirectory :: FilePath -> IO FilePath expandHomeDirectory ('~':'/':path) = getHomeDirectory <&> (</> path)-expandHomeDirectory path = return 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"- ])+ [ 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+getFirstExistingFile :: [FilePath] -> IO (Maybe FilePath)+getFirstExistingFile = fmap listToMaybe . filterM doesFileExist getSettingFile :: IO (Maybe FilePath)-getSettingFile = getFirstExistingFile $ getSettingFileCandidates+getSettingFile = getFirstExistingFile =<< getSettingFileCandidates getSetting :: IO Setting getSetting = do candidates <- getSettingFileCandidates- maybeFile <- getFirstExistingFile $ return candidates- case maybeFile of- Just file -> do- cnt <- BS.readFile file- case YAML.decode1 cnt of- Right setting -> return setting- Left (pos, err) -> error $ YAML.prettyPosWithSource pos cnt err- Nothing -> error $ unpack $ unlines $- "No setting file! Tried following locations:" :- map (\x -> " - " <> pack x) candidates+ getFirstExistingFile candidates >>= \case+ Just file -> do+ cnt <- BS.readFile file+ case YAML.decode1 cnt of+ Right setting -> return setting+ Left (pos, err) -> error $ YAML.prettyPosWithSource pos cnt err+ Nothing -> error $ unpack $ unlines $+ "No setting file! Tried following locations:" :+ map (\x -> " - " <> pack x) candidates pluginDirectory :: IO FilePath pluginDirectory = do- 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+ candidates <- sequence [+ getUserDataDir "miv",+ expandHomeDirectory "~/.vim/miv",+ expandHomeDirectory "~/vimfiles/miv" ]+ filterM doesDirectoryExist candidates >>= \case+ (path:_) -> return path+ [] -> expandHomeDirectory "~/.vim/miv" createPluginDirectory :: IO () createPluginDirectory =@@ -103,13 +101,15 @@ printUsage = mapM_ putStrLn usage commandHelp :: IO ()-commandHelp = mapM_ (putStrLn . show) arguments+commandHelp = mapM_ (putStrLn . display) arguments -data Argument = Argument (Text, Text)- deriving (Eq, Ord)-instance ShowText Argument where- show (Argument (x, y)) = x <> T.replicate (10 - T.length x) " " <> y+newtype Argument = Argument (Text, Text)+ deriving (Eq, Ord) +instance Display Argument where+ displayBuilder (Argument (x, y)) = Builder.fromText $+ x <> T.replicate (10 - T.length x) " " <> y+ arguments :: [Argument] arguments = map Argument [ ("install" , "Installs the uninstalled plugins.")@@ -134,7 +134,7 @@ , "" , "Commands:" ]- <> map (T.append " " . show) arguments+ <> map (T.append " " . display) arguments <> [ "" , "You can install the plugins by the following command:" , " miv install"@@ -165,7 +165,7 @@ levenshtein :: Eq a => [a] -> [a] -> Int levenshtein a b = last $ foldl' f [0..length a] b where- f [] _ = []+ f [] _ = [] f xs@(x:xs') c = scanl (g c) (x + 1) (zip3 a xs xs') g c z (d, x, y) = minimum [y + 1, z + 1, x + fromEnum (c /= d)] @@ -178,7 +178,7 @@ containedcommands = [y | y@(Argument (x, _)) <- arguments, length arg > 1 && arg `isContainedIn` unpack x] putStrLn $ "Unknown command: " <> pack arg putStrLn "Probably:"- mapM_ (putStrLn . (" "<>) . show) (if null prefixcommands then nub (containedcommands <> mincommands) else prefixcommands)+ mapM_ (putStrLn . (" "<>) . display) (if null prefixcommands then nub (containedcommands <> mincommands) else prefixcommands) isContainedIn :: Eq a => [a] -> [a] -> Bool isContainedIn xxs@(x:xs) (y:ys) = x == y && xs `isContainedIn` ys || xxs `isContainedIn` ys@@ -192,25 +192,27 @@ minplugins = [y | (x, y) <- distplugins, x == mindist] putStrLn $ "Unknown plugin: " <> pack arg putStrLn "Probably:"- mapM_ (putStrLn . (" "<>) . show) minplugins+ mapM_ (putStrLn . (" "<>) . display) minplugins data Update = Install | Update deriving Eq-instance ShowText Update where- show Install = "installing"- show Update = "updating" -data UpdateStatus- = UpdateStatus {- installed :: [Plugin],- updated :: [Plugin],- nosync :: [Plugin],- outdated :: [Plugin],- failed :: [Plugin]- }+instance Display Update where+ displayBuilder = Builder.fromText . \case+ Install -> "install"+ Update -> "update" +data UpdateStatus =+ UpdateStatus {+ installed :: [Plugin],+ updated :: [Plugin],+ nosync :: [Plugin],+ outdated :: [Plugin],+ failed :: [Plugin]+ }+ instance Semigroup UpdateStatus where- UpdateStatus i u n o f <> UpdateStatus i' u' n' o' f'- = UpdateStatus (i <> i') (u <> u') (n <> n') (o <> o') (f <> f')+ UpdateStatus i u n o f <> UpdateStatus i' u' n' o' f' =+ UpdateStatus (i <> i') (u <> u') (n <> n') (o <> o') (f <> f') instance Monoid UpdateStatus where mempty = UpdateStatus [] [] [] [] []@@ -218,28 +220,28 @@ updatePlugin :: Update -> Maybe [String] -> Setting -> IO () updatePlugin update maybePlugins setting = do setNumCapabilities =<< getNumProcessors- let unknownPlugins = filter (`notElem` map rtpName (plugins setting)) (fromMaybe [] maybePlugins)+ let unknownPlugins = filter (`notElem` map rtpName setting.plugins) (fromMaybe [] maybePlugins) unless (null unknownPlugins) $- mapM_ (suggestPlugin (plugins setting)) unknownPlugins+ mapM_ (suggestPlugin setting.plugins) unknownPlugins createPluginDirectory dir <- pluginDirectory let specified p = rtpName p `elem` fromMaybe [] maybePlugins || maybePlugins == Just [] let filterplugin p = isNothing maybePlugins || specified p- let ps = filter filterplugin (plugins setting)- let count xs = if length xs > 1 then "s (" <> show (length xs) <> ")" else ""+ let ps = filter filterplugin setting.plugins+ let count xs = if length xs > 1 then "s (" <> display (length xs) <> ")" else "" time <- maximum <$> mapM' (lastUpdatePlugin dir) ps status <- fmap mconcat <$> displayConsoleRegions $ mapM' (\p -> updateOnePlugin time dir update (specified p) p) 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) (sort (installed status))- unless (null (updated status)) do- putStrLn $ "Updated plugin" <> count (updated status) <> ": "- mapM_ (putStrLn . (" "<>) . name) (sort (updated status))- unless (null (failed status)) do- putStrLn $ "Failed plugin" <> count (failed status) <> ": "- mapM_ (putStrLn . (" "<>) . name) (sort (failed status))+ putStrLn $ (if null status.failed then "Success" else "Error occurred") <> " in " <> display update <> "."+ unless (null status.installed) do+ putStrLn $ "Installed plugin" <> count status.installed <> ": "+ mapM_ (\p -> putStrLn (" " <> p.name)) (sort status.installed)+ unless (null status.updated) do+ putStrLn $ "Updated plugin" <> count status.updated <> ": "+ mapM_ (\p -> putStrLn (" " <> p.name)) (sort status.updated)+ unless (null status.failed) do+ putStrLn $ "Failed plugin" <> count status.failed <> ": "+ mapM_ (\p -> putStrLn (" " <> p.name)) (sort status.failed) generatePluginCode setting gatherFtdetectScript setting generateHelpTags setting@@ -262,7 +264,7 @@ dir <- pluginDirectory 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") setting.plugins) \path -> do exists <- doesDirectoryExist path when exists $ void do (_, _, _, ph) <- createProcess (proc "sh" ["-c", "cp -R * " <> singleQuote docdir]) {@@ -281,18 +283,18 @@ updateOnePlugin :: Integer -> FilePath -> Update -> Bool -> Plugin -> IO UpdateStatus updateOnePlugin time dir update specified plugin = do 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- putStrLn' = \region -> setConsoleRegion region . ((name plugin <> ": ") <>)- finish' = \region -> finishConsoleRegion region . ((name plugin <> ": ") <>)+ repo = vimScriptRepo plugin.name+ cloneCommand = if plugin.submodule then cloneSubmodule else clone+ pullCommand = if plugin.submodule then pullSubmodule else pull+ putStrLn' region = setConsoleRegion region . (plugin.name<>) . (": "<>)+ finish' region = finishConsoleRegion region . (plugin.name<>) . (": "<>) exists <- doesDirectoryExist path gitstatus <- gitStatus path- if not exists || (gitstatus /= ExitSuccess && not (sync plugin))+ if not exists || (gitstatus /= ExitSuccess && not plugin.sync) then withConsoleRegion Linear \region -> do putStrLn' region "Installing" when exists $ removeDirectoryRecursive path- cloneStatus <- execCommand (unpack $ name plugin) region dir $ cloneCommand repo path+ cloneStatus <- execCommand (unpack plugin.name) region dir $ cloneCommand repo path created <- doesDirectoryExist path when created do buildPlugin path region@@ -300,7 +302,7 @@ if cloneStatus /= ExitSuccess || not created then return mempty { failed = [plugin] } else return mempty { installed = [plugin] }- else if update == Install || not (sync plugin)+ else if update == Install || not plugin.sync then return mempty { nosync = [plugin] } else withConsoleRegion Linear \region -> do lastUpdateTime <- lastUpdate path@@ -310,10 +312,10 @@ return mempty { outdated = [plugin] } else do putStrLn' region "Pulling"- pullStatus <- execCommand (unpack $ name plugin) region dir $ pullCommand path+ pullStatus <- execCommand (unpack plugin.name) region dir $ pullCommand path newUpdateTime <- lastUpdate path if pullStatus /= ExitSuccess- then return $ mempty { failed = [plugin] }+ then return mempty { failed = [plugin] } else if newUpdateTime <= lastUpdateTime then return mempty else do@@ -321,12 +323,11 @@ 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)+ when (mtime > 0) let ctime = fromInteger mtime+ in setFileTimes path ctime ctime+ buildPlugin path region =+ unless (T.null plugin.build) $+ void $ execCommand (unpack plugin.name) region path (unpack plugin.build) singleQuote :: String -> String singleQuote str = "'" <> str <> "'"@@ -347,26 +348,25 @@ code <- waitForProcess ph finishConsoleRegion region (pluginName ++ ": " ++ if null outline then errline else outline) return code- where go h mvar lastLine = do- e <- tryIOError $ hGetLine h- case e of- Left err -> if isEOFError err then putMVar mvar lastLine else return ()- Right line -> do- setConsoleRegion region (pluginName ++ ": " ++ line)- threadDelay 100000- go h mvar line+ where go h mvar lastLine =+ tryIOError (hGetLine h) >>= \case+ Left err -> when (isEOFError err) $ putMVar mvar lastLine+ Right line -> do+ setConsoleRegion region (pluginName ++ ": " ++ line)+ threadDelay 100000+ go h mvar line vimScriptRepo :: Text -> FilePath vimScriptRepo pluginname | T.any (=='/') pluginname = unpack pluginname | otherwise = unpack $ "vim-scripts/" <> pluginname listPlugin :: Setting -> IO ()-listPlugin setting = mapM_ putStrLn $ space $ map format $ plugins setting- where format p = [show p, name p, pack $ gitUrl (vimScriptRepo (name p))]+listPlugin setting = mapM_ putStrLn $ space $ map format $ setting.plugins+ where format (p :: Plugin) = (display p, p.name, pack $ gitUrl (vimScriptRepo p.name)) space xs =- let max0 = maximum (map (T.length . (!!0)) xs) + 1- max1 = maximum (map (T.length . (!!1)) xs) + 1- in map (\(as:bs:cs:_) -> as <> T.replicate (max0 - T.length as) " " <> bs <> T.replicate (max1 - T.length bs) " " <> cs) xs+ let max0 = maximum (map (T.length . fst3) xs) + 1+ max1 = maximum (map (T.length . snd3) xs) + 1+ in map (\(a, b, c) -> a <> T.replicate (max0 - T.length a) " " <> b <> T.replicate (max1 - T.length b) " " <> c) xs cleanDirectory :: Setting -> IO () cleanDirectory setting = do@@ -374,12 +374,12 @@ dir <- pluginDirectory createDirectoryIfMissing True dir cnt <- listDirectory dir- let paths = "miv" : map (unpack . show) (plugins setting)+ let paths = "miv" : map (unpack . display) setting.plugins delpath' = [ dir </> d | d <- cnt, d `notElem` paths ] deldirs <- filterM doesDirectoryExist delpath'- files <- getDirectoryFiles (dir </> "miv") $ (unpack . show . ($ "*")) <$> [ Autoload, Ftplugin, Syntax ]+ files <- getDirectoryFiles (dir </> "miv") $ unpack . display . ($ "*") <$> [ Autoload, Ftplugin, Syntax ] let delfiles = (delpath' \\ deldirs)- <> (((dir </> "miv") </>) <$> (files \\ [ unpack (show place) | (place, _) <- vimScriptToList (gatherScript setting) ]))+ <> (((dir </> "miv") </>) <$> (files \\ [ unpack (display place) | (place, _) <- vimScriptToList (gatherScript setting) ])) let delpaths = deldirs <> delfiles if not (null delpaths) then do putStrLn "Remove:"@@ -389,12 +389,12 @@ c <- getChar when (c == 'y' || c == 'Y') do mapM_ removeDirectoryRecursive deldirs- mapM_ removeFile $ delfiles+ mapM_ removeFile delfiles else putStrLn "Clean." saveScript :: (FilePath, Place, [Text]) -> IO () saveScript (dir, place, code) = do- let relname = show place+ let relname = display place path = dir </> unpack relname isAllAscii = all (T.all (<='~')) code body = "" : (if isAllAscii then [] else [ "scriptencoding utf-8", "" ])@@ -410,18 +410,17 @@ when (contents /= Just body) $ writeFile path $ unlines $ [ "\" Filename: " <> relname- , "\" Last Change: " <> show time+ , "\" Last Change: " <> pack (show time) , "\" Generated by " <> nameversion ] ++ body fileContents :: String -> IO (Maybe [Text])-fileContents path = do- eitherFile <- tryJust (guard . isDoesNotExistError) (openFile path ReadMode)- case eitherFile of- Right file -> do- contentLines <- T.lines <$> hGetContents file- hClose file- return $ Just $ dropWhile ("\" " `T.isPrefixOf`) contentLines- Left _ -> return Nothing+fileContents path =+ tryJust (guard . isDoesNotExistError) (openFile path ReadMode) >>= \case+ Right file -> do+ contentLines <- T.lines <$> hGetContents file+ hClose file+ return $ Just $ dropWhile ("\" " `T.isPrefixOf`) contentLines+ Left _ -> return Nothing generatePluginCode :: Setting -> IO () generatePluginCode setting = do@@ -431,7 +430,7 @@ createDirectoryIfMissing True (dir </> "autoload" </> "miv") createDirectoryIfMissing True (dir </> "ftplugin") createDirectoryIfMissing True (dir </> "syntax")- when (any (not . null . dependedby) (plugins setting)) $+ unless (all (null . (.dependedby)) setting.plugins) $ hPutStrLn stderr "`dependedby` is deprecated in favor of `loadafter`" P.mapM_ (saveScript . (\(t, s) -> (dir, t, s))) (vimScriptToList (gatherScript setting))@@ -441,7 +440,7 @@ gatherFtdetectScript setting = do dir <- pluginDirectory cleanAndCreateDirectory (dir </> "miv" </> "ftdetect")- forM_ (plugins setting) \plugin -> do+ forM_ setting.plugins \plugin -> do let path = rtpName plugin exists <- doesDirectoryExist (dir </> path </> "ftdetect") when exists do@@ -450,7 +449,7 @@ copyFile (dir </> path </> "ftdetect" </> file) (dir </> "miv" </> "ftdetect" </> file) putStrLn "Success in gathering ftdetect scripts." -data EachStatus = EachStatus { failed' :: [Plugin] }+newtype EachStatus = EachStatus { failed' :: [Plugin] } instance Semigroup EachStatus where EachStatus f <> EachStatus f' = EachStatus (f <> f')@@ -462,10 +461,10 @@ eachPlugin command setting = do createPluginDirectory dir <- pluginDirectory- status <- mconcat <$> mapM (eachOnePlugin command dir) (plugins setting)- unless (null (failed' status)) do+ status <- mconcat <$> mapM (eachOnePlugin command dir) setting.plugins+ unless (null status.failed') do putStrLn "Error:"- mapM_ (putStrLn . (" "<>) . name) (failed' status)+ mapM_ (\p -> putStrLn (" " <> p.name)) status.failed' eachOnePlugin :: String -> FilePath -> Plugin -> IO EachStatus eachOnePlugin command dir plugin = do@@ -476,19 +475,18 @@ else do (_, _, _, ph) <- createProcess (proc "sh" ["-c", command]) { cwd = Just path }- exitCode <- waitForProcess ph- case exitCode of- ExitSuccess -> return mempty- _ -> return $ mempty { failed' = [plugin] }+ waitForProcess ph >>= \case+ ExitSuccess -> return mempty+ _ -> return mempty { failed' = [plugin] } eachHelp :: IO () eachHelp = mapM_ putStrLn [ "Specify command:", " miv each [command]" ] pathPlugin :: [String] -> Setting -> IO () pathPlugin plugins' setting = do- let ps = filter (\p -> rtpName p `elem` plugins' || null plugins') (plugins setting)+ let ps = filter (\p -> rtpName p `elem` plugins' || null plugins') setting.plugins dir <- pluginDirectory- forM_ ps (\plugin -> putStrLn $ pack (dir </> unpack (show plugin)))+ forM_ ps (\plugin -> putStrLn $ pack (dir </> unpack (display plugin))) mainProgram :: [String] -> IO () mainProgram [] = printUsage
src/Mapping.hs view
@@ -1,49 +1,37 @@-{-# LANGUAGE OverloadedStrings #-} module Mapping where -import Data.Text (Text, unwords, null)-import Prelude hiding (show, unwords, null)+import Data.Default (Default(..))+import Data.Text (Text, null, unwords)+import Data.Text.Builder.Linear qualified as Builder+import Data.Text.Display (Display(..), display)+import Prelude hiding (null, unwords) import Mode-import ShowText -data MapUnique = MapUnique | MapNoUnique- deriving Eq--instance ShowText MapUnique where- show MapUnique = "<unique>"- show MapNoUnique = ""--data MapSilent = MapSilent | MapNoSilent- deriving Eq--instance ShowText MapSilent where- show MapSilent = "<silent>"- show MapNoSilent = ""- data Mapping =- Mapping { mapName :: Text- , mapRepText :: Text- , mapUnique :: MapUnique- , mapSilent :: MapSilent- , mapMode :: Mode- } deriving Eq+ Mapping {+ name :: Text,+ repl :: Text,+ unique :: Bool,+ silent :: Bool,+ mode :: Mode+ } deriving Eq -instance ShowText Mapping where- show m = unwords (filter (not . null)- [ show (mapMode m) <> "noremap"- , show (mapUnique m)- <> show (mapSilent m)- , mapName m- , mapRepText m- ])+instance Display Mapping where+ displayBuilder m =+ Builder.fromText $ unwords $ filter (not . null)+ [ display m.mode <> "noremap",+ (if m.unique then "<unique>" else "")+ <> (if m.silent then "<silent>" else ""),+ m.name,+ m.repl+ ] -defaultMapping :: Mapping-defaultMapping- = Mapping { mapName = ""- , mapRepText = ""- , mapUnique = MapUnique- , mapSilent = MapSilent- , mapMode = NormalMode+instance Default Mapping where+ def = Mapping {+ name = "",+ repl = "",+ unique = True,+ silent = True,+ mode = NormalMode }-
src/Mode.hs view
@@ -1,11 +1,10 @@-{-# LANGUAGE BlockArguments, LambdaCase, OverloadedStrings #-} module Mode where import Data.Text (unpack)+import Data.Text.Builder.Linear qualified as Builder+import Data.Text.Display (Display(..)) import Data.YAML -import ShowText- data Mode = NormalMode | VisualSelectMode | VisualMode@@ -17,16 +16,17 @@ | TerminalMode deriving (Eq, Ord) -instance ShowText Mode where- show NormalMode = "n"- show VisualSelectMode = "v"- show VisualMode = "x"- show SelectMode = "s"- show InsertMode = "i"- show CmdlineMode = "c"- show LangArgMode = "l"- show OperatorPendingMode = "o"- show TerminalMode = "t"+instance Display Mode where+ displayBuilder = Builder.fromText . \case+ NormalMode -> "n"+ VisualSelectMode -> "v"+ VisualMode -> "x"+ SelectMode -> "s"+ InsertMode -> "i"+ CmdlineMode -> "c"+ LangArgMode -> "l"+ OperatorPendingMode -> "o"+ TerminalMode -> "t" instance FromYAML Mode where parseYAML = withStr "!!str" \case
src/Plugin.hs view
@@ -1,40 +1,41 @@-{-# LANGUAGE BlockArguments, OverloadedStrings, RecordWildCards #-} module Plugin where import Control.Applicative ((<|>))-import qualified Data.Text as T import Data.Text (Text, unpack)+import Data.Text qualified as T+import Data.Text.Builder.Linear qualified as Builder+import Data.Text.Display (Display(..), display) import Data.YAML import Cmdline import Mode-import ShowText data Plugin =- Plugin { name :: Text- , filetypes :: [Text]- , commands :: [Text]- , functions :: [Text]- , mappings :: [Text]- , mapmodes :: [Mode]- , cmdlines :: [Cmdline]- , insert :: Bool- , enable :: Text- , sync :: Bool- , mapleader :: Text- , script :: [Text]- , after :: [Text]- , before :: [Text]- , dependon :: [Text]- , dependedby :: [Text]- , loadafter :: [Text]- , loadbefore :: [Text]- , build :: Text- , submodule :: Bool- } deriving (Eq, Ord)+ Plugin {+ name :: Text,+ filetypes :: [Text],+ commands :: [Text],+ functions :: [Text],+ mappings :: [Text],+ mapmodes :: [Mode],+ cmdlines :: [Cmdline],+ insert :: Bool,+ enable :: Text,+ sync :: Bool,+ mapleader :: Text,+ script :: [Text],+ after :: [Text],+ before :: [Text],+ dependon :: [Text],+ dependedby :: [Text],+ loadafter :: [Text],+ loadbefore :: [Text],+ build :: Text,+ submodule :: Bool+ } deriving (Eq, Ord) -instance ShowText Plugin where- show plg = subst (name plg)+instance Display Plugin where+ displayBuilder plugin = Builder.fromText $ subst plugin.name 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@@ -43,7 +44,7 @@ | otherwise = T.filter (`notElem`("!?;:/<>()[]{}|~'\"" :: String)) s rtpName :: Plugin -> String-rtpName = unpack . ShowText.show+rtpName = unpack . display instance FromYAML Plugin where parseYAML = withMap "!!map" \o -> do
src/Setting.hs view
@@ -1,9 +1,7 @@-{-# LANGUAGE BlockArguments, OverloadedStrings, RecordWildCards #-} module Setting where -import Data.Function (on)-import Data.List (sortBy)-import qualified Data.Map.Strict as M+import Data.List (sortOn)+import Data.Map.Strict qualified as M import Data.Text (Text, lines) import Data.YAML import Prelude hiding (lines)@@ -11,12 +9,13 @@ import Plugin data Setting =- Setting { plugins :: [Plugin]- , filetype :: M.Map Text [Text]- , syntax :: M.Map Text [Text]- , before :: [Text]- , after :: [Text]- } deriving Eq+ Setting {+ plugins :: [Plugin],+ filetype :: M.Map Text [Text],+ syntax :: M.Map Text [Text],+ before :: [Text],+ after :: [Text]+ } deriving Eq instance FromYAML Setting where parseYAML = withMap "!!map" \o -> do@@ -26,7 +25,5 @@ before <- lines <$> o .:? "before" .!= "" after <- lines <$> o .:? "after" .!= "" return Setting {..}- where pluginMapToList = sortWith name . M.foldlWithKey' (\a k v -> v { name = k } : a) []--sortWith :: Ord b => (a -> b) -> [a] -> [a]-sortWith = sortBy . on compare+ where pluginMapToList = sortOn (.name) .+ M.foldlWithKey' (\a k v -> v { name = k } : a) []
− src/ShowText.hs
@@ -1,10 +0,0 @@-{-# LANGUAGE FlexibleInstances, IncoherentInstances, UndecidableInstances #-}-module ShowText where--import Data.Text--class ShowText a where- show :: a -> Text--instance Show a => ShowText a where- show = pack . Prelude.show
src/VimScript.hs view
@@ -1,37 +1,39 @@-{-# LANGUAGE DeriveGeneric, OverloadedStrings #-} module VimScript where -import Data.Char (isAlpha, isAlphaNum, ord, toLower)-import Data.Function (on)-import Data.List (foldl', groupBy, sort, sortBy, nub)-import qualified Data.Map.Strict as M+import Data.Char (isAlpha, isAlphaNum, isSpace, ord, toLower)+import Data.Default (def)+import Data.List (foldl', nub, sort)+import Data.List.Extra (groupSort)+import Data.Map.Strict qualified as M import Data.Text (Text, singleton, unpack, unwords)-import qualified Data.Text as T-import Prelude hiding (show, unwords)+import Data.Text qualified as T+import Data.Text.Builder.Linear qualified as Builder+import Data.Text.Display (Display(..), display)+import Prelude hiding (unwords) import Cmdline-import qualified Command as C-import qualified Mapping as M+import Command+import Mapping import Mode-import qualified Plugin as P-import qualified Setting as S-import ShowText+import Plugin+import Setting -data VimScript = VimScript (M.Map Place [Text])- deriving (Eq)+newtype VimScript = VimScript (M.Map Place [Text])+ deriving Eq -data Place = Plugin+data Place = Plugin' | Autoload Text | Ftplugin Text | Syntax Text deriving (Eq, Ord) -instance ShowText Place where- show Plugin = "plugin/miv.vim"- show (Autoload "") = "autoload/miv.vim"- show (Autoload s) = "autoload/miv/" <> s <> ".vim"- show (Ftplugin s) = "ftplugin/" <> s <> ".vim"- show (Syntax s) = "syntax/" <> s <> ".vim"+instance Display Place where+ displayBuilder = Builder.fromText . \case+ Plugin' -> "plugin/miv.vim"+ Autoload "" -> "autoload/miv.vim"+ Autoload s -> "autoload/miv/" <> s <> ".vim"+ Ftplugin s -> "ftplugin/" <> s <> ".vim"+ Syntax s -> "syntax/" <> s <> ".vim" vimScriptToList :: VimScript -> [(Place, [Text])] vimScriptToList (VimScript x) = M.toList x@@ -44,23 +46,23 @@ where concat' a [] = a concat' [] b = b- concat' a b = a <> [""] <> b+ concat' a b = a <> [""] <> b instance Monoid VimScript where mempty = VimScript M.empty -gatherScript :: S.Setting -> VimScript+gatherScript :: Setting -> VimScript gatherScript setting = beforeScript setting- <> gatherBeforeAfterScript plugins- <> gather' "dependon" P.dependon P.loadbefore plugins- <> gather' "dependedby" P.dependedby P.loadafter plugins- <> gather "mappings" P.mappings plugins- <> gather "mapmodes" (map show . P.mapmodes) plugins- <> gather "functions" P.functions plugins+ <> gatherBeforeAfterScript setting.plugins+ <> gather' "dependon" (.dependon) (.loadbefore) setting.plugins+ <> gather' "dependedby" (.dependedby) (.loadafter) setting.plugins+ <> gather "mappings" (.mappings) setting.plugins+ <> gather "mapmodes" (map display . (.mapmodes)) setting.plugins+ <> gather "functions" (.functions) setting.plugins <> pluginLoader <> mappingLoader <> commandLoader- <> foldl' (<>) mempty (map pluginConfig plugins)+ <> foldl' (<>) mempty (map pluginConfig setting.plugins) <> filetypeLoader setting <> funcUndefinedLoader setting <> cmdlineEnterLoader setting@@ -68,9 +70,8 @@ <> filetypeScript setting <> syntaxScript setting <> afterScript setting- where plugins = S.plugins setting -gatherBeforeAfterScript :: [P.Plugin] -> VimScript+gatherBeforeAfterScript :: [Plugin] -> VimScript gatherBeforeAfterScript x = insertAuNameMap $ gatherScripts x (mempty, M.empty) where insertAuNameMap :: (VimScript, M.Map Text Text) -> VimScript@@ -78,107 +79,99 @@ [ "let s:autoload = {" ] <> [ " \\ " <> singleQuote k <> ": " <> singleQuote a <> "," | (k, a) <- M.toList m ] <> [ " \\ }" ]) <> vs- gatherScripts :: [P.Plugin] -> (VimScript, M.Map Text Text) -> (VimScript, M.Map Text Text)+ gatherScripts :: [Plugin] -> (VimScript, M.Map Text Text) -> (VimScript, M.Map Text Text) gatherScripts (p:ps) (vs, m)- | null (P.before p) && null (P.after p) = gatherScripts ps (vs, m)+ | null p.before && null p.after = gatherScripts ps (vs, m) | otherwise = gatherScripts ps (vs <> vs', M.insert name hchar m) where- name = T.filter isAlphaNum (T.toLower (show p))- hchar | null (loadScript p) = maybe "_" singleton $ getHeadChar $ show p+ name = T.filter isAlphaNum (T.toLower (display p))+ hchar | null (loadScript p) = maybe "_" singleton $ getHeadChar $ display p | otherwise = "_" funcname str = "miv#" <> hchar <> "#" <> str <> "_" <> name vs' = VimScript $ M.singleton (Autoload hchar) $- wrapFunction (funcname "before") (P.before p) <>- wrapFunction (funcname "after") (P.after p)+ wrapFunction (funcname "before") p.before <>+ wrapFunction (funcname "after") p.after gatherScripts [] (vs, m) = (vs, m) -gather :: Text -> (P.Plugin -> [Text]) -> [P.Plugin] -> VimScript-gather name f plg+gather :: Text -> (Plugin -> [Text]) -> [Plugin] -> VimScript+gather name f plugin = VimScript (M.singleton (Autoload "") $ [ "let s:" <> name <> " = {" ]- <> [ " \\ " <> singleQuote (show p)+ <> [ " \\ " <> singleQuote (display p) <> ": [ " <> T.intercalate ", " (map singleQuote (f p)) <> " ],"- | p <- plg, enabled p, not (null (f p)) ]+ | p <- plugin, p.enable /= "0", 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+gather' :: Text -> (Plugin -> [Text]) -> (Plugin -> [Text]) -> [Plugin] -> VimScript+gather' name f g plugin = VimScript (M.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 ] ]+ | (p, q) <- groupSort $ [ (display p, q) | p <- plugin, p.enable /= "0", q <- f p ]+ <> [ (q, display p) | p <- plugin, p.enable /= "0", 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 (M.singleton Plugin $ wrapInfo $- wrapEnable (P.enable plg) $ mapleader <> gatherCommand plg <> gatherMapping plg <> P.script plg <> loadScript plg)+pluginConfig :: Plugin -> VimScript+pluginConfig plugin+ = VimScript (M.singleton Plugin' $ wrapInfo $+ wrapEnable plugin.enable $ mapleader <> gatherCommand plugin <> gatherMapping plugin <> plugin.script <> loadScript plugin) where- wrapInfo [] = []- wrapInfo str = ("\" " <> P.name plg) : str- mapleader = (\s -> if T.null s then [] else ["let g:mapleader = " <> singleQuote s]) (P.mapleader plg)+ wrapInfo [] = []+ wrapInfo str = ("\" " <> plugin.name) : str+ mapleader = let s = plugin.mapleader in ["let g:mapleader = " <> singleQuote s | not (T.null s)] -loadScript :: P.Plugin -> [Text]-loadScript plg- | all null [ P.commands plg, P.mappings plg, P.functions plg, P.filetypes plg- , P.loadafter plg, P.loadbefore plg ] && null (P.cmdlines plg) && not (P.insert plg)- = ["call miv#load(" <> singleQuote (show plg) <> ")"]+loadScript :: Plugin -> [Text]+loadScript plugin+ | all null [ plugin.commands, plugin.mappings, plugin.functions, plugin.filetypes+ , plugin.loadafter, plugin.loadbefore ] && null plugin.cmdlines && not plugin.insert+ = ["call miv#load(" <> singleQuote (display plugin) <> ")"] | otherwise = [] -gatherCommand :: P.Plugin -> [Text]-gatherCommand plg- | not (null (P.commands plg))- = [show C.defaultCommand- { C.cmdName = c,- C.cmdRepText = unwords [- "call miv#command(" <> singleQuote (show plg) <> ",",+gatherCommand :: Plugin -> [Text]+gatherCommand plugin+ | not (null plugin.commands)+ = [display def+ { Command.name = c,+ Command.repl = unwords [+ "call miv#command(" <> singleQuote (display plugin) <> ",", singleQuote c <> ",", singleQuote "<bang>" <> ",", "<q-args>,", "expand('<line1>'),", "expand('<line2>'))"- ] } | c <- P.commands plg]+ ] } | c <- plugin.commands] | otherwise = [] -gatherMapping :: P.Plugin -> [Text]-gatherMapping plg- | not (null (P.mappings plg))- = [show M.defaultMapping- { M.mapName = mapping,- M.mapRepText = escape mode <> ":<C-u>call miv#mapping("- <> singleQuote (show plg) <> ", "+gatherMapping :: Plugin -> [Text]+gatherMapping plugin+ | not (null plugin.mappings)+ = [display def+ { Mapping.name = mapping,+ Mapping.repl = escape mode <> ":<C-u>call miv#mapping("+ <> singleQuote (display plugin) <> ", " <> singleQuote mapping <> ", "- <> singleQuote (show mode) <> ")<CR>",- M.mapMode = mode- } | mapping <- P.mappings plg, mode <- modes]+ <> singleQuote (display mode) <> ")<CR>",+ Mapping.mode = mode+ } | mapping <- plugin.mappings, mode <- modes] | otherwise = []- where modes = if null (P.mapmodes plg) then [NormalMode] else P.mapmodes plg+ where modes = if null plugin.mapmodes then [NormalMode] else plugin.mapmodes escape mode = if mode `elem` [InsertMode, OperatorPendingMode] then "<ESC>" else "" -beforeScript :: S.Setting -> VimScript-beforeScript setting = VimScript (M.singleton Plugin (S.before setting))+beforeScript :: Setting -> VimScript+beforeScript setting = VimScript (M.singleton Plugin' setting.before) -afterScript :: S.Setting -> VimScript-afterScript setting = VimScript (M.singleton Plugin (S.after setting))+afterScript :: Setting -> VimScript+afterScript setting = VimScript (M.singleton Plugin' setting.after) -filetypeLoader :: S.Setting -> VimScript-filetypeLoader setting- = mconcat $ map (uncurry f) $- collectSndByFst [(ft, p) | p <- S.plugins setting, ft <- P.filetypes p]+filetypeLoader :: Setting -> VimScript+filetypeLoader setting =+ mconcat $ map (uncurry f) $ groupSort [(ft, p) | p <- setting.plugins, ft <- p.filetypes] where- f :: Text -> [P.Plugin] -> VimScript+ f :: Text -> [Plugin] -> VimScript f ft plugins = flip foldMap (getHeadChar ft) $ \c -> let funcname = "miv#" <> singleton c <> "#load_" <> T.filter isAlphaNum (T.toLower ft)- in VimScript (M.singleton Plugin+ in VimScript (M.singleton Plugin' [ "augroup miv-file-type-" <> ft , " autocmd!" , " autocmd FileType " <> ft <> " call " <> funcname <> "()"@@ -194,29 +187,29 @@ , "endfunction" ]) wrapEnable :: Text -> [Text] -> [Text]-wrapEnable enable str- | null str = []- | T.null enable = str- | enable == "0" = []- | otherwise = (indent <> "if " <> enable)- : map (" "<>) str- <> [indent <> "endif"]- where indent = T.takeWhile (==' ') (head str)+wrapEnable _ [] = []+wrapEnable "" strs = strs+wrapEnable "0" _ = []+wrapEnable enable strs@(s:_) =+ [indent <> "if " <> enable] <>+ map (" "<>) strs <>+ [indent <> "endif"]+ where indent = T.takeWhile isSpace s -loadPlugins :: [P.Plugin] -> [Text]+loadPlugins :: [Plugin] -> [Text] loadPlugins plugins = concat [wrapEnable enable- [" call miv#load(" <> singleQuote (show p) <> ")" | p <- plugins']- | (enable, plugins') <- collectSndByFst [(P.enable p, p) | p <- plugins]]+ [" call miv#load(" <> singleQuote (display p) <> ")" | p <- plugins']+ | (enable, plugins') <- groupSort [(p.enable, p) | p <- plugins]] singleQuote :: Text -> Text singleQuote str = "'" <> str <> "'" -filetypeScript :: S.Setting -> VimScript-filetypeScript = foldMap (\(ft, src) -> VimScript (M.singleton (Ftplugin ft) src)) . M.toList . S.filetype+filetypeScript :: Setting -> VimScript+filetypeScript setting = foldMap (\(ft, src) -> VimScript (M.singleton (Ftplugin ft) src)) $ M.toList setting.filetype -syntaxScript :: S.Setting -> VimScript-syntaxScript = foldMap (\(ft, src) -> VimScript (M.singleton (Syntax ft) src)) . M.toList . S.syntax+syntaxScript :: Setting -> VimScript+syntaxScript setting = foldMap (\(ft, src) -> VimScript (M.singleton (Syntax ft) src)) $ M.toList setting.syntax wrapFunction :: Text -> [Text] -> [Text] wrapFunction funcname script =@@ -256,9 +249,9 @@ , " endtry" , "endfunction" ]) -funcUndefinedLoader :: S.Setting -> VimScript+funcUndefinedLoader :: Setting -> VimScript funcUndefinedLoader setting = if null functions then mempty else- VimScript (M.singleton Plugin+ VimScript (M.singleton Plugin' [ "\" FuncUndefined" , "augroup miv-func-undefined" , " autocmd!"@@ -283,20 +276,19 @@ , " endfor" , " endfor" , "endfunction" ])- where functions = [ f | p <- S.plugins setting, f <- P.functions p ]+ where functions = [f | p <- setting.plugins, f <- p.functions] -cmdlineEnterLoader :: S.Setting -> VimScript-cmdlineEnterLoader setting- = mconcat $ map (uncurry f) $- collectSndByFst [(cmdline, p) | p <- S.plugins setting, cmdline <- P.cmdlines p]+cmdlineEnterLoader :: Setting -> VimScript+cmdlineEnterLoader setting =+ mconcat $ map (uncurry f) $ groupSort [(cmdline, p) | p <- setting.plugins, cmdline <- p.cmdlines] where- f :: Cmdline -> [P.Plugin] -> VimScript- f cmdline plugins = VimScript (M.singleton Plugin- [ "\" CmdlineEnter " <> (show cmdline)+ f :: Cmdline -> [Plugin] -> VimScript+ f cmdline plugins = VimScript (M.singleton Plugin'+ [ "\" CmdlineEnter " <> display cmdline , "if exists('#CmdlineEnter')" , " augroup " <> group , " autocmd!"- , " autocmd CmdlineEnter " <> (cmdlinePattern cmdline) <> " call miv#cmdline_enter_" <> c <> "()"+ , " autocmd CmdlineEnter " <> cmdlinePattern cmdline <> " call miv#cmdline_enter_" <> c <> "()" , " augroup END" , "else" , " call miv#cmdline_enter_" <> c <> "()"@@ -309,12 +301,12 @@ , " augroup! " <> group , " endif" , "endfunction" ])- where c = T.concat $ map (show . ord) (unpack (show cmdline))+ where c = T.concat $ map (display . ord) (unpack (display cmdline)) group = "miv-cmdline-enter-" <> c -insertEnterLoader :: S.Setting -> VimScript+insertEnterLoader :: Setting -> VimScript insertEnterLoader setting = if null plugins then mempty else- VimScript (M.singleton Plugin+ VimScript (M.singleton Plugin' [ "\" InsertEnter" , "augroup miv-insert-enter" , " autocmd!"@@ -327,7 +319,7 @@ , " augroup! miv-insert-enter" , " silent! doautocmd InsertEnter" , "endfunction" ])- where plugins = filter P.insert (S.plugins setting)+ where plugins = filter (.insert) setting.plugins pluginLoader :: VimScript pluginLoader = VimScript (M.singleton (Autoload "")