{-# LANGUAGE DeriveLift #-}

module Argo.Internal.Pointer.Token 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 Data.String as String
import qualified Data.Word as Word

newtype Token
    = Token Text.Text
    deriving (Token -> Token -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> 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 => Token -> m Exp
forall (m :: * -> *). Quote m => Token -> Code m Token
liftTyped :: forall (m :: * -> *). Quote m => Token -> Code m Token
$cliftTyped :: forall (m :: * -> *). Quote m => Token -> Code m Token
lift :: forall (m :: * -> *). Quote m => Token -> m Exp
$clift :: forall (m :: * -> *). Quote m => Token -> m Exp
TH.Lift, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show)

instance DeepSeq.NFData Token where
    rnf :: Token -> ()
rnf = forall a. NFData a => a -> ()
DeepSeq.rnf forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Text
toText

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

fromText :: Text.Text -> Token
fromText :: Text -> Token
fromText = Text -> Token
Token

toText :: Token -> Text.Text
toText :: Token -> Text
toText (Token Text
x) = Text
x

decode :: Decoder.Decoder Token
decode :: Decoder Token
decode = do
    ByteString
x <- (Word8 -> Bool) -> Decoder ByteString
Decoder.takeWhile forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> a -> Bool
(/=) Word8
Literal.solidus
    ByteString
y <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (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 (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
unescape ByteString
x
    case ByteString -> Either UnicodeException Text
Text.decodeUtf8' ByteString
y 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
z -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Token
fromText Text
z

unescape :: ByteString.ByteString -> Either String ByteString.ByteString
unescape :: ByteString -> Either String ByteString
unescape = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> ByteString
ByteString.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> Either String [Word8]
unescapeHelper forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
ByteString.unpack

unescapeHelper :: [Word.Word8] -> Either String [Word.Word8]
unescapeHelper :: [Word8] -> Either String [Word8]
unescapeHelper [Word8]
xs = case [Word8]
xs of
    [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Word8]
xs
    Word8
x : [Word8]
ys -> if Word8
x forall a. Eq a => a -> a -> Bool
== Word8
Literal.tilde
        then case [Word8]
ys of
            Word8
y : [Word8]
zs
                | Word8
y forall a. Eq a => a -> a -> Bool
== Word8
Literal.digitZero
                -> (:) Word8
Literal.tilde forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word8] -> Either String [Word8]
unescapeHelper [Word8]
zs
                | Word8
y forall a. Eq a => a -> a -> Bool
== Word8
Literal.digitOne
                -> (:) Word8
Literal.solidus forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word8] -> Either String [Word8]
unescapeHelper [Word8]
zs
            [Word8]
_ -> forall a b. a -> Either a b
Left String
"invalid escape"
        else (:) Word8
x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word8] -> Either String [Word8]
unescapeHelper [Word8]
ys

encode :: Token -> Encoder.Encoder ()
encode :: Token -> Encoder ()
encode =
    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 b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Word8 -> Text -> Builder
Text.encodeUtf8BuilderEscaped BoundedPrim Word8
encodeChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Text
toText

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.tilde) (forall a. Word8 -> BoundedPrim a
encodeEscape Word8
Literal.digitZero)
        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.solidus) (forall a. Word8 -> BoundedPrim a
encodeEscape Word8
Literal.digitOne)
        forall a b. (a -> b) -> a -> b
$ forall a. FixedPrim a -> BoundedPrim a
Builder.liftFixedToBounded FixedPrim Word8
Builder.word8F

encodeEscape :: Word.Word8 -> Builder.BoundedPrim a
encodeEscape :: forall a. Word8 -> BoundedPrim a
encodeEscape 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.tilde, 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