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

module Argo.Pointer.Token where

import qualified Argo.Decoder as Decoder
import qualified Argo.Encoder as Encoder
import qualified Argo.Literal as Literal
import qualified Argo.Vendor.Builder as Builder
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.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)

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
    Text
y <- case ByteString -> Either UnicodeException Text
Text.decodeUtf8' ByteString
x of
        Left UnicodeException
e -> String -> Decoder Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder Text) -> String -> Decoder Text
forall a b. (a -> b) -> a -> b
$ UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
e
        Right Text
y -> Text -> Decoder Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
y
    case Text -> Maybe Text
unescapeText Text
y of
        Maybe Text
Nothing -> String -> Decoder Token
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid escape"
        Just 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

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

unescapeString :: String -> Maybe String
unescapeString :: String -> Maybe String
unescapeString String
xs = case String
xs of
    String
"" -> String -> Maybe String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
xs
    Char
x : String
ys -> case Char
x of
        Char
'~' -> case String
ys of
            Char
'0' : String
zs -> (Char
'~' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe String
unescapeString String
zs
            Char
'1' : String
zs -> (Char
'/' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe String
unescapeString String
zs
            String
_ -> String -> Maybe String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid escape"
        Char
_ -> (Char
x Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe String
unescapeString String
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