module Database.EJDB2.JBL ( decode, encode, encodeToByteString ) where

import           Control.Exception

import qualified Data.Aeson                  as Aeson
import qualified Data.ByteString             as BS
import qualified Data.ByteString.Lazy        as BSL
import           Data.IORef
import           Data.Int

import           Database.EJDB2.Bindings.JBL
import qualified Database.EJDB2.Result       as Result

import           Foreign
import           Foreign.C.Types
import           Foreign.Marshal.Array

decode :: Aeson.FromJSON a => JBL -> IO (Maybe a)
decode :: JBL -> IO (Maybe a)
decode JBL
jbl = ByteString -> Maybe a
forall a. FromJSON a => ByteString -> Maybe a
Aeson.decode' (ByteString -> Maybe a) -> IO ByteString -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JBL -> IO ByteString
decodeToByteString JBL
jbl

decodeToByteString :: JBL -> IO BSL.ByteString
decodeToByteString :: JBL -> IO ByteString
decodeToByteString JBL
jbl = do
    IORef ByteString
ref <- ByteString -> IO (IORef ByteString)
forall a. a -> IO (IORef a)
newIORef ByteString
BSL.empty
    FunPtr JBLJSONPrinter
thePrinter <- JBLJSONPrinter -> IO (FunPtr JBLJSONPrinter)
mkJBLJSONPrinter (IORef ByteString -> JBLJSONPrinter
printer IORef ByteString
ref)
    JBL -> FunPtr JBLJSONPrinter -> JBL -> JBLPrintFlags -> IO RC
c_jbl_as_json JBL
jbl FunPtr JBLJSONPrinter
thePrinter JBL
forall a. Ptr a
nullPtr JBLPrintFlags
0
        IO RC -> (RC -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> RC -> IO ()
forall a. IO a -> RC -> IO a
Result.checkRCFinally (FunPtr JBLJSONPrinter -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr JBLJSONPrinter
thePrinter)
    ByteString -> ByteString
BSL.reverse (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef ByteString -> IO ByteString
forall a. IORef a -> IO a
readIORef IORef ByteString
ref

printer :: IORef BSL.ByteString -> JBLJSONPrinter
printer :: IORef ByteString -> JBLJSONPrinter
printer IORef ByteString
ref Ptr CChar
_ CInt
0 (CChar Int8
ch) CInt
_ JBL
_ = do
    IORef ByteString -> (ByteString -> ByteString) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef ByteString
ref (Word8 -> ByteString -> ByteString
BSL.cons' (Int8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
ch))
    RC -> IO RC
forall (m :: * -> *) a. Monad m => a -> m a
return RC
0
printer IORef ByteString
ref Ptr CChar
buffer CInt
size CChar
_ CInt
_ JBL
_
    | CInt
size CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
> CInt
0 = Int -> Ptr CChar -> IO [CChar]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
size) Ptr CChar
buffer IO [CChar] -> ([CChar] -> IO RC) -> IO RC
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IORef ByteString -> [CChar] -> IO RC
printerArray IORef ByteString
ref
    | Bool
otherwise = CChar -> Ptr CChar -> IO [CChar]
forall a. (Storable a, Eq a) => a -> Ptr a -> IO [a]
peekArray0 (Int8 -> CChar
CChar Int8
0) Ptr CChar
buffer IO [CChar] -> ([CChar] -> IO RC) -> IO RC
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IORef ByteString -> [CChar] -> IO RC
printerArray IORef ByteString
ref

printerArray :: IORef BSL.ByteString -> [CChar] -> IO Result.RC
printerArray :: IORef ByteString -> [CChar] -> IO RC
printerArray IORef ByteString
ref [CChar]
array = do
    IORef ByteString -> (ByteString -> ByteString) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef ByteString
ref ((ByteString -> ByteString) -> IO ())
-> (ByteString -> ByteString) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ByteString
string ->
        (ByteString -> CChar -> ByteString)
-> ByteString -> [CChar] -> ByteString
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ByteString
result (CChar Int8
ch) -> Word8 -> ByteString -> ByteString
BSL.cons' (Int8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
ch) ByteString
result)
              ByteString
string
              [CChar]
array
    RC -> IO RC
forall (m :: * -> *) a. Monad m => a -> m a
return RC
0

encode :: Aeson.ToJSON a => a -> (JBL -> IO b) -> IO b
encode :: a -> (JBL -> IO b) -> IO b
encode a
obj JBL -> IO b
f = do
    let byteString :: ByteString
byteString = a -> ByteString
forall a. ToJSON a => a -> ByteString
encodeToByteString a
obj
    ByteString -> (Ptr CChar -> IO b) -> IO b
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
byteString ((Ptr CChar -> IO b) -> IO b) -> (Ptr CChar -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
string -> (Ptr JBL -> IO b) -> IO b
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr JBL -> IO b) -> IO b) -> (Ptr JBL -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr JBL
jblPtr ->
        IO b -> IO () -> IO b
forall a b. IO a -> IO b -> IO a
finally (Ptr JBL -> Ptr CChar -> IO RC
c_jbl_from_json Ptr JBL
jblPtr Ptr CChar
string IO RC -> (RC -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RC -> IO ()
Result.checkRC IO () -> IO JBL -> IO JBL
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr JBL -> IO JBL
forall a. Storable a => Ptr a -> IO a
peek Ptr JBL
jblPtr
                 IO JBL -> (JBL -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JBL -> IO b
f)
                (Ptr JBL -> IO ()
c_jbl_destroy Ptr JBL
jblPtr)

encodeToByteString :: Aeson.ToJSON a => a -> BS.ByteString
encodeToByteString :: a -> ByteString
encodeToByteString a
obj = ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode a
obj