{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}

{- |
Module      :  Neovim.Classes
Description :  Type classes used for conversion of msgpack and Haskell types
Copyright   :  (c) Sebastian Witte
License     :  Apache-2.0

Maintainer  :  woozletoff@gmail.com
Stability   :  experimental
-}
module Neovim.Classes (
    NvimObject (..),
    Dictionary,
    (+:),
    Generic,
    docToObject,
    docFromObject,
    docToText,
    Doc,
    AnsiStyle,
    Pretty (..),
    (<+>),
    module Data.Int,
    module Data.Word,
    module Control.DeepSeq,
) where

import Neovim.Exceptions (NeovimException (..))

import Control.Applicative (Applicative (liftA2))
import Control.Arrow ((***))
import Control.DeepSeq (NFData)
import Control.Monad ()
import Control.Monad.Except (
    MonadError (throwError),
 )
import Control.Monad.IO.Class (MonadIO)
import Data.ByteString (ByteString)
import Data.Int (
    Int16,
    Int32,
    Int64,
    Int8,
 )
import qualified Data.Map.Strict as SMap
import Data.MessagePack
import Data.Monoid
import Data.Text as Text (Text)
import Data.Vector (Vector)
import qualified Data.Vector as V
import Data.Word (
    Word,
    Word16,
    Word32,
    Word64,
    Word8,
 )
import GHC.Generics (Generic)
import Prettyprinter (
    Doc,
    Pretty (..),
    defaultLayoutOptions,
    layoutPretty,
    viaShow,
    (<+>),
 )
import qualified Prettyprinter as P
import Prettyprinter.Render.Terminal (
    AnsiStyle,
    renderStrict,
 )

import qualified Data.ByteString.UTF8 as UTF8 (fromString, toString)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import UnliftIO.Exception (throwIO)

import Prelude

infixr 5 +:

{- | Convenient operator to create a list of 'Object' from normal values.
 @
 values +: of :+ different :+ types :+ can +: be +: combined +: this +: way +: []
 @
-}
(+:) :: (NvimObject o) => o -> [Object] -> [Object]
o
o +: :: forall o. NvimObject o => o -> [Object] -> [Object]
+: [Object]
os = o -> Object
forall o. NvimObject o => o -> Object
toObject o
o Object -> [Object] -> [Object]
forall a. a -> [a] -> [a]
: [Object]
os

{- | Convert a 'Doc'-ument to a messagepack 'Object'. This is more a convenience
 method to transport error message from and to neovim. It generally does not
 hold that 'docToObject . docFromObject' = 'id'.
-}
docToObject :: Doc AnsiStyle -> Object
docToObject :: Doc AnsiStyle -> Object
docToObject = ByteString -> Object
ObjectString (ByteString -> Object)
-> (Doc AnsiStyle -> ByteString) -> Doc AnsiStyle -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> ByteString)
-> (Doc AnsiStyle -> Text) -> Doc AnsiStyle -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> Text
docToText

-- | See 'docToObject'.
docFromObject :: Object -> Either (Doc AnsiStyle) (Doc AnsiStyle)
docFromObject :: Object -> Either (Doc AnsiStyle) (Doc AnsiStyle)
docFromObject Object
o = (Text -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
P.viaShow :: Text -> Doc AnsiStyle) (Text -> Doc AnsiStyle)
-> Either (Doc AnsiStyle) Text
-> Either (Doc AnsiStyle) (Doc AnsiStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Either (Doc AnsiStyle) Text
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o

docToText :: Doc AnsiStyle -> Text
docToText :: Doc AnsiStyle -> Text
docToText = SimpleDocStream AnsiStyle -> Text
renderStrict (SimpleDocStream AnsiStyle -> Text)
-> (Doc AnsiStyle -> SimpleDocStream AnsiStyle)
-> Doc AnsiStyle
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc AnsiStyle -> SimpleDocStream AnsiStyle
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions

{- | A generic vim dictionary is a simply a map from strings to objects.  This
 type alias is sometimes useful as a type annotation especially if the
 OverloadedStrings extension is enabled.
-}
type Dictionary = SMap.Map ByteString Object

{- | Conversion from 'Object' files to Haskell types and back with respect
 to neovim's interpretation.

 The 'NFData' constraint has been added to allow forcing results of function
 evaluations in order to catch exceptions from pure code. This adds more
 stability to the plugin provider and seems to be a cleaner approach.
-}
class NFData o => NvimObject o where
    toObject :: o -> Object

    fromObjectUnsafe :: Object -> o
    fromObjectUnsafe Object
o = case Object -> Either (Doc AnsiStyle) o
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o of
        Left Doc AnsiStyle
e ->
            [Char] -> o
forall a. HasCallStack => [Char] -> a
error ([Char] -> o) -> (Doc AnsiStyle -> [Char]) -> Doc AnsiStyle -> o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> [Char]
forall a. Show a => a -> [Char]
show (Doc AnsiStyle -> o) -> Doc AnsiStyle -> o
forall a b. (a -> b) -> a -> b
$
                Doc AnsiStyle
"Not the expected object:"
                    Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
P.viaShow Object
o
                    Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
forall ann. Doc ann
P.lparen Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
e Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
P.rparen
        Right o
obj -> o
obj

    fromObject :: Object -> Either (Doc AnsiStyle) o
    fromObject = o -> Either (Doc AnsiStyle) o
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (o -> Either (Doc AnsiStyle) o)
-> (Object -> o) -> Object -> Either (Doc AnsiStyle) o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> o
forall o. NvimObject o => Object -> o
fromObjectUnsafe

    fromObject' :: (MonadIO io) => Object -> io o
    fromObject' = (Doc AnsiStyle -> io o)
-> (o -> io o) -> Either (Doc AnsiStyle) o -> io o
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (NeovimException -> io o
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (NeovimException -> io o)
-> (Doc AnsiStyle -> NeovimException) -> Doc AnsiStyle -> io o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> NeovimException
ErrorMessage) o -> io o
forall a. a -> io a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Doc AnsiStyle) o -> io o)
-> (Object -> Either (Doc AnsiStyle) o) -> Object -> io o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Either (Doc AnsiStyle) o
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject

    {-# MINIMAL toObject, (fromObject | fromObjectUnsafe) #-}

-- Instances for NvimObject {{{1
instance NvimObject () where
    toObject :: () -> Object
toObject ()
_ = Object
ObjectNil

    fromObject :: Object -> Either (Doc AnsiStyle) ()
fromObject Object
ObjectNil = () -> Either (Doc AnsiStyle) ()
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    fromObject Object
o = Doc AnsiStyle -> Either (Doc AnsiStyle) ()
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) ())
-> Doc AnsiStyle -> Either (Doc AnsiStyle) ()
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected ObjectNil, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
P.viaShow Object
o

-- We may receive truthy values from neovim, so we should be more forgiving
-- here.
instance NvimObject Bool where
    toObject :: Bool -> Object
toObject = Bool -> Object
ObjectBool

    fromObject :: Object -> Either (Doc AnsiStyle) Bool
fromObject (ObjectBool Bool
o) = Bool -> Either (Doc AnsiStyle) Bool
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
o
    fromObject (ObjectInt Int64
0) = Bool -> Either (Doc AnsiStyle) Bool
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    fromObject (ObjectUInt Word64
0) = Bool -> Either (Doc AnsiStyle) Bool
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    fromObject Object
ObjectNil = Bool -> Either (Doc AnsiStyle) Bool
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    fromObject (ObjectBinary ByteString
"0") = Bool -> Either (Doc AnsiStyle) Bool
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    fromObject (ObjectBinary ByteString
"") = Bool -> Either (Doc AnsiStyle) Bool
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    fromObject (ObjectString ByteString
"0") = Bool -> Either (Doc AnsiStyle) Bool
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    fromObject (ObjectString ByteString
"") = Bool -> Either (Doc AnsiStyle) Bool
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    fromObject Object
_ = Bool -> Either (Doc AnsiStyle) Bool
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

instance NvimObject Double where
    toObject :: Double -> Object
toObject = Double -> Object
ObjectDouble

    fromObject :: Object -> Either (Doc AnsiStyle) Double
fromObject (ObjectDouble Double
o) = Double -> Either (Doc AnsiStyle) Double
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
o
    fromObject (ObjectFloat Float
o) = Double -> Either (Doc AnsiStyle) Double
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Either (Doc AnsiStyle) Double)
-> Double -> Either (Doc AnsiStyle) Double
forall a b. (a -> b) -> a -> b
$ Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
o
    fromObject (ObjectInt Int64
o) = Double -> Either (Doc AnsiStyle) Double
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Either (Doc AnsiStyle) Double)
-> Double -> Either (Doc AnsiStyle) Double
forall a b. (a -> b) -> a -> b
$ Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
o
    fromObject (ObjectUInt Word64
o) = Double -> Either (Doc AnsiStyle) Double
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Either (Doc AnsiStyle) Double)
-> Double -> Either (Doc AnsiStyle) Double
forall a b. (a -> b) -> a -> b
$ Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
o
    fromObject Object
