module Ribosome.Msgpack.NvimObject where

import Neovim (NvimObject(..))
import Ribosome.Msgpack.Decode (MsgpackDecode(..))
import Ribosome.Msgpack.Encode (MsgpackEncode(..))

newtype NO a =
  NO { NO a -> a
unNO :: a }
  deriving (NO a -> NO a -> Bool
(NO a -> NO a -> Bool) -> (NO a -> NO a -> Bool) -> Eq (NO a)
forall a. Eq a => NO a -> NO a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NO a -> NO a -> Bool
$c/= :: forall a. Eq a => NO a -> NO a -> Bool
== :: NO a -> NO a -> Bool
$c== :: forall a. Eq a => NO a -> NO a -> Bool
Eq, Int -> NO a -> ShowS
[NO a] -> ShowS
NO a -> String
(Int -> NO a -> ShowS)
-> (NO a -> String) -> ([NO a] -> ShowS) -> Show (NO a)
forall a. Show a => Int -> NO a -> ShowS
forall a. Show a => [NO a] -> ShowS
forall a. Show a => NO a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NO a] -> ShowS
$cshowList :: forall a. Show a => [NO a] -> ShowS
show :: NO a -> String
$cshow :: forall a. Show a => NO a -> String
showsPrec :: Int -> NO a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> NO a -> ShowS
Show, (forall x. NO a -> Rep (NO a) x)
-> (forall x. Rep (NO a) x -> NO a) -> Generic (NO a)
forall x. Rep (NO a) x -> NO a
forall x. NO a -> Rep (NO a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (NO a) x -> NO a
forall a x. NO a -> Rep (NO a) x
$cto :: forall a x. Rep (NO a) x -> NO a
$cfrom :: forall a x. NO a -> Rep (NO a) x
Generic)
  deriving newtype (NO a -> ()
(NO a -> ()) -> NFData (NO a)
forall a. NFData a => NO a -> ()
forall a. (a -> ()) -> NFData a
rnf :: NO a -> ()
$crnf :: forall a. NFData a => NO a -> ()
NFData)

instance (MsgpackEncode a, MsgpackDecode a, NFData a) => NvimObject (NO a) where
  toObject :: NO a -> Object
toObject (NO a
a) = a -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack a
a
  fromObject :: Object -> Either (Doc AnsiStyle) (NO a)
fromObject Object
a = a -> NO a
forall a. a -> NO a
NO (a -> NO a)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) (NO a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Either (Doc AnsiStyle) a
forall a. MsgpackDecode a => Object -> Either (Doc AnsiStyle) a
fromMsgpack Object
a

(-$) :: (NO a -> b) -> a -> b
-$ :: (NO a -> b) -> a -> b
(-$) NO a -> b
f a
a = NO a -> b
f (a -> NO a
forall a. a -> NO a
NO a
a)