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
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
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 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 ref :: IORef ByteString
ref _ 0 (CChar ch :: Int8
ch) _ _ = 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
$ \string :: ByteString
string -> Word8 -> ByteString -> ByteString
BSL.cons Word8
word ByteString
string
    RC -> IO RC
forall (m :: * -> *) a. Monad m => a -> m a
return 0
  where
    word :: Word8
word = Int8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
ch
printer ref :: IORef ByteString
ref buffer :: Ptr CChar
buffer size :: CInt
size _ _ _
    | CInt
size CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = do
        [CChar]
array <- 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
        IORef ByteString -> [CChar] -> IO RC
printerArray IORef ByteString
ref [CChar]
array
    | Bool
otherwise = do
        [CChar]
array <- CChar -> Ptr CChar -> IO [CChar]
forall a. (Storable a, Eq a) => a -> Ptr a -> IO [a]
peekArray0 (Int8 -> CChar
CChar 0) Ptr CChar
buffer
        IORef ByteString -> [CChar] -> IO RC
printerArray IORef ByteString
ref [CChar]
array

printerArray :: IORef BSL.ByteString -> [CChar] -> IO Result.RC
printerArray :: IORef ByteString -> [CChar] -> IO RC
printerArray ref :: IORef ByteString
ref array :: [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
$ \string :: ByteString
string ->
        (ByteString -> CChar -> ByteString)
-> ByteString -> [CChar] -> ByteString
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\result :: ByteString
result (CChar ch :: 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 0

encode :: Aeson.ToJSON a => a -> (JBL -> IO b) -> IO b
encode :: a -> (JBL -> IO b) -> IO b
encode obj :: a
obj f :: 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
$ \string :: 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
$ \jblPtr :: 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 obj :: 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