o =
        Doc AnsiStyle -> Either (Doc AnsiStyle) Double
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) Double)
-> Doc AnsiStyle -> Either (Doc AnsiStyle) Double
forall a b. (a -> b) -> a -> b
$
            Doc AnsiStyle
"Expected ObjectDouble, but got"
                Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance NvimObject Integer where
    toObject :: Integer -> Object
toObject = Int64 -> Object
ObjectInt (Int64 -> Object) -> (Integer -> Int64) -> Integer -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

    fromObject :: Object -> Either (Doc AnsiStyle) Integer
fromObject (ObjectInt Int64
o) = Integer -> Either (Doc AnsiStyle) Integer
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Either (Doc AnsiStyle) Integer)
-> Integer -> Either (Doc AnsiStyle) Integer
forall a b. (a -> b) -> a -> b
$ Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
o
    fromObject (ObjectUInt Word64
o) = Integer -> Either (Doc AnsiStyle) Integer
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Either (Doc AnsiStyle) Integer)
-> Integer -> Either (Doc AnsiStyle) Integer
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
o
    fromObject (ObjectDouble Double
o) = Integer -> Either (Doc AnsiStyle) Integer
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Either (Doc AnsiStyle) Integer)
-> Integer -> Either (Doc AnsiStyle) Integer
forall a b. (a -> b) -> a -> b
$ Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
o
    fromObject (ObjectFloat Float
o) = Integer -> Either (Doc AnsiStyle) Integer
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Either (Doc AnsiStyle) Integer)
-> Integer -> Either (Doc AnsiStyle) Integer
forall a b. (a -> b) -> a -> b
$ Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Float
o
    fromObject Object
o = Doc AnsiStyle -> Either (Doc AnsiStyle) Integer
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) Integer)
-> Doc AnsiStyle -> Either (Doc AnsiStyle) Integer
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected ObjectInt, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance NvimObject Int64 where
    toObject :: Int64 -> Object
toObject = Int64 -> Object
ObjectInt

    fromObject :: Object -> Either (Doc AnsiStyle) Int64
fromObject (ObjectInt Int64
i) = Int64 -> Either (Doc AnsiStyle) Int64
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
i
    fromObject (ObjectUInt Word64
o) = Int64 -> Either (Doc AnsiStyle) Int64
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Either (Doc AnsiStyle) Int64)
-> Int64 -> Either (Doc AnsiStyle) Int64
forall a b. (a -> b) -> a -> b
$ Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
o
    fromObject (ObjectDouble Double
o) = Int64 -> Either (Doc AnsiStyle) Int64
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Either (Doc AnsiStyle) Int64)
-> Int64 -> Either (Doc AnsiStyle) Int64
forall a b. (a -> b) -> a -> b
$ Double -> Int64
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
o
    fromObject (ObjectFloat Float
o) = Int64 -> Either (Doc AnsiStyle) Int64
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Either (Doc AnsiStyle) Int64)
-> Int64 -> Either (Doc AnsiStyle) Int64
forall a b. (a -> b) -> a -> b
$ Float -> Int64
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Float
o
    fromObject Object
o = Doc AnsiStyle -> Either (Doc AnsiStyle) Int64
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) Int64)
-> Doc AnsiStyle -> Either (Doc AnsiStyle) Int64
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected any Integer value, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance NvimObject Int32 where
    toObject :: Int32 -> Object
toObject = Int64 -> Object
ObjectInt (Int64 -> Object) -> (Int32 -> Int64) -> Int32 -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

    fromObject :: Object -> Either (Doc AnsiStyle) Int32
fromObject (ObjectInt Int64
i) = Int32 -> Either (Doc AnsiStyle) Int32
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> Either (Doc AnsiStyle) Int32)
-> Int32 -> Either (Doc AnsiStyle) Int32
forall a b. (a -> b) -> a -> b
$ Int64 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
    fromObject (ObjectUInt Word64
i) = Int32 -> Either (Doc AnsiStyle) Int32
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> Either (Doc AnsiStyle) Int32)
-> Int32 -> Either (Doc AnsiStyle) Int32
forall a b. (a -> b) -> a -> b
$ Word64 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i
    fromObject (ObjectDouble Double
o) = Int32 -> Either (Doc AnsiStyle) Int32
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> Either (Doc AnsiStyle) Int32)
-> Int32 -> Either (Doc AnsiStyle) Int32
forall a b. (a -> b) -> a -> b
$ Double -> Int32
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
o
    fromObject (ObjectFloat Float
o) = Int32 -> Either (Doc AnsiStyle) Int32
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> Either (Doc AnsiStyle) Int32)
-> Int32 -> Either (Doc AnsiStyle) Int32
forall a b. (a -> b) -> a -> b
$ Float -> Int32
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Float
o
    fromObject Object
o = Doc AnsiStyle -> Either (Doc AnsiStyle) Int32
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) Int32)
-> Doc AnsiStyle -> Either (Doc AnsiStyle) Int32
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected any Integer value, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance NvimObject Int16 where
    toObject :: Int16 -> Object
toObject = Int64 -> Object
ObjectInt (Int64 -> Object) -> (Int16 -> Int64) -> Int16 -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

    fromObject :: Object -> Either (Doc AnsiStyle) Int16
fromObject (ObjectInt Int64
i) = Int16 -> Either (Doc AnsiStyle) Int16
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16 -> Either (Doc AnsiStyle) Int16)
-> Int16 -> Either (Doc AnsiStyle) Int16
forall a b. (a -> b) -> a -> b
$ Int64 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
    fromObject (ObjectUInt Word64
i) = Int16 -> Either (Doc AnsiStyle) Int16
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16 -> Either (Doc AnsiStyle) Int16)
-> Int16 -> Either (Doc AnsiStyle) Int16
forall a b. (a -> b) -> a -> b
$ Word64 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i
    fromObject (ObjectDouble Double
o) = Int16 -> Either (Doc AnsiStyle) Int16
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16 -> Either (Doc AnsiStyle) Int16)
-> Int16 -> Either (Doc AnsiStyle) Int16
forall a b. (a -> b) -> a -> b
$ Double -> Int16
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
o
    fromObject (ObjectFloat Float
o) = Int16 -> Either (Doc AnsiStyle) Int16
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16 -> Either (Doc AnsiStyle) Int16)
-> Int16 -> Either (Doc AnsiStyle) Int16
forall a b. (a -> b) -> a -> b
$ Float -> Int16
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Float
o
    fromObject Object
o = Doc AnsiStyle -> Either (Doc AnsiStyle) Int16
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) Int16)
-> Doc AnsiStyle -> Either (Doc AnsiStyle) Int16
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected any Integer value, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance NvimObject Int8 where
    toObject :: Int8 -> Object
toObject = Int64 -> Object
ObjectInt (Int64 -> Object) -> (Int8 -> Int64) -> Int8 -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

    fromObject :: Object -> Either (Doc AnsiStyle) Int8
