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

module Argo.Pointer.Pointer where

import qualified Argo.Json.Array as Array
import qualified Argo.Json.Member as Member
import qualified Argo.Json.Name as Name
import qualified Argo.Json.Object as Object
import qualified Argo.Json.String as String
import qualified Argo.Json.Value as Value
import qualified Argo.Literal as Literal
import qualified Argo.Pointer.Token as Token
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.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.Applicative as Applicative
import qualified Data.List as List
import qualified GHC.Generics as Generics
import qualified Text.Read as Read

-- | A JSON pointer, as described by RFC 6901.
-- <https://datatracker.ietf.org/doc/html/rfc6901>
newtype Pointer
    = Pointer [Token.Token]
    deriving (Pointer -> Pointer -> Bool
(Pointer -> Pointer -> Bool)
-> (Pointer -> Pointer -> Bool) -> Eq Pointer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pointer -> Pointer -> Bool
$c/= :: Pointer -> Pointer -> Bool
== :: Pointer -> Pointer -> Bool
$c== :: Pointer -> Pointer -> Bool
Eq, (forall x. Pointer -> Rep Pointer x)
-> (forall x. Rep Pointer x -> Pointer) -> Generic Pointer
forall x. Rep Pointer x -> Pointer
forall x. Pointer -> Rep Pointer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Pointer x -> Pointer
$cfrom :: forall x. Pointer -> Rep Pointer x
Generics.Generic, Pointer -> Q Exp
Pointer -> Q (TExp Pointer)
(Pointer -> Q Exp) -> (Pointer -> Q (TExp Pointer)) -> Lift Pointer
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Pointer -> Q (TExp Pointer)
$cliftTyped :: Pointer -> Q (TExp Pointer)
lift :: Pointer -> Q Exp
$clift :: Pointer -> Q Exp
TH.Lift, Pointer -> ()
(Pointer -> ()) -> NFData Pointer
forall a. (a -> ()) -> NFData a
rnf :: Pointer -> ()
$crnf :: Pointer -> ()
DeepSeq.NFData, Int -> Pointer -> ShowS
[Pointer] -> ShowS
Pointer -> String
(Int -> Pointer -> ShowS)
-> (Pointer -> String) -> ([Pointer] -> ShowS) -> Show Pointer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pointer] -> ShowS
$cshowList :: [Pointer] -> ShowS
show :: Pointer -> String
$cshow :: Pointer -> String
showsPrec :: Int -> Pointer -> ShowS
$cshowsPrec :: Int -> Pointer -> ShowS
Show)

fromList :: [Token.Token] -> Pointer
fromList :: [Token] -> Pointer
fromList = [Token] -> Pointer
Pointer

toList :: Pointer -> [Token.Token]
toList :: Pointer -> [Token]
toList (Pointer [Token]
x) = [Token]
x

decode :: Decoder.Decoder Pointer
decode :: Decoder Pointer
decode = [Token] -> Pointer
fromList ([Token] -> Pointer)
-> StateT ByteString (ExceptT String Identity) [Token]
-> Decoder Pointer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT ByteString (ExceptT String Identity) Token
-> StateT ByteString (ExceptT String Identity) [Token]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
Applicative.many StateT ByteString (ExceptT String Identity) Token
decodeToken

decodeToken :: Decoder.Decoder Token.Token
decodeToken :: StateT ByteString (ExceptT String Identity) Token
decodeToken = do
    Word8 -> Decoder ()
Decoder.word8 Word8
Literal.solidus
    StateT ByteString (ExceptT String Identity) Token
Token.decode

encode :: Pointer -> Encoder.Encoder ()
encode :: Pointer -> Encoder ()
encode = (Token -> Encoder ()) -> [Token] -> Encoder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Token -> Encoder ()
encodeToken ([Token] -> Encoder ())
-> (Pointer -> [Token]) -> Pointer -> Encoder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pointer -> [Token]
toList

encodeToken :: Token.Token -> Encoder.Encoder ()
encodeToken :: Token -> Encoder ()
encodeToken Token
x = do
    WriterT Builder Identity () -> Encoder ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (WriterT Builder Identity () -> Encoder ())
-> (Builder -> WriterT Builder Identity ())
-> Builder
-> 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 -> Encoder ()) -> Builder -> Encoder ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Builder
Builder.word8 Word8
Literal.solidus
    Token -> Encoder ()
