module Ribosome.Host.Data.ApiInfo where

import Data.MessagePack (Object)
import qualified Data.Serialize as Serialize
import System.Process.Typed (proc, readProcessStdout_)

import Ribosome.Host.Class.Msgpack.Decode (MsgpackDecode (fromMsgpack))
import Ribosome.Host.Data.ApiType (ApiType)

data RpcDecl =
  RpcDecl {
    RpcDecl -> String
name :: String,
    RpcDecl -> [(ApiType, String)]
parameters :: [(ApiType, String)],
    RpcDecl -> Maybe Int64
since :: Maybe Int64,
    RpcDecl -> Maybe Int64
deprecated_since :: Maybe Int64,
    RpcDecl -> Bool
method :: Bool,
    RpcDecl -> ApiType
return_type :: ApiType
  }
  deriving stock (RpcDecl -> RpcDecl -> Bool
(RpcDecl -> RpcDecl -> Bool)
-> (RpcDecl -> RpcDecl -> Bool) -> Eq RpcDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpcDecl -> RpcDecl -> Bool
$c/= :: RpcDecl -> RpcDecl -> Bool
== :: RpcDecl -> RpcDecl -> Bool
$c== :: RpcDecl -> RpcDecl -> Bool
Eq, Int -> RpcDecl -> ShowS
[RpcDecl] -> ShowS
RpcDecl -> String
(Int -> RpcDecl -> ShowS)
-> (RpcDecl -> String) -> ([RpcDecl] -> ShowS) -> Show RpcDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RpcDecl] -> ShowS
$cshowList :: [RpcDecl] -> ShowS
show :: RpcDecl -> String
$cshow :: RpcDecl -> String
showsPrec :: Int -> RpcDecl -> ShowS
$cshowsPrec :: Int -> RpcDecl -> ShowS
Show, (forall x. RpcDecl -> Rep RpcDecl x)
-> (forall x. Rep RpcDecl x -> RpcDecl) -> Generic RpcDecl
forall x. Rep RpcDecl x -> RpcDecl
forall x. RpcDecl -> Rep RpcDecl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RpcDecl x -> RpcDecl
$cfrom :: forall x. RpcDecl -> Rep RpcDecl x
Generic)
  deriving anyclass (String -> Object -> Either Text RpcDecl
Object -> Either Text RpcDecl
(Object -> Either Text RpcDecl)
-> (String -> Object -> Either Text RpcDecl)
-> MsgpackDecode RpcDecl
forall a.
(Object -> Either Text a)
-> (String -> Object -> Either Text a) -> MsgpackDecode a
missingKey :: String -> Object -> Either Text RpcDecl
$cmissingKey :: String -> Object -> Either Text RpcDecl
fromMsgpack :: Object -> Either Text RpcDecl
$cfromMsgpack :: Object -> Either Text RpcDecl
MsgpackDecode)

