{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# 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 GHC.Generics as Generics
import qualified Text.Read as Read
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 Array Value
a -> Token -> Array Value -> Either String Value
forall value. Token -> Array value -> Either String value
atIndex Token
t Array Value
a
Value.Object Object Value
o -> Token -> Object Value -> Either String Value
forall value. Token -> Object value -> Either String value
atKey Token
t Object 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.Array value -> Either String value
atIndex :: Token -> Array value -> Either String value
atIndex Token
t Array 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
$ Array value -> [value]
forall value. Array value -> [value]
Array.toList Array 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.Object value -> Either String value
atKey :: Token -> Object value -> Either String value
atKey Token
t =
Either String value
-> (Member value -> Either String value)
-> Maybe (Member 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 (Member value) -> Either String value)
-> (Object value -> Maybe (Member value))
-> Object value
-> Either String value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Member value -> Bool) -> [Member value] -> Maybe (Member 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
)
([Member value] -> Maybe (Member value))
-> (Object value -> [Member value])
-> Object value
-> Maybe (Member value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object value -> [Member value]
forall value. Object value -> [Member value]
Object.toList