{-# LANGUAGE OverloadedStrings #-}
module Neovim.API.Parser (
NeovimAPI (..),
NeovimFunction (..),
NeovimType (..),
parseAPI,
) where
import Neovim.Classes
import Neovim.OS (isWindows)
import Control.Applicative (optional)
import Control.Monad.Except (MonadError (throwError), forM)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import Data.Map (Map)
import qualified Data.Map as Map
import Data.MessagePack (Object)
import Data.Serialize (decode)
import Neovim.Compat.Megaparsec as P (
MonadParsec (eof, try),
Parser,
char,
noneOf,
oneOf,
parse,
some,
space,
string,
(<|>),
)
import System.Process.Typed (proc, readProcessStdout_)
import UnliftIO.Exception (
SomeException,
catch,
)
import Prelude
data NeovimType
= SimpleType String
| NestedType NeovimType (Maybe Int)
| Void
deriving (Int -> NeovimType -> ShowS
[NeovimType] -> ShowS
NeovimType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NeovimType] -> ShowS
$cshowList :: [NeovimType] -> ShowS
show :: NeovimType -> String
$cshow :: NeovimType -> String
showsPrec :: Int -> NeovimType -> ShowS
$cshowsPrec :: Int -> NeovimType -> ShowS
Show, NeovimType -> NeovimType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NeovimType -> NeovimType -> Bool
$c/= :: NeovimType -> NeovimType -> Bool
== :: NeovimType -> NeovimType -> Bool
$c== :: NeovimType -> NeovimType -> Bool
Eq)
data NeovimFunction = NeovimFunction
{
NeovimFunction -> String
name :: String
,
NeovimFunction -> [(NeovimType, String)]
parameters :: [(NeovimType, String)]
,
NeovimFunction -> Bool
canFail :: Bool
,
NeovimFunction -> Bool
async :: Bool
,
NeovimFunction -> NeovimType
returnType :: NeovimType
}
deriving (Int -> NeovimFunction -> ShowS
[NeovimFunction] -> ShowS
NeovimFunction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NeovimFunction] -> ShowS
$cshowList :: [NeovimFunction] -> ShowS
show :: NeovimFunction -> String
$cshow :: NeovimFunction -> String
showsPrec :: Int -> NeovimFunction -> ShowS
$cshowsPrec :: Int -> NeovimFunction -> ShowS
Show)
data NeovimAPI = NeovimAPI
{
NeovimAPI -> [(String, Int64)]
errorTypes :: [(String, Int64)]
,
NeovimAPI -> [(String, Int64)]
customTypes :: [(String, Int64)]
,
NeovimAPI -> [NeovimFunction]
functions :: [NeovimFunction]
}
deriving (Int -> NeovimAPI -> ShowS
[NeovimAPI] -> ShowS
NeovimAPI -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NeovimAPI] -> ShowS
$cshowList :: [NeovimAPI] -> ShowS
show :: NeovimAPI -> String
$cshow :: NeovimAPI -> String
showsPrec :: Int -> NeovimAPI -> ShowS
$cshowsPrec :: Int -> NeovimAPI -> ShowS
Show)
parseAPI :: IO (Either (Doc AnsiStyle) NeovimAPI)
parseAPI :: IO (Either (Doc AnsiStyle) NeovimAPI)
parseAPI = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty) Object -> Either (Doc AnsiStyle) NeovimAPI
extractAPI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either String Object)
go
where
go :: IO (Either String Object)
go
| Bool
isWindows = IO (Either String Object)
readFromAPIFile
| Bool
otherwise = IO (Either String Object)
decodeAPI forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \(SomeException
_ignored :: SomeException) -> IO (Either String Object)
readFromAPIFile
decodeAPI :: IO (Either String Object)
decodeAPI :: IO (Either String Object)
decodeAPI =
forall a. Serialize a => ByteString -> Either String a
decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LB.toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr -> m ByteString
readProcessStdout_ (String -> [String] -> ProcessConfig () () ()
proc String
"nvim" [String
"--api-info"])
extractAPI :: Object -> Either (Doc AnsiStyle) NeovimAPI
Object
apiObj =
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
apiObj forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Map String Object
apiMap ->
[(String, Int64)]
-> [(String, Int64)] -> [NeovimFunction] -> NeovimAPI
NeovimAPI
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String Object -> Either (Doc AnsiStyle) [(String, Int64)]
extractErrorTypes Map String Object
apiMap
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map String Object -> Either (Doc AnsiStyle) [(String, Int64)]
extractCustomTypes Map String Object
apiMap
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map String Object -> Either (Doc AnsiStyle) [NeovimFunction]
extractFunctions Map String Object
apiMap
readFromAPIFile :: IO (Either String Object)
readFromAPIFile :: IO (Either String Object)
readFromAPIFile = (forall a. Serialize a => ByteString -> Either String a
decode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
B.readFile String
"api") forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` SomeException -> IO (Either String Object)
returnNoApiForCodegeneratorErrorMessage
where
returnNoApiForCodegeneratorErrorMessage :: SomeException -> IO (Either String Object)
returnNoApiForCodegeneratorErrorMessage :: SomeException -> IO (Either String Object)
returnNoApiForCodegeneratorErrorMessage SomeException
_ =
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
String
"The 'nvim' process could not be started and there is no file named 'api' in the working directory as a substitute."
oLookup :: (NvimObject o) => String -> Map String Object -> Either (Doc AnsiStyle) o
oLookup :: forall o.
NvimObject o =>
String -> Map String Object -> Either (Doc AnsiStyle) o
oLookup String
qry = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {a}. Either (Doc AnsiStyle) a
throwErrorMessage forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
qry
where
throwErrorMessage :: Either (Doc AnsiStyle) a
throwErrorMessage = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"No entry for:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty String
qry
oLookupDefault :: (NvimObject o) => o -> String -> Map String Object -> Either (Doc AnsiStyle) o
oLookupDefault :: forall o.
NvimObject o =>
o -> String -> Map String Object -> Either (Doc AnsiStyle) o
oLookupDefault o
d String
qry Map String Object
m = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return o
d) forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
qry Map String Object
m
extractErrorTypes :: Map String Object -> Either (Doc AnsiStyle) [(String, Int64)]
Map String Object
objAPI = Object -> Either (Doc AnsiStyle) [(String, Int64)]
extractTypeNameAndID forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall o.
NvimObject o =>
String -> Map String Object -> Either (Doc AnsiStyle) o
oLookup String
"error_types" Map String Object
objAPI
extractTypeNameAndID :: Object -> Either (Doc AnsiStyle) [(String, Int64)]
extractTypeNameAndID :: Object -> Either (Doc AnsiStyle) [(String, Int64)]
extractTypeNameAndID Object
m = do
[(String, Map String Object)]
types <- forall k a. Map k a -> [(k, a)]
Map.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
m
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(String, Map String Object)]
types forall a b. (a -> b) -> a -> b
$ \(String
errName, Map String Object
idMap) -> do
Int64
i <- forall o.
NvimObject o =>
String -> Map String Object -> Either (Doc AnsiStyle) o
oLookup String
"id" Map String Object
idMap
forall (m :: * -> *) a. Monad m => a -> m a
return (String
errName, Int64
i)
extractCustomTypes :: Map String Object -> Either (Doc AnsiStyle) [(String, Int64)]
Map String Object
objAPI = Object -> Either (Doc AnsiStyle) [(String, Int64)]
extractTypeNameAndID forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall o.
NvimObject o =>
String -> Map String Object -> Either (Doc AnsiStyle) o
oLookup String
"types" Map String Object
objAPI
extractFunctions :: Map String Object -> Either (Doc AnsiStyle) [NeovimFunction]
Map String Object
objAPI = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Map String Object -> Either (Doc AnsiStyle) NeovimFunction
extractFunction forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall o.
NvimObject o =>
String -> Map String Object -> Either (Doc AnsiStyle) o
oLookup String
"functions" Map String Object
objAPI
toParameterlist :: [(String, String)] -> Either (Doc AnsiStyle) [(NeovimType, String)]
toParameterlist :: [(String, String)] -> Either (Doc AnsiStyle) [(NeovimType, String)]
toParameterlist [(String, String)]
ps = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(String, String)]
ps forall a b. (a -> b) -> a -> b
$ \(String
t, String
n) -> do
NeovimType
t' <- String -> Either (Doc AnsiStyle) NeovimType
parseType String
t
forall (m :: * -> *) a. Monad m => a -> m a
return (NeovimType
t', String
n)
extractFunction :: Map String Object -> Either (Doc AnsiStyle) NeovimFunction
Map String Object
funDefMap =
String
-> [(NeovimType, String)]
-> Bool
-> Bool
-> NeovimType
-> NeovimFunction
NeovimFunction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall o.
NvimObject o =>
String -> Map String Object -> Either (Doc AnsiStyle) o
oLookup String
"name" Map String Object
funDefMap
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall o.
NvimObject o =>
String -> Map String Object -> Either (Doc AnsiStyle) o
oLookup String
"parameters" Map String Object
funDefMap forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(String, String)] -> Either (Doc AnsiStyle) [(NeovimType, String)]
toParameterlist)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall o.
NvimObject o =>
o -> String -> Map String Object -> Either (Doc AnsiStyle) o
oLookupDefault Bool
True String
"can_fail" Map String Object
funDefMap
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall o.
NvimObject o =>
o -> String -> Map String Object -> Either (Doc AnsiStyle) o
oLookupDefault Bool
False String
"async" Map String Object
funDefMap
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall o.
NvimObject o =>
String -> Map String Object -> Either (Doc AnsiStyle) o
oLookup String
"return_type" Map String Object
funDefMap forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either (Doc AnsiStyle) NeovimType
parseType)
parseType :: String -> Either (Doc AnsiStyle) NeovimType
parseType :: String -> Either (Doc AnsiStyle) NeovimType
parseType String
s = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (ParsecT Void String Identity NeovimType
pType forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
s String
s
pType :: P.Parser NeovimType
pType :: ParsecT Void String Identity NeovimType
pType = ParsecT Void String Identity NeovimType
pArray forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
P.<|> ParsecT Void String Identity NeovimType
pVoid forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
P.<|> ParsecT Void String Identity NeovimType
pSimple
pVoid :: P.Parser NeovimType
pVoid :: ParsecT Void String Identity NeovimType
pVoid = NeovimType
Void forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"void") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)
pSimple :: P.Parser NeovimType
pSimple :: ParsecT Void String Identity NeovimType
pSimple = String -> NeovimType
SimpleType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.some (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
',', Char
')'])
pArray :: P.Parser NeovimType
pArray :: ParsecT Void String Identity NeovimType
pArray =
NeovimType -> Maybe Int -> NeovimType
NestedType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"ArrayOf(") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity NeovimType
pType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Int
pNum
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
')'
pNum :: P.Parser Int
pNum :: Parser Int
pNum = forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
',') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.some (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'0' .. Char
'9']))