fromObject (ObjectInt Int64
i) = Int8 -> Either (Doc AnsiStyle) Int8
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> Either (Doc AnsiStyle) Int8)
-> Int8 -> Either (Doc AnsiStyle) Int8
forall a b. (a -> b) -> a -> b
$ Int64 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
    fromObject (ObjectUInt Word64
i) = Int8 -> Either (Doc AnsiStyle) Int8
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> Either (Doc AnsiStyle) Int8)
-> Int8 -> Either (Doc AnsiStyle) Int8
forall a b. (a -> b) -> a -> b
$ Word64 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i
    fromObject (ObjectDouble Double
o) = Int8 -> Either (Doc AnsiStyle) Int8
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> Either (Doc AnsiStyle) Int8)
-> Int8 -> Either (Doc AnsiStyle) Int8
forall a b. (a -> b) -> a -> b
$ Double -> Int8
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
o
    fromObject (ObjectFloat Float
o) = Int8 -> Either (Doc AnsiStyle) Int8
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> Either (Doc AnsiStyle) Int8)
-> Int8 -> Either (Doc AnsiStyle) Int8
forall a b. (a -> b) -> a -> b
$ Float -> Int8
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Float
o
    fromObject Object
o = Doc AnsiStyle -> Either (Doc AnsiStyle) Int8
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) Int8)
-> Doc AnsiStyle -> Either (Doc AnsiStyle) Int8
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected any Integer value, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance NvimObject Word where
    toObject :: Word -> Object
toObject = Int64 -> Object
ObjectInt (Int64 -> Object) -> (Word -> Int64) -> Word -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

    fromObject :: Object -> Either (Doc AnsiStyle) Word
fromObject (ObjectInt Int64
i) = Word -> Either (Doc AnsiStyle) Word
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> Either (Doc AnsiStyle) Word)
-> Word -> Either (Doc AnsiStyle) Word
forall a b. (a -> b) -> a -> b
$ Int64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
    fromObject (ObjectUInt Word64
i) = Word -> Either (Doc AnsiStyle) Word
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> Either (Doc AnsiStyle) Word)
-> Word -> Either (Doc AnsiStyle) Word
forall a b. (a -> b) -> a -> b
$ Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i
    fromObject (ObjectDouble Double
o) = Word -> Either (Doc AnsiStyle) Word
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> Either (Doc AnsiStyle) Word)
-> Word -> Either (Doc AnsiStyle) Word
forall a b. (a -> b) -> a -> b
$ Double -> Word
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
o
    fromObject (ObjectFloat Float
o) = Word -> Either (Doc AnsiStyle) Word
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> Either (Doc AnsiStyle) Word)
-> Word -> Either (Doc AnsiStyle) Word
forall a b. (a -> b) -> a -> b
$ Float -> Word
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Float
o
    fromObject Object
o = Doc AnsiStyle -> Either (Doc AnsiStyle) Word
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) Word)
-> Doc AnsiStyle -> Either (Doc AnsiStyle) Word
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected any Integer value, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance NvimObject Word64 where
    toObject :: Word64 -> Object
toObject = Int64 -> Object
ObjectInt (Int64 -> Object) -> (Word64 -> Int64) -> Word64 -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

    fromObject :: Object -> Either (Doc AnsiStyle) Word64
fromObject (ObjectInt Int64
i) = Word64 -> Either (Doc AnsiStyle) Word64
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Either (Doc AnsiStyle) Word64)
-> Word64 -> Either (Doc AnsiStyle) Word64
forall a b. (a -> b) -> a -> b
$ Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
    fromObject (ObjectUInt Word64
i) = Word64 -> Either (Doc AnsiStyle) Word64
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Either (Doc AnsiStyle) Word64)
-> Word64 -> Either (Doc AnsiStyle) Word64
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i
    fromObject (ObjectDouble Double
o) = Word64 -> Either (Doc AnsiStyle) Word64
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Either (Doc AnsiStyle) Word64)
-> Word64 -> Either (Doc AnsiStyle) Word64
forall a b. (a -> b) -> a -> b
$ Double -> Word64
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
o
    fromObject (ObjectFloat Float
o) = Word64 -> Either (Doc AnsiStyle) Word64
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Either (Doc AnsiStyle) Word64)
-> Word64 -> Either (Doc AnsiStyle) Word64
forall a b. (a -> b) -> a -> b
$ Float -> Word64
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Float
o
    fromObject Object
o = Doc AnsiStyle -> Either (Doc AnsiStyle) Word64
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) Word64)
-> Doc AnsiStyle -> Either (Doc AnsiStyle) Word64
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected any Integer value, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance NvimObject Word32 where
    toObject :: Word32 -> Object
toObject = Int64 -> Object
ObjectInt (Int64 -> Object) -> (Word32 -> Int64) -> Word32 -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

    fromObject :: Object -> Either (Doc AnsiStyle) Word32
fromObject (ObjectInt Int64
i) = Word32 -> Either (Doc AnsiStyle) Word32
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Either (Doc AnsiStyle) Word32)
-> Word32 -> Either (Doc AnsiStyle) Word32
forall a b. (a -> b) -> a -> b
$ Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
    fromObject (ObjectUInt Word64
i) = Word32 -> Either (Doc AnsiStyle) Word32
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Either (Doc AnsiStyle) Word32)
-> Word32 -> Either (Doc AnsiStyle) Word32
forall a b. (a -> b) -> a -> b
$ Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i
    fromObject (ObjectDouble Double
o) = Word32 -> Either (Doc AnsiStyle) Word32
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Either (Doc AnsiStyle) Word32)
-> Word32 -> Either (Doc AnsiStyle) Word32
forall a b. (a -> b) -> a -> b
$ Double -> Word32
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
o
    fromObject (ObjectFloat Float
o) = Word32 -> Either (Doc AnsiStyle) Word32
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Either (Doc AnsiStyle) Word32)
-> Word32 -> Either (Doc AnsiStyle) Word32
forall a b. (a -> b) -> a -> b
$ Float -> Word32
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Float
o
    fromObject Object
o = Doc AnsiStyle -> Either (Doc AnsiStyle) Word32
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) Word32)
-> Doc AnsiStyle -> Either (Doc AnsiStyle) Word32
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected any Integer value, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance NvimObject Word16 where
    toObject :: Word16 -> Object
toObject = Int64 -> Object
ObjectInt (Int64 -> Object) -> (Word16 -> Int64) -> Word16 -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

    fromObject :: Object -> Either (Doc AnsiStyle) Word16
fromObject (ObjectInt Int64
i) = Word16 -> Either (Doc AnsiStyle) Word16
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> Either (Doc AnsiStyle) Word16)
-> Word16 -> Either (Doc AnsiStyle) Word16
forall a b. (a -> b) -> a -> b
$ Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
    fromObject (ObjectUInt Word64
i) = Word16 -> Either (Doc AnsiStyle) Word16
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> Either (Doc AnsiStyle) Word16)
-> Word16 -> Either (Doc AnsiStyle) Word16
forall a b. (a -> b) -> a -> b
$ Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i
    fromObject (ObjectDouble Double
o) = Word16 -> Either (Doc AnsiStyle) Word16
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> Either (Doc AnsiStyle) Word16)
-> Word16 -> Either (Doc AnsiStyle) Word16
forall a b. (a -> b) -> a -> b
$ Double -> Word16
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
o
    fromObject (ObjectFloat Float
o) = Word16 -> Either (Doc AnsiStyle) Word16
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> Either (Doc AnsiStyle) Word16)
-> Word16 -> Either (Doc AnsiStyle) Word16
forall a b. (a -> b) -> a -> b
$ Float -> Word16
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Float
o
    fromObject Object
o = Doc AnsiStyle -> Either (Doc AnsiStyle) Word16
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) Word16)
-> Doc AnsiStyle -> Either (Doc AnsiStyle) Word16
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected any Integer value, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance NvimObject Word8 where
    toObject :: Word8 -> Object
