{- |
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 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 Prelude

data NeovimType
    = SimpleType String
    | NestedType NeovimType (Maybe Int)
    | Void
    deriving (Int -> NeovimType -> ShowS
[NeovimType] -> ShowS
NeovimType -> String
(Int -> NeovimType -> ShowS)
-> (NeovimType -> String)
-> ([NeovimType] -> ShowS)
-> Show NeovimType
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
(NeovimType -> NeovimType -> Bool)
-> (NeovimType -> NeovimType -> Bool) -> Eq NeovimType
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
(Int -> NeovimFunction -> ShowS)
-> (NeovimFunction -> String)
-> ([NeovimFunction] -> ShowS)
-> Show NeovimFunction
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
(Int -> NeovimAPI -> ShowS)
-> (NeovimAPI -> String)
-> ([NeovimAPI] -> ShowS)
-> Show NeovimAPI
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 = (String -> Either (Doc AnsiStyle) NeovimAPI)
-> (Object -> Either (Doc AnsiStyle) NeovimAPI)
-> Either String Object
-> Either (Doc AnsiStyle) NeovimAPI
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Doc AnsiStyle -> Either (Doc AnsiStyle) NeovimAPI
forall a b. a -> Either a b
Left (Doc AnsiStyle -> Either (Doc AnsiStyle) NeovimAPI)
-> (String -> Doc AnsiStyle)
-> String
-> Either (Doc AnsiStyle) NeovimAPI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty) Object -> Either (Doc AnsiStyle) NeovimAPI
extractAPI (Either String Object -> Either (Doc AnsiStyle) NeovimAPI)
-> IO (Either String Object)
-> IO (Either (Doc AnsiStyle) NeovimAPI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO (Either String Object)
decodeAPI IO (Either String Object)
-> (SomeException -> IO (Either String Object))
-> IO (Either String Object)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` SomeException -> IO (Either String Object)
readFromAPIFile)

extractAPI :: Object -> Either (Doc AnsiStyle) NeovimAPI
extractAPI :: Object -> Either (Doc AnsiStyle) NeovimAPI
extractAPI Object
apiObj =
    Object -> Either (Doc AnsiStyle) (Map String Object)
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
apiObj Either (Doc AnsiStyle) (Map String Object)
-> (Map String Object -> Either (Doc AnsiStyle) NeovimAPI)
-> Either (Doc AnsiStyle) NeovimAPI
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Map String Object
apiMap ->
        [(String, Int64)]
-> [(String, Int64)] -> [NeovimFunction] -> NeovimAPI
NeovimAPI
            ([(String, Int64)]
 -> [(String, Int64)] -> [NeovimFunction] -> NeovimAPI)
-> Either (Doc AnsiStyle) [(String, Int64)]
-> Either
     (Doc AnsiStyle)
     ([(String, Int64)] -> [NeovimFunction] -> 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
            Either
  (Doc AnsiStyle)
  ([(String, Int64)] -> [NeovimFunction] -> NeovimAPI)
-> Either (Doc AnsiStyle) [(String, Int64)]
-> Either (Doc AnsiStyle) ([NeovimFunction] -> NeovimAPI)
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
            Either (Doc AnsiStyle) ([NeovimFunction] -> NeovimAPI)
-> Either (Doc AnsiStyle) [NeovimFunction]
-> Either (Doc AnsiStyle) NeovimAPI
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 :: SomeException -> IO (Either String Object)
readFromAPIFile :: SomeException -> IO (Either String Object)
readFromAPIFile SomeException
_ = (ByteString -> Either String Object
forall a. Serialize a => ByteString -> Either String a
decode (ByteString -> Either String Object)
-> IO ByteString -> IO (Either String Object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
B.readFile String
"api") IO (Either String Object)
-> (SomeException -> IO (Either String Object))
-> IO (Either String Object)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` SomeException -> IO (Either String Object)
returnPreviousExceptionAsText
  where
    returnPreviousExceptionAsText :: SomeException -> IO (Either String Object)
    returnPreviousExceptionAsText :: SomeException -> IO (Either String Object)
returnPreviousExceptionAsText SomeException
_ =
        Either String Object -> IO (Either String Object)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Object -> IO (Either String Object))
-> (String -> Either String Object)
-> String
-> IO (Either String Object)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Object
forall a b. a -> Either a b
Left (String -> IO (Either String Object))
-> String -> IO (Either String Object)
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."

decodeAPI :: IO (Either String Object)
decodeAPI :: IO (Either String Object)
decodeAPI =
    ByteString -> Either String Object
forall a. Serialize a => ByteString -> Either String a
decode (ByteString -> Either String Object)
-> (ByteString -> ByteString) -> ByteString -> Either String Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LB.toStrict (ByteString -> Either String Object)
-> IO ByteString -> IO (Either String 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" [String
"--api-info"])

