{-# 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