newtype ExtType =
  ExtType { ExtType -> String
unExtType :: String }
  deriving stock (ExtType -> ExtType -> Bool
(ExtType -> ExtType -> Bool)
-> (ExtType -> ExtType -> Bool) -> Eq ExtType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtType -> ExtType -> Bool
$c/= :: ExtType -> ExtType -> Bool
== :: ExtType -> ExtType -> Bool
$c== :: ExtType -> ExtType -> Bool
Eq, Int -> ExtType -> ShowS
[ExtType] -> ShowS
ExtType -> String
(Int -> ExtType -> ShowS)
-> (ExtType -> String) -> ([ExtType] -> ShowS) -> Show ExtType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtType] -> ShowS
$cshowList :: [ExtType] -> ShowS
show :: ExtType -> String
$cshow :: ExtType -> String
showsPrec :: Int -> ExtType -> ShowS
$cshowsPrec :: Int -> ExtType -> ShowS
Show)
  deriving newtype (String -> ExtType
(String -> ExtType) -> IsString ExtType
forall a. (String -> a) -> IsString a
fromString :: String -> ExtType
$cfromString :: String -> ExtType
IsString, Eq ExtType
Eq ExtType
-> (ExtType -> ExtType -> Ordering)
-> (ExtType -> ExtType -> Bool)
-> (ExtType -> ExtType -> Bool)
-> (ExtType -> ExtType -> Bool)
-> (ExtType -> ExtType -> Bool)
-> (ExtType -> ExtType -> ExtType)
-> (ExtType -> ExtType -> ExtType)
-> Ord ExtType
ExtType -> ExtType -> Bool
ExtType -> ExtType -> Ordering
ExtType -> ExtType -> ExtType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ExtType -> ExtType -> ExtType
$cmin :: ExtType -> ExtType -> ExtType
max :: ExtType -> ExtType -> ExtType
$cmax :: ExtType -> ExtType -> ExtType
>= :: ExtType -> ExtType -> Bool
$c>= :: ExtType -> ExtType -> Bool
> :: ExtType -> ExtType -> Bool
$c> :: ExtType -> ExtType -> Bool
<= :: ExtType -> ExtType -> Bool
$c<= :: ExtType -> ExtType -> Bool
< :: ExtType -> ExtType -> Bool
$c< :: ExtType -> ExtType -> Bool
compare :: ExtType -> ExtType -> Ordering
$ccompare :: ExtType -> ExtType -> Ordering
Ord, String -> Object -> Either Text ExtType
Object -> Either Text ExtType
(Object -> Either Text ExtType)
-> (String -> Object -> Either Text ExtType)
-> MsgpackDecode ExtType
forall a.
(Object -> Either Text a)
-> (String -> Object -> Either Text a) -> MsgpackDecode a
missingKey :: String -> Object -> Either Text ExtType
$cmissingKey :: String -> Object -> Either Text ExtType
fromMsgpack :: Object -> Either Text ExtType
$cfromMsgpack :: Object -> Either Text ExtType
MsgpackDecode)

data ExtTypeMeta =
  ExtTypeMeta {
    ExtTypeMeta -> Int64
id :: Int64,
    ExtTypeMeta -> String
prefix :: String
  }
  deriving stock (ExtTypeMeta -> ExtTypeMeta -> Bool
(ExtTypeMeta -> ExtTypeMeta -> Bool)
-> (ExtTypeMeta -> ExtTypeMeta -> Bool) -> Eq ExtTypeMeta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtTypeMeta -> ExtTypeMeta -> Bool
$c/= :: ExtTypeMeta -> ExtTypeMeta -> Bool
== :: ExtTypeMeta -> ExtTypeMeta -> Bool
$c== :: ExtTypeMeta -> ExtTypeMeta -> Bool
Eq, Int -> ExtTypeMeta -> ShowS
[ExtTypeMeta] -> ShowS
ExtTypeMeta -> String
(Int -> ExtTypeMeta -> ShowS)
-> (ExtTypeMeta -> String)
-> ([ExtTypeMeta] -> ShowS)
-> Show ExtTypeMeta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtTypeMeta] -> ShowS
$cshowList :: [ExtTypeMeta] -> ShowS
show :: ExtTypeMeta -> String
$cshow :: ExtTypeMeta -> String
showsPrec :: Int -> ExtTypeMeta -> ShowS
$cshowsPrec :: Int -> ExtTypeMeta -> ShowS
Show, (forall x. ExtTypeMeta -> Rep ExtTypeMeta x)
-> (forall x. Rep ExtTypeMeta x -> ExtTypeMeta)
-> Generic ExtTypeMeta
forall x. Rep ExtTypeMeta x -> ExtTypeMeta
forall x. ExtTypeMeta -> Rep ExtTypeMeta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExtTypeMeta x -> ExtTypeMeta
$cfrom :: forall x. ExtTypeMeta -> Rep ExtTypeMeta x
Generic)
  deriving anyclass (String -> Object -> Either Text ExtTypeMeta
Object -> Either Text ExtTypeMeta
(Object -> Either Text ExtTypeMeta)
-> (String -> Object -> Either Text ExtTypeMeta)
-> MsgpackDecode ExtTypeMeta
forall a.
(Object -> Either Text a)
-> (String -> Object -> Either Text a) -> MsgpackDecode a
missingKey :: String -> Object -> Either Text ExtTypeMeta
$cmissingKey :: String -> Object -> Either Text ExtTypeMeta
fromMsgpack :: Object -> Either Text ExtTypeMeta
$cfromMsgpack :: Object -> Either Text ExtTypeMeta
MsgpackDecode)

