module Neovim.API.Parser
( NeovimAPI(..)
, NeovimFunction(..)
, NeovimType(..)
, parseAPI
) where
import Neovim.Classes
import Control.Applicative
import Control.Monad.Except
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
import Data.Serialize
import Neovim.Compat.Megaparsec as P
import System.Process.Typed
import UnliftIO.Exception (SomeException,
catch)
import Data.Text.Prettyprint.Doc (Doc, Pretty(..), (<+>))
import Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle)
import Prelude
data NeovimType = SimpleType String
| NestedType NeovimType (Maybe Int)
| Void
deriving (Show, Eq)
data NeovimFunction
= NeovimFunction
{ name :: String
, parameters :: [(NeovimType, String)]
, canFail :: Bool
, async :: Bool
, returnType :: NeovimType
}
deriving (Show)
data NeovimAPI
= NeovimAPI
{ errorTypes :: [(String, Int64)]
, customTypes :: [(String, Int64)]
, functions :: [NeovimFunction]
}
deriving (Show)
parseAPI :: IO (Either (Doc AnsiStyle) NeovimAPI)
parseAPI = either (Left . pretty) extractAPI <$> (decodeAPI `catch` readFromAPIFile)
extractAPI :: Object -> Either (Doc AnsiStyle) NeovimAPI
extractAPI apiObj = fromObject apiObj >>= \apiMap -> NeovimAPI
<$> extractErrorTypes apiMap
<*> extractCustomTypes apiMap
<*> extractFunctions apiMap
readFromAPIFile :: SomeException -> IO (Either String Object)
readFromAPIFile _ = (decode <$> B.readFile "api") `catch` returnPreviousExceptionAsText
where
returnPreviousExceptionAsText :: SomeException -> IO (Either String Object)
returnPreviousExceptionAsText _ = return . Left $
"The 'nvim' process could not be started and there is no file named\
\ 'api' in the working directory as a substitute."
decodeAPI :: IO (Either String Object)
decodeAPI =
decode . LB.toStrict <$> readProcessStdout_ (proc "nvim" ["--api-info"])
oLookup :: (NvimObject o) => String -> Map String Object -> Either (Doc AnsiStyle) o
oLookup qry = maybe throwErrorMessage fromObject . Map.lookup qry
where
throwErrorMessage = throwError $ "No entry for:" <+> pretty qry
oLookupDefault :: (NvimObject o) => o -> String -> Map String Object -> Either (Doc AnsiStyle) o
oLookupDefault d qry m = maybe (return d) fromObject $ Map.lookup qry m
extractErrorTypes :: Map String Object -> Either (Doc AnsiStyle) [(String, Int64)]
extractErrorTypes objAPI = extractTypeNameAndID =<< oLookup "error_types" objAPI
extractTypeNameAndID :: Object -> Either (Doc AnsiStyle) [(String, Int64)]
extractTypeNameAndID m = do
types <- Map.toList <$> fromObject m
forM types $ \(errName, idMap) -> do
i <- oLookup "id" idMap
return (errName,i)
extractCustomTypes :: Map String Object -> Either (Doc AnsiStyle) [(String, Int64)]
extractCustomTypes objAPI = extractTypeNameAndID =<< oLookup "types" objAPI
extractFunctions :: Map String Object -> Either (Doc AnsiStyle) [NeovimFunction]
extractFunctions objAPI = mapM extractFunction =<< oLookup "functions" objAPI
toParameterlist :: [(String, String)] -> Either (Doc AnsiStyle) [(NeovimType, String)]
toParameterlist ps = forM ps $ \(t,n) -> do
t' <- parseType t
return (t', n)
extractFunction :: Map String Object -> Either (Doc AnsiStyle) NeovimFunction
extractFunction funDefMap = NeovimFunction
<$> (oLookup "name" funDefMap)
<*> (oLookup "parameters" funDefMap >>= toParameterlist)
<*> (oLookupDefault True "can_fail" funDefMap)
<*> (oLookupDefault False "async" funDefMap)
<*> (oLookup "return_type" funDefMap >>= parseType)
parseType :: String -> Either (Doc AnsiStyle) NeovimType
parseType s = either (throwError . pretty . show) return $ parse (pType <* eof) s s
pType :: P.Parser NeovimType
pType = pArray P.<|> pVoid P.<|> pSimple
pVoid :: P.Parser NeovimType
pVoid = const Void <$> (P.try (string "void") <* eof)
pSimple :: P.Parser NeovimType
pSimple = SimpleType <$> P.some (noneOf [',', ')'])
pArray :: P.Parser NeovimType
pArray = NestedType <$> (P.try (string "ArrayOf(") *> pType)
<*> optional pNum <* char ')'
pNum :: P.Parser Int
pNum = read <$> (P.try (char ',') *> space *> P.some (oneOf ['0'..'9']))