{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}

module Argo.Pointer.Token where

import qualified Argo.Literal as Literal
import qualified Argo.Type.Decoder as Decoder
import qualified Argo.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
import qualified GHC.Generics as Generics

newtype Token
    = Token Text.Text
    deriving (Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
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 x. Token -> Rep Token x)
-> (forall x. Rep Token x -> Token) -> Generic Token
forall x. Rep Token x -> Token
forall x. Token -> Rep Token x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Token x -> Token
$cfrom :: forall x. Token -> Rep Token x
Generics.Generic, Token -> Q Exp
Token -> Q (TExp Token)
(Token -> Q Exp) -> (Token -> Q (TExp Token)) -> Lift Token
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Token -> Q (TExp Token)
$cliftTyped :: Token -> Q (TExp Token)
lift :: Token -> Q Exp
$clift :: Token -> Q Exp
TH.Lift, Token -> ()
(Token -> ()) -> NFData Token
forall a. (a -> ()) -> NFData a
rnf :: Token -> ()
$crnf :: Token -> ()
DeepSeq.NFData, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
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 String.IsString Token where
    fromString :: String -> Token
fromString = Text -> Token
fromText (Text -> Token) -> (String -> Text) -> String -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
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 ((Word8 -> Bool) -> Decoder ByteString)
-> (Word8 -> Bool) -> Decoder ByteString
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Word8
Literal.solidus
    ByteString
y <- (String -> Decoder ByteString)
-> (ByteString -> Decoder ByteString)
-> Either String ByteString
-> Decoder ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ExceptT String Identity ByteString -> Decoder ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (ExceptT String Identity ByteString -> Decoder ByteString)
-> (String -> ExceptT String Identity ByteString)
-> String
-> Decoder ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ExceptT String Identity ByteString
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE) ByteString -> Decoder ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String ByteString -> Decoder ByteString)
-> Either String ByteString -> Decoder ByteString
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 -> ExceptT String Identity Token -> Decoder Token
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (ExceptT String Identity Token -> Decoder Token)
-> (String -> ExceptT String Identity Token)
-> String
-> Decoder Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ExceptT String Identity Token
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE (String -> Decoder Token) -> String -> Decoder Token
forall a b. (a -> b) -> a -> b
$ UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
e
        Right Text
z -> Token -> Decoder Token
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Token -> Decoder Token) -> Token -> Decoder Token
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 = ([Word8] -> ByteString)
-> Either String [Word8] -> Either String ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> ByteString
ByteString.pack (Either String [Word8] -> Either String ByteString)
-> (ByteString -> Either String [Word8])
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> Either String [Word8]
unescapeHelper ([Word8] -> Either String [Word8])
-> (ByteString -> [Word8]) -> ByteString -> Either String [Word8]
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
    [] -> [Word8] -> Either String [Word8]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Word8]
xs
    Word8
x : [Word8]
ys -> if Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
Literal.tilde
        then case [Word8]
ys of
            Word8
y : [Word8]
zs
                | Word8
y Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
Literal.digitZero
                -> (:) Word8
Literal.tilde ([Word8] -> [Word8])
-> Either String [Word8] -> Either String [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word8] -> Either String [Word8]
unescapeHelper [Word8]
zs
                | Word8
y Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
Literal.digitOne
                -> (:) Word8
Literal.solidus ([Word8] -> [Word8])
-> Either String [Word8] -> Either String [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word8] -> Either String [Word8]
unescapeHelper [Word8]
zs
            [Word8]
_ -> String -> Either String [Word8]
forall a b. a -> Either a b
Left String
"invalid escape"
        else (:) Word8
x ([Word8] -> [Word8])
-> Either String [Word8] -> Either String [Word8]
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 =
    WriterT Builder Identity () -> Encoder ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (WriterT Builder Identity () -> Encoder ())
-> (Token -> WriterT Builder Identity ()) -> Token -> Encoder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> WriterT Builder Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Trans.tell (Builder -> WriterT Builder Identity ())
-> (Token -> Builder) -> Token -> WriterT Builder Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Word8 -> Text -> Builder
Text.encodeUtf8BuilderEscaped BoundedPrim Word8
encodeChar (Text -> Builder) -> (Token -> Text) -> Token -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Text
toText

encodeChar :: Builder.BoundedPrim Word.Word8
encodeChar :: BoundedPrim Word8
encodeChar =
    (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
Builder.condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
Literal.tilde) (Word8 -> BoundedPrim Word8
forall a. Word8 -> BoundedPrim a
encodeEscape Word8
Literal.digitZero)
        (BoundedPrim Word8 -> BoundedPrim Word8)
-> (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8
-> BoundedPrim Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
Builder.condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
Literal.solidus) (Word8 -> BoundedPrim Word8
forall a. Word8 -> BoundedPrim a
encodeEscape Word8
Literal.digitOne)
        (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
Builder.liftFixedToBounded FixedPrim Word8
Builder.word8F

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