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

module Argo.Pointer.Pointer where

import qualified Argo.Decoder as Decoder
import qualified Argo.Encoder as Encoder
import qualified Argo.Json.Value as Value
import qualified Argo.Json.Object as Object
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.String as String
import qualified Argo.Literal as Literal
import qualified Argo.Pointer.Token as Token
import qualified Argo.Result as Result
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.Transformers as Trans
import qualified Argo.Vendor.Text as Text
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) -> Decoder [Token] -> Decoder Pointer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder Token -> Decoder [Token]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
Applicative.many Decoder Token
decodeToken

decodeToken :: Decoder.Decoder Token.Token
decodeToken :: Decoder Token
decodeToken = do
    Word8 -> Decoder ()
Decoder.word8 Word8
Literal.solidus
    Decoder 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 -> Result.Result Value.Value
evaluate :: Pointer -> Value -> Result Value
evaluate Pointer
p Value
v = case Pointer -> [Token]
toList Pointer
p of
    [] -> Value -> Result 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 -> Result Value
forall value. Token -> ArrayOf value -> Result value
atIndex Token
t ArrayOf Value
a
            Value.Object ObjectOf Value
o -> Token -> ObjectOf Value -> Result Value
forall value. Token -> ObjectOf value -> Result value
atKey Token
t ObjectOf Value
o
            Value
_ -> String -> Result Value
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not indexable"
        Pointer -> Value -> Result Value
evaluate ([Token] -> Pointer
fromList [Token]
ts) Value
w

atIndex :: Token.Token -> Array.ArrayOf value -> Result.Result value
atIndex :: Token -> ArrayOf value -> Result value
atIndex Token
t ArrayOf value
a = do
    Int
i <- Token -> Result 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 -> Result value
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Result value) -> String -> Result 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 -> Result value
forall (f :: * -> *) a. Applicative f => a -> f a
pure value
e

tokenToIndex :: Token.Token -> Result.Result Int
tokenToIndex :: Token -> Result 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 -> Result Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0 else String -> Result Int
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
invalid
        Maybe (Char, Text)
_ -> Result Int -> (Int -> Result Int) -> Maybe Int -> Result Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Result Int
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
invalid) Int -> Result Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Int -> Result Int)
-> (String -> Maybe Int) -> String -> Result Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Int
forall a. Read a => String -> Maybe a
Read.readMaybe (String -> Result Int) -> String -> Result Int
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
text

atKey :: Token.Token -> Object.ObjectOf value -> Result.Result value
atKey :: Token -> ObjectOf value -> Result value
atKey Token
t = Result value
-> (MemberOf value -> Result value)
-> Maybe (MemberOf value)
-> Result value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Result value
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Result value) -> String -> Result 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 -> Result value
forall (f :: * -> *) a. Applicative f => a -> f a
pure value
v)
    (Maybe (MemberOf value) -> Result value)
-> (ObjectOf value -> Maybe (MemberOf value))
-> ObjectOf value
-> Result 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