module Ribosome.Api.Exists where import Data.Text.Prettyprint.Doc (viaShow, (<+>)) import Neovim (AnsiStyle, Doc, Object(ObjectInt)) import Ribosome.Control.Monad.Ribo (NvimE) import Ribosome.Msgpack.Decode (MsgpackDecode, fromMsgpack) import Ribosome.Msgpack.Encode (toMsgpack) import Ribosome.Nvim.Api.IO (vimCallFunction) import Ribosome.System.Time (epochSeconds, sleep) data Retry = Retry Int Double deriving Int -> Retry -> ShowS [Retry] -> ShowS Retry -> String (Int -> Retry -> ShowS) -> (Retry -> String) -> ([Retry] -> ShowS) -> Show Retry forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Retry] -> ShowS $cshowList :: [Retry] -> ShowS show :: Retry -> String $cshow :: Retry -> String showsPrec :: Int -> Retry -> ShowS $cshowsPrec :: Int -> Retry -> ShowS Show instance Default Retry where def :: Retry def = Int -> Double -> Retry Retry Int 3 Double 0.1 retry :: MonadIO f => f a -> (a -> f (Either c b)) -> Retry -> f (Either c b) retry :: f a -> (a -> f (Either c b)) -> Retry -> f (Either c b) retry f a thunk a -> f (Either c b) check (Retry Int timeout Double interval) = do Int start <- f Int forall (m :: * -> *). MonadIO m => m Int epochSeconds Int -> f (Either c b) step Int start where step :: Int -> f (Either c b) step Int start = do a result <- f a thunk Either c b checked <- a -> f (Either c b) check a result Int -> Either c b -> f (Either c b) recurse Int start Either c b checked recurse :: Int -> Either c b -> f (Either c b) recurse Int _ (Right b b) = Either c b -> f (Either c b) forall (m :: * -> *) a. Monad m => a -> m a return (b -> Either c b forall a b. b -> Either a b Right b b) recurse Int start (Left c e) = do Int current <- f Int forall (m :: * -> *). MonadIO m => m Int epochSeconds if (Int current Int -> Int -> Int forall a. Num a => a -> a -> a - Int start) Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int timeout then do Double -> f () forall (m :: * -> *). MonadIO m => Double -> m () sleep Double interval Int -> f (Either c b) step Int start else Either c b -> f (Either c b) forall (m :: * -> *) a. Monad m => a -> m a return (Either c b -> f (Either c b)) -> Either c b -> f (Either c b) forall a b. (a -> b) -> a -> b $ c -> Either c b forall a b. a -> Either a b Left c e waitFor :: NvimE e m => MonadIO m => m Object -> (Object -> m (Either (Doc AnsiStyle) b)) -> Retry -> m (Either (Doc AnsiStyle) b) waitFor :: m Object -> (Object -> m (Either (Doc AnsiStyle) b)) -> Retry -> m (Either (Doc AnsiStyle) b) waitFor m Object thunk Object -> m (Either (Doc AnsiStyle) b) check' = m Object -> (Object -> m (Either (Doc AnsiStyle) b)) -> Retry -> m (Either (Doc AnsiStyle) b) forall (f :: * -> *) a c b. MonadIO f => f a -> (a -> f (Either c b)) -> Retry -> f (Either c b) retry m Object thunk Object -> m (Either (Doc AnsiStyle) b) check where check :: Object -> m (Either (Doc AnsiStyle) b) check Object result = case Object -> Either (Doc AnsiStyle) Object forall a. MsgpackDecode a => Object -> Either (Doc AnsiStyle) a fromMsgpack Object result of Right Object a -> Object -> m (Either (Doc AnsiStyle) b) check' Object a Left Doc AnsiStyle e -> Either (Doc AnsiStyle) b -> m (Either (Doc AnsiStyle) b) forall (m :: * -> *) a. Monad m => a -> m a return (Either (Doc AnsiStyle) b -> m (Either (Doc AnsiStyle) b)) -> Either (Doc AnsiStyle) b -> m (Either (Doc AnsiStyle) b) forall a b. (a -> b) -> a -> b $ Doc AnsiStyle -> Either (Doc AnsiStyle) b forall a b. a -> Either a b Left Doc AnsiStyle e existsResult :: Object -> Either (Doc AnsiStyle) () existsResult :: Object -> Either (Doc AnsiStyle) () existsResult (ObjectInt Int64 1) = () -> Either (Doc AnsiStyle) () forall a b. b -> Either a b Right () existsResult Object a = Doc AnsiStyle -> Either (Doc AnsiStyle) () forall a b. a -> Either a b Left (Doc AnsiStyle -> Either (Doc AnsiStyle) ()) -> Doc AnsiStyle -> Either (Doc AnsiStyle) () forall a b. (a -> b) -> a -> b $ Doc AnsiStyle "weird return type " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle forall ann. Doc ann -> Doc ann -> Doc ann <+> Object -> Doc AnsiStyle forall a ann. Show a => a -> Doc ann viaShow Object a vimExists :: NvimE e m => Text -> m Object vimExists :: Text -> m Object vimExists Text entity = Text -> [Object] -> m Object forall (m :: * -> *) e a. (Nvim m, MonadDeepError e RpcError m, MsgpackDecode a) => Text -> [Object] -> m a vimCallFunction Text "exists" [Text -> Object forall a. MsgpackEncode a => a -> Object toMsgpack Text entity] vimDoesExist :: NvimE e m => Text -> m Bool vimDoesExist :: Text -> m Bool vimDoesExist Text entity = (Object -> Bool) -> m Object -> m Bool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Either (Doc AnsiStyle) () -> Bool forall a b. Either a b -> Bool isRight (Either (Doc AnsiStyle) () -> Bool) -> (Object -> Either (Doc AnsiStyle) ()) -> Object -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Object -> Either (Doc AnsiStyle) () existsResult) (Text -> m Object forall e (m :: * -> *). NvimE e m => Text -> m Object vimExists Text entity) function :: NvimE e m => Text -> m Bool function :: Text -> m Bool function Text name = Text -> m Bool forall e (m :: * -> *). NvimE e m => Text -> m Bool vimDoesExist (Text "*" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text name) waitForFunction :: NvimE e m => MonadIO m => Text -> Retry -> m (Either (Doc AnsiStyle) ()) waitForFunction :: Text -> Retry -> m (Either (Doc AnsiStyle) ()) waitForFunction Text name = m Object -> (Object -> m (Either (Doc AnsiStyle) ())) -> Retry -> m (Either (Doc AnsiStyle) ()) forall e (m :: * -> *) b. (NvimE e m, MonadIO m) => m Object -> (Object -> m (Either (Doc AnsiStyle) b)) -> Retry -> m (Either (Doc AnsiStyle) b) waitFor m Object thunk (Either (Doc AnsiStyle) () -> m (Either (Doc AnsiStyle) ()) forall (m :: * -> *) a. Monad m => a -> m a return (Either (Doc AnsiStyle) () -> m (Either (Doc AnsiStyle) ())) -> (Object -> Either (Doc AnsiStyle) ()) -> Object -> m (Either (Doc AnsiStyle) ()) forall b c a. (b -> c) -> (a -> b) -> a -> c . Object -> Either (Doc AnsiStyle) () existsResult) where thunk :: m Object thunk = Text -> m Object forall e (m :: * -> *). NvimE e m => Text -> m Object vimExists (Text "*" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text name) waitForFunctionResult :: NvimE e m => MonadIO m => Eq a => Show a => MsgpackDecode a => Text -> a -> Retry -> m (Either (Doc AnsiStyle) ()) waitForFunctionResult :: Text -> a -> Retry -> m (Either (Doc AnsiStyle) ()) waitForFunctionResult Text name a a Retry retry' = Text -> Retry -> m (Either (Doc AnsiStyle) ()) forall e (m :: * -> *). (NvimE e m, MonadIO m) => Text -> Retry -> m (Either (Doc AnsiStyle) ()) waitForFunction Text name Retry retry' m (Either (Doc AnsiStyle) ()) -> (Either (Doc AnsiStyle) () -> m (Either (Doc AnsiStyle) ())) -> m (Either (Doc AnsiStyle) ()) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Right () _ -> m Object -> (Object -> m (Either (Doc AnsiStyle) ())) -> Retry -> m (Either (Doc AnsiStyle) ()) forall e (m :: * -> *) b. (NvimE e m, MonadIO m) => m Object -> (Object -> m (Either (Doc AnsiStyle) b)) -> Retry -> m (Either (Doc AnsiStyle) b) waitFor m Object thunk (Either (Doc AnsiStyle) () -> m (Either (Doc AnsiStyle) ()) forall (m :: * -> *) a. Monad m => a -> m a return (Either (Doc AnsiStyle) () -> m (Either (Doc AnsiStyle) ())) -> (Object -> Either (Doc AnsiStyle) ()) -> Object -> m (Either (Doc AnsiStyle) ()) forall b c a. (b -> c) -> (a -> b) -> a -> c . Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) () check (Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) ()) -> (Object -> Either (Doc AnsiStyle) a) -> Object -> Either (Doc AnsiStyle) () forall b c a. (b -> c) -> (a -> b) -> a -> c . Object -> Either (Doc AnsiStyle) a forall a. MsgpackDecode a => Object -> Either (Doc AnsiStyle) a fromMsgpack) Retry retry' Left Doc AnsiStyle e -> Either (Doc AnsiStyle) () -> m (Either (Doc AnsiStyle) ()) forall (m :: * -> *) a. Monad m => a -> m a return (Doc AnsiStyle -> Either (Doc AnsiStyle) () forall a b. a -> Either a b Left Doc AnsiStyle e) where thunk :: m Object thunk = Text -> [Object] -> m Object forall (m :: * -> *) e a. (Nvim m, MonadDeepError e RpcError m, MsgpackDecode a) => Text -> [Object] -> m a vimCallFunction Text name [] check :: Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) () check (Right a a') | a a a -> a -> Bool forall a. Eq a => a -> a -> Bool == a a' = () -> Either (Doc AnsiStyle) () forall a b. b -> Either a b Right () check (Right a a') = Doc AnsiStyle -> Either (Doc AnsiStyle) () forall a b. a -> Either a b Left (Doc AnsiStyle -> Either (Doc AnsiStyle) ()) -> Doc AnsiStyle -> Either (Doc AnsiStyle) () forall a b. (a -> b) -> a -> b $ Doc AnsiStyle "results differ:" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle forall ann. Doc ann -> Doc ann -> Doc ann <+> a -> Doc AnsiStyle forall b a. (Show a, IsString b) => a -> b show a a Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle forall ann. Doc ann -> Doc ann -> Doc ann <+> Doc AnsiStyle "/" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle forall ann. Doc ann -> Doc ann -> Doc ann <+> a -> Doc AnsiStyle forall b a. (Show a, IsString b) => a -> b show a a' check (Left Doc AnsiStyle e) = Doc AnsiStyle -> Either (Doc AnsiStyle) () forall a b. a -> Either a b Left (Doc AnsiStyle -> Either (Doc AnsiStyle) ()) -> Doc AnsiStyle -> Either (Doc AnsiStyle) () forall a b. (a -> b) -> a -> b $ Doc AnsiStyle "weird return type: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle forall ann. Doc ann -> Doc ann -> Doc ann <+> Doc AnsiStyle e