data ApiInfo =
  ApiInfo {
    ApiInfo -> Map ExtType ExtTypeMeta
types :: Map ExtType ExtTypeMeta,
    ApiInfo -> [RpcDecl]
functions :: [RpcDecl]
  }
  deriving stock (ApiInfo -> ApiInfo -> Bool
(ApiInfo -> ApiInfo -> Bool)
-> (ApiInfo -> ApiInfo -> Bool) -> Eq ApiInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiInfo -> ApiInfo -> Bool
$c/= :: ApiInfo -> ApiInfo -> Bool
== :: ApiInfo -> ApiInfo -> Bool
$c== :: ApiInfo -> ApiInfo -> Bool
Eq, Int -> ApiInfo -> ShowS
[ApiInfo] -> ShowS
ApiInfo -> String
(Int -> ApiInfo -> ShowS)
-> (ApiInfo -> String) -> ([ApiInfo] -> ShowS) -> Show ApiInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiInfo] -> ShowS
$cshowList :: [ApiInfo] -> ShowS
show :: ApiInfo -> String
$cshow :: ApiInfo -> String
showsPrec :: Int -> ApiInfo -> ShowS
$cshowsPrec :: Int -> ApiInfo -> ShowS
Show, (forall x. ApiInfo -> Rep ApiInfo x)
-> (forall x. Rep ApiInfo x -> ApiInfo) -> Generic ApiInfo
forall x. Rep ApiInfo x -> ApiInfo
forall x. ApiInfo -> Rep ApiInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiInfo x -> ApiInfo
$cfrom :: forall x. ApiInfo -> Rep ApiInfo x
Generic)
  deriving anyclass (String -> Object -> Either Text ApiInfo
Object -> Either Text ApiInfo
(Object -> Either Text ApiInfo)
-> (String -> Object -> Either Text ApiInfo)
-> MsgpackDecode ApiInfo
forall a.
(Object -> Either Text a)
-> (String -> Object -> Either Text a) -> MsgpackDecode a
missingKey :: String -> Object -> Either Text ApiInfo
$cmissingKey :: String -> Object -> Either Text ApiInfo
fromMsgpack :: Object -> Either Text ApiInfo
$cfromMsgpack :: Object -> Either Text ApiInfo
MsgpackDecode)

msgpack :: IO (Either Text Object)
msgpack :: IO (Either Text Object)
msgpack =
    (String -> Text) -> Either String Object -> Either Text Object
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
forall a. ToText a => a -> Text
toText (Either String Object -> Either Text Object)
-> (ByteString -> Either String Object)
-> ByteString
-> Either Text Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Object
forall a. Serialize a => ByteString -> Either String a
Serialize.decode (ByteString -> Either String Object)
-> (ByteString -> ByteString) -> ByteString -> Either String Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict (ByteString -> Either Text Object)
-> IO ByteString -> IO (Either Text Object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProcessConfig () () () -> IO ByteString
forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr -> m ByteString
readProcessStdout_ (String -> [String] -> ProcessConfig () () ()
proc String
"nvim" [Item [String]
"--api-info"])

apiInfo :: IO (Either Text ApiInfo)
apiInfo :: IO (Either Text ApiInfo)
apiInfo = (Object -> Either Text ApiInfo
forall a. MsgpackDecode a => Object -> Either Text a
fromMsgpack (Object -> Either Text ApiInfo)
-> Either Text Object -> Either Text ApiInfo
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Either Text Object -> Either Text ApiInfo)
-> IO (Either Text Object) -> IO (Either Text ApiInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either Text Object)
msgpack