toObject = Int64 -> Object
ObjectInt (Int64 -> Object) -> (Word8 -> Int64) -> Word8 -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

    fromObject :: Object -> Either (Doc AnsiStyle) Word8
fromObject (ObjectInt Int64
i) = Word8 -> Either (Doc AnsiStyle) Word8
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> Either (Doc AnsiStyle) Word8)
-> Word8 -> Either (Doc AnsiStyle) Word8
forall a b. (a -> b) -> a -> b
$ Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
    fromObject (ObjectUInt Word64
i) = Word8 -> Either (Doc AnsiStyle) Word8
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> Either (Doc AnsiStyle) Word8)
-> Word8 -> Either (Doc AnsiStyle) Word8
forall a b. (a -> b) -> a -> b
$ Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i
    fromObject (ObjectDouble Double
o) = Word8 -> Either (Doc AnsiStyle) Word8
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> Either (Doc AnsiStyle) Word8)
-> Word8 -> Either (Doc AnsiStyle) Word8
forall a b. (a -> b) -> a -> b
$ Double -> Word8
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
o
    fromObject (ObjectFloat Float
o) = Word8 -> Either (Doc AnsiStyle) Word8
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> Either (Doc AnsiStyle) Word8)
-> Word8 -> Either (Doc AnsiStyle) Word8
forall a b. (a -> b) -> a -> b
$ Float -> Word8
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Float
o
    fromObject Object
o = Doc AnsiStyle -> Either (Doc AnsiStyle) Word8
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) Word8)
-> Doc AnsiStyle -> Either (Doc AnsiStyle) Word8
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected any Integer value, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance NvimObject Int where
    toObject :: Int -> Object
toObject = Int64 -> Object
ObjectInt (Int64 -> Object) -> (Int -> Int64) -> Int -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

    fromObject :: Object -> Either (Doc AnsiStyle) Int
fromObject (ObjectInt Int64
i) = Int -> Either (Doc AnsiStyle) Int
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Either (Doc AnsiStyle) Int)
-> Int -> Either (Doc AnsiStyle) Int
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
    fromObject (ObjectUInt Word64
i) = Int -> Either (Doc AnsiStyle) Int
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Either (Doc AnsiStyle) Int)
-> Int -> Either (Doc AnsiStyle) Int
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i
    fromObject (ObjectDouble Double
o) = Int -> Either (Doc AnsiStyle) Int
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Either (Doc AnsiStyle) Int)
-> Int -> Either (Doc AnsiStyle) Int
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
o
    fromObject (ObjectFloat Float
o) = Int -> Either (Doc AnsiStyle) Int
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Either (Doc AnsiStyle) Int)
-> Int -> Either (Doc AnsiStyle) Int
forall a b. (a -> b) -> a -> b
$ Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Float
o
    fromObject Object
o = Doc AnsiStyle -> Either (Doc AnsiStyle) Int
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) Int)
-> Doc AnsiStyle -> Either (Doc AnsiStyle) Int
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected any Integer value, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance {-# OVERLAPPING #-} NvimObject [Char] where
    toObject :: [Char] -> Object
toObject = ByteString -> Object
ObjectBinary (ByteString -> Object)
-> ([Char] -> ByteString) -> [Char] -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
UTF8.fromString

    fromObject :: Object -> Either (Doc AnsiStyle) [Char]
fromObject (ObjectBinary ByteString
o) = [Char] -> Either (Doc AnsiStyle) [Char]
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Either (Doc AnsiStyle) [Char])
-> [Char] -> Either (Doc AnsiStyle) [Char]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
UTF8.toString ByteString
o
    fromObject (ObjectString ByteString
o) = [Char] -> Either (Doc AnsiStyle) [Char]
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Either (Doc AnsiStyle) [Char])
-> [Char] -> Either (Doc AnsiStyle) [Char]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
UTF8.toString ByteString
o
    fromObject Object
o = Doc AnsiStyle -> Either (Doc AnsiStyle) [Char]
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) [Char])
-> Doc AnsiStyle -> Either (Doc AnsiStyle) [Char]
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected ObjectString, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance {-# OVERLAPPABLE #-} NvimObject o => NvimObject [o] where
    toObject :: [o] -> Object
toObject = [Object] -> Object
ObjectArray ([Object] -> Object) -> ([o] -> [Object]) -> [o] -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (o -> Object) -> [o] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
map o -> Object
forall o. NvimObject o => o -> Object
toObject

    fromObject :: Object -> Either (Doc AnsiStyle) [o]
fromObject (ObjectArray [Object]
os) = (Object -> Either (Doc AnsiStyle) o)
-> [Object] -> Either (Doc AnsiStyle) [o]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Object -> Either (Doc AnsiStyle) o
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject [Object]
os
    fromObject Object
o = Doc AnsiStyle -> Either (Doc AnsiStyle) [o]
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) [o])
-> Doc AnsiStyle -> Either (Doc AnsiStyle) [o]
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected ObjectArray, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance NvimObject o => NvimObject (Maybe o) where
    toObject :: Maybe o -> Object
toObject = Object -> (o -> Object) -> Maybe o -> Object
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Object
ObjectNil o -> Object
forall o. NvimObject o => o -> Object
toObject

    fromObject :: Object -> Either (Doc AnsiStyle) (Maybe o)
fromObject Object
ObjectNil = Maybe o -> Either (Doc AnsiStyle) (Maybe o)
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe o
forall a. Maybe a
Nothing
    fromObject Object
o = (Doc AnsiStyle -> Either (Doc AnsiStyle) (Maybe o))
-> (o -> Either (Doc AnsiStyle) (Maybe o))
-> Either (Doc AnsiStyle) o
-> Either (Doc AnsiStyle) (Maybe o)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Doc AnsiStyle -> Either (Doc AnsiStyle) (Maybe o)
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Maybe o -> Either (Doc AnsiStyle) (Maybe o)
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe o -> Either (Doc AnsiStyle) (Maybe o))
-> (o -> Maybe o) -> o -> Either (Doc AnsiStyle) (Maybe o)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. o -> Maybe o
forall a. a -> Maybe a
Just) (Either (Doc AnsiStyle) o -> Either (Doc AnsiStyle) (Maybe o))
-> Either (Doc AnsiStyle) o -> Either (Doc AnsiStyle) (Maybe o)
forall a b. (a -> b) -> a -> b
$ Object -> Either (Doc AnsiStyle) o
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o

instance NvimObject o => NvimObject (Vector o) where
    toObject :: Vector o -> Object
toObject = [Object] -> Object
ObjectArray ([Object] -> Object)
-> (Vector o -> [Object]) -> Vector o -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Object -> [Object]
forall a. Vector a -> [a]
V.toList (Vector Object -> [Object])
-> (Vector o -> Vector Object) -> Vector o -> [Object]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (o -> Object) -> Vector o -> Vector Object
forall a b. (a -> b) -> Vector a -> Vector b
V.map o -> Object
forall o. NvimObject o => o -> Object
toObject

    fromObject :: Object -> Either (Doc AnsiStyle) (Vector o)
fromObject (ObjectArray [Object]
os) = [o] -> Vector o
forall a. [a] -> Vector a
V.fromList ([o] -> Vector o)
-> Either (Doc AnsiStyle) [o] -> Either (Doc AnsiStyle) (Vector o)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object -> Either (Doc AnsiStyle) o)
-> [Object] -> Either (Doc AnsiStyle) [o]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Object -> Either (Doc AnsiStyle) o
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject [Object]
os
    fromObject Object
o = Doc AnsiStyle -> Either (Doc AnsiStyle) (Vector o)
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) (Vector o))
-> Doc AnsiStyle -> Either (Doc AnsiStyle) (Vector o)
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected ObjectArray, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

-- | Right-biased instance for toObject.
instance (NvimObject l, NvimObject r) => NvimObject (Either l r) where
    toObject :: Either l r -> Object
