{-# LANGUAGE DeriveLift #-}

module Argo.Internal.Pointer.Pointer where

import qualified Argo.Internal.Json.Array as Array
import qualified Argo.Internal.Json.Member as Member
import qualified Argo.Internal.Json.Name as Name
import qualified Argo.Internal.Json.Object as Object
import qualified Argo.Internal.Json.String as String
import qualified Argo.Internal.Json.Value as Value
import qualified Argo.Internal.Literal as Literal
import qualified Argo.Internal.Pointer.Token as Token
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.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 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
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 t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Pointer -> m Exp
forall (m :: * -> *). Quote m => Pointer -> Code m Pointer
liftTyped :: forall (m :: * -> *). Quote m => Pointer -> Code m Pointer
$cliftTyped :: forall (m :: * -> *). Quote m => Pointer -> Code m Pointer
lift :: forall (m :: * -> *). Quote m => Pointer -> m Exp
$clift :: forall (m :: * -> *). Quote m => Pointer -> m Exp
TH.Lift, Int -> Pointer -> ShowS
[Pointer] -> ShowS
Pointer -> String
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)

instance DeepSeq.NFData Pointer where
    rnf :: Pointer -> ()
rnf = forall a. NFData a => a -> ()
DeepSeq.rnf forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pointer -> [Token]
toList

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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Token -> Encoder ()
encodeToken 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
    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 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
    [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
    Token
t : [Token]
ts -> do
        Value
w <- case Value
v of
            Value.Array Array Value
a -> forall value. Token -> Array value -> Either String value
atIndex Token
t Array Value
a
            Value.Object Object Value
o -> forall value. Token -> Object value -> Either String value
atKey Token
t Object Value
o
            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.Array value -> Either String value
atIndex :: forall value. Token -> Array value -> Either String value
atIndex Token
t Array value
a = do
    Int
i <- Token -> Either String Int
tokenToIndex Token
t
    case forall a. Int -> [a] -> [a]
drop Int
i forall a b. (a -> b) -> a -> b
$ forall value. Array value -> [value]
Array.toList Array value
a of
        [] -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"missing index: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Token
t
        value
e : [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: " forall a. Semigroup a => a -> a -> a
<> 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 forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0 else forall a b. a -> Either a b
Left String
invalid
        Maybe (Char, Text)
_ -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left String
invalid) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
Read.readMaybe forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
text

atKey :: Token.Token -> Object.Object value -> Either String value
atKey :: forall value. Token -> Object value -> Either String value
atKey Token
t =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"missing key: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Token
t) (\(Member.Member Name
_ value
v) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure value
v)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) forall a. Eq a => a -> a -> Bool
== Token -> Text
Token.toText Token
t
              )
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value. Object value -> [Member value]
Object.toList