{-# LANGUAGE DeriveLift #-}

module Argo.Internal.Json.String where

import qualified Argo.Internal.Literal as Literal
import qualified Argo.Internal.Type.Decoder as Decoder
import qualified Argo.Internal.Type.Encoder as Encoder
import qualified Argo.Vendor.Builder as Builder
import qualified Argo.Vendor.ByteString as ByteString
import qualified Argo.Vendor.DeepSeq as DeepSeq
import qualified Argo.Vendor.TemplateHaskell as TH
import qualified Argo.Vendor.Text as Text
import qualified Argo.Vendor.Transformers as Trans
import qualified Control.Monad as Monad
import qualified Data.Char as Char
import qualified Data.String as String
import qualified Data.Word as Word

newtype String
    = String Text.Text
    deriving (String -> String -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: String -> String -> Bool
$c/= :: String -> String -> Bool
== :: String -> String -> Bool
$c== :: String -> String -> Bool
Eq, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => String -> m Exp
forall (m :: * -> *). Quote m => String -> Code m String
liftTyped :: forall (m :: * -> *). Quote m => String -> Code m String
$cliftTyped :: forall (m :: * -> *). Quote m => String -> Code m String
lift :: forall (m :: * -> *). Quote m => String -> m Exp
$clift :: forall (m :: * -> *). Quote m => String -> m Exp
TH.Lift, Eq String
String -> String -> Bool
String -> String -> Ordering
String -> String -> String
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: String -> String -> String
$cmin :: String -> String -> String
max :: String -> String -> String
$cmax :: String -> String -> String
>= :: String -> String -> Bool
$c>= :: String -> String -> Bool
> :: String -> String -> Bool
$c> :: String -> String -> Bool
<= :: String -> String -> Bool
$c<= :: String -> String -> Bool
< :: String -> String -> Bool
$c< :: String -> String -> Bool
compare :: String -> String -> Ordering
$ccompare :: String -> String -> Ordering
Ord, Int -> String -> ShowS
[String] -> ShowS
String -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [String] -> ShowS
$cshowList :: [String] -> ShowS
show :: String -> String
$cshow :: String -> String
showsPrec :: Int -> String -> ShowS
$cshowsPrec :: Int -> String -> ShowS
Show)

instance DeepSeq.NFData Argo.Internal.Json.String.String where
    rnf :: String -> ()
rnf = forall a. NFData a => a -> ()
DeepSeq.rnf forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
toText

instance String.IsString Argo.Internal.Json.String.String where
    fromString :: String -> String
fromString = Text -> String
fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
String.fromString

fromText :: Text.Text -> Argo.Internal.Json.String.String
fromText :: Text -> String
fromText = Text -> String
String

toText :: Argo.Internal.Json.String.String -> Text.Text
toText :: String -> Text
toText (String Text
x) = Text
x

encode :: Argo.Internal.Json.String.String -> Encoder.Encoder ()
encode :: String -> Encoder ()
encode String
x =
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Trans.tell
        forall a b. (a -> b) -> a -> b
$ Word8 -> Builder
Builder.word8 Word8
Literal.quotationMark
        forall a. Semigroup a => a -> a -> a
<> BoundedPrim Word8 -> Text -> Builder
Text.encodeUtf8BuilderEscaped BoundedPrim Word8
encodeChar (String -> Text
toText String
x)
        forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
Builder.word8 Word8
Literal.quotationMark

encodeChar :: Builder.BoundedPrim Word.Word8
encodeChar :: BoundedPrim Word8
encodeChar =
    forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
Builder.condB
            (forall a. Eq a => a -> a -> Bool
== Word8
Literal.quotationMark)
            (forall a. Word8 -> BoundedPrim a
encodeShortEscape Word8
Literal.quotationMark)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
Builder.condB
              (forall a. Eq a => a -> a -> Bool
== Word8
Literal.reverseSolidus)
              (forall a. Word8 -> BoundedPrim a
encodeShortEscape Word8
Literal.reverseSolidus)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
Builder.condB
              (forall a. Eq a => a -> a -> Bool
== Word8
Literal.backspace)
              (forall a. Word8 -> BoundedPrim a
encodeShortEscape Word8
Literal.latinSmallLetterB)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
Builder.condB
              (forall a. Eq a => a -> a -> Bool
== Word8
Literal.formFeed)
              (forall a. Word8 -> BoundedPrim a
encodeShortEscape Word8
Literal.latinSmallLetterF)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
Builder.condB
              (forall a. Eq a => a -> a -> Bool
== Word8
Literal.newLine)
              (forall a. Word8 -> BoundedPrim a
encodeShortEscape Word8
Literal.latinSmallLetterN)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
Builder.condB
              (forall a. Eq a => a -> a -> Bool
== Word8
Literal.carriageReturn)
              (forall a. Word8 -> BoundedPrim a
encodeShortEscape Word8
Literal.latinSmallLetterR)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
Builder.condB
              (forall a. Eq a => a -> a -> Bool
== Word8
Literal.horizontalTabulation)
              (forall a. Word8 -> BoundedPrim a
encodeShortEscape Word8
Literal.latinSmallLetterT)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
Builder.condB (forall a. Ord a => a -> a -> Bool
< Word8
Literal.space) BoundedPrim Word8
encodeLongEscape
        forall a b. (a -> b) -> a -> b
$ forall a. FixedPrim a -> BoundedPrim a
Builder.liftFixedToBounded FixedPrim Word8
Builder.word8F

encodeShortEscape :: Word.Word8 -> Builder.BoundedPrim a
encodeShortEscape :: forall a. Word8 -> BoundedPrim a
encodeShortEscape Word8
x =
    forall a. FixedPrim a -> BoundedPrim a
Builder.liftFixedToBounded
        forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (Word8
Literal.reverseSolidus, Word8
x)
        forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
Builder.>$< FixedPrim Word8
Builder.word8F
        forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
Builder.>*< FixedPrim Word8
Builder.word8F

encodeLongEscape :: Builder.BoundedPrim Word.Word8
encodeLongEscape :: BoundedPrim Word8
encodeLongEscape =
    forall a. FixedPrim a -> BoundedPrim a
Builder.liftFixedToBounded
        forall a b. (a -> b) -> a -> b
$ (\Word8
x ->
              ( Word8
Literal.reverseSolidus
              , (Word8
Literal.latinSmallLetterU, Word8 -> Word16
word8ToWord16 Word8
x)
              )
          )
        forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
Builder.>$< FixedPrim Word8
Builder.word8F
        forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
Builder.>*< FixedPrim Word8
Builder.word8F
        forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
Builder.>*< FixedPrim Word16
Builder.word16HexFixed

word8ToWord16 :: Word.Word8 -> Word.Word16
word8ToWord16 :: Word8 -> Word16
word8ToWord16 = forall a b. (Integral a, Num b) => a -> b
fromIntegral

decode :: Decoder.Decoder Argo.Internal.Json.String.String
decode :: Decoder String
decode = do
    Word8 -> Decoder ()
Decoder.word8 Word8
Literal.quotationMark
    ByteString
b1 <- forall (m :: * -> *) s. Monad m => StateT s m s
Trans.get
    Int
i <- case ByteString -> Int -> Maybe Int
getClose ByteString
b1 Int
0 of
        Maybe Int
Nothing -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE String
"unterminated string"
        Just Int
i -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
    let (ByteString
xs, ByteString
b2) = Int -> ByteString -> (ByteString, ByteString)
ByteString.splitAt Int
i ByteString
b1
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when ((Word8 -> Bool) -> ByteString -> Bool
ByteString.any (forall a. Ord a => a -> a -> Bool
< Word8
Literal.space) ByteString
xs)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift
        forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE String
"unescaped control character"
    forall (m :: * -> *) s. Monad m => s -> StateT s m ()
Trans.put ByteString
b2
    Word8 -> Decoder ()
Decoder.word8 Word8
Literal.quotationMark
    Decoder ()
Decoder.spaces
    case ByteString -> Either UnicodeException Text
Text.decodeUtf8' ByteString
xs of
        Left UnicodeException
e -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show UnicodeException
e
        Right Text
x -> case Text -> Either String Text
unescapeText Text
x of
            Left String
e -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE String
e
            Right Text
y -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> String
fromText Text
y

findAt :: Word.Word8 -> Int -> ByteString.ByteString -> Maybe Int
findAt :: Word8 -> Int -> ByteString -> Maybe Int
findAt Word8
x Int
i = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
+ Int
i) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> Maybe Int
ByteString.elemIndex Word8
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
ByteString.drop Int
i