toObject = (l -> Object) -> (r -> Object) -> Either l r -> Object
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either l -> Object
forall o. NvimObject o => o -> Object
toObject r -> Object
forall o. NvimObject o => o -> Object
toObject

    fromObject :: Object -> Either (Doc AnsiStyle) (Either l r)
fromObject Object
o = case Object -> Either (Doc AnsiStyle) r
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o of
        Right r
r ->
            Either l r -> Either (Doc AnsiStyle) (Either l r)
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either l r -> Either (Doc AnsiStyle) (Either l r))
-> Either l r -> Either (Doc AnsiStyle) (Either l r)
forall a b. (a -> b) -> a -> b
$ r -> Either l r
forall a b. b -> Either a b
Right r
r
        Left Doc AnsiStyle
e1 -> case Object -> Either (Doc AnsiStyle) l
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o of
            Right l
l ->
                Either l r -> Either (Doc AnsiStyle) (Either l r)
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either l r -> Either (Doc AnsiStyle) (Either l r))
-> Either l r -> Either (Doc AnsiStyle) (Either l r)
forall a b. (a -> b) -> a -> b
$ l -> Either l r
forall a b. a -> Either a b
Left l
l
            Left Doc AnsiStyle
e2 ->
                Doc AnsiStyle -> Either (Doc AnsiStyle) (Either l r)
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) (Either l r))
-> Doc AnsiStyle -> Either (Doc AnsiStyle) (Either l r)
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
e1 Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"--" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
e2

instance
    (Ord key, NvimObject key, NvimObject val) =>
    NvimObject (SMap.Map key val)
    where
    toObject :: Map key val -> Object
toObject =
        Map Object Object -> Object
ObjectMap
            (Map Object Object -> Object)
-> (Map key val -> Map Object Object) -> Map key val -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Object, Object)] -> Map Object Object
forall k a. Ord k => [(k, a)] -> Map k a
SMap.fromList
            ([(Object, Object)] -> Map Object Object)
-> (Map key val -> [(Object, Object)])
-> Map key val
-> Map Object Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((key, val) -> (Object, Object))
-> [(key, val)] -> [(Object, Object)]
forall a b. (a -> b) -> [a] -> [b]
map (key -> Object
forall o. NvimObject o => o -> Object
toObject (key -> Object)
-> (val -> Object) -> (key, val) -> (Object, Object)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** val -> Object
forall o. NvimObject o => o -> Object
toObject)
            ([(key, val)] -> [(Object, Object)])
-> (Map key val -> [(key, val)])
-> Map key val
-> [(Object, Object)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map key val -> [(key, val)]
forall k a. Map k a -> [(k, a)]
SMap.toList

    fromObject :: Object -> Either (Doc AnsiStyle) (Map key val)
fromObject (ObjectMap Map Object Object
om) =
        [(key, val)] -> Map key val
forall k a. Ord k => [(k, a)] -> Map k a
SMap.fromList
            ([(key, val)] -> Map key val)
-> Either (Doc AnsiStyle) [(key, val)]
-> Either (Doc AnsiStyle) (Map key val)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( ((Object, Object) -> Either (Doc AnsiStyle) (key, val))
-> [(Object, Object)] -> Either (Doc AnsiStyle) [(key, val)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse
                    ( (Either (Doc AnsiStyle) key
 -> Either (Doc AnsiStyle) val -> Either (Doc AnsiStyle) (key, val))
-> (Either (Doc AnsiStyle) key, Either (Doc AnsiStyle) val)
-> Either (Doc AnsiStyle) (key, val)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((key -> val -> (key, val))
-> Either (Doc AnsiStyle) key
-> Either (Doc AnsiStyle) val
-> Either (Doc AnsiStyle) (key, val)
forall a b c.
(a -> b -> c)
-> Either (Doc AnsiStyle) a
-> Either (Doc AnsiStyle) b
-> Either (Doc AnsiStyle) c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,))
                        ((Either (Doc AnsiStyle) key, Either (Doc AnsiStyle) val)
 -> Either (Doc AnsiStyle) (key, val))
-> ((Object, Object)
    -> (Either (Doc AnsiStyle) key, Either (Doc AnsiStyle) val))
-> (Object, Object)
-> Either (Doc AnsiStyle) (key, val)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Object -> Either (Doc AnsiStyle) key
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject (Object -> Either (Doc AnsiStyle) key)
-> (Object -> Either (Doc AnsiStyle) val)
-> (Object, Object)
-> (Either (Doc AnsiStyle) key, Either (Doc AnsiStyle) val)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Object -> Either (Doc AnsiStyle) val
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject)
                    )
                    ([(Object, Object)] -> Either (Doc AnsiStyle) [(key, val)])
-> (Map Object Object -> [(Object, Object)])
-> Map Object Object
-> Either (Doc AnsiStyle) [(key, val)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Object Object -> [(Object, Object)]
forall k a. Map k a -> [(k, a)]
SMap.toList
                )
                Map Object Object
om
    fromObject Object
o = Doc AnsiStyle -> Either (Doc AnsiStyle) (Map key val)
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) (Map key val))
-> Doc AnsiStyle -> Either (Doc AnsiStyle) (Map key val)
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected ObjectMap, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance NvimObject Text where
    toObject :: Text -> Object
toObject = ByteString -> Object
ObjectBinary (ByteString -> Object) -> (Text -> ByteString) -> Text -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

    fromObject :: Object -> Either (Doc AnsiStyle) Text
fromObject (ObjectBinary ByteString
o) = Text -> Either (Doc AnsiStyle) Text
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either (Doc AnsiStyle) Text)
-> Text -> Either (Doc AnsiStyle) Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
o
    fromObject (ObjectString ByteString
o) = Text -> Either (Doc AnsiStyle) Text
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either (Doc AnsiStyle) Text)
-> Text -> Either (Doc AnsiStyle) Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
o
    fromObject Object
o = Doc AnsiStyle -> Either (Doc AnsiStyle) Text
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) Text)
-> Doc AnsiStyle -> Either (Doc AnsiStyle) Text
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected ObjectBinary, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance NvimObject ByteString where
    toObject :: ByteString -> Object
toObject = ByteString -> Object
ObjectBinary

    fromObject :: Object -> Either (Doc AnsiStyle) ByteString
fromObject (ObjectBinary ByteString
o) = ByteString -> Either (Doc AnsiStyle) ByteString
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
o
    fromObject (ObjectString ByteString
o) = ByteString -> Either (Doc AnsiStyle) ByteString
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
o
    fromObject Object
o = Doc AnsiStyle -> Either (Doc AnsiStyle) ByteString
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) ByteString)
-> Doc AnsiStyle -> Either (Doc AnsiStyle) ByteString
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected ObjectBinary, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance NvimObject Object where
    toObject :: Object -> Object
toObject = Object -> Object
forall a. a -> a
id

    fromObject :: Object -> Either (Doc AnsiStyle) Object
fromObject = Object -> Either (Doc AnsiStyle) Object
forall a. a -> Either (Doc AnsiStyle) a
forall (m :: * -> *) a. Monad m => a -> m a
return
    fromObjectUnsafe :: Object -> Object
fromObjectUnsafe = Object -> Object
forall a. a -> a
id

-- By the magic of vim, i will create these.
instance (NvimObject o1, NvimObject o2) => NvimObject (o1, o2) where
    toObject :: (o1, o2) -> Object
toObject (o1
o1, o2
o2) = [Object] -> Object
ObjectArray [o1 -> Object
forall o. NvimObject o => o -> Object
toObject o1
o1, o2 -> Object
forall o. NvimObject o => o -> Object
toObject o2
o2]

    fromObject :: Object -> Either (Doc AnsiStyle) (o1, o2)
fromObject (ObjectArray [Object
o1, Object
o2]) =
        (,)
            (o1 -> o2 -> (o1, o2))