Token.encode Token
x

evaluate :: Pointer -> Value.Value -> Either String Value.Value
evaluate :: Pointer -> Value -> Either String Value
evaluate Pointer
p Value
v = case Pointer -> [Token]
toList Pointer
p of
    [] -> Value -> Either String Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
    Token
t : [Token]
ts -> do
        Value
w <- case Value
v of
            Value.Array ArrayOf Value
a -> Token -> ArrayOf Value -> Either String Value
forall value. Token -> ArrayOf value -> Either String value
atIndex Token
t ArrayOf Value
a
            Value.Object ObjectOf Value
o -> Token -> ObjectOf Value -> Either String Value
forall value. Token -> ObjectOf value -> Either String value
atKey Token
t ObjectOf Value
o
            Value
_ -> String -> Either String Value
forall a b. a -> Either a b
Left String
"not indexable"
        Pointer -> Value -> Either String Value
evaluate ([Token] -> Pointer
fromList [Token]
ts) Value
w

atIndex :: Token.Token -> Array.ArrayOf value -> Either String value
atIndex :: Token -> ArrayOf value -> Either String value
atIndex Token
t ArrayOf value
a = do
    Int
i <- Token -> Either String Int
tokenToIndex Token
t
    case Int -> [value] -> [value]
forall a. Int -> [a] -> [a]
drop Int
i ([value] -> [value]) -> [value] -> [value]
forall a b. (a -> b) -> a -> b
$ ArrayOf value -> [value]
forall value. ArrayOf value -> [value]
Array.toList ArrayOf value
a of
        [] -> String -> Either String value
forall a b. a -> Either a b
Left (String -> Either String value) -> String -> Either String value
forall a b. (a -> b) -> a -> b
$ String
"missing index: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Token -> String
forall a. Show a => a -> String
show Token
t
        value
e : [value]
_ -> value -> Either String value
forall (f :: * -> *) a. Applicative f => a -> f a
pure value
e

tokenToIndex :: Token.Token -> Either String Int
tokenToIndex :: Token -> Either String Int
tokenToIndex Token
token = do
    let text :: Text
text = Token -> Text
Token.toText Token
token
        invalid :: String
invalid = String
"invalid index: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Token -> String
forall a. Show a => a -> String
show Token
token
    case Text -> Maybe (Char, Text)
Text.uncons Text
text of
        Just (Char
'0', Text
rest) -> if Text -> Bool
Text.null Text
rest then Int -> Either String Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0 else String -> Either String Int
forall a b. a -> Either a b
Left String
invalid
        Maybe (Char, Text)
_ -> Either String Int
-> (Int -> Either String Int) -> Maybe Int -> Either String Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String Int
forall a b. a -> Either a b
Left String
invalid) Int -> Either String Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Int -> Either String Int)
-> (String -> Maybe Int) -> String -> Either String Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Int
forall a. Read a => String -> Maybe a
Read.readMaybe (String -> Either String Int) -> String -> Either String Int
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
text

atKey :: Token.Token -> Object.ObjectOf value -> Either String value
atKey :: Token -> ObjectOf value -> Either String value
atKey Token
t =
    Either String value
-> (MemberOf value -> Either String value)
-> Maybe (MemberOf value)
-> Either String value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String value
forall a b. a -> Either a b
Left (String -> Either String value) -> String -> Either String value
forall a b. (a -> b) -> a -> b
$ String
"missing key: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Token -> String
forall a. Show a => a -> String
show Token
t) (\(Member.Member Name
_ value
v) -> value -> Either String value
forall (f :: * -> *) a. Applicative f => a -> f a
pure value
v)
        (Maybe (MemberOf value) -> Either String value)
-> (ObjectOf value -> Maybe (MemberOf value))
-> ObjectOf value
-> Either String value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MemberOf value -> Bool)
-> [MemberOf value] -> Maybe (MemberOf value)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find
              (\(Member.Member Name
k value
_) ->
                  String -> Text
String.toText (Name -> String
Name.toString Name
k) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Token -> Text
Token.toText Token
t
              )
        ([MemberOf value] -> Maybe (MemberOf value))
-> (ObjectOf value -> [MemberOf value])
-> ObjectOf value
-> Maybe (MemberOf value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectOf value -> [MemberOf value]
forall value. ObjectOf value -> [MemberOf value]
Object.toList