oLookup :: (NvimObject o) => String -> Map String Object -> Either (Doc AnsiStyle) o
oLookup :: String -> Map String Object -> Either (Doc AnsiStyle) o
oLookup String
qry = Either (Doc AnsiStyle) o
-> (Object -> Either (Doc AnsiStyle) o)
-> Maybe Object
-> Either (Doc AnsiStyle) o
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either (Doc AnsiStyle) o
forall a. Either (Doc AnsiStyle) a
throwErrorMessage Object -> Either (Doc AnsiStyle) o
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject (Maybe Object -> Either (Doc AnsiStyle) o)
-> (Map String Object -> Maybe Object)
-> Map String Object
-> Either (Doc AnsiStyle) o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Map String Object -> Maybe Object
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
qry
  where
    throwErrorMessage :: Either (Doc AnsiStyle) a
throwErrorMessage = Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) a)
-> Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"No entry for:" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty String
qry

oLookupDefault :: (NvimObject o) => o -> String -> Map String Object -> Either (Doc AnsiStyle) o
oLookupDefault :: o -> String -> Map String Object -> Either (Doc AnsiStyle) o
oLookupDefault o
d String
qry Map String Object
m = Either (Doc AnsiStyle) o
-> (Object -> Either (Doc AnsiStyle) o)
-> Maybe Object
-> Either (Doc AnsiStyle) o
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (o -> Either (Doc AnsiStyle) o
forall (m :: * -> *) a. Monad m => a -> m a
return o
d) Object -> Either (Doc AnsiStyle) o
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject (Maybe Object -> Either (Doc AnsiStyle) o)
-> Maybe Object -> Either (Doc AnsiStyle) o
forall a b. (a -> b) -> a -> b
$ String -> Map String Object -> Maybe Object
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 (Object -> Either (Doc AnsiStyle) [(String, Int64)])
-> Either (Doc AnsiStyle) Object
-> Either (Doc AnsiStyle) [(String, Int64)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> Map String Object -> Either (Doc AnsiStyle) Object
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 <- Map String (Map String Object) -> [(String, Map String Object)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map String (Map String Object) -> [(String, Map String Object)])
-> Either (Doc AnsiStyle) (Map String (Map String Object))
-> Either (Doc AnsiStyle) [(String, Map String Object)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Either (Doc AnsiStyle) (Map String (Map String Object))
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
m
    [(String, Map String Object)]
-> ((String, Map String Object)
    -> Either (Doc AnsiStyle) (String, Int64))
-> Either (Doc AnsiStyle) [(String, Int64)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(String, Map String Object)]
types (((String, Map String Object)
  -> Either (Doc AnsiStyle) (String, Int64))
 -> Either (Doc AnsiStyle) [(String, Int64)])
-> ((String, Map String Object)
    -> Either (Doc AnsiStyle) (String, Int64))
-> Either (Doc AnsiStyle) [(String, Int64)]
forall a b. (a -> b) -> a -> b
$ \(String
errName, Map String Object
idMap) -> do
        Int64
i <- String -> Map String Object -> Either (Doc AnsiStyle) Int64
forall o.
NvimObject o =>
String -> Map String Object -> Either (Doc AnsiStyle) o
oLookup String
"id" Map String Object
idMap
        (String, Int64) -> Either (Doc AnsiStyle) (String, Int64)
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 (Object -> Either (Doc AnsiStyle) [(String, Int64)])
-> Either (Doc AnsiStyle) Object
-> Either (Doc AnsiStyle) [(String, Int64)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> Map String Object -> Either (Doc AnsiStyle) Object
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 = (Map String Object -> Either (Doc AnsiStyle) NeovimFunction)
-> [Map String Object] -> Either (Doc AnsiStyle) [NeovimFunction]
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 ([Map String Object] -> Either (Doc AnsiStyle) [NeovimFunction])
-> Either (Doc AnsiStyle) [Map String Object]
-> Either (Doc AnsiStyle) [NeovimFunction]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String
-> Map String Object -> Either (Doc AnsiStyle) [Map String Object]
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 = [(String, String)]
-> ((String, String)
    -> Either (Doc AnsiStyle) (NeovimType, String))
-> Either (Doc AnsiStyle) [(NeovimType, String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(String, String)]
ps (((String, String) -> Either (Doc AnsiStyle) (NeovimType, String))
 -> Either (Doc AnsiStyle) [(NeovimType, String)])
-> ((String, String)
    -> Either (Doc AnsiStyle) (NeovimType, String))
-> Either (Doc AnsiStyle) [(NeovimType, String)]
forall a b. (a -> b) -> a -> b
$ \(String
t, String
n) -> do
    NeovimType
t' <- String -> Either (Doc AnsiStyle) NeovimType
parseType String
t
    (NeovimType, String) -> Either (Doc AnsiStyle) (NeovimType, String)
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
        (String
 -> [(NeovimType, String)]
 -> Bool
 -> Bool
 -> NeovimType
 -> NeovimFunction)
-> Either (Doc AnsiStyle) String
-> Either
     (Doc AnsiStyle)
     ([(NeovimType, String)]
      -> Bool -> Bool -> NeovimType -> NeovimFunction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Map String Object -> Either (Doc AnsiStyle) String
forall o.
NvimObject o =>
String -> Map String Object -> Either (Doc AnsiStyle) o
oLookup String
"name" Map String Object
funDefMap
        Either
  (Doc AnsiStyle)
  ([(NeovimType, String)]
   -> Bool -> Bool -> NeovimType -> NeovimFunction)
-> Either (Doc AnsiStyle) [(NeovimType, String)]
-> Either
     (Doc AnsiStyle) (Bool -> Bool -> NeovimType -> NeovimFunction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String
-> Map String Object -> Either (Doc AnsiStyle) [(String, String)]
forall o.
NvimObject o =>
String -> Map String Object -> Either (Doc AnsiStyle) o
oLookup String
"parameters" Map String Object
funDefMap Either (Doc AnsiStyle) [(String, String)]
-> ([(String, String)]
    -> Either (Doc AnsiStyle) [(NeovimType, String)])
-> Either (Doc AnsiStyle) [(NeovimType, String)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(String, String)] -> Either (Doc AnsiStyle) [(NeovimType, String)]
toParameterlist)
        Either
  (Doc AnsiStyle) (Bool -> Bool -> NeovimType -> NeovimFunction)
-> Either (Doc AnsiStyle) Bool
-> Either (Doc AnsiStyle) (Bool -> NeovimType -> NeovimFunction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> String -> Map String Object -> Either (Doc AnsiStyle) Bool
forall o.
NvimObject o =>
o -> String -> Map String Object -> Either (Doc AnsiStyle) o
oLookupDefault Bool
True String
"can_fail" Map String Object
funDefMap
        Either (Doc AnsiStyle) (Bool -> NeovimType -> NeovimFunction)
-> Either (Doc AnsiStyle) Bool
-> Either (Doc AnsiStyle) (NeovimType -> NeovimFunction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> String -> Map String Object -> Either (Doc AnsiStyle) Bool
forall o.
NvimObject o =>
o -> String -> Map String Object -> Either (Doc AnsiStyle) o
oLookupDefault Bool
False String
"async" Map String Object
funDefMap
        Either (Doc AnsiStyle) (NeovimType -> NeovimFunction)
-> Either (Doc AnsiStyle) NeovimType
-> Either (Doc AnsiStyle) NeovimFunction
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Map String Object -> Either (Doc AnsiStyle) String
forall o.
NvimObject o =>
String -> Map String Object -> Either (Doc AnsiStyle) o
oLookup String
"return_type" Map String Object
funDefMap Either (Doc AnsiStyle) String
-> (String -> Either (Doc AnsiStyle) NeovimType)
-> Either (Doc AnsiStyle) NeovimType
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 = (ParseErrorBundle String Void -> Either (Doc AnsiStyle) NeovimType)
-> (NeovimType -> Either (Doc AnsiStyle) NeovimType)
-> Either (ParseErrorBundle String Void) NeovimType
-> Either (Doc AnsiStyle) NeovimType
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Doc AnsiStyle -> Either (Doc AnsiStyle) NeovimType
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) NeovimType)
-> (ParseErrorBundle String Void -> Doc AnsiStyle)
-> ParseErrorBundle String Void
-> Either (Doc AnsiStyle) NeovimType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc AnsiStyle)
-> (ParseErrorBundle String Void -> String)
-> ParseErrorBundle String Void
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle String Void -> String
forall a. Show a => a -> String
show) NeovimType -> Either (Doc AnsiStyle) NeovimType
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (ParseErrorBundle String Void) NeovimType
 -> Either (Doc AnsiStyle) NeovimType)
-> Either (ParseErrorBundle String Void) NeovimType
-> Either (Doc AnsiStyle) NeovimType
forall a b. (a -> b) -> a -> b
$ Parsec Void String NeovimType
-> String
-> String
-> Either (ParseErrorBundle String Void) NeovimType
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parsec Void String NeovimType
pType Parsec Void String NeovimType
-> ParsecT Void String Identity () -> Parsec Void String NeovimType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
s String
s

pType :: P.Parser NeovimType
pType :: Parsec Void String NeovimType
pType = Parsec Void String NeovimType
pArray Parsec Void String NeovimType
-> Parsec Void String NeovimType -> Parsec Void String NeovimType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
P.<|> Parsec Void String NeovimType
pVoid Parsec Void String NeovimType
-> Parsec Void String NeovimType -> Parsec Void String NeovimType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
P.<|> Parsec Void String NeovimType
pSimple

pVoid :: P.Parser NeovimType
pVoid :: Parsec Void String NeovimType
pVoid = NeovimType
Void NeovimType
-> ParsecT Void String Identity String
-> Parsec Void String NeovimType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"void") ParsecT Void String Identity String
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)