-> Either (Doc AnsiStyle) o1
-> Either (Doc AnsiStyle) (o2 -> (o1, o2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Either (Doc AnsiStyle) o1
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o1
            Either (Doc AnsiStyle) (o2 -> (o1, o2))
-> Either (Doc AnsiStyle) o2 -> Either (Doc AnsiStyle) (o1, o2)
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o2
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o2
    fromObject Object
o = Doc AnsiStyle -> Either (Doc AnsiStyle) (o1, o2)
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) (o1, o2))
-> Doc AnsiStyle -> Either (Doc AnsiStyle) (o1, o2)
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected ObjectArray, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance (NvimObject o1, NvimObject o2, NvimObject o3) => NvimObject (o1, o2, o3) where
    toObject :: (o1, o2, o3) -> Object
toObject (o1
o1, o2
o2, o3
o3) = [Object] -> Object
ObjectArray [o1 -> Object
forall o. NvimObject o => o -> Object
toObject o1
o1, o2 -> Object
forall o. NvimObject o => o -> Object
toObject o2
o2, o3 -> Object
forall o. NvimObject o => o -> Object
toObject o3
o3]

    fromObject :: Object -> Either (Doc AnsiStyle) (o1, o2, o3)
fromObject (ObjectArray [Object
o1, Object
o2, Object
o3]) =
        (,,)
            (o1 -> o2 -> o3 -> (o1, o2, o3))
-> Either (Doc AnsiStyle) o1
-> Either (Doc AnsiStyle) (o2 -> o3 -> (o1, o2, o3))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Either (Doc AnsiStyle) o1
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o1
            Either (Doc AnsiStyle) (o2 -> o3 -> (o1, o2, o3))
-> Either (Doc AnsiStyle) o2
-> Either (Doc AnsiStyle) (o3 -> (o1, o2, o3))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o2
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o2
            Either (Doc AnsiStyle) (o3 -> (o1, o2, o3))
-> Either (Doc AnsiStyle) o3 -> Either (Doc AnsiStyle) (o1, o2, o3)
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o3
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o3
    fromObject Object
o = Doc AnsiStyle -> Either (Doc AnsiStyle) (o1, o2, o3)
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) (o1, o2, o3))
-> Doc AnsiStyle -> Either (Doc AnsiStyle) (o1, o2, o3)
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected ObjectArray, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4) => NvimObject (o1, o2, o3, o4) where
    toObject :: (o1, o2, o3, o4) -> Object
toObject (o1
o1, o2
o2, o3
o3, o4
o4) = [Object] -> Object
ObjectArray [o1 -> Object
forall o. NvimObject o => o -> Object
toObject o1
o1, o2 -> Object
forall o. NvimObject o => o -> Object
toObject o2
o2, o3 -> Object
forall o. NvimObject o => o -> Object
toObject o3
o3, o4 -> Object
forall o. NvimObject o => o -> Object
toObject o4
o4]

    fromObject :: Object -> Either (Doc AnsiStyle) (o1, o2, o3, o4)
fromObject (ObjectArray [Object
o1, Object
o2, Object
o3, Object
o4]) =
        (,,,)
            (o1 -> o2 -> o3 -> o4 -> (o1, o2, o3, o4))
-> Either (Doc AnsiStyle) o1
-> Either (Doc AnsiStyle) (o2 -> o3 -> o4 -> (o1, o2, o3, o4))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Either (Doc AnsiStyle) o1
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o1
            Either (Doc AnsiStyle) (o2 -> o3 -> o4 -> (o1, o2, o3, o4))
-> Either (Doc AnsiStyle) o2
-> Either (Doc AnsiStyle) (o3 -> o4 -> (o1, o2, o3, o4))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o2
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o2
            Either (Doc AnsiStyle) (o3 -> o4 -> (o1, o2, o3, o4))
-> Either (Doc AnsiStyle) o3
-> Either (Doc AnsiStyle) (o4 -> (o1, o2, o3, o4))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o3
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o3
            Either (Doc AnsiStyle) (o4 -> (o1, o2, o3, o4))
-> Either (Doc AnsiStyle) o4
-> Either (Doc AnsiStyle) (o1, o2, o3, o4)
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o4
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o4
    fromObject Object
o = Doc AnsiStyle -> Either (Doc AnsiStyle) (o1, o2, o3, o4)
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) (o1, o2, o3, o4))
-> Doc AnsiStyle -> Either (Doc AnsiStyle) (o1, o2, o3, o4)
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected ObjectArray, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5) => NvimObject (o1, o2, o3, o4, o5) where
    toObject :: (o1, o2, o3, o4, o5) -> Object
toObject (o1
o1, o2
o2, o3
o3, o4
o4, o5
o5) = [Object] -> Object
ObjectArray [o1 -> Object
forall o. NvimObject o => o -> Object
toObject o1
o1, o2 -> Object
forall o. NvimObject o => o -> Object
toObject o2
o2, o3 -> Object
forall o. NvimObject o => o -> Object
toObject o3
o3, o4 -> Object
forall o. NvimObject o => o -> Object
toObject o4
o4, o5 -> Object
forall o. NvimObject o => o -> Object
toObject o5
o5]

    fromObject :: Object -> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5)
fromObject (ObjectArray [Object
o1, Object
o2, Object
o3, Object
o4, Object
o5]) =
        (,,,,)
            (o1 -> o2 -> o3 -> o4 -> o5 -> (o1, o2, o3, o4, o5))
-> Either (Doc AnsiStyle) o1
-> Either
     (Doc AnsiStyle) (o2 -> o3 -> o4 -> o5 -> (o1, o2, o3, o4, o5))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Either (Doc AnsiStyle) o1
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o1
            Either
  (Doc AnsiStyle) (o2 -> o3 -> o4 -> o5 -> (o1, o2, o3, o4, o5))
-> Either (Doc AnsiStyle) o2
-> Either (Doc AnsiStyle) (o3 -> o4 -> o5 -> (o1, o2, o3, o4, o5))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o2
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o2
            Either (Doc AnsiStyle) (o3 -> o4 -> o5 -> (o1, o2, o3, o4, o5))
-> Either (Doc AnsiStyle) o3
-> Either (Doc AnsiStyle) (o4 -> o5 -> (o1, o2, o3, o4, o5))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o3
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o3
            Either (Doc AnsiStyle) (o4 -> o5 -> (o1, o2, o3, o4, o5))
-> Either (Doc AnsiStyle) o4
-> Either (Doc AnsiStyle) (o5 -> (o1, o2, o3, o4, o5))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o4
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o4
            Either (Doc AnsiStyle) (o5 -> (o1, o2, o3, o4, o5))
-> Either (Doc AnsiStyle) o5
-> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5)
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o5
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o5
    fromObject Object
o = Doc AnsiStyle -> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5)
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5))
-> Doc AnsiStyle -> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5)
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected ObjectArray, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5, NvimObject o6) => NvimObject (o1, o2, o3, o4, o5, o6) where
    toObject :: (o1, o2, o3, o4, o5, o6) -> Object
toObject (o1
o1, o2
o2, o3
o3, o4
o4, o5
o5, o6
o6) = [Object] -> Object
ObjectArray [o1 -> Object
forall o. NvimObject o => o -> Object
toObject o1
o1, o2 -> Object
forall o. NvimObject o => o -> Object
toObject o2
o2, o3 -> Object
forall o. NvimObject o => o -> Object
toObject o3
o3, o4 -> Object
forall o. NvimObject o => o -> Object
toObject o4
o4, o5 -> Object
forall o. NvimObject o => o -> Object
toObject o5
o5, o6 -> Object
forall o. NvimObject o => o -> Object
toObject o6
o6]

    fromObject :: Object -> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6)
fromObject (ObjectArray [Object
o1, Object
o2, Object
o3, Object
o4, Object
o5, Object
o6]) =
        (,,,,,)
            (o1 -> o2 -> o3 -> o4 -> o5 -> o6 -> (o1, o2, o3, o4, o5, o6))
