--   This Source Code Form is subject to the terms of the Mozilla Public
--   License, v. 2.0. If a copy of the MPL was not distributed with this
--   file, You can obtain one at http://mozilla.org/MPL/2.0/.

{-# LANGUAGE DerivingStrategies #-}

-- | JSON string
module Libjwt.JsonByteString
  ( JsonByteString(..)
  , jsonFromStrict
  , toJsonStrict
  , toJsonBuilder
  )
where

import           Data.ByteString                ( ByteString )
import           Data.ByteString.Builder        ( Builder
                                                , lazyByteString
                                                )
import qualified Data.ByteString.Lazy          as Lazy

-- | Represents a string which is already in JSON format. 
--
--   Can be used for cases such as integration with /aeson/
--   
-- @
-- data Account = MkAccount { account_name :: Text, account_id :: UUID }
--   deriving stock (Show, Eq, Generic)
-- 
-- instance FromJSON Account
-- instance ToJSON Account
-- 
-- instance 'Libjwt.Classes.JwtRep' 'JsonByteString' Account where
--   rep   = Json . encode
--   unRep = decode . toJson
-- @
newtype JsonByteString = Json { JsonByteString -> ByteString
toJson :: Lazy.ByteString }
  deriving stock (Int -> JsonByteString -> ShowS
[JsonByteString] -> ShowS
JsonByteString -> String
(Int -> JsonByteString -> ShowS)
-> (JsonByteString -> String)
-> ([JsonByteString] -> ShowS)
-> Show JsonByteString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsonByteString] -> ShowS
$cshowList :: [JsonByteString] -> ShowS
show :: JsonByteString -> String
$cshow :: JsonByteString -> String
showsPrec :: Int -> JsonByteString -> ShowS
$cshowsPrec :: Int -> JsonByteString -> ShowS
Show, JsonByteString -> JsonByteString -> Bool
(JsonByteString -> JsonByteString -> Bool)
-> (JsonByteString -> JsonByteString -> Bool) -> Eq JsonByteString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsonByteString -> JsonByteString -> Bool
$c/= :: JsonByteString -> JsonByteString -> Bool
== :: JsonByteString -> JsonByteString -> Bool
$c== :: JsonByteString -> JsonByteString -> Bool
Eq)

jsonFromStrict :: ByteString -> JsonByteString
jsonFromStrict :: ByteString -> JsonByteString
jsonFromStrict = ByteString -> JsonByteString
Json (ByteString -> JsonByteString)
-> (ByteString -> ByteString) -> ByteString -> JsonByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Lazy.fromStrict

toJsonStrict :: JsonByteString -> ByteString
toJsonStrict :: JsonByteString -> ByteString
toJsonStrict = ByteString -> ByteString
Lazy.toStrict (ByteString -> ByteString)
-> (JsonByteString -> ByteString) -> JsonByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonByteString -> ByteString
toJson

toJsonBuilder :: JsonByteString -> Builder
toJsonBuilder :: JsonByteString -> Builder
toJsonBuilder = ByteString -> Builder
lazyByteString (ByteString -> Builder)
-> (JsonByteString -> ByteString) -> JsonByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonByteString -> ByteString
toJson