miv-0.3.0: src/VimScript.hs
{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}
module VimScript where
import Data.Char (isAlpha, isAlphaNum, toLower)
import Data.Hashable
import qualified Data.HashMap.Lazy as HM
import Data.List (foldl')
import Data.Maybe (mapMaybe)
import Data.Monoid ((<>))
import Data.Text (Text, unwords, singleton)
import qualified Data.Text as T
import GHC.Generics (Generic)
import Prelude hiding (show, unwords, read)
import qualified Command as C
import qualified Mapping as M
import Mode
import qualified Plugin as P
import ReadText
import qualified Setting as S
import ShowText
data VimScript = VimScript (HM.HashMap Place [Text])
deriving (Eq)
data Place = Plugin
| Autoload Text
| Ftplugin Text
deriving (Eq, Generic)
instance Hashable Place where
hashWithSalt a Plugin = a `hashWithSalt` (0 :: Int) `hashWithSalt` ("" :: Text)
hashWithSalt a (Autoload s) = a `hashWithSalt` (1 :: Int) `hashWithSalt` s
hashWithSalt a (Ftplugin s) = a `hashWithSalt` (2 :: Int) `hashWithSalt` s
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"
autoloadSubdirName :: Place -> Maybe Text
autoloadSubdirName (Autoload "") = Nothing
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
instance Semigroup VimScript where
VimScript x <> VimScript y
| HM.null x = VimScript y
| HM.null y = VimScript x
| otherwise = VimScript (HM.unionWith concat' x y)
where
concat' a [] = a
concat' [] b = b
concat' a b = a <> [""] <> b
instance Monoid VimScript where
mempty = VimScript HM.empty
gatherScript :: S.Setting -> VimScript
gatherScript setting = addAutoloadNames
$ beforeScript setting
<> gatherBeforeAfterScript plugins
<> gather "dependon" P.dependon plugins
<> gather "dependedby" P.dependedby plugins
<> gather "mappings" P.mappings plugins
<> gather "mapmodes" P.mapmodes plugins
<> gatherFuncUndefined setting
<> pluginLoader
<> mappingLoader
<> commandLoader
<> foldl' (<>) mempty (map pluginConfig plugins)
<> filetypeLoader setting
<> gatherInsertEnter setting
<> filetypeScript (S.filetype setting)
<> afterScript setting
where plugins = S.plugins setting
gatherBeforeAfterScript :: [P.Plugin] -> VimScript
gatherBeforeAfterScript x = insertAuNameMap $ gatherScripts x (mempty, HM.empty)
where
insertAuNameMap :: (VimScript, HM.HashMap Text Text) -> VimScript
insertAuNameMap (vs, hm) = VimScript (HM.singleton (Autoload "") $
[ "let s:autoload = {" ]
<> [ " \\ " <> singleQuote k <> ": " <> singleQuote a <> "," | (k, a) <- HM.toList hm ]
<> [ " \\ }" ]) <> vs
gatherScripts :: [P.Plugin] -> (VimScript, HM.HashMap Text Text) -> (VimScript, HM.HashMap Text Text)
gatherScripts (p:ps) (vs, hm)
| null (P.before p) && null (P.after p) = gatherScripts ps (vs, hm)
| otherwise = gatherScripts ps (vs <> vs', HM.insert name hchar hm)
where
name = T.filter isAlphaNum (T.toLower (show p))
hchar | null (loadScript p) = maybe "_" singleton $ getHeadChar $ show p
| otherwise = "_"
funcname str = "miv#" <> hchar <> "#" <> str <> "_" <> name
au = Autoload hchar
vs' = VimScript $ HM.singleton au $ wrapFunction (funcname "before") (P.before p)
<> wrapFunction (funcname "after") (P.after p)
gatherScripts [] (vs, hm) = (vs, hm)
addAutoloadNames :: VimScript -> VimScript
addAutoloadNames h@(VimScript hm)
= VimScript (HM.singleton (Autoload "")
[ "let s:autoloads = { " <> T.intercalate ", " (((<>": 1") . singleQuote)
<$> mapMaybe autoloadSubdirName (HM.keys hm)) <> " }"])
<> h
gather :: Text -> (P.Plugin -> [Text]) -> [P.Plugin] -> VimScript
gather name f plg
= VimScript (HM.singleton (Autoload "") $
[ "let s:" <> name <> " = {" ]
<> [ " \\ " <> singleQuote (show p)
<> ": [ " <> T.intercalate ", " (map singleQuote (f p)) <> " ],"
| p <- plg, not (null (f p)) ]
<> [ " \\ }" ])
pluginConfig :: P.Plugin -> VimScript
pluginConfig plg
= VimScript (HM.singleton Plugin $ wrapInfo $
wrapEnable plg $ mapleader <> gatherCommand plg <> gatherMapping plg <> P.script plg <> loadScript plg)
where
wrapInfo [] = []
wrapInfo str = ("\" " <> P.name plg) : str
mapleader = (\s -> if T.null s then [] else ["let g:mapleader = " <> singleQuote s]) (P.mapleader plg)
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 ] && not (P.insert plg)
= ["call miv#load(" <> singleQuote (show plg) <> ")"]
| 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) <> ","
, singleQuote c <> ","
, singleQuote "<bang>" <> ","
, "<q-args>,"
, "expand('<line1>'),"
, "expand('<line2>'))" ] }) | c <- P.commands plg]
| otherwise = []
gatherMapping :: P.Plugin -> [Text]
gatherMapping plg
| not (null (P.mappings plg))
= let genMapping
= [\mode ->
M.defaultMapping
{ M.mapName = c
, M.mapRepText = escape mode <> ":<C-u>call miv#mapping("
<> singleQuote (show plg) <> ", "
<> singleQuote c <> ", "
<> singleQuote (show mode) <> ")<CR>"
, M.mapMode = mode } | c <- P.mappings plg]
escape m = if m `elem` [ InsertMode, OperatorPendingMode ] then "<ESC>" else ""
modes = if null (P.mapmodes plg) then [NormalMode, VisualMode] else map read (P.mapmodes plg)
in concat [map (show . f) modes | f <- genMapping]
| otherwise = []
beforeScript :: S.Setting -> VimScript
beforeScript setting = VimScript (HM.singleton Plugin (S.before setting))
afterScript :: S.Setting -> VimScript
afterScript setting = VimScript (HM.singleton Plugin (S.after setting))
filetypeLoader :: S.Setting -> VimScript
filetypeLoader setting
= HM.foldrWithKey f mempty (filetypeLoadPlugins (S.plugins setting) HM.empty)
where
f ft plg val =
case getHeadChar ft of
Nothing -> val
Just c ->
let funcname = "miv#" <> singleton c <> "#load_" <> T.filter isAlphaNum (T.toLower ft)
in val
<> VimScript (HM.singleton (Autoload (singleton c))
(("function! " <> funcname <> "() abort")
: " setl ft="
: concat [wrapEnable b
[ " call miv#load(" <> singleQuote (show b) <> ")"] | b <- plg]
<> [ " autocmd! MivFileTypeLoad" <> ft
, " setl ft=" <> ft
, " silent! doautocmd FileType " <> ft
, "endfunction"
]))
<> VimScript (HM.singleton Plugin
[ "augroup MivFileTypeLoad" <> ft
, " autocmd!"
, " autocmd FileType " <> ft <> " call " <> funcname <> "()"
, "augroup END"
])
filetypeLoadPlugins :: [P.Plugin] -> HM.HashMap Text [P.Plugin] -> HM.HashMap Text [P.Plugin]
filetypeLoadPlugins (b:plugins) fts
| not (null (P.filetypes b))
= filetypeLoadPlugins plugins (foldr (flip (HM.insertWith (<>)) [b]) fts (P.filetypes b))
| otherwise = filetypeLoadPlugins plugins fts
filetypeLoadPlugins [] fts = fts
gatherInsertEnter :: S.Setting -> VimScript
gatherInsertEnter setting
= VimScript (HM.singleton Plugin (f [ p | p <- S.plugins setting, P.insert p ]))
where f [] = []
f plgs = "\" InsertEnter"
: "function! s:insertEnter() abort"
: [ " call miv#load(" <> singleQuote (show p) <> ")" | p <- plgs :: [P.Plugin] ]
<> [ " autocmd! MivInsertEnter"
, " silent! doautocmd InsertEnter"
, "endfunction"
, ""
, "augroup MivInsertEnter"
, " autocmd!"
, " autocmd InsertEnter * call s:insertEnter()"
, "augroup END"
, "" ]
gatherFuncUndefined :: S.Setting -> VimScript
gatherFuncUndefined setting
= VimScript (HM.singleton Plugin (f [ p | p <- S.plugins setting, not (null (P.functions p))]))
where f [] = []
f plgs = "\" FuncUndefined"
: "function! s:funcUndefined() abort"
: " let f = expand('<amatch>')"
: concat [
[ " if f =~# " <> singleQuote q
, " call miv#load(" <> singleQuote (show p) <> ")"
, " endif" ] | (p, q) <- concatMap (\q -> map ((,) q) (P.functions q)) plgs]
<> [ "endfunction"
, ""
, "augroup MivFuncUndefined"
, " autocmd!"
, " autocmd FuncUndefined * call s:funcUndefined()"
, "augroup END"
, "" ]
wrapEnable :: P.Plugin -> [Text] -> [Text]
wrapEnable plg str
| null str = []
| T.null (P.enable plg) = str
| P.enable plg == "0" = []
| otherwise = (indent <> "if " <> P.enable plg)
: map (" "<>) str
<> [indent <> "endif"]
where indent = T.takeWhile (==' ') (head str)
singleQuote :: Text -> Text
singleQuote str = "'" <> str <> "'"
filetypeScript :: HM.HashMap Text [Text] -> VimScript
filetypeScript =
HM.foldrWithKey (\ft scr val -> val <> VimScript (HM.singleton (Ftplugin ft) scr)) mempty
wrapFunction :: Text -> [Text] -> [Text]
wrapFunction funcname script =
["function! " <> funcname <> "() abort"]
<> map (" "<>) script
<> ["endfunction"]
getHeadChar :: Text -> Maybe Char
getHeadChar xs
| T.null xs = Nothing
| otherwise = let x = T.head xs in if isAlpha x then Just (toLower x) else getHeadChar (T.tail xs)
mappingLoader :: VimScript
mappingLoader = VimScript (HM.singleton (Autoload "")
[ "function! miv#mapping(name, mapping, mode) abort"
, " call miv#load(a:name)"
, " if a:mode ==# 'v' || a:mode ==# 'x'"
, " call feedkeys('gv', 'n')"
, " elseif a:mode ==# 'o'"
, " call feedkeys(\"\\<Esc>\", 'n')"
, " call feedkeys(v:operator, 'm')"
, " endif"
, " call feedkeys((v:count ? v:count : '') . substitute(a:mapping, '<Plug>', \"\\<Plug>\", 'g'), 'm')"
, " return ''"
, "endfunction"
])
commandLoader :: VimScript
commandLoader = VimScript (HM.singleton (Autoload "")
[ "function! miv#command(name, command, bang, args, line1, line2) abort"
, " silent! execute 'delcommand' a:command"
, " call miv#load(a:name)"
, " let range = a:line1 != a:line2 ? a:line1.','.a:line2 : ''"
, " try"
, " exec range.a:command.a:bang a:args"
, " catch /^Vim\\%((\\a\\+)\\)\\=:E481:/"
, " exec a:command.a:bang a:args"
, " endtry"
, "endfunction"
])
pluginLoader :: VimScript
pluginLoader = VimScript (HM.singleton (Autoload "")
[ "let s:loaded = {}"
, "let s:path = expand('<sfile>:p:h:h')"
, "let s:mivpath = expand('<sfile>:p:h:h:h') . '/'"
, "function! miv#load(name) abort"
, " if has_key(s:loaded, a:name)"
, " return"
, " endif"
, " let s:loaded[a:name] = 1"
, " for n in get(s:dependon, a:name, [])"
, " call miv#load(n)"
, " endfor"
, " for mode in get(s:mapmodes, a:name, [ 'n', 'v' ])"
, " for mapping in get(s:mappings, a:name, [])"
, " silent! execute mode . 'unmap' mapping"
, " endfor"
, " endfor"
, " let name = substitute(tolower(a:name), '[^a-z0-9]', '', 'g')"
, " let au = has_key(s:autoload, name) && get(s:autoloads, s:autoload[name])"
, " if au"
, " call miv#{s:autoload[name]}#before_{name}()"
, " endif"
, " let newrtp = s:mivpath . a:name . '/'"
, " if !isdirectory(newrtp)"
, " return"
, " endif"
, " let rtps = split(&rtp, ',')"
, " let i = index(map(deepcopy(rtps), 'resolve(v:val)'), s:path)"
, " if i < 0"
, " let mivpath = get(filter(deepcopy(rtps), 'v:val =~# \"miv.\\\\?$\"'), 0, '')"
, " let i = max([0, index(deepcopy(rtps), mivpath)])"
, " endif"
, " let &rtp = join(insert(rtps, newrtp, i), ',')"
, " if isdirectory(newrtp . 'after/')"
, " exec 'set rtp+=' . newrtp . 'after/'"
, " endif"
, " for dir in filter(['plugin', 'after/plugin'], 'isdirectory(newrtp . v:val)')"
, " for file in split(glob(newrtp . dir . '/**/*.vim'), '\\n')"
, " silent! source `=file`"
, " endfor"
, " endfor"
, " if au"
, " call miv#{s:autoload[name]}#after_{name}()"
, " endif"
, " for n in get(s:dependedby, a:name, [])"
, " call miv#load(n)"
, " endfor"
, "endfunction"
])