module Data.Hermes.Decoder.Path
  ( withKey
  , withIndex
  , withPointer
  ) where

import           Data.Text (Text)

import           Data.Hermes.Decoder.Internal (DecoderM, HermesEnv(hPath), Path(..), local)

withKey :: Text -> DecoderM a -> DecoderM a
withKey :: forall a. Text -> DecoderM a -> DecoderM a
withKey Text
key = forall a. (HermesEnv -> HermesEnv) -> DecoderM a -> DecoderM a
local forall a b. (a -> b) -> a -> b
$ \HermesEnv
st -> HermesEnv
st { hPath :: [Path]
hPath = Text -> Path
Key Text
key forall a. a -> [a] -> [a]
: HermesEnv -> [Path]
hPath HermesEnv
st }
{-# INLINE withKey #-}

withPointer :: Text -> DecoderM a -> DecoderM a
withPointer :: forall a. Text -> DecoderM a -> DecoderM a
withPointer Text
path = forall a. (HermesEnv -> HermesEnv) -> DecoderM a -> DecoderM a
local forall a b. (a -> b) -> a -> b
$ \HermesEnv
st -> HermesEnv
st { hPath :: [Path]
hPath = [Text -> Path
Pointer Text
path] }
{-# INLINE withPointer #-}

withIndex :: Int -> DecoderM a -> DecoderM a
withIndex :: forall a. Int -> DecoderM a -> DecoderM a
withIndex Int
idx = forall a. (HermesEnv -> HermesEnv) -> DecoderM a -> DecoderM a
local forall a b. (a -> b) -> a -> b
$ \HermesEnv
st -> HermesEnv
st { hPath :: [Path]
hPath = Int -> Path
Idx Int
idx forall a. a -> [a] -> [a]
: HermesEnv -> [Path]
hPath HermesEnv
st }
{-# INLINE withIndex #-}