--   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/.

{-# OPTIONS_HADDOCK show-extensions #-}

{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

-- | The classes in this module are responsible for encoding and decoding values into JWT objects.
--
-- = Encoding
--
--   The encoders are divided into three groups:
--
--       * /Native/ - types: ByteString, Bool, Int, NumericDate and 'JsonByteString'.
--         They are encoded by simply calling the appropriate FFI function
--       * /Derived/ - types for which there is an instance of 'JwtRep'.
--         They are converted via 'rep' (transitively) to something we know how to encode
--       * /Specialized/ - 'Maybe' and lists
--
-- == JwtRep typeclass and derived encoders
--
--   This typeclass converts a value to its encodable representation. E.g.,
--   to encode 'UUID' we first convert it to something we know how to encode (ByteString).
--     
-- @
-- instance 'JwtRep' ByteString UUID where
--   rep = UUID.toASCIIBytes
-- @
--
--   This is an example of /derived/ encoder that calls 'rep' and then uses a different encoder (native) to perform the actual encoding.
--   This is sufficent to encode any single 'UUID' as 'ByteString' is natively supported.
--   Native encoders automatically take care of converting values to JSON format (escaping, quoting, UTF-8 encoding etc).
--
--   You can use the same method to extend the library to __support your type__.
--
-- @
-- newtype UserName = Un { toText :: Text }
--  deriving stock (Show, Eq)
--
-- instance 'JwtRep' Text UserName where
--  rep   = toText
--  unRep = Just . Un   
-- @
-- 
--   But there is an easier way. Just use /deriving/ clause
--
-- @
-- newtype UserName = Un { toText :: Text }
--  deriving stock (Show, Eq)
--  deriving newtype ('JwtRep' ByteString)
-- @
--
-- == JsonBuilder and lists
--
--  To encode values such as lists, a different strategy has to be used. 
--  Because JWT values have to be in JSON format and there is no native support for more complex data structures (such as JSON arrays)
--  we have to do the conversion ourselves. For this we must know how to encode the value as a __JSON value__
--
--  This is the role of 'JsonBuilder' typeclass.
--  You must provide its instance if you want to be able to __encode lists of values of a custom type__.
--
--  If you already have a 'JwtRep' instance, the default implementation (use 'JsonBuilder' of the 'rep') should be fine
--
-- @
-- instance 'JsonBuilder' UserName
-- @
-- 
--  or
--
-- @
-- newtype UserName = Un { toText :: Text }
--  deriving stock (Show, Eq)
--  deriving newtype ('JwtRep' ByteString, 'JsonBuilder')
-- @
--
-- = Decoding
--
--   The decoders are similarily divided into three groups:
--
--       * /Native/ - types: ByteString, Bool, Int, NumericDate and 'JsonByteString'.
--         Decoded in C
--       * /Derived/ - types for which a 'JwtRep' instance exists.
--         They are extracted via 'unRep' (transitively) from something we could decode
--       * /Specialized/ - Lists
--
-- == JwtRep typeclass
--
--   'JwtRep' also knows how to go backwards - from the JWT representation to, maybe, a value. To complete the 'UUID' example
--     
-- @
-- instance 'JwtRep' ByteString UUID where
--   rep = 'UUID.toASCIIBytes'
--   unRep = 'UUID.fromASCIIBytes'
-- @
--
--   /Derived/ decoder will first try to parse a byteString from JSON, and then convert it via 'unRep' to a UUID.
--   Each of these steps can fail - the failure will manifest itself as "Libjwt.Exceptions.MissingClaim" or
--   @Nothing@ if all you want is @Maybe UUID@
--
--   And of course, 'JwtRep' of @UserName@ handles decoding the same way as described.
--
-- == JsonParser and lists
--
--  'JsonParser' performs the opposite role of 'JsonBuilder' during decoding. It is used for extracting values
--  out of JSON arrays
--
--  You must provide its instance if you want to be able to __decode lists of values of a custom type__.
--
--  And again - the default implementation (@unRep <=< jsonParser@) should be fine
--
-- @
-- instance 'JsonParser' UserName
-- @
-- 
--  or
--
-- @
-- newtype UserName = Un { toText :: Text }
--  deriving stock (Show, Eq)
--  deriving newtype ('JwtRep' ByteString, 'JsonBuilder', 'JsonParser')
-- @
--
-- = Integration with aeson
--
--  If you want to work with more complex objects as claims (e.g. lists of records) or
--  you just want to integrate this library with your existing code that uses /aeson/ - it's simple
-- 
-- @
-- data Account = MkAccount { account_name :: Text, account_id :: UUID }
--   deriving stock (Show, Eq, Generic)
-- 
-- instance FromJSON Account
-- instance ToJSON Account
-- 
-- instance 'JwtRep' 'JsonByteString' Account where
--   rep   = Json . encode
--   unRep = decode . toJson
-- 
-- instance 'JsonBuilder' Account
-- instance 'JsonParser' Account
-- @
--
--  'JsonByteString' is for cases where you already have your claims correctly represented as JSON,
--  so you can use /aeson/ (or any other method) to create 'JsonByteString'.
--
-- = Warning
--
--  Do not use @\NUL@ characters in strings you encode or decode with this library.
--  Safety is not guaranteed (ie, may crash your program) due to the way /libjwt/ works.
module Libjwt.Classes
  ( JwtRep(..)
  , JsonBuilder(..)
  , JsonParser(..)
  , JsonToken(..)
  )
where

import           Libjwt.ASCII
import           Libjwt.FFI.Jwt                 ( JsonToken(..) )
import           Libjwt.Flag
import           Libjwt.JsonByteString
import           Libjwt.NumericDate

import           Control.Monad                  ( guard
                                                , (<=<)
                                                )
import           Control.Monad.Zip              ( mzip )

import           Data.ByteString                ( ByteString )
import qualified Data.ByteString               as Word8
import           Data.ByteString.Builder        ( Builder
                                                , char7
                                                , byteString
                                                , intDec
                                                , int64Dec
                                                , string7
                                                , charUtf8
                                                )
import           Data.ByteString.Builder.Extra  ( toLazyByteStringWith
                                                , safeStrategy
                                                )
import           Data.ByteString.Builder.Prim   ( (>*<)
                                                , condB
                                                , (>$<)
                                                , liftFixedToBounded
                                                )
import qualified Data.ByteString.Builder.Prim  as E
import qualified Data.ByteString.Char8         as Char8
import qualified Data.ByteString.Lazy          as Lazy
import qualified Data.ByteString.Lazy.Char8    as Lazy8

import qualified Data.ByteString.Lazy.UTF8     as LazyUTF8
import qualified Data.ByteString.UTF8          as UTF8

import           Data.Char                      ( ord
                                                , digitToInt
                                                , chr
                                                )
import           Data.Coerce                    ( coerce )

import           Data.Either.Extra              ( eitherToMaybe )

import           Data.List                      ( intersperse )
import           Data.List.NonEmpty             ( NonEmpty )
import qualified Data.List.NonEmpty            as NEL
import           Data.Maybe                     ( fromJust )

import           Data.Text                      ( Text )
import qualified Data.Text.Encoding            as Text
import           Data.Text.Lazy                 ( toStrict )
import qualified Data.Text.Lazy.Encoding       as LazyText

import           Data.Time.Calendar             ( Day )
import           Data.Time.Clock
import           Data.Time.Format.ISO8601
import           Data.Time.LocalTime

import           Data.UUID                      ( UUID )
import qualified Data.UUID                     as UUID

import           Data.Word                      ( Word16
                                                , Word8
                                                )

-- | Conversion between @a@ and @b@ 
--
--   If an instance of this typeclass exists for a type @b@, then JWT encoder and decoder can be derived for that type.
--   This derived encoder/decoder will use the encoder/decoder of @a@ and perform the convertions through this typeclass.
class JwtRep a b | b -> a where
  -- | Convert @b@ to @a@
  rep :: b -> a
  -- | Try to convert @a@ to @b@, returning @Nothing@ if unable
  unRep :: a -> Maybe b

instance JwtRep ByteString String where
  rep :: String -> ByteString
rep   = String -> ByteString
UTF8.fromString
  unRep :: ByteString -> Maybe String
unRep = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (ByteString -> String) -> ByteString -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
UTF8.toString

instance JwtRep ByteString ASCII where
  rep :: ASCII -> ByteString
rep   = String -> ByteString
Char8.pack (String -> ByteString) -> (ASCII -> String) -> ASCII -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII -> String
coerce
  unRep :: ByteString -> Maybe ASCII
unRep = Maybe String -> Maybe ASCII
coerce (Maybe String -> Maybe ASCII)
-> (ByteString -> Maybe String) -> ByteString -> Maybe ASCII
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (ByteString -> String) -> ByteString -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
Char8.unpack

instance JwtRep ByteString UUID where
  rep :: UUID -> ByteString
rep   = UUID -> ByteString
UUID.toASCIIBytes
  unRep :: ByteString -> Maybe UUID
unRep = ByteString -> Maybe UUID
UUID.fromASCIIBytes

encodeAsIso8601 :: (ISO8601 t) => t -> ASCII
encodeAsIso8601 :: t -> ASCII
encodeAsIso8601 = String -> ASCII
ASCII (String -> ASCII) -> (t -> String) -> t -> ASCII
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> String
forall t. ISO8601 t => t -> String
iso8601Show

decodeFromISO8601 :: (ISO8601 t) => ASCII -> Maybe t
decodeFromISO8601 :: ASCII -> Maybe t
decodeFromISO8601 = String -> Maybe t
forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
iso8601ParseM (String -> Maybe t) -> (ASCII -> String) -> ASCII -> Maybe t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII -> String
getASCII

instance JwtRep ASCII UTCTime where
  rep :: UTCTime -> ASCII
rep   = UTCTime -> ASCII
forall t. ISO8601 t => t -> ASCII
encodeAsIso8601
  unRep :: ASCII -> Maybe UTCTime
unRep = ASCII -> Maybe UTCTime
forall t. ISO8601 t => ASCII -> Maybe t
decodeFromISO8601

instance JwtRep ASCII ZonedTime where
  rep :: ZonedTime -> ASCII
rep   = ZonedTime -> ASCII
forall t. ISO8601 t => t -> ASCII
encodeAsIso8601
  unRep :: ASCII -> Maybe ZonedTime
unRep = ASCII -> Maybe ZonedTime
forall t. ISO8601 t => ASCII -> Maybe t
decodeFromISO8601

instance JwtRep ASCII LocalTime where
  rep :: LocalTime -> ASCII
rep   = LocalTime -> ASCII
forall t. ISO8601 t => t -> ASCII
encodeAsIso8601
  unRep :: ASCII -> Maybe LocalTime
unRep = ASCII -> Maybe LocalTime
forall t. ISO8601 t => ASCII -> Maybe t
decodeFromISO8601

instance JwtRep ASCII Day where
  rep :: Day -> ASCII
rep   = Day -> ASCII
forall t. ISO8601 t => t -> ASCII
encodeAsIso8601
  unRep :: ASCII -> Maybe Day
unRep = ASCII -> Maybe Day
forall t. ISO8601 t => ASCII -> Maybe t
decodeFromISO8601

instance JwtRep ByteString Text where
  rep :: Text -> ByteString
rep   = Text -> ByteString
Text.encodeUtf8
  unRep :: ByteString -> Maybe Text
unRep = Either UnicodeException Text -> Maybe Text
forall a b. Either a b -> Maybe b
eitherToMaybe (Either UnicodeException Text -> Maybe Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
Text.decodeUtf8'

instance JwtRep [a] (NonEmpty a) where
  rep :: NonEmpty a -> [a]
rep   = NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NEL.toList
  unRep :: [a] -> Maybe (NonEmpty a)
unRep = [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty

instance AFlag a => JwtRep ASCII (Flag a) where
  rep :: Flag a -> ASCII
rep   = Flag a -> ASCII
forall a. AFlag a => a -> ASCII
getFlagValue
  unRep :: ASCII -> Maybe (Flag a)
unRep = ASCII -> Maybe (Flag a)
forall a. AFlag a => ASCII -> Maybe a
setFlagValue

-- | Types that can be converted to a valid JSON representation
--
--   This typeclass will be used to encode a list of @t@ values (or a list of tuples whose element is of type @t@)
class JsonBuilder t where
  -- | Encode as JSON.
  -- 
  --   Must generate a valid JSON value: take care of quoting, escaping, UTF-8 encoding etc.
  jsonBuilder :: t -> Builder

  default jsonBuilder :: (JwtRep a t, JsonBuilder a) => t -> Builder
  jsonBuilder = a -> Builder
forall t. JsonBuilder t => t -> Builder
jsonBuilder (a -> Builder) -> (t -> a) -> t -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> a
forall a b. JwtRep a b => b -> a
rep

instance JsonBuilder ByteString where
  jsonBuilder :: ByteString -> Builder
jsonBuilder = (BoundedPrim Word8 -> ByteString -> Builder)
-> ByteString -> Builder
forall a. (BoundedPrim Word8 -> a -> Builder) -> a -> Builder
optimizedEscapeWords BoundedPrim Word8 -> ByteString -> Builder
E.primMapByteStringBounded

instance JsonBuilder Bool where
  jsonBuilder :: Bool -> Builder
jsonBuilder Bool
True  = Builder
"true"
  jsonBuilder Bool
False = Builder
"false"

instance JsonBuilder Int where
  jsonBuilder :: Int -> Builder
jsonBuilder = Int -> Builder
intDec

instance JsonBuilder NumericDate where
  jsonBuilder :: NumericDate -> Builder
jsonBuilder = Int64 -> Builder
int64Dec (Int64 -> Builder)
-> (NumericDate -> Int64) -> NumericDate -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumericDate -> Int64
coerce

instance {-# OVERLAPPING #-} JsonBuilder String where
  jsonBuilder :: String -> Builder
jsonBuilder = BoundedPrim Char -> String -> Builder
optimizedEscapeString BoundedPrim Char
E.charUtf8

instance JsonBuilder ASCII where
  jsonBuilder :: ASCII -> Builder
jsonBuilder = BoundedPrim Char -> String -> Builder
optimizedEscapeString (FixedPrim Char -> BoundedPrim Char
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded FixedPrim Char
E.char7) (String -> Builder) -> (ASCII -> String) -> ASCII -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII -> String
getASCII

instance JsonBuilder Text where
  jsonBuilder :: Text -> Builder
jsonBuilder = (BoundedPrim Word8 -> Text -> Builder) -> Text -> Builder
forall a. (BoundedPrim Word8 -> a -> Builder) -> a -> Builder
optimizedEscapeWords BoundedPrim Word8 -> Text -> Builder
Text.encodeUtf8BuilderEscaped

instance JsonBuilder UUID where
  jsonBuilder :: UUID -> Builder
jsonBuilder = Builder -> Builder
quoteString (Builder -> Builder) -> (UUID -> Builder) -> UUID -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
byteString (ByteString -> Builder) -> (UUID -> ByteString) -> UUID -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> ByteString
UUID.toASCIIBytes

iso8601Builder :: (ISO8601 t) => t -> Builder
iso8601Builder :: t -> Builder
iso8601Builder = Builder -> Builder
quoteString (Builder -> Builder) -> (t -> Builder) -> t -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
string7 (String -> Builder) -> (t -> String) -> t -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> String
forall t. ISO8601 t => t -> String
iso8601Show

instance JsonBuilder UTCTime where
  jsonBuilder :: UTCTime -> Builder
jsonBuilder = UTCTime -> Builder
forall t. ISO8601 t => t -> Builder
iso8601Builder

instance JsonBuilder LocalTime where
  jsonBuilder :: LocalTime -> Builder
jsonBuilder = LocalTime -> Builder
forall t. ISO8601 t => t -> Builder
iso8601Builder

instance JsonBuilder ZonedTime where
  jsonBuilder :: ZonedTime -> Builder
jsonBuilder = ZonedTime -> Builder
forall t. ISO8601 t => t -> Builder
iso8601Builder

instance JsonBuilder Day where
  jsonBuilder :: Day -> Builder
jsonBuilder = Day -> Builder
forall t. ISO8601 t => t -> Builder
iso8601Builder

instance AFlag a => JsonBuilder (Flag a) where
  jsonBuilder :: Flag a -> Builder
jsonBuilder = Builder -> Builder
quoteString (Builder -> Builder) -> (Flag a -> Builder) -> Flag a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
string7 (String -> Builder) -> (Flag a -> String) -> Flag a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII -> String
getASCII (ASCII -> String) -> (Flag a -> ASCII) -> Flag a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag a -> ASCII
forall a. AFlag a => a -> ASCII
getFlagValue

instance JsonBuilder JsonByteString where
  jsonBuilder :: JsonByteString -> Builder
jsonBuilder = JsonByteString -> Builder
toJsonBuilder

instance JsonBuilder a => JsonBuilder [a] where
  jsonBuilder :: [a] -> Builder
jsonBuilder = [a] -> Builder
forall a. JsonBuilder a => [a] -> Builder
encodeArray

instance JsonBuilder a => JsonBuilder (Maybe a) where
  jsonBuilder :: Maybe a -> Builder
jsonBuilder Maybe a
Nothing  = Builder
"null"
  jsonBuilder (Just a
a) = a -> Builder
forall t. JsonBuilder t => t -> Builder
jsonBuilder a
a

instance (JsonBuilder a, JsonBuilder b) => JsonBuilder (a, b) where
  jsonBuilder :: (a, b) -> Builder
jsonBuilder (a
a, b
b) =
    Builder -> Builder
arrayBrackets (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ a -> Builder
forall t. JsonBuilder t => t -> Builder
jsonBuilder a
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
',' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> b -> Builder
forall t. JsonBuilder t => t -> Builder
jsonBuilder b
b

encodeArray :: JsonBuilder a => [a] -> Builder
encodeArray :: [a] -> Builder
encodeArray =
  Builder -> Builder
arrayBrackets (Builder -> Builder) -> ([a] -> Builder) -> [a] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> ([a] -> [Builder]) -> [a] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Char -> Builder
char7 Char
',') ([Builder] -> [Builder]) -> ([a] -> [Builder]) -> [a] -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Builder) -> [a] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map a -> Builder
forall t. JsonBuilder t => t -> Builder
jsonBuilder

arrayBrackets :: Builder -> Builder
arrayBrackets :: Builder -> Builder
arrayBrackets Builder
bs = Char -> Builder
char7 Char
'[' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
bs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
']'

quoteString :: Builder -> Builder
quoteString :: Builder -> Builder
quoteString Builder
bs = Char -> Builder
char7 Char
'"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
bs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'"'

optimizedEscapeWords :: (E.BoundedPrim Word8 -> a -> Builder) -> a -> Builder
optimizedEscapeWords :: (BoundedPrim Word8 -> a -> Builder) -> a -> Builder
optimizedEscapeWords BoundedPrim Word8 -> a -> Builder
f = Builder -> Builder
quoteString (Builder -> Builder) -> (a -> Builder) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Word8 -> a -> Builder
f
  (   (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
92) ((Char, Char) -> BoundedPrim Word8
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'\\'))
  (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$   (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
34) ((Char, Char) -> BoundedPrim Word8
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'"'))
  (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$   (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
32) (FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded FixedPrim Word8
E.word8)
  (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$   (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
13) ((Char, Char) -> BoundedPrim Word8
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'r'))
  (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$   (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
12) ((Char, Char) -> BoundedPrim Word8
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'f'))
  (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$   (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
10) ((Char, Char) -> BoundedPrim Word8
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'n'))
  (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$   (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
9)  ((Char, Char) -> BoundedPrim Word8
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
't'))
  (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$   (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
8)  ((Char, Char) -> BoundedPrim Word8
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'b'))
  (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$   FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded
  (FixedPrim Word8 -> BoundedPrim Word8)
-> FixedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$   Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  (Word8 -> Word16) -> FixedPrim Word16 -> FixedPrim Word8
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word16
uEscape
  )

optimizedEscapeString :: E.BoundedPrim Char -> String -> Builder
optimizedEscapeString :: BoundedPrim Char -> String -> Builder
optimizedEscapeString BoundedPrim Char
enc = Builder -> Builder
quoteString (Builder -> Builder) -> (String -> Builder) -> String -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Char -> String -> Builder
forall a. BoundedPrim a -> [a] -> Builder
E.primMapListBounded BoundedPrim Char
escape
 where
  escape :: BoundedPrim Char
escape =
    (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\') ((Char, Char) -> BoundedPrim Char
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'\\'))
      (BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$   (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"')  ((Char, Char) -> BoundedPrim Char
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'"'))
      (BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$   (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
' ')  BoundedPrim Char
enc
      (BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$   (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r') ((Char, Char) -> BoundedPrim Char
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'r'))
      (BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$   (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\f') ((Char, Char) -> BoundedPrim Char
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'f'))
      (BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$   (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') ((Char, Char) -> BoundedPrim Char
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'n'))
      (BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$   (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t') ((Char, Char) -> BoundedPrim Char
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
't'))
      (BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$   (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\b') ((Char, Char) -> BoundedPrim Char
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'b'))
      (BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$   FixedPrim Char -> BoundedPrim Char
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded
      (FixedPrim Char -> BoundedPrim Char)
-> FixedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$   (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> (Char -> Int) -> Char -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord)
      (Char -> Word16) -> FixedPrim Word16 -> FixedPrim Char
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word16
uEscape

-- | Types that can be converted from JSON representation
--
--   This typeclass will be used to decode a list of @a@ values (or a list of tuples whose element is of type @a@)
class JsonParser a where
  -- | Decode from JSON token.
  jsonParser :: JsonToken -> Maybe a

  default jsonParser :: (JwtRep t a, JsonParser t) => JsonToken -> Maybe a
  jsonParser = t -> Maybe a
forall a b. JwtRep a b => a -> Maybe b
unRep (t -> Maybe a) -> (JsonToken -> Maybe t) -> JsonToken -> Maybe a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JsonToken -> Maybe t
forall a. JsonParser a => JsonToken -> Maybe a
jsonParser

instance JsonParser ByteString where
  jsonParser :: JsonToken -> Maybe ByteString
jsonParser (JsStr ByteString
bs) = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall a. (ByteString -> a) -> (ByteString -> a) -> ByteString -> a
withUnescapedString ByteString -> ByteString
Lazy.toStrict ByteString -> ByteString
forall a. a -> a
id ByteString
bs
  jsonParser JsonToken
_          = Maybe ByteString
forall a. Maybe a
Nothing

instance JsonParser Bool where
  jsonParser :: JsonToken -> Maybe Bool
jsonParser JsonToken
JsTrue  = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
  jsonParser JsonToken
JsFalse = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
  jsonParser JsonToken
_       = Maybe Bool
forall a. Maybe a
Nothing

instance JsonParser Int where
  jsonParser :: JsonToken -> Maybe Int
jsonParser (JsNum ByteString
bs) = do
    (Int
int, ByteString
remainder) <- ByteString -> Maybe (Int, ByteString)
Char8.readInt ByteString
bs
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
Char8.null ByteString
remainder
    Int -> Maybe Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
int
  jsonParser JsonToken
_ = Maybe Int
forall a. Maybe a
Nothing

instance {-# OVERLAPPING #-} JsonParser String where
  jsonParser :: JsonToken -> Maybe String
jsonParser (JsStr ByteString
bs) =
    String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ (ByteString -> String)
-> (ByteString -> String) -> ByteString -> String
forall a. (ByteString -> a) -> (ByteString -> a) -> ByteString -> a
withUnescapedString ByteString -> String
LazyUTF8.toString ByteString -> String
UTF8.toString ByteString
bs
  jsonParser JsonToken
_ = Maybe String
forall a. Maybe a
Nothing

instance JsonParser ASCII where
  jsonParser :: JsonToken -> Maybe ASCII
jsonParser (JsStr ByteString
bs) =
    ASCII -> Maybe ASCII
forall a. a -> Maybe a
Just (ASCII -> Maybe ASCII) -> ASCII -> Maybe ASCII
forall a b. (a -> b) -> a -> b
$ String -> ASCII
coerce (String -> ASCII) -> String -> ASCII
forall a b. (a -> b) -> a -> b
$ (ByteString -> String)
-> (ByteString -> String) -> ByteString -> String
forall a. (ByteString -> a) -> (ByteString -> a) -> ByteString -> a
withUnescapedString ByteString -> String
Lazy8.unpack ByteString -> String
Char8.unpack ByteString
bs
  jsonParser JsonToken
_ = Maybe ASCII
forall a. Maybe a
Nothing

instance JsonParser Text where
  jsonParser :: JsonToken -> Maybe Text
jsonParser (JsStr ByteString
bs) = Either UnicodeException Text -> Maybe Text
forall a b. Either a b -> Maybe b
eitherToMaybe (Either UnicodeException Text -> Maybe Text)
-> Either UnicodeException Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (ByteString -> Either UnicodeException Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Either UnicodeException Text
forall a. (ByteString -> a) -> (ByteString -> a) -> ByteString -> a
withUnescapedString
    ((Text -> Text)
-> Either UnicodeException Text -> Either UnicodeException Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
toStrict (Either UnicodeException Text -> Either UnicodeException Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
LazyText.decodeUtf8')
    ByteString -> Either UnicodeException Text
Text.decodeUtf8'
    ByteString
bs
  jsonParser JsonToken
_ = Maybe Text
forall a. Maybe a
Nothing

instance JsonParser NumericDate where
  jsonParser :: JsonToken -> Maybe NumericDate
jsonParser (JsNum ByteString
bs) = do
    (Integer
int, ByteString
remainder) <- ByteString -> Maybe (Integer, ByteString)
Char8.readInteger ByteString
bs
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
Char8.null ByteString
remainder
    NumericDate -> Maybe NumericDate
forall (m :: * -> *) a. Monad m => a -> m a
return (NumericDate -> Maybe NumericDate)
-> NumericDate -> Maybe NumericDate
forall a b. (a -> b) -> a -> b
$ Int64 -> NumericDate
NumericDate (Int64 -> NumericDate) -> Int64 -> NumericDate
forall a b. (a -> b) -> a -> b
$ Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
int
  jsonParser JsonToken
_ = Maybe NumericDate
forall a. Maybe a
Nothing

instance JsonParser UUID where
  jsonParser :: JsonToken -> Maybe UUID
jsonParser (JsStr ByteString
bs) = ByteString -> Maybe UUID
UUID.fromASCIIBytes ByteString
bs
  jsonParser JsonToken
_          = Maybe UUID
forall a. Maybe a
Nothing

iso8601Parser :: ISO8601 t => JsonToken -> Maybe t
iso8601Parser :: JsonToken -> Maybe t
iso8601Parser (JsStr ByteString
bs) = String -> Maybe t
forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
iso8601ParseM (String -> Maybe t) -> String -> Maybe t
forall a b. (a -> b) -> a -> b
$ ByteString -> String
Char8.unpack ByteString
bs
iso8601Parser JsonToken
_          = Maybe t
forall a. Maybe a
Nothing

instance JsonParser UTCTime where
  jsonParser :: JsonToken -> Maybe UTCTime
jsonParser = JsonToken -> Maybe UTCTime
forall t. ISO8601 t => JsonToken -> Maybe t
iso8601Parser

instance JsonParser LocalTime where
  jsonParser :: JsonToken -> Maybe LocalTime
jsonParser = JsonToken -> Maybe LocalTime
forall t. ISO8601 t => JsonToken -> Maybe t
iso8601Parser

instance JsonParser ZonedTime where
  jsonParser :: JsonToken -> Maybe ZonedTime
jsonParser = JsonToken -> Maybe ZonedTime
forall t. ISO8601 t => JsonToken -> Maybe t
iso8601Parser

instance JsonParser Day where
  jsonParser :: JsonToken -> Maybe Day
jsonParser = JsonToken -> Maybe Day
forall t. ISO8601 t => JsonToken -> Maybe t
iso8601Parser

instance AFlag a => JsonParser (Flag a) where
  jsonParser :: JsonToken -> Maybe (Flag a)
jsonParser (JsStr ByteString
bs) = ASCII -> Maybe (Flag a)
forall a. AFlag a => ASCII -> Maybe a
setFlagValue (ASCII -> Maybe (Flag a)) -> ASCII -> Maybe (Flag a)
forall a b. (a -> b) -> a -> b
$ String -> ASCII
ASCII (String -> ASCII) -> String -> ASCII
forall a b. (a -> b) -> a -> b
$ ByteString -> String
Char8.unpack ByteString
bs
  jsonParser JsonToken
_          = Maybe (Flag a)
forall a. Maybe a
Nothing

instance JsonParser JsonByteString where
  jsonParser :: JsonToken -> Maybe JsonByteString
jsonParser (JsBlob ByteString
bs) = JsonByteString -> Maybe JsonByteString
forall a. a -> Maybe a
Just (JsonByteString -> Maybe JsonByteString)
-> JsonByteString -> Maybe JsonByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> JsonByteString
jsonFromStrict ByteString
bs
  jsonParser JsonToken
_           = Maybe JsonByteString
forall a. Maybe a
Nothing

instance JsonParser a => JsonParser [a] where
  jsonParser :: JsonToken -> Maybe [a]
jsonParser (JsArray [JsonToken]
as) = (JsonToken -> Maybe a) -> [JsonToken] -> Maybe [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse JsonToken -> Maybe a
forall a. JsonParser a => JsonToken -> Maybe a
jsonParser [JsonToken]
as
  jsonParser JsonToken
_            = Maybe [a]
forall a. Maybe a
Nothing

instance JsonParser a => JsonParser (Maybe a) where
  jsonParser :: JsonToken -> Maybe (Maybe a)
jsonParser JsonToken
JsNull = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing
  jsonParser JsonToken
a'     = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Maybe a -> Maybe (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JsonToken -> Maybe a
forall a. JsonParser a => JsonToken -> Maybe a
jsonParser JsonToken
a'

instance (JsonParser a, JsonParser b) => JsonParser (a, b) where
  jsonParser :: JsonToken -> Maybe (a, b)
jsonParser (JsArray [JsonToken
a', JsonToken
b']) = Maybe a -> Maybe b -> Maybe (a, b)
forall (m :: * -> *) a b. MonadZip m => m a -> m b -> m (a, b)
mzip (JsonToken -> Maybe a
forall a. JsonParser a => JsonToken -> Maybe a
jsonParser JsonToken
a') (JsonToken -> Maybe b
forall a. JsonParser a => JsonToken -> Maybe a
jsonParser JsonToken
b')
  jsonParser JsonToken
_                  = Maybe (a, b)
forall a. Maybe a
Nothing

withUnescapedString
  :: (Lazy.ByteString -> a) -> (ByteString -> a) -> ByteString -> a
withUnescapedString :: (ByteString -> a) -> (ByteString -> a) -> ByteString -> a
withUnescapedString ByteString -> a
lazy ByteString -> a
strict ByteString
bs = case (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
Word8.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
92) ByteString
bs of
  (ByteString
x, ByteString
y)
    | ByteString -> Bool
Word8.null ByteString
y -> ByteString -> a
strict ByteString
x
    | Bool
otherwise -> ByteString -> a
lazy
    (ByteString -> a) -> ByteString -> a
forall a b. (a -> b) -> a -> b
$ AllocationStrategy -> ByteString -> Builder -> ByteString
toLazyByteStringWith AllocationStrategy
allocationStrategy ByteString
forall a. Monoid a => a
mempty (ByteString -> Builder
byteString ByteString
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
go0 ByteString
y)
 where
  go0 :: ByteString -> Builder
go0 ByteString
ws = case Maybe (Word8, ByteString) -> (Word8, ByteString)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Word8, ByteString) -> (Word8, ByteString))
-> Maybe (Word8, ByteString) -> (Word8, ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe (Word8, ByteString)
Word8.uncons ByteString
rest of
    (Word8
h, ByteString
tl)
      | Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
117
      -> let (ByteString
hex, ByteString
tl') = Int -> ByteString -> (ByteString, ByteString)
Word8.splitAt Int
4 ByteString
tl
         in  Char -> Builder
charUtf8 (Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
hexValue ByteString
hex) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
builder ByteString
tl'
      | Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
116
      -> Char -> Builder
char7 Char
'\t' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
builder ByteString
tl
      | Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
114
      -> Char -> Builder
char7 Char
'\r' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
builder ByteString
tl
      | Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
110
      -> Char -> Builder
char7 Char
'\n' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
builder ByteString
tl
      | Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
102
      -> Char -> Builder
char7 Char
'\f' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
builder ByteString
tl
      | Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
98
      -> Char -> Builder
char7 Char
'\b' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
builder ByteString
tl
      | Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
92
      -> Char -> Builder
char7 Char
'\\' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
builder ByteString
tl
      | Bool
otherwise
      -> ByteString -> Builder
go1 ByteString
rest
   where
    rest :: ByteString
rest = ByteString -> ByteString
Word8.tail ByteString
ws
    builder :: ByteString -> Builder
builder ByteString
b = case ByteString -> Maybe (Word8, ByteString)
Word8.uncons ByteString
b of
      Maybe (Word8, ByteString)
Nothing -> Builder
forall a. Monoid a => a
mempty
      Just (Word8
h, ByteString
_) | Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
92   -> ByteString -> Builder
go0 ByteString
b
                  | Bool
otherwise -> ByteString -> Builder
go1 ByteString
b

  go1 :: ByteString -> Builder
go1 ByteString
ws = case (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
Word8.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
92) ByteString
ws of
    (ByteString
x, ByteString
y) | ByteString -> Bool
Word8.null ByteString
y -> ByteString -> Builder
byteString ByteString
x
           | Bool
otherwise    -> ByteString -> Builder
byteString ByteString
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
go0 ByteString
y

  allocationStrategy :: AllocationStrategy
allocationStrategy =
    let initialLength :: Int
initialLength = ByteString -> Int
Word8.length ByteString
bs
        wanted :: Int
wanted        = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
32 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int
initialLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
    in  Int -> Int -> AllocationStrategy
safeStrategy Int
wanted Int
wanted

  hexValue :: ByteString -> Int
hexValue = (Int -> Char -> Int) -> Int -> ByteString -> Int
forall a. (a -> Char -> a) -> a -> ByteString -> a
Char8.foldl' (\Int
val Char
c -> Int
val Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
c) Int
0

fixed2 :: (Char, Char) -> E.BoundedPrim b
fixed2 :: (Char, Char) -> BoundedPrim b
fixed2 (Char, Char)
repl = FixedPrim b -> BoundedPrim b
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded (FixedPrim b -> BoundedPrim b) -> FixedPrim b -> BoundedPrim b
forall a b. (a -> b) -> a -> b
$ (Char, Char) -> b -> (Char, Char)
forall a b. a -> b -> a
const (Char, Char)
repl (b -> (Char, Char)) -> FixedPrim (Char, Char) -> FixedPrim b
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Char
E.char7 FixedPrim Char -> FixedPrim Char -> FixedPrim (Char, Char)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
E.char7
{-# INLINE fixed2 #-}

uEscape :: E.FixedPrim Word16
uEscape :: FixedPrim Word16
uEscape = ((Char
'\\', Char
'u'), ) (Word16 -> ((Char, Char), Word16))
-> FixedPrim ((Char, Char), Word16) -> FixedPrim Word16
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (FixedPrim Char
E.char7 FixedPrim Char -> FixedPrim Char -> FixedPrim (Char, Char)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
E.char7) FixedPrim (Char, Char)
-> FixedPrim Word16 -> FixedPrim ((Char, Char), Word16)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Word16
E.word16HexFixed
{-# INLINE uEscape #-}