-> Either (Doc AnsiStyle) o1
-> Either
     (Doc AnsiStyle)
     (o2 -> o3 -> o4 -> o5 -> o6 -> (o1, o2, o3, o4, o5, o6))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Either (Doc AnsiStyle) o1
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o1
            Either
  (Doc AnsiStyle)
  (o2 -> o3 -> o4 -> o5 -> o6 -> (o1, o2, o3, o4, o5, o6))
-> Either (Doc AnsiStyle) o2
-> Either
     (Doc AnsiStyle) (o3 -> o4 -> o5 -> o6 -> (o1, o2, o3, o4, o5, o6))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o2
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o2
            Either
  (Doc AnsiStyle) (o3 -> o4 -> o5 -> o6 -> (o1, o2, o3, o4, o5, o6))
-> Either (Doc AnsiStyle) o3
-> Either
     (Doc AnsiStyle) (o4 -> o5 -> o6 -> (o1, o2, o3, o4, o5, o6))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o3
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o3
            Either (Doc AnsiStyle) (o4 -> o5 -> o6 -> (o1, o2, o3, o4, o5, o6))
-> Either (Doc AnsiStyle) o4
-> Either (Doc AnsiStyle) (o5 -> o6 -> (o1, o2, o3, o4, o5, o6))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o4
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o4
            Either (Doc AnsiStyle) (o5 -> o6 -> (o1, o2, o3, o4, o5, o6))
-> Either (Doc AnsiStyle) o5
-> Either (Doc AnsiStyle) (o6 -> (o1, o2, o3, o4, o5, o6))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o5
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o5
            Either (Doc AnsiStyle) (o6 -> (o1, o2, o3, o4, o5, o6))
-> Either (Doc AnsiStyle) o6
-> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6)
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o6
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o6
    fromObject Object
o = Doc AnsiStyle -> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6)
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6))
-> Doc AnsiStyle -> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6)
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected ObjectArray, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5, NvimObject o6, NvimObject o7) => NvimObject (o1, o2, o3, o4, o5, o6, o7) where
    toObject :: (o1, o2, o3, o4, o5, o6, o7) -> Object
toObject (o1
o1, o2
o2, o3
o3, o4
o4, o5
o5, o6
o6, o7
o7) = [Object] -> Object
ObjectArray [o1 -> Object
forall o. NvimObject o => o -> Object
toObject o1
o1, o2 -> Object
forall o. NvimObject o => o -> Object
toObject o2
o2, o3 -> Object
forall o. NvimObject o => o -> Object
toObject o3
o3, o4 -> Object
forall o. NvimObject o => o -> Object
toObject o4
o4, o5 -> Object
forall o. NvimObject o => o -> Object
toObject o5
o5, o6 -> Object
forall o. NvimObject o => o -> Object
toObject o6
o6, o7 -> Object
forall o. NvimObject o => o -> Object
toObject o7
o7]

    fromObject :: Object -> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6, o7)
fromObject (ObjectArray [Object
o1, Object
o2, Object
o3, Object
o4, Object
o5, Object
o6, Object
o7]) =
        (,,,,,,)
            (o1
 -> o2
 -> o3
 -> o4
 -> o5
 -> o6
 -> o7
 -> (o1, o2, o3, o4, o5, o6, o7))
-> Either (Doc AnsiStyle) o1
-> Either
     (Doc AnsiStyle)
     (o2 -> o3 -> o4 -> o5 -> o6 -> o7 -> (o1, o2, o3, o4, o5, o6, o7))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Either (Doc AnsiStyle) o1
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o1
            Either
  (Doc AnsiStyle)
  (o2 -> o3 -> o4 -> o5 -> o6 -> o7 -> (o1, o2, o3, o4, o5, o6, o7))
-> Either (Doc AnsiStyle) o2
-> Either
     (Doc AnsiStyle)
     (o3 -> o4 -> o5 -> o6 -> o7 -> (o1, o2, o3, o4, o5, o6, o7))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o2
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o2
            Either
  (Doc AnsiStyle)
  (o3 -> o4 -> o5 -> o6 -> o7 -> (o1, o2, o3, o4, o5, o6, o7))
-> Either (Doc AnsiStyle) o3
-> Either
     (Doc AnsiStyle)
     (o4 -> o5 -> o6 -> o7 -> (o1, o2, o3, o4, o5, o6, o7))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o3
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o3
            Either
  (Doc AnsiStyle)
  (o4 -> o5 -> o6 -> o7 -> (o1, o2, o3, o4, o5, o6, o7))
-> Either (Doc AnsiStyle) o4
-> Either
     (Doc AnsiStyle) (o5 -> o6 -> o7 -> (o1, o2, o3, o4, o5, o6, o7))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o4
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o4
            Either
  (Doc AnsiStyle) (o5 -> o6 -> o7 -> (o1, o2, o3, o4, o5, o6, o7))
-> Either (Doc AnsiStyle) o5
-> Either
     (Doc AnsiStyle) (o6 -> o7 -> (o1, o2, o3, o4, o5, o6, o7))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o5
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o5
            Either (Doc AnsiStyle) (o6 -> o7 -> (o1, o2, o3, o4, o5, o6, o7))
-> Either (Doc AnsiStyle) o6
-> Either (Doc AnsiStyle) (o7 -> (o1, o2, o3, o4, o5, o6, o7))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o6
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o6
            Either (Doc AnsiStyle) (o7 -> (o1, o2, o3, o4, o5, o6, o7))
-> Either (Doc AnsiStyle) o7
-> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6, o7)
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o7
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o7
    fromObject Object
o = Doc AnsiStyle
-> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6, o7)
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle
 -> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6, o7))
-> Doc AnsiStyle
-> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6, o7)
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected ObjectArray, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5, NvimObject o6, NvimObject o7, NvimObject o8) => NvimObject (o1, o2, o3, o4, o5, o6, o7, o8) where
    toObject :: (o1, o2, o3, o4, o5, o6, o7, o8) -> Object
toObject (o1
o1, o2
o2, o3
o3, o4
o4, o5
o5, o6
o6, o7
o7, o8
o8) = [Object] -> Object
ObjectArray [o1 -> Object
forall o. NvimObject o => o -> Object
toObject o1
o1, o2 -> Object
forall o. NvimObject o => o -> Object
toObject o2
o2, o3 -> Object
forall o. NvimObject o => o -> Object
toObject o3
o3, o4 -> Object
forall o. NvimObject o => o -> Object
toObject o4
o4, o5 -> Object
forall o. NvimObject o => o -> Object
toObject o5
o5, o6 -> Object
forall o. NvimObject o => o -> Object
toObject o6
o6, o7 -> Object
forall o. NvimObject o => o -> Object
toObject o7
o7, o8 -> Object
forall o. NvimObject o => o -> Object
toObject o8
o8]

    fromObject :: Object -> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6, o7, o8)
fromObject (ObjectArray [Object
o1, Object
o2, Object
o3, Object
o4, Object
o5, Object
o6, Object
o7, Object
o8]) =
        (,,,,,,,)
            (o1
 -> o2
 -> o3
 -> o4
 -> o5
 -> o6
 -> o7
 -> o8
 -> (o1, o2, o3, o4, o5, o6, o7, o8))
-> Either (Doc AnsiStyle) o1
-> Either
     (Doc AnsiStyle)
     (o2
      -> o3
      -> o4
      -> o5
      -> o6
      -> o7
      -> o8
      -> (o1, o2, o3, o4, o5, o6, o7, o8))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Either (Doc AnsiStyle) o1
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o1
            Either
  (Doc AnsiStyle)
  (o2
   -> o3
   -> o4
   -> o5
   -> o6
   -> o7
   -> o8
   -> (o1, o2, o3, o4, o5, o6, o7, o8))
