{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Binary.Instances.Aeson where

import Data.Binary         (Binary, Get, get, put)
import Data.Binary.Orphans ()

import Data.Binary.Instances.Scientific ()
import Data.Binary.Instances.Text ()
import Data.Binary.Instances.UnorderedContainers ()
import Data.Binary.Instances.Vector ()

import qualified Data.Aeson as A

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KM
#endif

instance Binary A.Value where
    get :: Get Value
get = do
        Int
t <- Get Int
forall t. Binary t => Get t
get :: Get Int
        case Int
t of
            Int
0 -> (Object -> Value) -> Get Object -> Get Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Object -> Value
A.Object Get Object
forall t. Binary t => Get t
get
            Int
1 -> (Array -> Value) -> Get Array -> Get Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Array -> Value
A.Array Get Array
forall t. Binary t => Get t
get
            Int
2 -> (Text -> Value) -> Get Text -> Get Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Value
A.String Get Text
forall t. Binary t => Get t
get
            Int
3 -> (Scientific -> Value) -> Get Scientific -> Get Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Scientific -> Value
A.Number Get Scientific
forall t. Binary t => Get t
get
            Int
4 -> (Bool -> Value) -> Get Bool -> Get Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Value
A.Bool Get Bool
forall t. Binary t => Get t
get
            Int
5 -> Value -> Get Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
A.Null
            Int
_ -> String -> Get Value
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Value) -> String -> Get Value
forall a b. (a -> b) -> a -> b
$ String
"Invalid Value tag: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
t

    put :: Value -> Put
put (A.Object Object
v) = Int -> Put
forall t. Binary t => t -> Put
put (Int
0 :: Int) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Object -> Put
forall t. Binary t => t -> Put
put Object
v
    put (A.Array Array
v)  = Int -> Put
forall t. Binary t => t -> Put
put (Int
1 :: Int) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Array -> Put
forall t. Binary t => t -> Put
put Array
v
    put (A.String Text
v) = Int -> Put
forall t. Binary t => t -> Put
put (Int
2 :: Int) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Put
forall t. Binary t => t -> Put
put Text
v
    put (A.Number Scientific
v) = Int -> Put
forall t. Binary t => t -> Put
put (Int
3 :: Int) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Scientific -> Put
forall t. Binary t => t -> Put
put Scientific
v
    put (A.Bool Bool
v)   = Int -> Put
forall t. Binary t => t -> Put
put (Int
4 :: Int) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Put
forall t. Binary t => t -> Put
put Bool
v
    put Value
A.Null       = Int -> Put
forall t. Binary t => t -> Put
put (Int
5 :: Int)

#if MIN_VERSION_aeson(2,0,0)
instance Binary Key.Key where
    get :: Get Key
get = Text -> Key
Key.fromText (Text -> Key) -> Get Text -> Get Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
forall t. Binary t => Get t
get
    put :: Key -> Put
put = Text -> Put
forall t. Binary t => t -> Put
put (Text -> Put) -> (Key -> Text) -> Key -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Text
Key.toText

instance Binary v => Binary (KM.KeyMap v) where
    get :: Get (KeyMap v)
get = ([(Key, v)] -> KeyMap v) -> Get [(Key, v)] -> Get (KeyMap v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Key, v)] -> KeyMap v
forall v. [(Key, v)] -> KeyMap v
KM.fromList Get [(Key, v)]
forall t. Binary t => Get t
get
    put :: KeyMap v -> Put
put = [(Key, v)] -> Put
forall t. Binary t => t -> Put
put ([(Key, v)] -> Put) -> (KeyMap v -> [(Key, v)]) -> KeyMap v -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap v -> [(Key, v)]
forall v. KeyMap v -> [(Key, v)]
KM.toList
#endif