-- |
-- Simple DSL for mapping Haskell values into JSON representation and
-- rendering it into 'ByteString'.
module Jsonifier
  ( -- * Execution
    toByteString,
    toWrite,

    -- * Json
    Json,

    -- ** Primitives
    null,
    bool,

    -- ** Numbers
    intNumber,
    wordNumber,
    doubleNumber,
    scientificNumber,

    -- ** Strings
    textString,
    scientificString,

    -- ** Composites
    array,
    object,

    -- ** Low-level
    fromByteString,
    fromWrite,
  )
where

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

-- |
-- 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.
{-# 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.
{-# 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 ByteString.
--
-- This is a low-level function allowing to avoid unnecessary processing
-- in cases where you already have a rendered JSON at hand.
--
-- __Warning:__
--
-- It is your responsibility to ensure that the content is correct JSON.
fromByteString :: ByteString.ByteString -> Json
fromByteString :: ByteString -> Json
fromByteString = Write -> Json
Json (Write -> Json) -> (ByteString -> Write) -> ByteString -> Json
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Write
Write.byteString

-- |
-- 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.
fromWrite :: Write.Write -> Json
fromWrite :: Write -> Json
fromWrite = Write -> Json
Json