-> Either (Doc AnsiStyle) o2
-> Either
     (Doc AnsiStyle)
     (o3
      -> o4 -> o5 -> o6 -> o7 -> o8 -> (o1, o2, o3, o4, o5, o6, o7, o8))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o2
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o2
            Either
  (Doc AnsiStyle)
  (o3
   -> o4 -> o5 -> o6 -> o7 -> o8 -> (o1, o2, o3, o4, o5, o6, o7, o8))
-> Either (Doc AnsiStyle) o3
-> Either
     (Doc AnsiStyle)
     (o4 -> o5 -> o6 -> o7 -> o8 -> (o1, o2, o3, o4, o5, o6, o7, o8))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o3
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o3
            Either
  (Doc AnsiStyle)
  (o4 -> o5 -> o6 -> o7 -> o8 -> (o1, o2, o3, o4, o5, o6, o7, o8))
-> Either (Doc AnsiStyle) o4
-> Either
     (Doc AnsiStyle)
     (o5 -> o6 -> o7 -> o8 -> (o1, o2, o3, o4, o5, o6, o7, o8))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o4
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o4
            Either
  (Doc AnsiStyle)
  (o5 -> o6 -> o7 -> o8 -> (o1, o2, o3, o4, o5, o6, o7, o8))
-> Either (Doc AnsiStyle) o5
-> Either
     (Doc AnsiStyle)
     (o6 -> o7 -> o8 -> (o1, o2, o3, o4, o5, o6, o7, o8))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o5
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o5
            Either
  (Doc AnsiStyle)
  (o6 -> o7 -> o8 -> (o1, o2, o3, o4, o5, o6, o7, o8))
-> Either (Doc AnsiStyle) o6
-> Either
     (Doc AnsiStyle) (o7 -> o8 -> (o1, o2, o3, o4, o5, o6, o7, o8))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o6
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o6
            Either
  (Doc AnsiStyle) (o7 -> o8 -> (o1, o2, o3, o4, o5, o6, o7, o8))
-> Either (Doc AnsiStyle) o7
-> Either (Doc AnsiStyle) (o8 -> (o1, o2, o3, o4, o5, o6, o7, o8))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o7
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o7
            Either (Doc AnsiStyle) (o8 -> (o1, o2, o3, o4, o5, o6, o7, o8))
-> Either (Doc AnsiStyle) o8
-> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6, o7, o8)
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o8
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o8
    fromObject Object
o = Doc AnsiStyle
-> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6, o7, o8)
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle
 -> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6, o7, o8))
-> Doc AnsiStyle
-> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6, o7, o8)
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected ObjectArray, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5, NvimObject o6, NvimObject o7, NvimObject o8, NvimObject o9) => NvimObject (o1, o2, o3, o4, o5, o6, o7, o8, o9) where
    toObject :: (o1, o2, o3, o4, o5, o6, o7, o8, o9) -> Object
toObject (o1
o1, o2
o2, o3
o3, o4
o4, o5
o5, o6
o6, o7
o7, o8
o8, o9
o9) = [Object] -> Object
ObjectArray [o1 -> Object
forall o. NvimObject o => o -> Object
toObject o1
o1, o2 -> Object
forall o. NvimObject o => o -> Object
toObject o2
o2, o3 -> Object
forall o. NvimObject o => o -> Object
toObject o3
o3, o4 -> Object
forall o. NvimObject o => o -> Object
toObject o4
o4, o5 -> Object
forall o. NvimObject o => o -> Object
toObject o5
o5, o6 -> Object
forall o. NvimObject o => o -> Object
toObject o6
o6, o7 -> Object
forall o. NvimObject o => o -> Object
toObject o7
o7, o8 -> Object
forall o. NvimObject o => o -> Object
toObject o8
o8, o9 -> Object
forall o. NvimObject o => o -> Object
toObject o9
o9]

    fromObject :: Object
-> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6, o7, o8, o9)
fromObject (ObjectArray [Object
o1, Object
o2, Object
o3, Object
o4, Object
o5, Object
o6, Object
o7, Object
o8, Object
o9]) =
        (,,,,,,,,)
            (o1
 -> o2
 -> o3
 -> o4
 -> o5
 -> o6
 -> o7
 -> o8
 -> o9
 -> (o1, o2, o3, o4, o5, o6, o7, o8, o9))
-> Either (Doc AnsiStyle) o1
-> Either
     (Doc AnsiStyle)
     (o2
      -> o3
      -> o4
      -> o5
      -> o6
      -> o7
      -> o8
      -> o9
      -> (o1, o2, o3, o4, o5, o6, o7, o8, o9))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Either (Doc AnsiStyle) o1
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o1
            Either
  (Doc AnsiStyle)
  (o2
   -> o3
   -> o4
   -> o5
   -> o6
   -> o7
   -> o8
   -> o9
   -> (o1, o2, o3, o4, o5, o6, o7, o8, o9))
-> Either (Doc AnsiStyle) o2
-> Either
     (Doc AnsiStyle)
     (o3
      -> o4
      -> o5
      -> o6
      -> o7
      -> o8
      -> o9
      -> (o1, o2, o3, o4, o5, o6, o7, o8, o9))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o2
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o2
            Either
  (Doc AnsiStyle)
  (o3
   -> o4
   -> o5
   -> o6
   -> o7
   -> o8
   -> o9
   -> (o1, o2, o3, o4, o5, o6, o7, o8, o9))
-> Either (Doc AnsiStyle) o3
-> Either
     (Doc AnsiStyle)
     (o4
      -> o5
      -> o6
      -> o7
      -> o8
      -> o9
      -> (o1, o2, o3, o4, o5, o6, o7, o8, o9))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o3
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o3
            Either
  (Doc AnsiStyle)
  (o4
   -> o5
   -> o6
   -> o7
   -> o8
   -> o9
   -> (o1, o2, o3, o4, o5, o6, o7, o8, o9))
-> Either (Doc AnsiStyle) o4
-> Either
     (Doc AnsiStyle)
     (o5
      -> o6 -> o7 -> o8 -> o9 -> (o1, o2, o3, o4, o5, o6, o7, o8, o9))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o4
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o4
            Either
  (Doc AnsiStyle)
  (o5
   -> o6 -> o7 -> o8 -> o9 -> (o1, o2, o3, o4, o5, o6, o7, o8, o9))
-> Either (Doc AnsiStyle) o5
-> Either
     (Doc AnsiStyle)
     (o6 -> o7 -> o8 -> o9 -> (o1, o2, o3, o4, o5, o6, o7, o8, o9))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o5
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o5
            Either
  (Doc AnsiStyle)
  (o6 -> o7 -> o8 -> o9 -> (o1, o2, o3, o4, o5, o6, o7, o8, o9))
-> Either (Doc AnsiStyle) o6
-> Either
     (Doc AnsiStyle)
     (o7 -> o8 -> o9 -> (o1, o2, o3, o4, o5, o6, o7, o8, o9))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o6
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o6
            Either
  (Doc AnsiStyle)
  (o7 -> o8 -> o9 -> (o1, o2, o3, o4, o5, o6, o7, o8, o9))
-> Either (Doc AnsiStyle) o7
-> Either
     (Doc AnsiStyle) (o8 -> o9 -> (o1, o2, o3, o4, o5, o6, o7, o8, o9))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o7
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o7
            Either
  (Doc AnsiStyle) (o8 -> o9 -> (o1, o2, o3, o4, o5, o6, o7, o8, o9))
-> Either (Doc AnsiStyle) o8
-> Either
     (Doc AnsiStyle) (o9 -> (o1, o2, o3, o4, o5, o6, o7, o8, o9))
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o8
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o8
            Either (Doc AnsiStyle) (o9 -> (o1, o2, o3, o4, o5, o6, o7, o8, o9))
-> Either (Doc AnsiStyle) o9
-> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6, o7, o8, o9)
forall a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) o9
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o9
    fromObject Object
o = Doc AnsiStyle
-> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6, o7, o8, o9)
forall a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle
 -> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6, o7, o8, o9))
-> Doc AnsiStyle
-> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6, o7, o8, o9)
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected ObjectArray, but got" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o

-- 1}}}