ribosome-root (empty) → 0.3.0.0
raw patch · 16 files changed
+1199/−0 lines, 16 filesdep +HTFdep +MissingHdep +aeson
Dependencies added: HTF, MissingH, aeson, ansi-terminal, base-noprelude, bytestring, chiasma, composition-extra, conduit, containers, cornea, data-default, deepseq, directory, either, exceptions, filepath, hslogger, lens, lifted-base, messagepack, monad-control, mtl, nvim-hs, pretty-terminal, prettyprinter, prettyprinter-ansi-terminal, process, relude, resourcet, ribosome, ribosome-test, safe, split, stm, template-haskell, text, th-abstraction, time, transformers, transformers-base, typed-process, unix, unliftio, unliftio-core, utf8-string
Files
- LICENSE +55/−0
- ribosome-root.cabal +99/−0
- test/u/AutocmdSpec.hs +57/−0
- test/u/MappingSpec.hs +71/−0
- test/u/MenuSpec.hs +194/−0
- test/u/MsgpackSpec.hs +103/−0
- test/u/NvimMenuSpec.hs +154/−0
- test/u/Prelude.hs +5/−0
- test/u/RpcSpec.hs +136/−0
- test/u/ScratchSpec.hs +68/−0
- test/u/SettingSpec.hs +58/−0
- test/u/SpecMain.hs +21/−0
- test/u/SyntaxSpec.hs +54/−0
- test/u/THSpec.hs +48/−0
- test/u/TestError.hs +29/−0
- test/u/WatcherSpec.hs +47/−0
+ LICENSE view
@@ -0,0 +1,55 @@+# Blue Oak Model License++Version 1.0.0++## Purpose++This license gives everyone as much permission to work with+this software as possible, while protecting contributors+from liability.++## Acceptance++In order to receive this license, you must agree to its+rules. The rules of this license are both obligations+under that agreement and conditions to your license.+You must not do anything with this software that triggers+a rule that you cannot or will not follow.++## Copyright++Each contributor licenses you to do everything with this+software that would otherwise infringe that contributor's+copyright in it.++## Notices++You must ensure that everyone who gets a copy of+any part of this software from you, with or without+changes, also gets the text of this license or a link to+<https://blueoakcouncil.org/license/1.0.0>.++## Excuse++If anyone notifies you in writing that you have not+complied with [Notices](#notices), you can keep your+license by taking all practical steps to comply within 30+days after the notice. If you do not do so, your license+ends immediately.++## Patent++Each contributor licenses you to do everything with this+software that would otherwise infringe any patent claims+they can license or become able to license.++## Reliability++No contributor can revoke this license.++## No Liability++***As far as the law allows, this software comes as is,+without any warranty or condition, and no contributor+will be liable to anyone for any damages related to this+software or this license, under any kind of legal claim.***
+ ribosome-root.cabal view
@@ -0,0 +1,99 @@+cabal-version: 1.12+name: ribosome-root+version: 0.3.0.0+license: OtherLicense+license-file: LICENSE+copyright: 2019 Torsten Schmits+maintainer: tek@tryp.io+author: Torsten Schmits+homepage: https://github.com/tek/ribosome-hs#readme+bug-reports: https://github.com/tek/ribosome-hs/issues+synopsis: api extensions for nvim-hs+description:+ Please see the README on GitHub at <https://github.com/tek/ribosome-hs>+category: Neovim+build-type: Simple++source-repository head+ type: git+ location: https://github.com/tek/ribosome-hs++test-suite ribosome-unit+ type: exitcode-stdio-1.0+ main-is: SpecMain.hs+ hs-source-dirs: test/u+ other-modules:+ AutocmdSpec+ MappingSpec+ MenuSpec+ MsgpackSpec+ NvimMenuSpec+ Prelude+ RpcSpec+ ScratchSpec+ SettingSpec+ SyntaxSpec+ TestError+ THSpec+ WatcherSpec+ Paths_ribosome_root+ default-language: Haskell2010+ default-extensions: AutoDeriveTypeable BangPatterns BinaryLiterals+ ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable+ DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable+ DoAndIfThenElse EmptyDataDecls ExistentialQuantification+ FlexibleContexts FlexibleInstances FunctionalDependencies GADTs+ GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase+ MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns+ OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds+ RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving+ TupleSections TypeApplications TypeFamilies TypeSynonymInstances+ UnicodeSyntax ViewPatterns+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ HTF >=0.13.2.5 && <0.14,+ MissingH >=1.4.1.0 && <1.5,+ aeson >=1.3.1.1 && <1.4,+ ansi-terminal >=0.8.2 && <0.9,+ base-noprelude >=4.7 && <5,+ bytestring >=0.10.8.2 && <0.11,+ chiasma >=0.1.0.0 && <0.2,+ composition-extra >=2.0.0 && <2.1,+ conduit >=1.3.1 && <1.4,+ containers >=0.5.11.0 && <0.6,+ cornea >=0.2.2.0 && <0.3,+ data-default >=0.7.1.1 && <0.8,+ deepseq >=1.4.3.0 && <1.5,+ directory >=1.3.1.5 && <1.4,+ either >=5.0.1 && <5.1,+ exceptions >=0.10.0 && <0.11,+ filepath >=1.4.2 && <1.5,+ hslogger >=1.2.12 && <1.3,+ lens >=4.16.1 && <4.17,+ lifted-base >=0.2.3.12 && <0.3,+ messagepack >=0.5.4 && <0.6,+ monad-control >=1.0.2.3 && <1.1,+ mtl >=2.2.2 && <2.3,+ nvim-hs >=2.1.0.0 && <2.2,+ pretty-terminal >=0.1.0.0 && <0.2,+ prettyprinter >=1.2.1 && <1.3,+ prettyprinter-ansi-terminal >=1.1.1.2 && <1.2,+ process >=1.6.3.0 && <1.7,+ relude >=0.1.1 && <0.2,+ resourcet >=1.2.2 && <1.3,+ ribosome >=0.3.0.0 && <0.4,+ ribosome-test >=0.3.0.0 && <0.4,+ safe >=0.3.17 && <0.4,+ split >=0.2.3.3 && <0.3,+ stm >=2.4.5.1 && <2.5,+ template-haskell >=2.13.0.0 && <2.14,+ text >=1.2.3.1 && <1.3,+ th-abstraction >=0.2.10.0 && <0.3,+ time >=1.8.0.2 && <1.9,+ transformers >=0.5.5.0 && <0.6,+ transformers-base >=0.4.5.2 && <0.5,+ typed-process >=0.2.3.0 && <0.3,+ unix >=2.7.2.2 && <2.8,+ unliftio >=0.2.9.0 && <0.3,+ unliftio-core >=0.1.2.0 && <0.2,+ utf8-string >=1.0.1.1 && <1.1
+ test/u/AutocmdSpec.hs view
@@ -0,0 +1,57 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE TemplateHaskell #-}++module AutocmdSpec(+ htf_thisModulesTests+) where++import Control.Monad.Trans.Except (ExceptT)+import Data.Default (def)+import Neovim (Neovim, Plugin(..))+import Test.Framework++import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE)+import Ribosome.Control.Ribosome (Ribosome, newRibosome)+import Ribosome.Msgpack.Encode (MsgpackEncode(toMsgpack))+import Ribosome.Nvim.Api.IO (vimCommand, vimGetVar, vimSetVar)+import Ribosome.Nvim.Api.RpcCall (RpcError)+import Ribosome.Orphans ()+import Ribosome.Plugin (autocmd, riboPlugin, rpcHandler)+import Ribosome.Test.Await (await)+import Ribosome.Test.Embed (integrationSpecDef)+import Ribosome.Test.Orphans ()+import TestError (handleTestError)++varName :: Text+varName =+ "result"++result :: Int+result =+ 5++testAuto ::+ NvimE e m =>+ MonadRibo m =>+ m ()+testAuto =+ vimSetVar varName (toMsgpack result)++$(return [])++autocmdPlugin :: IO (Plugin (Ribosome ()))+autocmdPlugin = do+ env <- newRibosome "test" ()+ return $ riboPlugin "test" env funcs [] handleTestError def+ where+ funcs = [$(rpcHandler (autocmd "BufWritePre") 'testAuto)]++autocmdSpec :: ExceptT RpcError (Neovim ()) ()+autocmdSpec = do+ () <- vimCommand "doautocmd BufWritePre"+ await (gassertEqual result) (vimGetVar varName)++test_autocmd :: IO ()+test_autocmd = do+ plug <- autocmdPlugin+ integrationSpecDef plug autocmdSpec
+ test/u/MappingSpec.hs view
@@ -0,0 +1,71 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE TemplateHaskell #-}++module MappingSpec (htf_thisModulesTests) where++import Control.Monad.Trans.Except (ExceptT)+import qualified Data.Map as Map (empty)+import Neovim (Neovim, Plugin(..))+import Test.Framework++import Ribosome.Api.Buffer (currentBufferContent)+import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE)+import Ribosome.Control.Ribosome (Ribosome, newRibosome)+import Ribosome.Data.Mapping (Mapping(Mapping), MappingIdent(MappingIdent))+import Ribosome.Data.ScratchOptions (ScratchOptions(ScratchOptions))+import Ribosome.Msgpack.Encode (MsgpackEncode(toMsgpack))+import Ribosome.Msgpack.Error (DecodeError)+import Ribosome.Nvim.Api.IO (nvimFeedkeys, vimCallFunction, vimGetVar, vimSetVar)+import Ribosome.Nvim.Api.RpcCall (RpcError)+import Ribosome.Plugin (riboPlugin, rpcHandlerDef)+import Ribosome.Plugin.Mapping (MappingHandler, mappingHandler)+import Ribosome.Scratch (showInScratch)+import Ribosome.Test.Await (await)+import Ribosome.Test.Embed (integrationSpecDef)+import Ribosome.Test.Orphans ()+import TestError (handleTestError)++target :: [Text]+target = ["line 1", "line 2"]++go :: NvimE e m => m ()+go =+ vimSetVar "number" (toMsgpack (13 :: Int))++mapping :: Mapping+mapping =+ Mapping (MappingIdent "go") "a" "n" False True++mapHandler :: NvimE e m => MappingHandler m+mapHandler =+ mappingHandler "go" go++setupMappingScratch ::+ MonadDeepError e DecodeError m =>+ MonadRibo m =>+ NvimE e m =>+ m ()+setupMappingScratch = do+ _ <- showInScratch target (ScratchOptions False True False True True True Nothing Nothing [] [mapping] "buffi")+ return ()++$(return [])++mappingPlugin :: IO (Plugin (Ribosome ()))+mappingPlugin = do+ env <- newRibosome "mapping" ()+ return $ riboPlugin "mapping" env funcs [mapHandler] handleTestError Map.empty+ where+ funcs = [$(rpcHandlerDef 'setupMappingScratch)]++mappingSpec :: ExceptT RpcError (Neovim ()) ()+mappingSpec = do+ () <- vimCallFunction "SetupMappingScratch" []+ await (gassertEqual target) currentBufferContent+ nvimFeedkeys "a" "x" False+ await (gassertEqual (13 :: Int)) (vimGetVar "number")++test_mapping :: IO ()+test_mapping = do+ plug <- mappingPlugin+ integrationSpecDef plug mappingSpec
+ test/u/MenuSpec.hs view
@@ -0,0 +1,194 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}++module MenuSpec (htf_thisModulesTests) where++import Conduit (ConduitT, yieldMany)+import Control.Concurrent.MVar.Lifted (modifyMVar_)+import Control.Monad.Trans.Control (MonadBaseControl)+import qualified Data.Map as Map (fromList)+import Test.Framework++import Ribosome.Control.StrictRibosome (StrictRibosome)+import Ribosome.Menu.Data.Menu (Menu(Menu))+import Ribosome.Menu.Data.MenuAction (MenuAction)+import Ribosome.Menu.Data.MenuConfig (MenuConfig(MenuConfig))+import Ribosome.Menu.Data.MenuConsumer (MenuConsumer(MenuConsumer))+import Ribosome.Menu.Data.MenuConsumerAction (MenuConsumerAction)+import qualified Ribosome.Menu.Data.MenuEvent as MenuEvent (MenuEvent(..))+import Ribosome.Menu.Data.MenuItem (MenuItem(MenuItem))+import qualified Ribosome.Menu.Data.MenuItem as MenuItem (MenuItem(_text))+import Ribosome.Menu.Data.MenuRenderEvent (MenuRenderEvent)+import qualified Ribosome.Menu.Data.MenuRenderEvent as MenuRenderEvent (MenuRenderEvent(..))+import Ribosome.Menu.Data.MenuUpdate (MenuUpdate(MenuUpdate))+import Ribosome.Menu.Prompt.Data.Prompt (Prompt(Prompt))+import Ribosome.Menu.Prompt.Data.PromptConfig (PromptConfig(PromptConfig))+import Ribosome.Menu.Prompt.Data.PromptEvent (PromptEvent)+import qualified Ribosome.Menu.Prompt.Data.PromptEvent as PromptEvent (PromptEvent(..))+import qualified Ribosome.Menu.Prompt.Data.PromptState as PromptState (PromptState(..))+import Ribosome.Menu.Prompt.Run (basicTransition, noPromptRenderer)+import Ribosome.Menu.Run (runMenu)+import Ribosome.Menu.Simple (basicMenu, menuContinue, menuQuit, simpleMenu)+import Ribosome.System.Time (sleep)++promptInput ::+ MonadIO m =>+ [Text] ->+ ConduitT () PromptEvent m ()+promptInput chars = do+ lift $ sleep 0.1+ yieldMany (PromptEvent.Character <$> chars)++menuItems ::+ Monad m =>+ [Text] ->+ ConduitT () MenuItem m ()+menuItems =+ yieldMany . fmap (MenuItem "name")++storePrompt ::+ MonadBaseControl IO m =>+ MVar [Prompt] ->+ MenuUpdate m a ->+ m (MenuConsumerAction m a, Menu)+storePrompt prompts (MenuUpdate event menu) =+ check event+ where+ check (MenuEvent.PromptChange _ prompt) =+ store prompt+ check (MenuEvent.Mapping _ prompt) =+ store prompt+ check (MenuEvent.Quit _) =+ menuQuit menu+ check _ =+ menuContinue menu+ store prompt =+ modifyMVar_ prompts (return . (prompt :)) *> menuContinue menu++render ::+ MonadIO m =>+ MonadBaseControl IO m =>+ MVar [[MenuItem]] ->+ MenuRenderEvent m a ->+ m ()+render varItems (MenuRenderEvent.Render _ (Menu _ items _ _ _)) = do+ modifyMVar_ varItems (return . (items :))+ sleep 0.01+render _ (MenuRenderEvent.Quit _) =+ return ()++type MenuTestM = StateT (StrictRibosome ()) IO++menuTest ::+ (MenuUpdate MenuTestM a -> MenuTestM (MenuAction MenuTestM a, Menu)) ->+ [Text] ->+ [Text] ->+ IO [[MenuItem]]+menuTest handler items chars = do+ itemsVar <- newMVar []+ void $ runMenu (MenuConfig (menuItems items) (MenuConsumer handler) (render itemsVar) promptConfig) `execStateT` def+ readMVar itemsVar+ where+ promptConfig =+ PromptConfig (promptInput chars) basicTransition noPromptRenderer True++promptTest :: [Text] -> [Text] -> IO ([[MenuItem]], [Prompt])+promptTest items chars = do+ prompts <- newMVar []+ itemsResult <- menuTest (basicMenu (storePrompt prompts)) items chars+ (itemsResult,) <$> readMVar prompts++promptsTarget1 :: [Prompt]+promptsTarget1 =+ uncurry one' <$> [+ (1, PromptState.Insert),+ (0, PromptState.Normal),+ (0, PromptState.Normal),+ (1, PromptState.Insert)+ ]+ where+ one' c s = Prompt c s "i"++items1 :: [Text]+items1 =+ [+ "i1",+ "j1",+ "i2",+ "i3",+ "j2",+ "i4"+ ]++chars1 :: [Text]+chars1 =+ [+ "i",+ "esc",+ "k",+ "a",+ "2"+ ]++itemsTarget1 :: [[MenuItem]]+itemsTarget1 =+ [+ item <$> ["i2"],+ item <$> ["i4", "i3", "i2", "i1"]+ ]+ where+ item =+ MenuItem "name"++test_strictMenuModeChange :: IO ()+test_strictMenuModeChange = do+ (items, prompts) <- promptTest items1 chars1+ assertEqual itemsTarget1 (take 2 items)+ assertEqual promptsTarget1 (take 4 $ reverse prompts)++chars2 :: [Text]+chars2 =+ ["l", "o", "n", "g", "-", "i", "t", "e", "m"]++items2 :: [Text]+items2 =+ [+ "long",+ "short",+ "long-item",+ "longitem"+ ]++itemsTarget :: [MenuItem]+itemsTarget =+ [MenuItem "name" "long-item"]++test_strictMenuFilter :: IO ()+test_strictMenuFilter = do+ items <- fst <$> promptTest items2 chars2+ assertEqual [itemsTarget] (take 1 items)++chars3 :: [Text]+chars3 =+ ["i", "esc", "cr"]++items3 :: [Text]+items3 =+ [+ "item1",+ "item2"+ ]++exec ::+ MonadIO m =>+ MVar [Text] ->+ Menu ->+ Prompt ->+ m (MenuConsumerAction m a, Menu)+exec var m@(Menu _ items _ _ _) _ =+ swapMVar var (MenuItem._text <$> items) *> menuQuit m++test_strictMenuExecute :: IO ()+test_strictMenuExecute = do+ var <- newMVar []+ _ <- menuTest (simpleMenu (Map.fromList [("cr", exec var)])) items3 chars3+ assertEqual (reverse items3) =<< readMVar var
+ test/u/MsgpackSpec.hs view
@@ -0,0 +1,103 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}++module MsgpackSpec(+ htf_thisModulesTests+) where++import Data.Int (Int64)+import Data.Map (Map)+import qualified Data.Map as Map (fromList)+import Data.MessagePack (Object(..))+import Data.Text (Text)+import Data.Text.Prettyprint.Doc (Doc, defaultLayoutOptions, layoutPretty)+import Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle, renderStrict)+import GHC.Generics (Generic)+import Test.Framework++import Ribosome.Msgpack.Decode (MsgpackDecode(..))+import Ribosome.Msgpack.Encode (MsgpackEncode(..))+import qualified Ribosome.Msgpack.Util as Util (string)++newtype NT =+ NT Text+ deriving (Eq, Show, Generic, MsgpackEncode, MsgpackDecode)++data Blob =+ Blob {+ key4 :: [[Int]],+ key5 :: Map Int Text,+ key6 :: NT,+ key7 :: (Int, String)+ }+ deriving (Eq, Show, Generic, MsgpackEncode, MsgpackDecode)++data Prod =+ Prod Text Int+ deriving (Eq, Show, Generic, MsgpackEncode, MsgpackDecode)++data Dat =+ Dat {+ key1 :: Blob,+ key2 :: Bool,+ key3 :: Maybe Prod+ }+ deriving (Eq, Show, Generic, MsgpackEncode, MsgpackDecode)++dat :: Dat+dat = Dat (Blob [[1, 2], [3]] (Map.fromList [(1, "1"), (2, "2")]) (NT "nt") (91, "pair")) False (Just $ Prod "dat" 27)++os :: String -> Object+os = Util.string++i :: Int64 -> Object+i = ObjectInt++encodedBlob :: Object+encodedBlob =+ ObjectMap $ Map.fromList [+ (os "key4", ObjectArray [ObjectArray [i 1, i 2], ObjectArray [i 3]]),+ (os "key5", ObjectMap $ Map.fromList [(i 1, os "1"), (i 2, os "2")]),+ (os "key6", os "nt"),+ (os "key7", ObjectArray [ObjectInt 91, ObjectString "pair"])+ ]++encoded :: Object+encoded =+ ObjectMap $ Map.fromList [+ (os "key1", encodedBlob),+ (os "key2", ObjectBool False),+ (os "key3", ObjectArray [os "dat", i 27])+ ]++test_encode :: IO ()+test_encode =+ assertEqual encoded (toMsgpack dat)++doc2Text :: Either (Doc AnsiStyle) a -> Either Text a+doc2Text =+ mapLeft (renderStrict . layoutPretty defaultLayoutOptions)++test_decode :: IO ()+test_decode =+ assertEqual (Right dat) (doc2Text $ fromMsgpack encoded)++data Nope =+ Nope {+ present :: Int,+ absent :: Maybe Int+ }+ deriving (Eq, Show, Generic, MsgpackDecode)++encodedNope :: Object+encodedNope =+ ObjectMap $ Map.fromList [(os "present", i 5)]++test_maybeMissing :: IO ()+test_maybeMissing =+ assertEqual (Right (Nope 5 Nothing)) (doc2Text $ fromMsgpack encodedNope)++test_decodeEither :: IO ()+test_decodeEither =+ assertEqual (Right (Left "text" :: Either Text Int)) (doc2Text $ fromMsgpack $ ObjectString "text")
+ test/u/NvimMenuSpec.hs view
@@ -0,0 +1,154 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}++module NvimMenuSpec (htf_thisModulesTests) where++import Conduit (ConduitT, yieldMany)+import Control.Concurrent.Lifted (fork, killThread)+import Control.Exception.Lifted (bracket)+import Control.Lens ((^?))+import qualified Control.Lens as Lens (element)+import qualified Data.Map as Map (empty, fromList)+import Test.Framework++import Ribosome.Api.Input (syntheticInput)+import Ribosome.Control.Monad.Ribo (Ribo)+import Ribosome.Menu.Data.Menu (Menu(Menu))+import Ribosome.Menu.Data.MenuConsumerAction (MenuConsumerAction)+import Ribosome.Menu.Data.MenuItem (MenuItem(MenuItem))+import qualified Ribosome.Menu.Data.MenuItem as MenuItem (text)+import Ribosome.Menu.Data.MenuResult (MenuResult)+import qualified Ribosome.Menu.Data.MenuResult as MenuResult (MenuResult(..))+import Ribosome.Menu.Prompt.Data.Prompt (Prompt(Prompt))+import Ribosome.Menu.Prompt.Data.PromptConfig (PromptConfig(PromptConfig))+import Ribosome.Menu.Prompt.Data.PromptEvent (PromptEvent)+import qualified Ribosome.Menu.Prompt.Data.PromptEvent as PromptEvent (PromptEvent(..))+import Ribosome.Menu.Prompt.Nvim (getCharC, nvimPromptRenderer)+import Ribosome.Menu.Prompt.Run (basicTransition)+import Ribosome.Menu.Run (nvimMenu)+import Ribosome.Menu.Simple (Mappings, defaultMenu, menuReturn)+import Ribosome.Nvim.Api.IO (vimGetWindows)+import Ribosome.System.Time (sleep)+import Ribosome.Test.Tmux (tmuxGuiSpecDef)+import TestError (RiboT, TestError)++promptInput ::+ MonadIO m =>+ [Text] ->+ ConduitT () PromptEvent m ()+promptInput chars' = do+ lift $ sleep 0.1+ yieldMany (PromptEvent.Character <$> chars')++menuItems ::+ Monad m =>+ [Text] ->+ ConduitT () MenuItem m ()+menuItems =+ yieldMany . fmap (MenuItem "name")++chars :: [Text]+chars =+ ["i", "t", "e", "esc", "k", "k", "k", "cr"]++items :: [Text]+items =+ ("item" <>) . show <$> [(1 :: Int)..8]++exec ::+ MonadIO m =>+ Menu ->+ Prompt ->+ m (MenuConsumerAction m (Maybe Text), Menu)+exec m@(Menu _ items' _ selected _) _ =+ menuReturn item m+ where+ item =+ items' ^? Lens.element selected . MenuItem.text++promptConfig ::+ ConduitT () PromptEvent (Ribo () TestError) () ->+ PromptConfig (Ribo () TestError)+promptConfig source =+ PromptConfig source basicTransition nvimPromptRenderer True++runNvimMenu ::+ Mappings (Ribo () TestError) a ->+ ConduitT () PromptEvent (Ribo () TestError) () ->+ RiboT (MenuResult a)+runNvimMenu maps source =+ nvimMenu def (menuItems items) (defaultMenu maps) (promptConfig source)++mappings :: Mappings (Ribo () TestError) (Maybe Text)+mappings =+ Map.fromList [("cr", exec)]++nvimMenuSpec ::+ ConduitT () PromptEvent (Ribo () TestError) () ->+ RiboT ()+nvimMenuSpec =+ gassertEqual (MenuResult.Return (Just "item5")) <=< runNvimMenu mappings++nvimMenuStrictSpec :: RiboT ()+nvimMenuStrictSpec =+ nvimMenuSpec (promptInput chars)++test_nvimMenuStrict :: IO ()+test_nvimMenuStrict =+ tmuxGuiSpecDef nvimMenuStrictSpec++nativeChars :: [Text]+nativeChars =+ ["i", "t", "e", "<esc>", "k", "k", "k", "<cr>"]++nvimMenuNativeSpec :: RiboT ()+nvimMenuNativeSpec =+ bracket (fork input) killThread (const $ nvimMenuSpec (getCharC 0.1))+ where+ input =+ syntheticInput (Just 0.2) nativeChars++test_nvimMenuNative :: IO ()+test_nvimMenuNative =+ tmuxGuiSpecDef nvimMenuNativeSpec++nvimMenuInterruptSpec :: RiboT ()+nvimMenuInterruptSpec = do+ gassertEqual MenuResult.Aborted =<< spec+ gassertEqual 1 =<< length <$> vimGetWindows+ where+ spec :: RiboT (MenuResult ())+ spec =+ bracket (fork input) killThread (const run)+ run =+ nvimMenu def (menuItems items) (defaultMenu Map.empty) (promptConfig (getCharC 0.1))+ input =+ syntheticInput (Just 0.2) ["<c-c>", "<cr>"]++test_nvimMenuInterrupt :: IO ()+test_nvimMenuInterrupt =+ tmuxGuiSpecDef nvimMenuInterruptSpec++returnPrompt ::+ MonadIO m =>+ Menu ->+ Prompt ->+ m (MenuConsumerAction m Text, Menu)+returnPrompt m@(Menu _ _ _ _ _) (Prompt _ _ text) =+ menuReturn text m++navChars :: [Text]+navChars =+ ["i", "t", "e", "m", "1", "<bs>", "<esc>", "h", "h", "h", "h", "h", "x", "a", "o", "<cr>"]++nvimMenuNavSpec :: RiboT ()+nvimMenuNavSpec =+ gassertEqual (MenuResult.Return "toem") =<< run+ where+ run =+ bracket (fork input) killThread (const $ runNvimMenu (Map.fromList [("cr", returnPrompt)]) (getCharC 0.1))+ input =+ syntheticInput (Just 0.2) navChars++test_nvimMenuNav :: IO ()+test_nvimMenuNav =+ tmuxGuiSpecDef nvimMenuNavSpec
+ test/u/Prelude.hs view
@@ -0,0 +1,5 @@+module Prelude (+ module Ribosome.Prelude+) where++import Ribosome.Prelude
+ test/u/RpcSpec.hs view
@@ -0,0 +1,136 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE TemplateHaskell #-}++module RpcSpec (htf_thisModulesTests) where++import qualified Data.Map as Map (empty)+-- import Language.Haskell.TH hiding (reportError)+import Neovim (CommandArguments, Neovim, Plugin(..))+import Test.Framework++import Ribosome.Api.Variable (setVar)+import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE)+import Ribosome.Control.Ribosome (Ribosome, newRibosome)+import Ribosome.Error.Report (reportError)+import Ribosome.Nvim.Api.IO (vimCommand, vimGetVar)+import Ribosome.Nvim.Api.RpcCall (RpcError)+import Ribosome.Plugin (RpcDef, cmd, riboPlugin, rpcHandler, sync)+import Ribosome.System.Time (sleep)+import Ribosome.Test.Embed (integrationSpecDef)+import System.Log.Logger (Priority(DEBUG), setLevel, updateGlobalLogger)+import TestError (RiboT, TestError)++handleError :: TestError -> RiboT ()+handleError =+ reportError "test"++target :: Int+target =+ 13++resultVar :: Text+resultVar =+ "test_result"++handler ::+ NvimE e m =>+ m Int+handler = do+ setVar resultVar target+ return target++handlerCmdCmdArgs ::+ MonadRibo m =>+ NvimE e m =>+ CommandArguments ->+ Text ->+ Text ->+ Text ->+ m Int+handlerCmdCmdArgs _ _ _ _ =+ handler++handlerCmdNoCmdArgs ::+ MonadRibo m =>+ NvimE e m =>+ Text ->+ Text ->+ Text ->+ m Int+handlerCmdNoCmdArgs _ _ _ =+ handler++handlerCmdNoArgs ::+ MonadRibo m =>+ NvimE e m =>+ m Int+handlerCmdNoArgs =+ handler++handlerCmdOneArg ::+ MonadRibo m =>+ NvimE e m =>+ Text ->+ m Int+handlerCmdOneArg _ =+ handler++$(return [])++handlers ::+ MonadRibo m =>+ NvimE e m =>+ [[RpcDef m]]+handlers =+ [+ $(rpcHandler (sync . cmd []) 'handlerCmdCmdArgs),+ $(rpcHandler (sync . cmd []) 'handlerCmdNoCmdArgs),+ $(rpcHandler (sync . cmd []) 'handlerCmdNoArgs),+ $(rpcHandler (sync . cmd []) 'handlerCmdOneArg)+ ]++plugin :: IO (Plugin (Ribosome ()))+plugin = do+ ribo <- newRibosome "test" def+ return $ riboPlugin "test" ribo handlers [] handleError Map.empty++successCommand ::+ AssertM m =>+ NvimE e m =>+ Text ->+ m ()+successCommand cmd' = do+ setVar resultVar (0 :: Int)+ vimCommand cmd'+ gassertEqual target =<< vimGetVar resultVar++failureCommand ::+ AssertM m =>+ NvimE e m =>+ Text ->+ m ()+failureCommand cmd' = do+ setVar resultVar (0 :: Int)+ catchAt recoverRpc (vimCommand cmd')+ gassertEqual (0 :: Int) =<< vimGetVar resultVar+ where+ recoverRpc (_ :: RpcError) =+ return ()++rpcSpec :: ExceptT RpcError (Neovim ()) ()+rpcSpec = do+ successCommand "HandlerCmdCmdArgs a b c"+ successCommand "HandlerCmdNoCmdArgs a b c"+ successCommand "HandlerCmdNoArgs"+ successCommand "HandlerCmdOneArg a"+ failureCommand "HandlerCmdCmdArgs a b"+ failureCommand "HandlerCmdNoCmdArgs a b"+ failureCommand "HandlerCmdNoArgs a"+ sleep 1++test_rpc :: IO ()+test_rpc = do+ liftIO $ updateGlobalLogger "test" (setLevel DEBUG)+ plug <- plugin+ -- traverse_ putStrLn $ lines $(stringE . pprint =<< rpcHandler (sync . cmd []) 'handlerCmdOneArg)+ integrationSpecDef plug rpcSpec
+ test/u/ScratchSpec.hs view
@@ -0,0 +1,68 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE TemplateHaskell #-}++module ScratchSpec (htf_thisModulesTests) where++import Data.Default (def)+import qualified Data.Map as Map (toList)+import Neovim (Neovim, Plugin(..))+import Test.Framework++import Ribosome.Api.Buffer (currentBufferContent)+import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE, pluginInternalL)+import Ribosome.Control.Ribosome (Ribosome, newRibosome)+import qualified Ribosome.Control.Ribosome as Ribosome (scratch)+import Ribosome.Data.ScratchOptions (ScratchOptions(ScratchOptions))+import Ribosome.Msgpack.Error (DecodeError)+import Ribosome.Nvim.Api.IO (vimCallFunction, vimCommand)+import Ribosome.Nvim.Api.RpcCall (RpcError)+import Ribosome.Plugin (riboPlugin, rpcHandler, rpcHandlerDef, sync)+import Ribosome.Scratch (showInScratch)+import Ribosome.Test.Await (await)+import Ribosome.Test.Embed (integrationSpecDef)+import TestError (handleTestError)++target :: [Text]+target = ["line 1", "line 2"]++name :: Text+name =+ "buffi"++makeScratch ::+ MonadDeepError e DecodeError m =>+ MonadRibo m =>+ NvimE e m =>+ m ()+makeScratch =+ void $ showInScratch target (ScratchOptions False True False True True True Nothing (Just 0) [] [] name)++scratchCount ::+ MonadRibo m =>+ m Int+scratchCount =+ length . Map.toList <$> pluginInternalL Ribosome.scratch++$(return [])++scratchPlugin :: IO (Plugin (Ribosome ()))+scratchPlugin = do+ env <- newRibosome "test" ()+ return $ riboPlugin "test" env funcs [] handleTestError def+ where+ funcs = [$(rpcHandlerDef 'makeScratch), $(rpcHandler sync 'scratchCount)]++scratchSpec :: ExceptT RpcError (Neovim ()) ()+scratchSpec = do+ () <- vimCallFunction "MakeScratch" []+ await (gassertEqual (1 :: Int)) scratches+ await (gassertEqual target) currentBufferContent+ vimCommand "bdelete"+ await (gassertEqual 0) scratches+ where+ scratches = vimCallFunction "ScratchCount" []++test_scratch :: IO ()+test_scratch = do+ plug <- scratchPlugin+ integrationSpecDef plug scratchSpec
+ test/u/SettingSpec.hs view
@@ -0,0 +1,58 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE TemplateHaskell #-}++module SettingSpec(+ htf_thisModulesTests,+) where++import Control.Monad.DeepError (catchAt)+import Data.DeepPrisms (deepPrisms)+import Data.Default (def)+import Data.Functor (void)+import Test.Framework++import Ribosome.Config.Setting (setting, updateSetting)+import Ribosome.Control.Monad.Ribo (Ribo)+import Ribosome.Data.Setting (Setting(Setting))+import Ribosome.Data.SettingError (SettingError)+import Ribosome.Error.Report.Class (ReportError(..))+import Ribosome.Nvim.Api.RpcCall (RpcError)+import Ribosome.Test.Unit (unitSpec)++data SettingSpecError =+ Sett SettingError+ |+ Rpc RpcError+ deriving Show++instance ReportError SettingSpecError where+ errorReport = undefined++deepPrisms ''SettingSpecError++sett :: Setting Int+sett = Setting "name" True Nothing++settingSuccessSpec :: Ribo s SettingSpecError ()+settingSuccessSpec = do+ updateSetting sett 5+ r <- setting sett+ gassertEqual 5 r++test_settingSuccess :: IO ()+test_settingSuccess =+ unitSpec def () settingSuccessSpec++settingFailSpec :: Ribo s SettingSpecError ()+settingFailSpec = do+ ea <- catchAt catch $ Right <$> result+ void $ gassertLeft ea+ where+ result :: Ribo s SettingSpecError Int+ result = setting sett+ catch :: SettingError -> Ribo s SettingSpecError (Either SettingError Int)+ catch = return . Left++test_settingFail :: IO ()+test_settingFail =+ unitSpec def () settingFailSpec
+ test/u/SpecMain.hs view
@@ -0,0 +1,21 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}++module Main where++import Test.Framework+import Test.Framework.BlackBoxTest ()++import {-@ HTF_TESTS @-} AutocmdSpec+import {-@ HTF_TESTS @-} MappingSpec+import {-@ HTF_TESTS @-} MenuSpec+import {-@ HTF_TESTS @-} MsgpackSpec+import {-@ HTF_TESTS @-} NvimMenuSpec+import {-@ HTF_TESTS @-} RpcSpec+import {-@ HTF_TESTS @-} ScratchSpec+import {-@ HTF_TESTS @-} SettingSpec+import {-@ HTF_TESTS @-} SyntaxSpec+import {-@ HTF_TESTS @-} THSpec+import {-@ HTF_TESTS @-} WatcherSpec++main :: IO ()+main = htfMain htf_importedTests
+ test/u/SyntaxSpec.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -F -pgmF htfpp #-}++module SyntaxSpec(+ htf_thisModulesTests,+) where++import Chiasma.Data.TmuxError (TmuxError)+import Chiasma.Test.Tmux (TmuxTestConf(..))+import Data.DeepPrisms (deepPrisms)+import Data.Default (def)+import Test.Framework++import Ribosome.Api.Buffer (setCurrentBufferContent)+import Ribosome.Api.Syntax (executeSyntax)+import Ribosome.Control.Monad.Ribo (Ribo)+import Ribosome.Data.Syntax (+ Syntax(Syntax),+ syntaxHighlight,+ syntaxMatch,+ )+import Ribosome.Error.Report.Class (ReportError(..))+import Ribosome.System.Time (sleep)+import Ribosome.Test.Embed (defaultTestConfig)+import Ribosome.Test.Screenshot (assertScreenshot)+import Ribosome.Test.Tmux (tmuxSpec')+import TestError (TestError)++data SyntaxSpecError =+ Test TestError+ |+ Tmux TmuxError++deepPrisms ''SyntaxSpecError++instance ReportError SyntaxSpecError where+ errorReport _ =+ undefined++syntax :: Syntax+syntax =+ Syntax [syntaxMatch "TestColons" "::"] [syntaxHighlight "TestColons"+ [("cterm", "reverse"), ("ctermfg", "1"), ("gui", "reverse"), ("guifg", "#dc322f")]] []++syntaxSpec :: Ribo () SyntaxSpecError ()+syntaxSpec = do+ setCurrentBufferContent ["function :: String -> Int", "function _ = 5"]+ _ <- executeSyntax syntax+ sleep 0.5+ assertScreenshot "syntax" False 0++test_syntax :: IO ()+test_syntax =+ tmuxSpec' def { ttcWidth = 300, ttcHeight = 51, ttcGui = False } (defaultTestConfig "syntax") def syntaxSpec
+ test/u/THSpec.hs view
@@ -0,0 +1,48 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}+{-# OPTIONS_GHC -Wno-unused-top-binds #-}+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveAnyClass #-}+{- HLINT ignore -}++module THSpec(htf_thisModulesTests) where++import Data.Aeson (FromJSON)+-- import Data.Default (def)+import GHC.Generics (Generic)+import Language.Haskell.TH+import Neovim (Plugin(..))+import Test.Framework++-- import Ribosome.Control.Ribosome (Ribosome, newRibosome)+import Ribosome.Control.Ribosome (Ribosome, newRibosome)+import Ribosome.Msgpack.Decode (MsgpackDecode)+import Ribosome.Msgpack.Encode (MsgpackEncode)+import Ribosome.Plugin+-- import TestError (handleTestError)++data Par =+ Par {+ parA :: Int,+ parB :: Int+ }+ deriving (Eq, Show, Generic, MsgpackDecode, MsgpackEncode, FromJSON)++handler :: Monad m => Text -> m ()+handler =+ undefined++$(return [])++plugin' :: IO (Plugin (Ribosome Int))+plugin' = do+ -- ribo <- newRibosome ("test" :: Text) 1+ undefined+ -- return $ riboPlugin "test" ribo [$(rpcHandler (cmd []) 'handler)] [] handleTestError def++test_plug :: IO ()+test_plug = do+ return ()+ -- _ <- plugin'+ -- traverse_ putStrLn $ lines $(stringE . pprint =<< rpcHandler (sync . cmd []) 'handler)
+ test/u/TestError.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveAnyClass #-}++module TestError where++import Data.DeepPrisms (deepPrisms)++import Ribosome.Control.Monad.Ribo (Ribo)+import Ribosome.Data.Mapping (MappingError)+import Ribosome.Error.Report.Class (ReportError(..))+import Ribosome.Log (showError)+import Ribosome.Msgpack.Error (DecodeError)+import Ribosome.Nvim.Api.RpcCall (RpcError)++data TestError =+ Rpc RpcError+ |+ Decode DecodeError+ |+ Mapping MappingError+ deriving (Show, Generic, ReportError)++deepPrisms ''TestError++handleTestError :: TestError -> Ribo s TestError ()+handleTestError =+ showError "error in test:"++type RiboT a = Ribo () TestError a
+ test/u/WatcherSpec.hs view
@@ -0,0 +1,47 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}++module WatcherSpec(+ htf_thisModulesTests,+) where++import Control.Monad.Trans.Except (ExceptT)+import qualified Data.Map as Map (singleton)+import Data.MessagePack (Object)+import Neovim (Neovim, Plugin(..))+import Test.Framework++import Ribosome.Api.Autocmd (doautocmd)+import Ribosome.Api.Variable (setVar)+import Ribosome.Control.Monad.Ribo (NvimE)+import Ribosome.Control.Ribosome (Ribosome, newRibosome)+import Ribosome.Nvim.Api.IO (vimGetVar)+import Ribosome.Nvim.Api.RpcCall (RpcError)+import Ribosome.Plugin (riboPlugin)+import Ribosome.Test.Await (await)+import Ribosome.Test.Embed (integrationSpecDef)+import Ribosome.Test.Orphans ()+import TestError (handleTestError)++changed :: NvimE e m => Object -> m ()+changed _ =+ setVar "number" =<< (+(1 :: Int)) <$> vimGetVar "number"++varWatcherPlugin :: IO (Plugin (Ribosome ()))+varWatcherPlugin = do+ env <- newRibosome "varwatcher" ()+ return $ riboPlugin "varwatcher" env [] [] handleTestError (Map.singleton "trigger" changed)++varWatcherSpec :: ExceptT RpcError (Neovim ()) ()+varWatcherSpec = do+ setVar "number" (10 :: Int)+ setVar "trigger" (5 :: Int)+ doautocmd "CmdlineLeave"+ doautocmd "CmdlineLeave"+ setVar "trigger" (6 :: Int)+ doautocmd "CmdlineLeave"+ await (gassertEqual (12 :: Int)) (vimGetVar "number")++test_varWatcher :: IO ()+test_varWatcher = do+ plug <- varWatcherPlugin+ integrationSpecDef plug varWatcherSpec