pSimple :: P.Parser NeovimType
pSimple :: Parsec Void String NeovimType
pSimple = String -> NeovimType
SimpleType (String -> NeovimType)
-> ParsecT Void String Identity String
-> Parsec Void String NeovimType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.some ([Token String] -> ParsecT Void String Identity (Token String)
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 :: Parsec Void String NeovimType
pArray =
    NeovimType -> Maybe Int -> NeovimType
NestedType (NeovimType -> Maybe Int -> NeovimType)
-> Parsec Void String NeovimType
-> ParsecT Void String Identity (Maybe Int -> NeovimType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"ArrayOf(") ParsecT Void String Identity String
-> Parsec Void String NeovimType -> Parsec Void String NeovimType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void String NeovimType
pType)
        ParsecT Void String Identity (Maybe Int -> NeovimType)
-> ParsecT Void String Identity (Maybe Int)
-> Parsec Void String NeovimType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void String Identity Int
-> ParsecT Void String Identity (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void String Identity Int
pNum Parsec Void String NeovimType
-> ParsecT Void String Identity Char
-> Parsec Void String NeovimType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
')'

pNum :: P.Parser Int
pNum :: ParsecT Void String Identity Int
pNum = String -> Int
forall a. Read a => String -> a
read (String -> Int)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
',') ParsecT Void String Identity Char
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void String Identity ()
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.some ([Token String] -> ParsecT Void String Identity (Token String)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'0' .. Char
'9']))