packages feed

ribosome (empty) → 0.1.0.0

raw patch · 33 files changed

+1109/−0 lines, 33 filesdep +HTFdep +MissingHdep +aeson

Dependencies added: HTF, MissingH, aeson, ansi-terminal, base, bytestring, containers, data-default-class, deepseq, directory, either, filepath, hslogger, lens, messagepack, mtl, nvim-hs, pretty-terminal, prettyprinter, process, resourcet, ribosome, safe, split, stm, strings, text, time, transformers, unliftio, utf8-string

Files

+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2018 Torsten Schmits++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies+of the Software, and to permit persons to whom the Software is furnished to do+so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ lib/Ribosome/Api/Buffer.hs view
@@ -0,0 +1,53 @@+module Ribosome.Api.Buffer(+  edit,+  buflisted,+  setBufferContent,+  bufferContent,+  currentBufferContent,+  setCurrentBufferContent,+) where++import Neovim (+  Neovim,+  Buffer,+  NvimObject(..),+  Object,+  toObject,+  vim_command',+  vim_call_function',+  buffer_get_number',+  buffer_get_lines',+  buffer_set_lines',+  vim_get_current_buffer',+  )+import Ribosome.Control.Ribo (Ribo)++edit :: FilePath -> Ribo e ()+edit path = vim_command' $ "silent! edit " ++ path++nvimCallBool :: String -> [Object] -> Neovim e Bool+nvimCallBool fun args =+  vim_call_function' fun args >>= fromObject'++buflisted :: Buffer -> Neovim e Bool+buflisted buf = do+  num <- buffer_get_number' buf+  nvimCallBool "buflisted" [toObject num]++bufferContent :: Buffer -> Neovim e [String]+bufferContent buffer =+  buffer_get_lines' buffer 0 (-1) False++currentBufferContent :: Neovim e [String]+currentBufferContent = do+  buffer <- vim_get_current_buffer'+  bufferContent buffer++setBufferContent :: Buffer -> [String] -> Neovim e ()+setBufferContent buffer =+  buffer_set_lines' buffer 0 (-1) False++setCurrentBufferContent :: [String] -> Neovim e ()+setCurrentBufferContent content = do+  buffer <- vim_get_current_buffer'+  setBufferContent buffer content
+ lib/Ribosome/Api/Echo.hs view
@@ -0,0 +1,20 @@+module Ribosome.Api.Echo(+  echom,+  echomS,+) where++import Neovim (vim_command')+import Ribosome.Control.Ribo (Ribo)+import qualified Ribosome.Control.Ribo as Ribo (name)++escapeQuotes :: Char -> String+escapeQuotes '\'' = "''"+escapeQuotes a = [a]++echom :: String -> Ribo e ()+echom msg = do+  name <- Ribo.name+  vim_command' $ "echom '" ++ name ++ ": " ++ concatMap escapeQuotes msg ++ "'"++echomS :: Show a => a -> Ribo e ()+echomS = echom . show
+ lib/Ribosome/Api/Function.hs view
@@ -0,0 +1,8 @@+module Ribosome.Api.Function(+  callFunction,+) where++import Neovim (Neovim, fromObject', NvimObject, Object, vim_call_function')++callFunction :: NvimObject a => String -> [Object] -> Neovim e a+callFunction name args = vim_call_function' name args >>= fromObject'
+ lib/Ribosome/Api/Option.hs view
@@ -0,0 +1,30 @@+module Ribosome.Api.Option(+  optionCat,+  rtpCat,+  optionList,+  option,+  optionString,+) where++import Control.Monad ((>=>))+import Data.List.Split (splitOn)+import Neovim (Neovim, vim_get_option', fromObject', vim_set_option', toObject, NvimObject)++optionCat :: String -> String -> Neovim e ()+optionCat name extra = do+  current <- vim_get_option' name >>= fromObject'+  vim_set_option' name $ toObject $ current ++ "," ++ extra++rtpCat :: String -> Neovim e ()+rtpCat = optionCat "runtimepath"++option :: NvimObject a => String -> Neovim e a+option = vim_get_option' >=> fromObject'++optionString :: String -> Neovim e String+optionString = option++optionList :: String -> Neovim e [String]+optionList name = do+  s <- option name+  return $ splitOn "," s
+ lib/Ribosome/Api/Path.hs view
@@ -0,0 +1,8 @@+module Ribosome.Api.Path(+  nvimCwd,+) where++import Neovim (Neovim, vim_call_function', fromObject')++nvimCwd :: Neovim e FilePath+nvimCwd = vim_call_function' "getcwd" [] >>= fromObject'
+ lib/Ribosome/Api/Response.hs view
@@ -0,0 +1,27 @@+module Ribosome.Api.Response(+  nvimFatal,+  nvimResponseString,+  nvimResponseStringArray,+  nvimValidateFatal,+)+where++import Data.ByteString.UTF8+import Neovim++nvimFatal :: Either NeovimException a -> Neovim env a+nvimFatal (Right a) = return a+nvimFatal (Left e) = (liftIO . fail . show) e++nvimResponseString :: Object -> Neovim env String+nvimResponseString (ObjectString a) = return $ toString a+nvimResponseString a = liftIO . fail $ "invalid nvim type for String: " ++ show a++nvimResponseStringArray :: Object -> Neovim env [String]+nvimResponseStringArray (ObjectArray a) = traverse nvimResponseString a+nvimResponseStringArray a = liftIO . fail $ "invalid nvim type for Array: " ++ show a++nvimValidateFatal :: (Object -> Neovim env a) -> Either NeovimException Object -> Neovim env a+nvimValidateFatal validate response = do+  result <- nvimFatal response+  validate result
+ lib/Ribosome/Api/Window.hs view
@@ -0,0 +1,3 @@+module Ribosome.Api.Window(+) where+
+ lib/Ribosome/Config/Setting.hs view
@@ -0,0 +1,47 @@+module Ribosome.Config.Setting(+  Setting (..),+  setting,+  settingE,+  updateSetting,+  settingVariableName,+) where++import Neovim+import Ribosome.Control.Ribo (Ribo)+import qualified Ribosome.Control.Ribosome as R (name)++data Setting a =+  Setting {+    name :: String,+    prefix :: Bool,+    fallback :: Maybe a+  }++settingVariableName :: Setting a -> Ribo e String+settingVariableName (Setting n False _) = return n+settingVariableName (Setting n True _) = do+  pluginName <- R.name <$> ask+  return $ pluginName ++ "_" ++ n++settingE :: NvimObject a => Setting a -> Ribo e (Either String a)+settingE s@(Setting _ _ fallback') = do+  varName <- settingVariableName s+  raw <- vim_get_var varName+  case raw of+    Right o -> fromObject' o+    Left a -> return $ case fallback' of+      Just fb -> Right fb+      Nothing -> Left $ show a++setting :: NvimObject a => Setting a -> Ribo e a+setting s = do+  raw <- settingE s+  case raw of+    Right o -> return o+    Left e -> fail e++updateSetting :: NvimObject a => Setting a -> a -> Ribo e ()+updateSetting s a = do+  varName <- settingVariableName s+  _ <- vim_set_var' varName (toObject a)+  return ()
+ lib/Ribosome/Config/Settings.hs view
@@ -0,0 +1,8 @@+module Ribosome.Config.Settings(+  persistenceDir,+) where++import Ribosome.Config.Setting (Setting(Setting))++persistenceDir :: Setting FilePath+persistenceDir = Setting "ribosome_persistence_dir" False Nothing
+ lib/Ribosome/Control/Ribo.hs view
@@ -0,0 +1,69 @@+module Ribosome.Control.Ribo(+  Ribo,+  state,+  inspect,+  modify,+  name,+  lockOrSkip,+) where++import Control.Concurrent.STM.TVar (modifyTVar)+import qualified Control.Lens as Lens (view, over, at)+import qualified Data.Map.Strict as Map (insert)+import UnliftIO (finally)+import UnliftIO.STM (TVar, TMVar, atomically, readTVarIO, newTMVarIO, tryTakeTMVar, tryPutTMVar)+import Neovim (Neovim, ask)+import Ribosome.Control.Ribosome (Ribosome(Ribosome), Locks)+import qualified Ribosome.Control.Ribosome as Ribosome (_locks, locks)++type Ribo e = Neovim (Ribosome e)++state :: Ribo (TVar e) e+state = do+  Ribosome _ _ t <- ask+  readTVarIO t++inspect :: (e -> a) -> Ribo (TVar e) a+inspect f = fmap f state++modify :: (e -> e) -> Ribo (TVar e) ()+modify f = do+  Ribosome _ _ t <- ask+  atomically $ modifyTVar t f++name :: Ribo e String+name = do+  Ribosome n _ _ <- ask+  return n++getLocks :: Ribo e Locks+getLocks = do+  Ribosome _ intTv _ <- ask+  int <- readTVarIO intTv+  return $ Ribosome.locks int++inspectLocks :: (Locks -> a) -> Ribo e a+inspectLocks f = fmap f getLocks++modifyLocks :: (Locks -> Locks) -> Ribo e ()+modifyLocks f = do+  Ribosome _ intTv _ <- ask+  atomically $ modifyTVar intTv $ Lens.over Ribosome._locks f++getOrCreateLock :: String -> Ribo e (TMVar ())+getOrCreateLock key = do+  currentLock <- inspectLocks $ Lens.view $ Lens.at key+  case currentLock of+    Just tv -> return tv+    Nothing -> do+      tv <- newTMVarIO ()+      modifyLocks $ Map.insert key tv+      getOrCreateLock key++lockOrSkip :: String -> Ribo e () -> Ribo e ()+lockOrSkip key thunk = do+  currentLock <- getOrCreateLock key+  currentState <- atomically $ tryTakeTMVar currentLock+  case currentState of+    Just _ -> finally thunk $ atomically $ tryPutTMVar currentLock ()+    Nothing -> return ()
+ lib/Ribosome/Control/Ribosome.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}++module Ribosome.Control.Ribosome(+  Ribosome (..),+  newRibosome,+  RibosomeInternal (..),+  _internal,+  _locks,+  Locks,+  newInternalTVar,+) where++import Control.Lens (makeClassy_)+import UnliftIO.STM (TVar, newTVarIO, TMVar)+import Control.Monad.IO.Class (MonadIO)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map (empty)++type Locks = Map String (TMVar ())++newtype RibosomeInternal =+  RibosomeInternal {+    locks :: Locks+  }+makeClassy_ ''RibosomeInternal++data Ribosome e =+  Ribosome {+    name :: String,+    internal :: TVar RibosomeInternal,+    env :: e+  }+makeClassy_ ''Ribosome++newInternalTVar :: MonadIO m => m (TVar RibosomeInternal)+newInternalTVar = newTVarIO (RibosomeInternal Map.empty)++newRibosome :: MonadIO m => String -> e -> m (Ribosome (TVar e))+newRibosome name' env' = do+  envTv <- newTVarIO env'+  intTv <- newInternalTVar+  return $ Ribosome name' intTv envTv
+ lib/Ribosome/Data/Errors.hs view
@@ -0,0 +1,27 @@+module Ribosome.Data.Errors(+  ComponentName(..),+  Error(..),+  Errors(..),+) where++import qualified Data.Map as Map+import Data.Default.Class (Default(def))+import Data.Map.Strict (Map)++newtype ComponentName =+  ComponentName String+  deriving (Eq, Ord, Show)++data Error =+  Error {+    errorTimestamp :: Int,+    errorMessage :: [String]+  }+  deriving Show++newtype Errors =+  Errors (Map ComponentName [Error])+  deriving Show++instance Default Errors where+  def = Errors Map.empty
+ lib/Ribosome/Data/Foldable.hs view
@@ -0,0 +1,12 @@+module Ribosome.Data.Foldable(+  findMapMaybeM,+) where++import Control.Monad (foldM)++findMapMaybeM :: (Monad m, Foldable f) => (a -> m (Maybe b)) -> f a -> m (Maybe b)+findMapMaybeM f fa =+  foldM evaluate Nothing fa+  where+    evaluate (Just b) _ = return (Just b)+    evaluate Nothing a = f a
+ lib/Ribosome/Data/Maybe.hs view
@@ -0,0 +1,7 @@+module Ribosome.Data.Maybe(+  orElse,+) where++orElse :: Maybe a -> Maybe a -> Maybe a+orElse fallback Nothing = fallback+orElse _ a = a
+ lib/Ribosome/Data/Scratch.hs view
@@ -0,0 +1,13 @@+module Ribosome.Data.Scratch(+  Scratch(..),+) where++import Neovim (Buffer, Window, Tabpage)++data Scratch =+  Scratch {+    scratchBuffer :: Buffer,+    scratchWindow :: Window,+    scratchTab :: Maybe Tabpage+  }+  deriving (Eq, Show)
+ lib/Ribosome/Data/ScratchOptions.hs view
@@ -0,0 +1,16 @@+module Ribosome.Data.ScratchOptions(+  ScratchOptions(..),+  defaultScratchOptions,+) where++data ScratchOptions =+  ScratchOptions {+    tab :: Bool,+    vertical :: Bool,+    size :: Maybe Int,+    wrap :: Bool,+    name :: String+  }++defaultScratchOptions :: String -> ScratchOptions+defaultScratchOptions = ScratchOptions False False Nothing False
+ lib/Ribosome/File.hs view
@@ -0,0 +1,23 @@+module Ribosome.File(+  canonicalPathWithHome,+  canonicalPath,+  canonicalPaths,+) where++import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.String.Utils (replace)+import System.Directory (getHomeDirectory, canonicalizePath)++canonicalPathWithHome :: FilePath -> FilePath -> FilePath+canonicalPathWithHome = replace "~"++canonicalPath :: MonadIO m => FilePath -> m FilePath+canonicalPath path = do+  home <- liftIO getHomeDirectory+  return $ canonicalPathWithHome home path++canonicalPaths :: MonadIO m => [FilePath] -> m [FilePath]+canonicalPaths paths = do+  home <- liftIO getHomeDirectory+  let withHome = fmap (canonicalPathWithHome home) paths+  liftIO $ mapM canonicalizePath withHome
+ lib/Ribosome/Internal/IO.hs view
@@ -0,0 +1,25 @@+module Ribosome.Internal.IO(+  retypeNeovim,+  forkNeovim,+) where++import GHC.Conc.Sync (forkIO)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Reader (ask, runReaderT, withReaderT)+import Control.Monad.Trans.Resource (runResourceT)+import Data.Functor (void)+import Neovim.Context.Internal (Neovim(..), Config(..), retypeConfig, runNeovim)++-- try using Contravariant with this+retypeNeovim :: (e0 -> e1) -> Neovim e1 a -> Neovim e0 a+retypeNeovim transform thunk = do+  env <- Neovim ask+  liftIO $ runReaderT (withReaderT (newEnv env) $ runResourceT $ unNeovim thunk) env+  where+    newEnv = retypeConfig . transform . customConfig++forkNeovim :: Neovim e () -> Neovim e ()+forkNeovim thunk = do+  env <- Neovim ask+  _ <- liftIO $ forkIO $ void $ runNeovim env thunk+  return ()
+ lib/Ribosome/Internal/NvimObject.hs view
@@ -0,0 +1,28 @@+module Ribosome.Internal.NvimObject(+  deriveString,+  extractObject,+  extractObjectOr,+) where++import qualified Data.ByteString.UTF8 as UTF8 (fromString)+import Data.Map.Strict (Map, (!?))+import Data.Text.Prettyprint.Doc ((<+>), pretty)+import Neovim (Object(ObjectString), Doc, AnsiStyle, fromObject, NvimObject)++deriveString :: (String -> a) -> Object -> Either (Doc AnsiStyle) a+deriveString cons o = fmap cons (fromObject o :: Either (Doc AnsiStyle) String)++objectKeyMissing :: String -> Maybe Object -> Either (Doc AnsiStyle) Object+objectKeyMissing _ (Just o) = Right o+objectKeyMissing key Nothing = Left (pretty "missing key in nvim data:" <+> pretty key)++extractObject :: NvimObject o => String -> Map Object Object -> Either (Doc AnsiStyle) o+extractObject key data' = do+  value <- objectKeyMissing key $ data' !? (ObjectString . UTF8.fromString) key+  fromObject value++extractObjectOr :: NvimObject o => String -> o -> Map Object Object -> o+extractObjectOr key default' data' =+  case extractObject key data' of+    Right a -> a+    Left _ -> default'
+ lib/Ribosome/Log.hs view
@@ -0,0 +1,17 @@+module Ribosome.Log(+  debug,+  info,+  p,+) where++import Control.Monad.IO.Class (MonadIO, liftIO)+import Neovim.Log (debugM, infoM)++debug :: (MonadIO m, Show a) => String -> a -> m ()+debug name message = liftIO $ debugM name $ show message++info :: (MonadIO m, Show a) => String -> a -> m ()+info name message = liftIO $ infoM name $ show message++p :: (MonadIO m, Show a) => a -> m ()+p = liftIO . print
+ lib/Ribosome/Monad.hs view
@@ -0,0 +1,13 @@+module Ribosome.Monad(+  liftExceptTIO,+  liftExceptT,+) where++import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Except (ExceptT(ExceptT))++liftExceptTIO :: (MonadIO m) => IO a -> ExceptT e m a+liftExceptTIO fa = ExceptT $ Right <$> liftIO fa++liftExceptT :: (Functor m) => m a -> ExceptT e m a+liftExceptT fa = ExceptT $ Right <$> fa
+ lib/Ribosome/Persist.hs view
@@ -0,0 +1,55 @@+module Ribosome.Persist(+  persistStore,+  persistenceFile,+  persistencePath,+  defaultPersistencePath,+  persistLoad,+) where++import GHC.IO.Exception (IOException)+import Control.Exception (try)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Except (ExceptT(ExceptT), catchE)+import Data.Aeson (ToJSON, FromJSON, encode, eitherDecode)+import qualified Data.ByteString.Lazy as B (writeFile, readFile, ByteString)+import System.FilePath (takeDirectory, (</>))+import System.Directory (getXdgDirectory, XdgDirectory(XdgCache), createDirectoryIfMissing)+import Ribosome.Monad (liftExceptT)+import Ribosome.Control.Ribo (Ribo)+import qualified Ribosome.Control.Ribo as Ribo (name)+import Ribosome.Config.Setting (settingE)+import qualified Ribosome.Config.Settings as S (persistenceDir)++defaultPersistencePath :: FilePath -> IO FilePath+defaultPersistencePath =+  getXdgDirectory XdgCache++persistencePath :: FilePath -> Ribo e FilePath+persistencePath path = do+  name <- Ribo.name+  let prefixed = name </> path+  custom <- settingE S.persistenceDir+  either (const $ liftIO $ defaultPersistencePath prefixed) (\c -> return $ c </> prefixed) custom++persistenceFile :: FilePath -> Ribo e FilePath+persistenceFile path = do+  file <- persistencePath path+  liftIO $ createDirectoryIfMissing True (takeDirectory file)+  return $ file ++ ".json"++persistStore :: ToJSON a => FilePath -> a -> Ribo e ()+persistStore path a = do+  file <- persistenceFile path+  liftIO $ B.writeFile file (encode a)++noSuchFile :: Monad m => FilePath -> ExceptT String m a+noSuchFile file = ExceptT $ return $ Left $ "persistence file " ++ file ++ " doesn't exist"++safeReadFile :: MonadIO m => FilePath -> m (Either IOException B.ByteString)+safeReadFile file = liftIO $ try $ B.readFile file++persistLoad :: FromJSON a => FilePath -> ExceptT String (Ribo e) a+persistLoad path = do+  file <- liftExceptT $ persistenceFile path+  json <- catchE (ExceptT $ safeReadFile file) (const $ noSuchFile file)+  ExceptT $ return $ eitherDecode json
+ lib/Ribosome/Scratch.hs view
@@ -0,0 +1,83 @@+module Ribosome.Scratch(+  showInScratch,+) where++import Neovim (+  Neovim,+  Buffer,+  Window,+  Tabpage,+  toObject,+  vim_command',+  vim_get_current_window',+  vim_get_current_tabpage',+  buffer_set_option',+  buffer_set_name',+  window_get_buffer',+  window_set_option',+  )+import Ribosome.Data.Scratch (Scratch(Scratch))+import Ribosome.Data.ScratchOptions (ScratchOptions(ScratchOptions))+import Ribosome.Api.Buffer (setBufferContent)++createScratchTab :: Neovim e Tabpage+createScratchTab = do+  vim_command' "tabnew"+  vim_get_current_tabpage'++createScratchWindow :: Bool -> Bool -> Maybe Int -> Neovim e Window+createScratchWindow vertical wrap size = do+  vim_command' $ prefix ++ cmd+  win <- vim_get_current_window'+  window_set_option' win "wrap" (toObject wrap)+  return win+  where+    cmd = if vertical then "vnew" else "new"+    prefix = maybe "" show size++createScratchUiInTab :: Neovim e (Window, Maybe Tabpage)+createScratchUiInTab = do+  tab <- createScratchTab+  win <- vim_get_current_window'+  return (win, Just tab)++createScratchUiInWindow :: Bool -> Bool -> Maybe Int -> Neovim e (Window, Maybe Tabpage)+createScratchUiInWindow vertical wrap size = do+  win <- createScratchWindow vertical wrap size+  return (win, Nothing)++createScratchUi :: Bool -> Bool -> Bool -> Maybe Int -> Neovim e (Window, Maybe Tabpage)+createScratchUi True _ _ _ =+  createScratchUiInTab+createScratchUi False vertical wrap size =+  createScratchUiInWindow vertical wrap size++configureScratchBuffer :: Buffer -> String -> Neovim e ()+configureScratchBuffer buffer name = do+  buffer_set_option' buffer "buftype" (toObject "nofile")+  buffer_set_option' buffer "bufhidden" (toObject "wipe")+  buffer_set_name' buffer name++setupScratchBuffer :: Window -> String -> Neovim e Buffer+setupScratchBuffer window name = do+  buffer <- window_get_buffer' window+  configureScratchBuffer buffer name+  return buffer++createScratch :: ScratchOptions -> Neovim e Scratch+createScratch (ScratchOptions useTab vertical size wrap name) = do+  (window, tab) <- createScratchUi useTab vertical wrap size+  buffer <- setupScratchBuffer window name+  return (Scratch buffer window tab)++setScratchContent :: Scratch -> [String] -> Neovim e ()+setScratchContent (Scratch buffer _ _) lines' = do+  buffer_set_option' buffer "modifiable" (toObject True)+  setBufferContent buffer lines'+  buffer_set_option' buffer "modifiable" (toObject False)++showInScratch :: [String] -> ScratchOptions -> Neovim e Scratch+showInScratch lines' options = do+  scratch <- createScratch options+  setScratchContent scratch lines'+  return scratch
+ lib/Ribosome/Test/Embed.hs view
@@ -0,0 +1,56 @@+module Ribosome.Test.Embed(+  defaultTestConfig,+  defaultTestConfigWith,+  TestConfig (..),+  Vars(..),+  unsafeEmbeddedSpec,+  setVars,+  setupPluginEnv,+) where++import Control.Monad.IO.Class (liftIO)+import Data.Default.Class (Default(def))+import Data.Foldable (traverse_)+import System.Directory (makeAbsolute)+import Neovim (Neovim, Object, vim_set_var')+import Neovim.Test (testWithEmbeddedNeovim, Seconds(..))+import Ribosome.Control.Ribo (Ribo)+import Ribosome.Control.Ribosome (Ribosome(Ribosome), newInternalTVar)+import Ribosome.Api.Option (rtpCat)++type Runner env = TestConfig -> Neovim env () -> Neovim env ()++newtype Vars = Vars [(String, Object)]++data TestConfig =+  TestConfig {+    pluginName :: String,+    extraRtp :: String,+    logPath :: FilePath,+    tcTimeout :: Word,+    variables :: Vars+  }++instance Default TestConfig where+  def = TestConfig "ribosome" "test/f/fixtures/rtp" "test/f/temp/log" 5 (Vars [])++defaultTestConfigWith :: String -> Vars -> TestConfig+defaultTestConfigWith name = TestConfig name "test/f/fixtures/rtp" "test/f/temp/log" 5++defaultTestConfig :: String -> TestConfig+defaultTestConfig name = defaultTestConfigWith name (Vars [])++setVars :: Vars -> Neovim e ()+setVars (Vars vars) =+  traverse_ (uncurry vim_set_var') vars++setupPluginEnv :: TestConfig -> Neovim e ()+setupPluginEnv (TestConfig _ rtp _ _ vars) = do+  absRtp <- liftIO $ makeAbsolute rtp+  rtpCat absRtp+  setVars vars++unsafeEmbeddedSpec :: Runner (Ribosome e) -> TestConfig -> e -> Ribo e () -> IO ()+unsafeEmbeddedSpec runner conf env spec = do+  internal <- newInternalTVar+  testWithEmbeddedNeovim Nothing (Seconds (tcTimeout conf)) (Ribosome (pluginName conf) internal env) $ runner conf spec
+ lib/Ribosome/Test/Exists.hs view
@@ -0,0 +1,44 @@+module Ribosome.Test.Exists(+  waitForPlugin,+  sleep,+) where++import Data.Time.Clock.POSIX+import Data.Strings (strCapitalize)+import Control.Monad.IO.Class+import Control.Concurrent (threadDelay)+import Neovim++epochSeconds :: MonadIO f => f Int+epochSeconds = liftIO $ fmap round getPOSIXTime++sleep :: MonadIO f => Double -> f ()+sleep seconds = liftIO $ threadDelay $ round $ seconds * 10e6++retry :: MonadIO f => Double -> Int -> f a -> (a -> f (Either String b)) -> f b+retry interval timeout thunk check = do+  start <- epochSeconds+  step start+  where+    step start = do+      result <- thunk+      checked <- check result+      recurse start checked+    recurse _ (Right b) = return b+    recurse start (Left e) = do+      current <- epochSeconds+      if (current - start) < timeout+      then do+        sleep interval+        step start+      else fail e++waitForPlugin :: String -> Double -> Int -> Neovim env ()+waitForPlugin name interval timeout =+  retry interval timeout thunk check+  where+    thunk = vim_call_function "exists" [toObject $ "*" ++ strCapitalize name ++ "Poll"]+    check (Right (ObjectInt 1)) = return $ Right ()+    check (Right a) = return $ Left $ errormsg ++ "weird return type " ++ show a+    check (Left e) = return $ Left $ errormsg ++ show e+    errormsg = "plugin didn't start within " ++ show timeout ++ " seconds: "
+ lib/Ribosome/Test/File.hs view
@@ -0,0 +1,32 @@+module Ribosome.Test.File(+  tempDirIO,+  tempDir,+  fixture,+) where++import Control.Monad.IO.Class (liftIO, MonadIO)+import System.Directory (canonicalizePath, createDirectoryIfMissing, removePathForcibly)+import System.FilePath ((</>))++testDir :: String -> IO FilePath+testDir prefix = canonicalizePath $ "test" </> prefix++-- raises exception if cwd is not the package root so we don't damage anything+tempDirIO :: String -> FilePath -> IO FilePath+tempDirIO prefix path = do+  base <- testDir prefix+  let dir = base </> "temp"+  removePathForcibly dir+  createDirectoryIfMissing False dir+  let absPath = dir </> path+  createDirectoryIfMissing True absPath+  return absPath++tempDir :: MonadIO m => String -> FilePath -> m FilePath+tempDir prefix path =+  liftIO $ tempDirIO prefix path++fixture :: MonadIO m => String -> FilePath -> m FilePath+fixture prefix path = do+  base <- liftIO $ testDir prefix+  return $ base </> "fixtures" </> path
+ lib/Ribosome/Test/Functional.hs view
@@ -0,0 +1,80 @@+module Ribosome.Test.Functional(+  startPlugin,+  fSpec,+  functionalSpec,+  tempDir,+  tempFile,+  fixture,+) where++import Control.Monad (when)+import Control.Monad.IO.Class+import Control.Exception (finally)+import Data.Foldable (traverse_)+import System.Directory (getCurrentDirectory, createDirectoryIfMissing, removePathForcibly, doesFileExist, makeAbsolute)+import System.FilePath (takeDirectory, (</>), takeFileName)+import System.Console.ANSI (setSGR, SGR(SetColor, Reset), ConsoleLayer(Foreground), ColorIntensity(Dull), Color(Green))+import Neovim (Neovim, vim_command')+import Ribosome.Control.Ribo (Ribo)+import Ribosome.Test.Exists (waitForPlugin)+import Ribosome.Test.Embed (TestConfig(..), unsafeEmbeddedSpec, setupPluginEnv)+import qualified Ribosome.Test.File as F (tempDir, fixture)++jobstart :: MonadIO f => String -> f String+jobstart cmd = do+  dir <- liftIO getCurrentDirectory+  return $ "call jobstart('" ++ cmd ++ "', { 'rpc': v:true, 'cwd': '" ++ dir ++ "' })"++logFile :: TestConfig -> IO FilePath+logFile conf = makeAbsolute $ logPath conf ++ "-spec"++startPlugin :: TestConfig -> Neovim env ()+startPlugin conf = do+  absLogPath <- liftIO $ makeAbsolute (logPath conf)+  absLogFile <- liftIO $ logFile conf+  liftIO $ createDirectoryIfMissing True (takeDirectory absLogPath)+  liftIO $ removePathForcibly absLogFile+  setupPluginEnv conf+  cmd <- jobstart $ "stack run -- -l " ++ absLogFile ++ " -v INFO"+  vim_command' cmd+  waitForPlugin (pluginName conf) 0.1 3++fSpec :: TestConfig -> Neovim env () -> Neovim env ()+fSpec conf spec = startPlugin conf >> spec++showLog' :: String -> IO ()+showLog' output = do+  putStrLn ""+  setSGR [SetColor Foreground Dull Green]+  putStrLn "plugin output:"+  setSGR [Reset]+  traverse_ putStrLn (lines output)+  putStrLn ""++showLog :: TestConfig -> IO ()+showLog conf = do+  file <- logFile conf+  exists <- doesFileExist file+  when exists $ do+    output <- readFile file+    case output of+      [] -> return ()+      o -> showLog' o++functionalSpec :: TestConfig -> Ribo () () -> IO ()+functionalSpec conf spec =+  finally (unsafeEmbeddedSpec fSpec conf () spec) (showLog conf)++fPrefix :: String+fPrefix = "f"++tempDir :: FilePath -> Neovim e FilePath+tempDir = F.tempDir fPrefix++tempFile :: FilePath -> Neovim e FilePath+tempFile file = do+  absDir <- tempDir $ takeDirectory file+  return $ absDir </> takeFileName file++fixture :: MonadIO m => FilePath -> m FilePath+fixture = F.fixture fPrefix
+ lib/Ribosome/Test/Unit.hs view
@@ -0,0 +1,37 @@+module Ribosome.Test.Unit(+  unitSpec,+  tempDir,+  tempFile,+  uPrefix,+  fixture,+) where++import Control.Monad.IO.Class (MonadIO)+import System.FilePath (takeDirectory, takeFileName, (</>))+import Neovim (Neovim)+import Ribosome.Control.Ribo (Ribo)+import Ribosome.Test.Embed (TestConfig(..), setupPluginEnv, unsafeEmbeddedSpec)+import qualified Ribosome.Test.File as F (tempDir, fixture)++uPrefix :: String+uPrefix = "u"++uSpec :: TestConfig -> Neovim env () -> Neovim env ()+uSpec conf spec = do+  setupPluginEnv conf+  spec++unitSpec :: TestConfig -> e -> Ribo e () -> IO ()+unitSpec =+  unsafeEmbeddedSpec uSpec++tempDir :: FilePath -> Neovim e FilePath+tempDir = F.tempDir uPrefix++tempFile :: FilePath -> Neovim e FilePath+tempFile file = do+  absDir <- tempDir $ takeDirectory file+  return $ absDir </> takeFileName file++fixture :: MonadIO m => FilePath -> m FilePath+fixture = F.fixture uPrefix
+ lib/Ribosome/Unsafe.hs view
@@ -0,0 +1,8 @@+module Ribosome.Unsafe(+  unsafeLog,+) where++import GHC.IO.Unsafe (unsafePerformIO)++unsafeLog :: Show a => a -> b -> b+unsafeLog a b = unsafePerformIO $ (print a) >> return b
+ ribosome.cabal view
@@ -0,0 +1,176 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.1.+--+-- see: https://github.com/sol/hpack+--+-- hash: 3044c78924fbc3f752664beb04fcb36f3821d795c7a8fc89a0ecdfa32e894805++name:           ribosome+version:        0.1.0.0+synopsis:       api extensions for nvim-hs+description:    Please see the README on GitHub at <https://github.com/tek/proteome-hs>+category:       Neovim+homepage:       https://github.com/tek/ribosome-hs#readme+bug-reports:    https://github.com/tek/ribosome-hs/issues+author:         Torsten Schmits+maintainer:     tek@tryp.io+copyright:      2018 Torsten Schmits+license:        MIT+license-file:   LICENSE+build-type:     Simple++source-repository head+  type: git+  location: https://github.com/tek/ribosome-hs++library+  exposed-modules:+      Ribosome.Api.Buffer+      Ribosome.Api.Echo+      Ribosome.Api.Function+      Ribosome.Api.Option+      Ribosome.Api.Path+      Ribosome.Api.Response+      Ribosome.Api.Window+      Ribosome.Config.Setting+      Ribosome.Config.Settings+      Ribosome.Control.Ribo+      Ribosome.Control.Ribosome+      Ribosome.Data.Errors+      Ribosome.Data.Foldable+      Ribosome.Data.Maybe+      Ribosome.Data.Scratch+      Ribosome.Data.ScratchOptions+      Ribosome.File+      Ribosome.Internal.IO+      Ribosome.Internal.NvimObject+      Ribosome.Log+      Ribosome.Monad+      Ribosome.Persist+      Ribosome.Scratch+      Ribosome.Test.Embed+      Ribosome.Test.Exists+      Ribosome.Test.File+      Ribosome.Test.Functional+      Ribosome.Test.Unit+      Ribosome.Unsafe+  other-modules:+      Paths_ribosome+  hs-source-dirs:+      lib+  build-depends:+      MissingH+    , aeson+    , ansi-terminal+    , base >=4.7 && <5+    , bytestring+    , containers+    , data-default-class+    , deepseq+    , directory+    , either+    , filepath+    , hslogger+    , lens+    , messagepack+    , mtl+    , nvim-hs+    , pretty-terminal+    , prettyprinter+    , process+    , resourcet+    , safe+    , split+    , stm+    , strings+    , text+    , time+    , transformers+    , unliftio+    , utf8-string+  default-language: Haskell2010++test-suite ribosome-functional+  type: exitcode-stdio-1.0+  main-is: SpecMain.hs+  other-modules:+      Paths_ribosome+  hs-source-dirs:+      test/f+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      HTF+    , MissingH+    , aeson+    , ansi-terminal+    , base >=4.7 && <5+    , bytestring+    , containers+    , data-default-class+    , deepseq+    , directory+    , either+    , filepath+    , hslogger+    , lens+    , messagepack+    , mtl+    , nvim-hs+    , pretty-terminal+    , prettyprinter+    , process+    , resourcet+    , ribosome+    , safe+    , split+    , stm+    , strings+    , text+    , time+    , transformers+    , unliftio+    , utf8-string+  default-language: Haskell2010++test-suite ribosome-unit+  type: exitcode-stdio-1.0+  main-is: SpecMain.hs+  other-modules:+      Paths_ribosome+  hs-source-dirs:+      test/u+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      HTF+    , MissingH+    , aeson+    , ansi-terminal+    , base >=4.7 && <5+    , bytestring+    , containers+    , data-default-class+    , deepseq+    , directory+    , either+    , filepath+    , hslogger+    , lens+    , messagepack+    , mtl+    , nvim-hs+    , pretty-terminal+    , prettyprinter+    , process+    , resourcet+    , ribosome+    , safe+    , split+    , stm+    , strings+    , text+    , time+    , transformers+    , unliftio+    , utf8-string+  default-language: Haskell2010
+ test/f/SpecMain.hs view
@@ -0,0 +1,9 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}++module Main where++import Test.Framework+import Test.Framework.BlackBoxTest ()++main :: IO ()+main = htfMain htf_importedTests
+ test/u/SpecMain.hs view
@@ -0,0 +1,9 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}++module Main where++import Test.Framework+import Test.Framework.BlackBoxTest ()++main :: IO ()+main = htfMain htf_importedTests