nvim-hs-0.0.2: library/Neovim/Classes.hs
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverlappingInstances #-}
{-# 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
, module Data.Int
) where
import Neovim.Context
import Control.Applicative
import Control.Arrow
import Control.Monad.Except
import Data.ByteString (ByteString)
import Data.Int (Int16, Int32, Int64)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.MessagePack
import Data.Monoid
import Data.Text as Text (Text)
import Data.Traversable hiding (forM, mapM)
import Prelude
-- FIXME saep 2014-11-28 Is assuming UTF-8 reasonable?
import qualified Data.ByteString.UTF8 as U (fromString, toString)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
-- | 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 = Map ByteString Object
-- | Conversion from 'Object' files to Haskell types and back with respect
-- to neovim's interpretation.
class NvimObject o where
toObject :: o -> Object
fromObjectUnsafe :: Object -> o
fromObjectUnsafe o = case fromObject o of
Left e -> error $ unwords
[ "Not the expected object:"
, show o , "(", e, ")"
]
Right obj -> obj
fromObject :: (NvimObject o) => Object -> Either String o
fromObject = return . fromObjectUnsafe
-- Instances for NvimObject {{{1
instance NvimObject () where
toObject _ = ObjectNil
fromObject ObjectNil = return ()
fromObject o = throwError $ "Expected ObjectNil, but got " <> show o
-- We may receive truthy values from neovim, so we should be more forgiving
-- here.
instance NvimObject Bool where
toObject = ObjectBool
fromObject (ObjectBool o) = return o
fromObject (ObjectInt 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 o = throwError $ "Expected ObjectDouble, but got " <> show o
instance NvimObject Integer where
toObject = ObjectInt . fromIntegral
fromObject (ObjectInt o) = return $ toInteger o
fromObject (ObjectDouble o) = return $ round o
fromObject (ObjectFloat o) = return $ round o
fromObject o = throwError $ "Expected ObjectInt, but got " <> show o
instance NvimObject Int64 where
toObject = ObjectInt
fromObject (ObjectInt i) = return i
fromObject (ObjectDouble o) = return $ round o
fromObject (ObjectFloat o) = return $ round o
fromObject o = throwError $ "Expected any Integer value, but got " <> show o
instance NvimObject Int32 where
toObject = ObjectInt . fromIntegral
fromObject (ObjectInt 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 " <> show o
instance NvimObject Int16 where
toObject = ObjectInt . fromIntegral
fromObject (ObjectInt 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 " <> show o
instance NvimObject Int where
toObject = ObjectInt . fromIntegral
fromObject (ObjectInt 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 " <> show o
instance NvimObject Char where
toObject c = ObjectBinary . U.fromString $ [c]
fromObject str = case fromObject str of
Right [c] -> return c
_ -> throwError $ "Expected one element string but got: " <> show str
instance NvimObject [Char] where
toObject = ObjectBinary . U.fromString
fromObject (ObjectBinary o) = return $ U.toString o
fromObject (ObjectString o) = return $ U.toString o
fromObject o = throwError $ "Expected ObjectBinary, but got " <> show o
instance NvimObject o => NvimObject [o] where
toObject = ObjectArray . map toObject
fromObject (ObjectArray os) = mapM fromObject os
fromObject o = throwError $ "Expected ObjectArray, but got " <> show 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 (Ord key, NvimObject key, NvimObject val)
=> NvimObject (Map key val) where
toObject = ObjectMap
. Map.fromList . map (toObject *** toObject) . Map.toList
fromObject (ObjectMap om) = Map.fromList <$>
(sequenceA
. map (uncurry (liftA2 (,))
. (fromObject *** fromObject))
. Map.toList) om
fromObject o = throwError $ "Expected ObjectMap, but got " <> show 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 " <> show o
instance NvimObject ByteString where
toObject = ObjectBinary
fromObject (ObjectBinary o) = return o
fromObject o = throwError $ "Expected ObjectBinary, but got " <> show o
instance NvimObject Object where
toObject = id
fromObject = return
fromObjectUnsafe = id
-- By the magic of vim, i will create these.
instance NvimObject o => NvimObject (o, o) where
toObject (o1, o2) = ObjectArray $ map toObject [o1, o2]
fromObject (ObjectArray [o1, o2]) = (,)
<$> fromObject o1
<*> fromObject o2
fromObject o = throwError $ "Expected ObjectArray, but got " <> show o
instance NvimObject o => NvimObject (o, o, o) where
toObject (o1, o2, o3) = ObjectArray $ map toObject [o1, o2, o3]
fromObject (ObjectArray [o1, o2, o3]) = (,,)
<$> fromObject o1
<*> fromObject o2
<*> fromObject o3
fromObject o = throwError $ "Expected ObjectArray, but got " <> show o
instance NvimObject o => NvimObject (o, o, o, o) where
toObject (o1, o2, o3, o4) = ObjectArray $ map toObject [o1, o2, o3, o4]
fromObject (ObjectArray [o1, o2, o3, o4]) = (,,,)
<$> fromObject o1
<*> fromObject o2
<*> fromObject o3
<*> fromObject o4
fromObject o = throwError $ "Expected ObjectArray, but got " <> show o
instance NvimObject o => NvimObject (o, o, o, o, o) where
toObject (o1, o2, o3, o4, o5) = ObjectArray $ map toObject [o1, o2, o3, o4, 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 " <> show o
instance NvimObject o => NvimObject (o, o, o, o, o, o) where
toObject (o1, o2, o3, o4, o5, o6) = ObjectArray $ map toObject [o1, o2, o3, o4, o5, 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 " <> show o
instance NvimObject o => NvimObject (o, o, o, o, o, o, o) where
toObject (o1, o2, o3, o4, o5, o6, o7) = ObjectArray $ map toObject [o1, o2, o3, o4, o5, o6, 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 " <> show o
instance NvimObject o => NvimObject (o, o, o, o, o, o, o, o) where
toObject (o1, o2, o3, o4, o5, o6, o7, o8) = ObjectArray $ map toObject [o1, o2, o3, o4, o5, o6, o7, 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 " <> show o
instance NvimObject o => NvimObject (o, o, o, o, o, o, o, o, o) where
toObject (o1, o2, o3, o4, o5, o6, o7, o8, o9) = ObjectArray $ map toObject [o1, o2, o3, o4, o5, o6, o7, o8, 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 " <> show o
-- 1}}}