{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
#if __GLASGOW_HASKELL__ < 710
{-# LANGUAGE OverlappingInstances #-}
#endif
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
import Control.Arrow ((***))
import Control.DeepSeq
import Control.Monad.Except
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.Text.Prettyprint.Doc
( Doc
, Pretty (..)
, defaultLayoutOptions
, layoutPretty
, viaShow
, (<+>)
)
import qualified Data.Text.Prettyprint.Doc as P
import Data.Text.Prettyprint.Doc.Render.Terminal
( AnsiStyle
, renderStrict
)
import Data.Traversable hiding (forM, mapM)
import Data.Vector (Vector)
import qualified Data.Vector as V
import Data.Word
( Word
, Word16
, Word32
, Word64
, Word8
)
import GHC.Generics (Generic)
import qualified Data.ByteString.UTF8 as UTF8 (fromString, toString)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import UnliftIO.Exception (throwIO)
import Prelude
infixr 5 +:
(+:) :: (NvimObject o) => o -> [Object] -> [Object]
o +: os = toObject o : os
docToObject :: Doc AnsiStyle -> Object
docToObject = ObjectString . encodeUtf8 . docToText
docFromObject :: Object -> Either (Doc AnsiStyle) (Doc AnsiStyle)
docFromObject o = (P.viaShow :: Text -> Doc AnsiStyle) <$> fromObject o
docToText :: Doc AnsiStyle -> Text
docToText = renderStrict . layoutPretty defaultLayoutOptions
type Dictionary = SMap.Map ByteString Object
class NFData o => NvimObject o where
toObject :: o -> Object
fromObjectUnsafe :: Object -> o
fromObjectUnsafe o = case fromObject o of
Left e -> error . show $
"Not the expected object:" <+> P.viaShow o
<+> P.lparen <> e <> P.rparen
Right obj -> obj
fromObject :: Object -> Either (Doc AnsiStyle) o
fromObject = return . fromObjectUnsafe
fromObject' :: (MonadIO io) => Object -> io o
fromObject' = either (throwIO . ErrorMessage) return . fromObject
{-# MINIMAL toObject, (fromObject | fromObjectUnsafe) #-}
instance NvimObject () where
toObject _ = ObjectNil
fromObject ObjectNil = return ()
fromObject o = throwError $ "Expected ObjectNil, but got" <+> P.viaShow o
instance NvimObject Bool where
toObject = ObjectBool
fromObject (ObjectBool o) = return o
fromObject (ObjectInt 0) = return False
fromObject (ObjectUInt 0) = return False
fromObject ObjectNil = return False
fromObject (ObjectBinary "0") = return False
fromObject (ObjectBinary "") = return False
fromObject (ObjectString "0") = return False
fromObject (ObjectString "") = return False
fromObject _ = return True
instance NvimObject Double where
toObject = ObjectDouble
fromObject (ObjectDouble o) = return o
fromObject (ObjectFloat o) = return $ realToFrac o
fromObject (ObjectInt o) = return $ fromIntegral o
fromObject (ObjectUInt o) = return $ fromIntegral o
fromObject o = throwError $ "Expected ObjectDouble, but got"
<+> viaShow o
instance NvimObject Integer where
toObject = ObjectInt . fromIntegral
fromObject (ObjectInt o) = return $ toInteger o
fromObject (ObjectUInt o) = return $ toInteger o
fromObject (ObjectDouble o) = return $ round o
fromObject (ObjectFloat o) = return $ round o
fromObject o = throwError $ "Expected ObjectInt, but got" <+> viaShow o
instance NvimObject Int64 where
toObject = ObjectInt
fromObject (ObjectInt i) = return i
fromObject (ObjectUInt o) = return $ fromIntegral o
fromObject (ObjectDouble o) = return $ round o
fromObject (ObjectFloat o) = return $ round o
fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o
instance NvimObject Int32 where
toObject = ObjectInt . fromIntegral
fromObject (ObjectInt i) = return $ fromIntegral i
fromObject (ObjectUInt i) = return $ fromIntegral i
fromObject (ObjectDouble o) = return $ round o
fromObject (ObjectFloat o) = return $ round o
fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o
instance NvimObject Int16 where
toObject = ObjectInt . fromIntegral
fromObject (ObjectInt i) = return $ fromIntegral i
fromObject (ObjectUInt i) = return $ fromIntegral i
fromObject (ObjectDouble o) = return $ round o
fromObject (ObjectFloat o) = return $ round o
fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o
instance NvimObject Int8 where
toObject = ObjectInt . fromIntegral
fromObject (ObjectInt i) = return $ fromIntegral i
fromObject (ObjectUInt i) = return $ fromIntegral i
fromObject (ObjectDouble o) = return $ round o
fromObject (ObjectFloat o) = return $ round o
fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o
instance NvimObject Word where
toObject = ObjectInt . fromIntegral
fromObject (ObjectInt i) = return $ fromIntegral i
fromObject (ObjectUInt i) = return $ fromIntegral i
fromObject (ObjectDouble o) = return $ round o
fromObject (ObjectFloat o) = return $ round o
fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o
instance NvimObject Word64 where
toObject = ObjectInt . fromIntegral
fromObject (ObjectInt i) = return $ fromIntegral i
fromObject (ObjectUInt i) = return $ fromIntegral i
fromObject (ObjectDouble o) = return $ round o
fromObject (ObjectFloat o) = return $ round o
fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o
instance NvimObject Word32 where
toObject = ObjectInt . fromIntegral
fromObject (ObjectInt i) = return $ fromIntegral i
fromObject (ObjectUInt i) = return $ fromIntegral i
fromObject (ObjectDouble o) = return $ round o
fromObject (ObjectFloat o) = return $ round o
fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o
instance NvimObject Word16 where
toObject = ObjectInt . fromIntegral
fromObject (ObjectInt i) = return $ fromIntegral i
fromObject (ObjectUInt i) = return $ fromIntegral i
fromObject (ObjectDouble o) = return $ round o
fromObject (ObjectFloat o) = return $ round o
fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o
instance NvimObject Word8 where
toObject = ObjectInt . fromIntegral
fromObject (ObjectInt i) = return $ fromIntegral i
fromObject (ObjectUInt i) = return $ fromIntegral i
fromObject (ObjectDouble o) = return $ round o
fromObject (ObjectFloat o) = return $ round o
fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o
instance NvimObject Int where
toObject = ObjectInt . fromIntegral
fromObject (ObjectInt i) = return $ fromIntegral i
fromObject (ObjectUInt i) = return $ fromIntegral i
fromObject (ObjectDouble o) = return $ round o
fromObject (ObjectFloat o) = return $ round o
fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o
instance {-# OVERLAPPING #-} NvimObject [Char] where
toObject = ObjectBinary . UTF8.fromString
fromObject (ObjectBinary o) = return $ UTF8.toString o
fromObject (ObjectString o) = return $ UTF8.toString o
fromObject o = throwError $ "Expected ObjectString, but got" <+> viaShow o
instance {-# OVERLAPPABLE #-} NvimObject o => NvimObject [o] where
toObject = ObjectArray . map toObject
fromObject (ObjectArray os) = mapM fromObject os
fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o
instance NvimObject o => NvimObject (Maybe o) where
toObject = maybe ObjectNil toObject
fromObject ObjectNil = return Nothing
fromObject o = either throwError (return . Just) $ fromObject o
instance NvimObject o => NvimObject (Vector o) where
toObject = ObjectArray . V.toList . V.map toObject
fromObject (ObjectArray os) = V.fromList <$> mapM fromObject os
fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o
instance (NvimObject l, NvimObject r) => NvimObject (Either l r) where
toObject = either toObject toObject
fromObject o = case fromObject o of
Right r ->
return $ Right r
Left e1 -> case fromObject o of
Right l ->
return $ Left l
Left e2 ->
throwError $ e1 <+> "--" <+> e2
instance (Ord key, NvimObject key, NvimObject val)
=> NvimObject (SMap.Map key val) where
toObject = ObjectMap
. SMap.fromList . map (toObject *** toObject) . SMap.toList
fromObject (ObjectMap om) = SMap.fromList <$>
(sequenceA
. map (uncurry (liftA2 (,))
. (fromObject *** fromObject))
. SMap.toList) om
fromObject o = throwError $ "Expected ObjectMap, but got" <+> viaShow o
instance NvimObject Text where
toObject = ObjectBinary . encodeUtf8
fromObject (ObjectBinary o) = return $ decodeUtf8 o
fromObject (ObjectString o) = return $ decodeUtf8 o
fromObject o = throwError $ "Expected ObjectBinary, but got" <+> viaShow o
instance NvimObject ByteString where
toObject = ObjectBinary
fromObject (ObjectBinary o) = return o
fromObject (ObjectString o) = return o
fromObject o = throwError $ "Expected ObjectBinary, but got" <+> viaShow o
instance NvimObject Object where
toObject = id
fromObject = return
fromObjectUnsafe = id
instance (NvimObject o1, NvimObject o2) => NvimObject (o1, o2) where
toObject (o1, o2) = ObjectArray $ [toObject o1, toObject o2]
fromObject (ObjectArray [o1, o2]) = (,)
<$> fromObject o1
<*> fromObject o2
fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o
instance (NvimObject o1, NvimObject o2, NvimObject o3) => NvimObject (o1, o2, o3) where
toObject (o1, o2, o3) = ObjectArray $ [toObject o1, toObject o2, toObject o3]
fromObject (ObjectArray [o1, o2, o3]) = (,,)
<$> fromObject o1
<*> fromObject o2
<*> fromObject o3
fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o
instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4) => NvimObject (o1, o2, o3, o4) where
toObject (o1, o2, o3, o4) = ObjectArray $ [toObject o1, toObject o2, toObject o3, toObject o4]
fromObject (ObjectArray [o1, o2, o3, o4]) = (,,,)
<$> fromObject o1
<*> fromObject o2
<*> fromObject o3
<*> fromObject o4
fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow 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) = ObjectArray $ [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5]
fromObject (ObjectArray [o1, o2, o3, o4, o5]) = (,,,,)
<$> fromObject o1
<*> fromObject o2
<*> fromObject o3
<*> fromObject o4
<*> fromObject o5
fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow 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) = ObjectArray $ [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5, toObject o6]
fromObject (ObjectArray [o1, o2, o3, o4, o5, o6]) = (,,,,,)
<$> fromObject o1
<*> fromObject o2
<*> fromObject o3
<*> fromObject o4
<*> fromObject o5
<*> fromObject o6
fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow 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) = ObjectArray $ [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5, toObject o6, toObject o7]
fromObject (ObjectArray [o1, o2, o3, o4, o5, o6, o7]) = (,,,,,,)
<$> fromObject o1
<*> fromObject o2
<*> fromObject o3
<*> fromObject o4
<*> fromObject o5
<*> fromObject o6
<*> fromObject o7
fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow 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) = ObjectArray $ [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5, toObject o6, toObject o7, toObject o8]
fromObject (ObjectArray [o1, o2, o3, o4, o5, o6, o7, o8]) = (,,,,,,,)
<$> fromObject o1
<*> fromObject o2
<*> fromObject o3
<*> fromObject o4
<*> fromObject o5
<*> fromObject o6
<*> fromObject o7
<*> fromObject o8
fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow 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) = ObjectArray $ [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5, toObject o6, toObject o7, toObject o8, toObject o9]
fromObject (ObjectArray [o1, o2, o3, o4, o5, o6, o7, o8, o9]) = (,,,,,,,,)
<$> fromObject o1
<*> fromObject o2
<*> fromObject o3
<*> fromObject o4
<*> fromObject o5
<*> fromObject o6
<*> fromObject o7
<*> fromObject o8
<*> fromObject o9
fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o