{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverlappingInstances  #-}
{-# 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 _              = 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) = return $ map fromObjectUnsafe 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}}}