module Argo.Decode where

import qualified Argo.Class.FromValue as FromValue
import qualified Argo.Decoder as Decoder
import qualified Argo.Json.Value as Value
import qualified Argo.Pointer.Pointer as Pointer
import qualified Argo.Result as Result
import qualified Argo.Vendor.ByteString as ByteString

decode :: FromValue.FromValue a => ByteString.ByteString -> Result.Result a
decode :: ByteString -> Result a
decode ByteString
x = do
    (ByteString
_, Value
y) <- Decoder Value -> ByteString -> Result (ByteString, Value)
forall a. Decoder a -> ByteString -> Result (ByteString, a)
Decoder.run (Decoder ()
Decoder.spaces Decoder () -> Decoder Value -> Decoder Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Decoder Value
Value.decode Decoder Value -> Decoder () -> Decoder Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Decoder ()
Decoder.eof) ByteString
x
    Value -> Result a
forall a. FromValue a => Value -> Result a
FromValue.fromValue Value
y

decodePointer :: ByteString.ByteString -> Result.Result Pointer.Pointer
decodePointer :: ByteString -> Result Pointer
decodePointer =
    let d :: Decoder Pointer
d = Decoder Pointer
Pointer.decode Decoder Pointer -> Decoder () -> Decoder Pointer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Decoder ()
Decoder.eof
    in ((ByteString, Pointer) -> Pointer)
-> Result (ByteString, Pointer) -> Result Pointer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString, Pointer) -> Pointer
forall a b. (a, b) -> b
snd (Result (ByteString, Pointer) -> Result Pointer)
-> (ByteString -> Result (ByteString, Pointer))
-> ByteString
-> Result Pointer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decoder Pointer -> ByteString -> Result (ByteString, Pointer)
forall a. Decoder a -> ByteString -> Result (ByteString, a)
Decoder.run Decoder Pointer
d