countConsecutive :: Word.Word8 -> Int -> ByteString.ByteString -> Int
countConsecutive :: Word8 -> Int -> ByteString -> Int
countConsecutive Word8
x Int
i =
    ByteString -> Int
ByteString.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
ByteString.takeWhileEnd (forall a. Eq a => a -> a -> Bool
== Word8
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
ByteString.take Int
i

getClose :: ByteString.ByteString -> Int -> Maybe Int
getClose :: ByteString -> Int -> Maybe Int
getClose ByteString
b Int
i = do
    Int
j <- Word8 -> Int -> ByteString -> Maybe Int
findAt Word8
Literal.quotationMark Int
i ByteString
b
    let n :: Int
n = Word8 -> Int -> ByteString -> Int
countConsecutive Word8
Literal.reverseSolidus Int
j ByteString
b
    if forall a. Integral a => a -> Bool
even Int
n then forall a. a -> Maybe a
Just Int
j else ByteString -> Int -> Maybe Int
getClose ByteString
b forall a b. (a -> b) -> a -> b
$ Int
j forall a. Num a => a -> a -> a
+ Int
1

unescapeText :: Text.Text -> Either Prelude.String Text.Text
unescapeText :: Text -> Either String Text
unescapeText =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
combineSurrogatePairs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String String
unescapeString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

combineSurrogatePairs :: Prelude.String -> Prelude.String
combineSurrogatePairs :: ShowS
combineSurrogatePairs String
xs = case String
xs of
    String
"" -> String
xs
    Char
x : Char
y : String
zs | Char -> Bool
isHighSurrogate Char
x Bool -> Bool -> Bool
&& Char -> Bool
isLowSurrogate Char
y ->
        Char -> Char -> Char
combineSurrogatePair Char
x Char
y forall a. a -> [a] -> [a]
: ShowS
combineSurrogatePairs String
zs
    Char
x : String
ys -> Char
x forall a. a -> [a] -> [a]
: ShowS
combineSurrogatePairs String
ys

combineSurrogatePair :: Char -> Char -> Char
combineSurrogatePair :: Char -> Char -> Char
combineSurrogatePair Char
hi Char
lo =
    Int -> Char
Char.chr
        forall a b. (a -> b) -> a -> b
$ Int
0x10000
        forall a. Num a => a -> a -> a
+ ((Char -> Int
Char.ord Char
hi forall a. Num a => a -> a -> a
- Int
0xd800) forall a. Num a => a -> a -> a
* Int
0x400)
        forall a. Num a => a -> a -> a
+ (Char -> Int
Char.ord Char
lo forall a. Num a => a -> a -> a
- Int
0xdc00)

isHighSurrogate :: Char -> Bool
isHighSurrogate :: Char -> Bool
isHighSurrogate Char
x = Char
'\xd800' forall a. Ord a => a -> a -> Bool
<= Char
x Bool -> Bool -> Bool
&& Char
x forall a. Ord a => a -> a -> Bool
<= Char
'\xdbff'

isLowSurrogate :: Char -> Bool
isLowSurrogate :: Char -> Bool
isLowSurrogate Char
x = Char
'\xdc00' forall a. Ord a => a -> a -> Bool
<= Char
x Bool -> Bool -> Bool
&& Char
x forall a. Ord a => a -> a -> Bool
<= Char
'\xdfff'

unescapeString :: Prelude.String -> Either Prelude.String Prelude.String
unescapeString :: String -> Either String String
unescapeString String
xs = case String
xs of
    String
"" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
xs
    Char
'\\' : String
ys -> case String
ys of
        String
"" -> forall a b. a -> Either a b
Left String
"empty escape"
        Char
x : String
zs -> case Char
x of
            Char
'"' -> (Char
'"' forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String String
unescapeString String
zs
            Char
'\\' -> (Char
'\\' forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String String
unescapeString String
zs
            Char
'/' -> (Char
'/' forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String String
unescapeString String
zs
            Char
'b' -> (Char
'\b' forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String String
unescapeString String
zs
            Char
'f' -> (Char
'\f' forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String String
unescapeString String
zs
            Char
'n' -> (Char
'\n' forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String String
unescapeString String
zs
            Char
'r' -> (Char
'\r' forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String String
unescapeString String
zs
            Char
't' -> (Char
'\t' forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String String
unescapeString String
zs
            Char
'u' -> case String
zs of
                Char
a : Char
b : Char
c : Char
d : String
es | Just Char
y <- Char -> Char -> Char -> Char -> Maybe Char
fromLongEscape Char
a Char
b Char
c Char
d ->
                    (Char
y forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String String
unescapeString String
es
                String
_ -> forall a b. a -> Either a b
Left String
"invalid long escape"
            Char
_ -> forall a b. a -> Either a b
Left String
"invalid short escape"
    Char
x : String
ys -> (Char
x forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String String
unescapeString String
ys

fromLongEscape :: Char -> Char -> Char -> Char -> Maybe Char
fromLongEscape :: Char -> Char -> Char -> Char -> Maybe Char
fromLongEscape Char
a Char
b Char
c Char
d = do
    Int
w <- Char -> Maybe Int
fromHexadecimalDigit Char
a
    Int
x <- Char -> Maybe Int
fromHexadecimalDigit Char
b
    Int
y <- Char -> Maybe Int
fromHexadecimalDigit Char
c
    Int
z <- Char -> Maybe Int
fromHexadecimalDigit Char
d
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
Char.chr forall a b. (a -> b) -> a -> b
$ (Int
0x1000 forall a. Num a => a -> a -> a
* Int
w) forall a. Num a => a -> a -> a
+ (Int
0x100 forall a. Num a => a -> a -> a
* Int
x) forall a. Num a => a -> a -> a
+ (Int
0x10 forall a. Num a => a -> a -> a
* Int
y) forall a. Num a => a -> a -> a
+ Int
z

fromHexadecimalDigit :: Char -> Maybe Int
fromHexadecimalDigit :: Char -> Maybe Int
fromHexadecimalDigit Char
x =
    if Char -> Bool
Char.isHexDigit Char
x then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> Int
Char.digitToInt Char
x else forall a. Maybe a
Nothing