CtrlP matcher written in Haskell (uses nvim-hs)

gistfile1.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where

import           Neovim
import           Neovim.API.Plugin

import qualified Data.ByteString       as B
import           Data.List             (foldl', sortBy)
import           Data.MessagePack
import           System.Log.Logger
import           Text.Regex.PCRE.Light

main :: IO ()
main = neovim def
    { logOptions = Just ("nvim-log.txt", DEBUG)
    , plugins    = [ ctrlpMatcher ]
    }

ctrlpMatcher :: IO SomePlugin
ctrlpMatcher = do
    debugM "ctrlpMatcher" "Starting"
    return $ SomePlugin $ Plugin
      { name = "CtrlP matcher written in Haskell"
      , functions = [ ("CtrlPHsMatch", matcher) ]
      , statefulFunctions = [ ]
      , services = [ ]
      }

unwrapBinary :: Object -> Neovim' B.ByteString
unwrapBinary (ObjectBinary b) = return b
unwrapBinary notBin = throwError $ "Argument is not a binary: " ++ show notBin

filenameScore :: B.ByteString -> Regex -> Int64
filenameScore bs regex =
    maybe 0 (foldl' (\c b -> c + fromIntegral (B.length b)) 0) $ match regex bs []

-- TODO: Only runs in regex mode, ignores all settings.
matcher :: [Object] -> Neovim' Object
matcher [ObjectArray items,
         ObjectBinary str,
         ObjectInt limit,
         ObjectBinary mmode,
         ObjectInt isPath,
         ObjectBinary crfile,
         ObjectInt aregex] = do
  -- liftIO $ debugM "CtrlpHsMatch" $ "str: " ++ show str
  items' <- mapM unwrapBinary items

  let regex = compile str [caseless, no_auto_capture]
  let ret   = sortBy (\a b -> fst b `compare` fst a) $
                map (\l -> (filenameScore l regex, l)) items'

  return . ObjectArray $ map (ObjectBinary . snd) ret

matcher args = do
    liftIO $ debugM "plugin" $ "Unexpected arguments: " ++ show args
    throwError $ "Unexpected arguments: " ++ show args

gistfile2.vim

let s:plugin_path = escape(expand('<sfile>:p:h'), '\')
echo s:plugin_path . '/.cabal-sandbox/bin/ctrlp-matcher'
let s:rpc_chan = rpcstart(s:plugin_path . '/.cabal-sandbox/bin/ctrlp-matcher', [])

function! ctrlp_hs_matcher#echo_rpc_chan()
  echo s:rpc_chan
endfunction

function! ctrlp_hs_matcher#HsMatch(items, str, limit, mmode, ispath, crfile, regex)
  " TODO: Highlight matches

  if a:str == ''
    return a:items
  endif

  return rpcrequest(s:rpc_chan, 'CtrlPHsMatch', a:items, a:str, a:limit, a:mmode, a:ispath, a:crfile, a:regex)
endfunction

let g:ctrlp_match_func = { 'match': 'ctrlp_hs_matcher#HsMatch' }