{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module: Data.Greskell.GraphSON.GraphSONTyped
-- Description: 
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- __Internal module.__ Just to resolve cyclic dependency between
-- GraphSON and GMap.
module Data.Greskell.GraphSON.GraphSONTyped
       ( GraphSONTyped(..)
       ) where

import Data.Text (Text)
import Data.Vector (Vector)
import qualified Data.HashMap.Lazy as L (HashMap)
import qualified Data.HashMap.Strict as S (HashMap)
import Data.HashSet (HashSet)
import Data.Int (Int8, Int16, Int32, Int64)
import qualified Data.IntMap.Lazy as L (IntMap)
import qualified Data.IntMap.Strict as S (IntMap)
import Data.IntSet (IntSet)
import qualified Data.Map.Lazy as L (Map)
import qualified Data.Map.Strict as S (Map)
import Data.Scientific (Scientific)
import Data.Sequence (Seq)
import Data.Set (Set)


-- | Types that have an intrinsic type ID for 'gsonType' field.
class GraphSONTyped a where
  gsonTypeFor :: a -> Text
  -- ^ Type ID for 'gsonType'.

instance GraphSONTyped Char where
  gsonTypeFor :: Char -> Text
gsonTypeFor Char
_ = Text
"gx:Char"

-- | Map to \"gx:Byte\". Note that Java's Byte is signed.
instance GraphSONTyped Int8 where
  gsonTypeFor :: Int8 -> Text
gsonTypeFor Int8
_ = Text
"gx:Byte"

instance GraphSONTyped Int16 where
  gsonTypeFor :: Int16 -> Text
gsonTypeFor Int16
_ = Text
"gx:Int16"

instance GraphSONTyped Int32 where
  gsonTypeFor :: Int32 -> Text
gsonTypeFor Int32
_ = Text
"g:Int32"

instance GraphSONTyped Int64 where
  gsonTypeFor :: Int64 -> Text
gsonTypeFor Int64
_ = Text
"g:Int64"

instance GraphSONTyped Float where
  gsonTypeFor :: Float -> Text
gsonTypeFor Float
_ = Text
"g:Float"

instance GraphSONTyped Double where
  gsonTypeFor :: Double -> Text
gsonTypeFor Double
_ = Text
"g:Double"

instance GraphSONTyped [a] where
  gsonTypeFor :: [a] -> Text
gsonTypeFor [a]
_ = Text
"g:List"

-- | @since 0.1.2.0
instance GraphSONTyped (Vector a) where
  gsonTypeFor :: Vector a -> Text
gsonTypeFor Vector a
_ = Text
"g:List"

-- | @since 0.1.2.0
instance GraphSONTyped (Seq a) where
  gsonTypeFor :: Seq a -> Text
gsonTypeFor Seq a
_ = Text
"g:List"

-- | Map to \"g:Double\".
instance GraphSONTyped Scientific where
  gsonTypeFor :: Scientific -> Text
gsonTypeFor Scientific
_ = Text
"g:Double"

instance GraphSONTyped (HashSet a) where
  gsonTypeFor :: HashSet a -> Text
gsonTypeFor HashSet a
_ = Text
"g:Set"

-- | @since 0.1.2.0
instance GraphSONTyped IntSet where
  gsonTypeFor :: IntSet -> Text
gsonTypeFor IntSet
_ = Text
"g:Set"

-- | @since 0.1.2.0
instance GraphSONTyped (Set a) where
  gsonTypeFor :: Set a -> Text
gsonTypeFor Set a
_ = Text
"g:Set"

instance GraphSONTyped (L.HashMap k v) where
  gsonTypeFor :: HashMap k v -> Text
gsonTypeFor HashMap k v
_ = Text
"g:Map"

-- | @since 0.1.2.0
instance GraphSONTyped (L.Map k v) where
  gsonTypeFor :: Map k v -> Text
gsonTypeFor Map k v
_= Text
"g:Map"

-- | @since 0.1.2.0
instance GraphSONTyped (L.IntMap v) where
  gsonTypeFor :: IntMap v -> Text
gsonTypeFor IntMap v
_= Text
"g:Map"

-- -- Implementation of Lazy and Strict types are the same.
-- 
-- instance GraphSONTyped (S.HashMap k v) where
--   gsonTypeFor _ = "g:Map"
-- 
-- instance GraphSONTyped (S.Map k v) where
--   gsonTypeFor _= "g:Map"
-- 
-- instance GraphSONTyped (S.IntMap v) where
--   gsonTypeFor _= "g:Map"

-- | @since 0.1.2.0
instance (GraphSONTyped a, GraphSONTyped b) => GraphSONTyped (Either a b) where
  gsonTypeFor :: Either a b -> Text
gsonTypeFor Either a b
e = (a -> Text) -> (b -> Text) -> Either a b -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Text
forall a. GraphSONTyped a => a -> Text
gsonTypeFor b -> Text
forall a. GraphSONTyped a => a -> Text
gsonTypeFor Either a b
e