{-# LANGUAGE OverloadedStrings #-}
{- |
Module      :  Neovim.API.Parser
Description :  P.Parser for the msgpack output stram API
Copyright   :  (c) Sebastian Witte
License     :  Apache-2.0

Maintainer  :  woozletoff@gmail.com
Stability   :  experimental
-}
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)

{- | This data type contains simple information about a function as received
 throudh the @nvim --api-info@ command.
-}
data NeovimFunction = NeovimFunction
    { -- | function name
      NeovimFunction -> String
name :: String
    , -- | A list of type name and variable name.
      NeovimFunction -> [(NeovimType, String)]
parameters :: [(NeovimType, String)]
    , -- | Indicator whether the function can fail/throws exceptions.
      NeovimFunction -> Bool
canFail :: Bool
    , -- | Indicator whether the this function is asynchronous.
      NeovimFunction -> Bool
async :: Bool
    , -- | Functions return type.
      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)

{- | This data type represents the top-level structure of the @nvim --api-info@
 output.
-}
data NeovimAPI = NeovimAPI
    { -- | The error types are defined by a name and an identifier.
      NeovimAPI -> [(String, Int64)]
errorTypes :: [(String, Int64)]
    , -- | Extension types defined by neovim.
      NeovimAPI -> [(String, Int64)]
customTypes :: [(String, Int64)]
    , -- | The remotely executable functions provided by the neovim api.
      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)

-- | Run @nvim --api-info@ and parse its output.
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
extractAPI :: Object -> Either (Doc AnsiStyle) NeovimAPI
extractAPI 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)]
extractErrorTypes :: Map String Object -> Either (Doc AnsiStyle) [(String, Int64)]
extractErrorTypes 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)]
extractCustomTypes :: Map String Object -> Either (Doc AnsiStyle) [(String, Int64)]
extractCustomTypes 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]
extractFunctions :: Map String Object -> Either (Doc AnsiStyle) [NeovimFunction]
extractFunctions 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
extractFunction :: Map String Object -> Either (Doc AnsiStyle) NeovimFunction
extractFunction 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']))