{-|
Simple DSL for mapping Haskell values into JSON representation and
rendering it into 'ByteString'.
-}
module Jsonifier
(
  -- * ByteString
  toByteString,
  toWrite,
  -- * Json
  Json,
  -- ** Primitives
  null,
  bool,
  -- ** Numbers
  intNumber,
  wordNumber,
  doubleNumber,
  scientificNumber,
  -- ** Strings
  textString,
  scientificString,
  -- ** Composites
  array,
  object,
  -- ** Low-level
  writeJson,
)
where

import Jsonifier.Prelude hiding (null, bool)
import PtrPoker.Poke (Poke)
import PtrPoker.Write (Write)
import qualified Jsonifier.Size as Size
import qualified Jsonifier.Poke as Poke
import qualified Jsonifier.Write as Write
import qualified PtrPoker.Poke as Poke
import qualified PtrPoker.Write as Write
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Internal as ByteString


{-|
Render a JSON value into strict bytestring.
-}
{-# INLINE toByteString #-}
toByteString :: Json -> ByteString
toByteString :: Json -> ByteString
toByteString =
  Write -> ByteString
Write.writeToByteString (Write -> ByteString) -> (Json -> Write) -> Json -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Json -> Write
coerce

{-|
Render a JSON value into Write.
-}
{-# INLINE toWrite #-}
toWrite :: Json -> Write
toWrite :: Json -> Write
toWrite =
  Json -> Write
coerce


-- * Json
-------------------------

{-|
Specification of how to render a JSON value to 'ByteString'.
Sort of a JSON-specialized 'ByteString' builder.

You can construct it from Haskell types
using the specialized conversion functions
like 'intNumber', 'textString' or 'object'.
After constructing, you can convert to strict 'ByteString'
using the 'toByteString' function.
-}
newtype Json =
  Json Write.Write

{-# INLINE write #-}
write :: Int -> Poke.Poke -> Json
write :: Int -> Poke -> Json
write Int
size Poke
poke =
  Write -> Json
Json (Int -> Poke -> Write
Write.Write Int
size Poke
poke)

{-|
JSON Null literal.
-}
{-# INLINE null #-}
null :: Json
null :: Json
null =
  Int -> Poke -> Json
write Int
4 Poke
Poke.null

{-|
JSON Boolean literal.
-}
{-# INLINE bool #-}
bool :: Bool -> Json
bool :: Bool -> Json
bool =
  \ case
    Bool
True ->
      Int -> Poke -> Json
write Int
4 Poke
Poke.true
    Bool
False ->
      Int -> Poke -> Json
write Int
5 Poke
Poke.false

{-|
JSON Number literal from @Int@.
-}
{-# INLINE intNumber #-}
intNumber :: Int -> Json
intNumber :: Int -> Json
intNumber =
  Write -> Json
Json (Write -> Json) -> (Int -> Write) -> Int -> Json
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Write
Write.intAsciiDec

{-|
JSON Number literal from @Word@.
-}
{-# INLINE wordNumber #-}
wordNumber :: Word -> Json
wordNumber :: Word -> Json
wordNumber =
  Write -> Json
Json (Write -> Json) -> (Word -> Write) -> Word -> Json
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word -> Write
Write.wordAsciiDec

{-|
JSON Number literal from @Double@.

Since JSON doesn\'t have support for them,
non-real values like @NaN@, @Infinity@, @-Infinity@ get rendered as @0@.
-}
{-# INLINE doubleNumber #-}
doubleNumber :: Double -> Json
doubleNumber :: Double -> Json
doubleNumber =
  Write -> Json
Json (Write -> Json) -> (Double -> Write) -> Double -> Json
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Double -> Write
Write.zeroNonRealDoubleAsciiDec

{-|
JSON Number literal from @Scientific@.
-}
{-# INLINE scientificNumber #-}
scientificNumber :: Scientific -> Json
scientificNumber :: Scientific -> Json
scientificNumber =
  Write -> Json
Json (Write -> Json) -> (Scientific -> Write) -> Scientific -> Json
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Scientific -> Write
Write.scientificAsciiDec

{-|
JSON String literal from @Text@.
-}
{-# INLINE textString #-}
textString :: Text -> Json
textString :: Text -> Json
textString Text
text =
  let
    size :: Int
size =
      Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
Size.stringBody Text
text
    poke :: Poke
poke =
      Text -> Poke
Poke.string Text
text
    in Int -> Poke -> Json
write Int
size Poke
poke

{-|
JSON String literal from @Scientific@.

You may need this when the reader of your JSON
cannot handle large number literals.
-}
{-# INLINE scientificString #-}
scientificString :: Scientific -> Json
scientificString :: Scientific -> Json
scientificString =
  Write -> Json
Json (Write -> Json) -> (Scientific -> Write) -> Scientific -> Json
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Scientific -> Write
Write.scientificString

{-|
JSON Array literal from a foldable over element literals.

Don\'t be afraid to use 'fmap' to map the elements of the input datastructure,
it will all be optimized away.
-}
{-# INLINE array #-}
array :: Foldable f => f Json -> Json
array :: f Json -> Json
array f Json
foldable =
  Int -> Poke -> Json
write Int
size Poke
poke
  where
    size :: Int
size =
      (Json -> (Int -> Int -> Int) -> Int -> Int -> Int)
-> (Int -> Int -> Int) -> f Json -> Int -> Int -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Json -> (Int -> Int -> Int) -> Int -> Int -> Int
forall t t. Enum t => Json -> (t -> Int -> t) -> t -> Int -> t
step Int -> Int -> Int
finalize f Json
foldable Int
0 Int
0
      where
        step :: Json -> (t -> Int -> t) -> t -> Int -> t
step (Json (Write.Write Int
writeSize Poke
_)) t -> Int -> t
next !t
count !Int
size =
          t -> Int -> t
next (t -> t
forall a. Enum a => a -> a
succ t
count) (Int
writeSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size)
        finalize :: Int -> Int -> Int
finalize Int
count Int
size =
          Int -> Int -> Int
Size.array Int
count Int
size
    poke :: Poke
poke =
      (Ptr Word8 -> IO (Ptr Word8)) -> Poke
Poke.Poke ((Ptr Word8 -> IO (Ptr Word8)) -> Poke)
-> (Ptr Word8 -> IO (Ptr Word8)) -> Poke
forall a b. (a -> b) -> a -> b
$
        Poke -> Ptr Word8 -> IO (Ptr Word8)
Poke.pokePtr Poke
Poke.openingSquareBracket (Ptr Word8 -> IO (Ptr Word8))
-> (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
        (Json
 -> (Bool -> Ptr Word8 -> IO (Ptr Word8))
 -> Bool
 -> Ptr Word8
 -> IO (Ptr Word8))
-> (Bool -> Ptr Word8 -> IO (Ptr Word8))
-> f Json
-> Bool
-> Ptr Word8
-> IO (Ptr Word8)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Json
-> (Bool -> Ptr Word8 -> IO (Ptr Word8))
-> Bool
-> Ptr Word8
-> IO (Ptr Word8)
forall c.
Json -> (Bool -> Ptr Word8 -> IO c) -> Bool -> Ptr Word8 -> IO c
step Bool -> Ptr Word8 -> IO (Ptr Word8)
forall p. p -> Ptr Word8 -> IO (Ptr Word8)
finalize f Json
foldable Bool
True
      where
        step :: Json -> (Bool -> Ptr Word8 -> IO c) -> Bool -> Ptr Word8 -> IO c
step (Json (Write.Write Int
_ Poke
poke)) Bool -> Ptr Word8 -> IO c
next Bool
first =
          if Bool
first
            then
              Poke -> Ptr Word8 -> IO (Ptr Word8)
Poke.pokePtr Poke
poke (Ptr Word8 -> IO (Ptr Word8))
-> (Ptr Word8 -> IO c) -> Ptr Word8 -> IO c
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
              Bool -> Ptr Word8 -> IO c
next Bool
False
            else
              Poke -> Ptr Word8 -> IO (Ptr Word8)
Poke.pokePtr Poke
Poke.comma (Ptr Word8 -> IO (Ptr Word8))
-> (Ptr Word8 -> IO c) -> Ptr Word8 -> IO c
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
              Poke -> Ptr Word8 -> IO (Ptr Word8)
Poke.pokePtr Poke
poke (Ptr Word8 -> IO (Ptr Word8))
-> (Ptr Word8 -> IO c) -> Ptr Word8 -> IO c
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
              Bool -> Ptr Word8 -> IO c
next Bool
False
        finalize :: p -> Ptr Word8 -> IO (Ptr Word8)
finalize p
_ =
          Poke -> Ptr Word8 -> IO (Ptr Word8)
Poke.pokePtr Poke
Poke.closingSquareBracket

{-|
JSON Object literal from a foldable over pairs of key to value literal.

Don\'t be afraid to use 'fmap' to map the elements of the input datastructure,
it will all be optimized away.
-}
{-# INLINE object #-}
object :: Foldable f => f (Text, Json) -> Json
object :: f (Text, Json) -> Json
object f (Text, Json)
f =
  ((Text, Json)
 -> (Bool -> Int -> Int -> Poke -> Json)
 -> Bool
 -> Int
 -> Int
 -> Poke
 -> Json)
-> (Bool -> Int -> Int -> Poke -> Json)
-> f (Text, Json)
-> Bool
-> Int
-> Int
-> Poke
-> Json
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Text, Json)
-> (Bool -> Int -> Int -> Poke -> Json)
-> Bool
-> Int
-> Int
-> Poke
-> Json
forall t p.
(Num t, Enum t) =>
(Text, Json)
-> (Bool -> t -> Int -> Poke -> p) -> Bool -> t -> Int -> Poke -> p
step Bool -> Int -> Int -> Poke -> Json
forall p. p -> Int -> Int -> Poke -> Json
finalize f (Text, Json)
f Bool
True Int
0 Int
0 Poke
forall a. Monoid a => a
mempty
  where
    step :: (Text, Json)
-> (Bool -> t -> Int -> Poke -> p) -> Bool -> t -> Int -> Poke -> p
step (Text
key, Json (Write.Write{Int
Poke
writeSize :: Write -> Int
writePoke :: Write -> Poke
writePoke :: Poke
writeSize :: Int
..})) Bool -> t -> Int -> Poke -> p
next Bool
first !t
count !Int
size !Poke
poke =
      if Bool
first
        then
          Bool -> t -> Int -> Poke -> p
next Bool
False t
1 Int
rowSize Poke
rowPoke
        else
          Bool -> t -> Int -> Poke -> p
next Bool
False (t -> t
forall a. Enum a => a -> a
succ t
count) (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rowSize)
            (Poke
poke Poke -> Poke -> Poke
forall a. Semigroup a => a -> a -> a
<> Poke
Poke.comma Poke -> Poke -> Poke
forall a. Semigroup a => a -> a -> a
<> Poke
rowPoke)
      where
        rowSize :: Int
rowSize =
          Text -> Int
Size.stringBody Text
key Int -> Int -> Int
forall a. Num a => a -> a -> a
+
          Int
writeSize
        rowPoke :: Poke
rowPoke =
          Text -> Poke -> Poke
Poke.objectRow Text
key Poke
writePoke
    finalize :: p -> Int -> Int -> Poke -> Json
finalize p
_ Int
count Int
contentsSize Poke
bodyPoke =
      Int -> Poke -> Json
write Int
size Poke
poke
      where
        size :: Int
size =
          Int -> Int -> Int
Size.object Int
count Int
contentsSize
        poke :: Poke
poke =
          Poke
Poke.openingCurlyBracket Poke -> Poke -> Poke
forall a. Semigroup a => a -> a -> a
<> Poke
bodyPoke Poke -> Poke -> Poke
forall a. Semigroup a => a -> a -> a
<> Poke
Poke.closingCurlyBracket

{-|
Any JSON literal manually rendered as Write.

This is a low-level function allowing to avoid unnecessary processing
in cases where you already have a rendered JSON at hand.

You can think of Write as a specialized version of ByteString builder.
You can efficiently convert a ByteString to Write using 'PtrPoker.Write.byteString',
making it possible to have parts of the JSON value tree rendered using other libraries.
You can as well manually implement encoders for your custom types.

__Warning:__

It is your responsibility to ensure that the content is correct,
otherwise you may produce invalid JSON.
-}
writeJson :: Write.Write -> Json
writeJson :: Write -> Json
writeJson = Write -> Json
coerce