{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
-- |
--
-- Types and Functions for turning JSON into Haskell.
--
-- We will work through a basic example, using the following type:
--
-- @
-- data Person = Person
--   { _personName                    :: Text
--   , _personAge                     :: Int
--   , _personAddress                 :: Text
--   , _personFavouriteLotteryNumbers :: [Int]
--   }
--   deriving (Eq, Show)
-- @
--
-- Expect the following JSON as input:
--
-- @
-- { \"name\":    \"Krag\"
-- , \"age\":     88
-- , \"address\": \"Red House 4, Three Neck Lane, Greentown.\"
-- , \"numbers\": [86,3,32,42,73]
-- }
-- @
--
-- We'll need to import the 'Waargonaut.Decode' module. You may of course use whatever import scheme you like,
-- I prefer this method:
--
-- @
-- import Waargonaut.Decode (Decoder)
-- import qualified Waargonaut.Decode as D
-- @
--
-- The 'Waargonaut.Decode.Decoder' is based upon a data structure called a @zipper@. This allows us
-- to move around the JSON structure using arbitrary movements. Such as
-- 'Waargonaut.Decode.moveRight1' to move from a key on an object to the value at that key. Or
-- 'Waargonaut.Decode.down' to move into the first element of an array or object. Waargonaut
-- provides a suite of these functions to move around and dissect the JSON input.
--
-- This zipper is combined with a 'Control.Monad.State.StateT' transformer that maintains a history of your movements.
-- So if the JSON input is not as your 'Waargonaut.Decode.Decoder' expects you are given a complete
-- path to where things went awry.
--
-- Decoding a JSON value is done by moving the cursor to specific points of interest, then focusing
-- on that point with a 'Waargonaut.Decode.Decoder' of the desired value.
--
-- NB: The "Monad" constraint is provided as a flexibility for more interesting and nefarious uses
-- of 'Waargonaut.Decode.Decoder'.
--
-- Here is the 'Waargonaut.Decode.Decoder' for our @Person@ data type. It will help to turn on the
-- @OverloadedStrings@ language pragma as these functions expect 'Data.Text.Text' input.
--
-- @
-- personDecoder :: Monad f => Decoder f Person
-- personDecoder = D.withCursor $ \\c -> do
--   o     <- D.down c
--   name  <- D.fromKey "name" D.text o
--   age   <- D.fromKey "age" D.int o
--   addr  <- D.fromKey "address" D.text o
--   lotto <- D.fromKey "numbers" (D.list D.int) o
--   pure $ Person name age addr lotto
-- @
--
-- The 'Waargonaut.Decode.withCursor' function provides our cursor: @c@. We then move
-- 'Waargonaut.Decode.down' into the JSON object. The reasons for this are:
--
-- * The initial cursor position is always at the very beginning of the input. On freshly indexed
--   JSON input, using our example, the cursor will be at:
--
-- @
-- \<cursor\>{ \"name\": \"Krag\"
--         , \"age\": 88
--         ...
-- @
--
-- * Because of the above reason, our decoder makes an assumption about the placement of the cursor
--   on the JSON input. This sort of assumption is reasonable for reasons we will go over later.
--
-- The cursor output from 'Waargonaut.Decode.down' will located here:
--
-- @
-- { \<cursor\>\"name\": \"Krag\"
--   , \"age\": 88
--   ...
-- @
--
-- Then we use one of the helper functions, 'Waargonaut.Decode.fromKey' to find the "key - value"
-- pair that we're interested in and decode it for us:
--
-- @
-- fromKey :: Monad f => Text -> Decoder f b -> JCurs -> DecodeResult f b
-- @
--
-- We could also write this 'Waargonaut.Decode.Decoder' as:
--
-- @
-- personDecoder2 :: Monad f => Decoder f Person
-- personDecoder2 = Person
--   \<$> D.atKey \"name\" D.text
--   \<*> D.atKey \"age\" D.int
--   \<*> D.atKey \"address\" D.text
--   \<*> D.atKey \"numbers\" (D.list D.int)
-- @
--
-- Using the 'Waargonaut.Decode.atKey' function which tries to handle those basic movements for us
-- and has those assumptions included. Very useful for when the JSON input closely mirrors your data
-- structure.
--
-- @
-- atKey :: Monad f => Text -> Decoder f a -> Decoder f a
-- @
--
-- The next part is being able to apply our 'Waargonaut.Decode.Decoder' to some input. Assuming we
-- have some input. We want to pass it through our @personDecoder@ for a result. Waargonaut uses
-- the <https://hackage.haskell.org/package/parsers parsers> package to define its parser. This
-- allows you to choose your own favourite parsing library to do the heavy lifting. Provided it
-- implements the right typeclasses from the @parsers@ package.
--
-- To apply a 'Waargonaut.Decode.Decoder' to some input you will need one of the
-- decoder running functions from 'Waargonaut.Decode'. There are a few different
-- functions provided for some of the common input text-like types.:
--
-- @
-- decodeFromByteString
--   :: ( CharParsing f
--      , Monad f
--      , Monad g
--      , Show e
--      )
--   => (forall a. f a -> ByteString -> Either e a)
--   -> Decoder g x
--   -> ByteString
--   -> g (Either (DecodeError, CursorHistory) x)
-- @
--
--
-- As well as a parsing function from your parsing library of choice, that also
-- has an implementation of the 'Text.Parser.Char.CharParsing' typeclass from @parsers@. We will
-- use @attoparsec@ in the examples below.
--
-- @
-- import qualified Data.Attoparsec.ByteString as AB
-- @
--
-- @
-- decodeFromByteString AB.parseOnly personDecode inp
-- @
--
-- Which will run the @personDecode@ 'Waargonaut.Decode.Decoder' using the parsing function
-- (@AB.parseOnly@), starting at the cursor from the top of the @inp@ input.
--
-- Again the 'Control.Monad.Monad' constraint is there so that you have more options available for utilising the
-- 'Waargonaut.Decode.Decoder' in ways we haven't thought of.
--
-- Or if you don't need the 'Control.Monad.Monad' constraint then you may use 'Waargonaut.Decode.pureDecodeFromByteString'.
-- This function specialises the 'Control.Monad.Monad' constraint to 'Data.Functor.Identity'.:
--
-- @
-- pureDecodeFromByteString
--   :: ( Monad f
--      , CharParsing f
--      , Show e
--      )
--   => (forall a. f a -> ByteString -> Either e a)
--   -> Decoder Identity x
--   -> ByteString
--   -> Either (DecodeError, CursorHistory) x
-- @
--
-- @
-- pureDecodeFromByteString AB.parseOnly personDecode inp
-- @
--
-- Waargonaut provides some default implementations using the <https://hackage.haskell.org/package/attoparsec attoparsec> package in the @Waargonaut.Attoparsec@ module. These functions have exactly the same behaviour as the functions above, without the need to provide the parsing function.
module Waargonaut.Decode
  (
    -- * Types
    CursorHistory
  , Cursor
  , DecodeResult (..)
  , Decoder (..)
  , JCurs (..)
  , Err (..)
  , JsonType (..)

    -- * Runners
  , module Waargonaut.Decode.Runners

    -- * Helpers
  , generaliseDecoder
  , DI.ppCursorHistory

    -- * Cursors
  , withCursor
  , mkCursor
  , cursorRankL
  , manyMoves
  , down
  , up
  , DI.try
  , moveRightN
  , moveRight1
  , moveLeftN
  , moveLeft1
  , moveToKey
  , moveToRankN

    -- * Decoding at cursor
  , jsonAtCursor
  , fromKey
  , atKey
  , focus

    -- * Attempting decoding
  , fromKeyOptional
  , atKeyOptional

    -- * Inspection
  , withType
  , jsonTypeAt

    -- * Provided Decoders
  , leftwardCons
  , rightwardSnoc
  , foldCursor
  , rank
  , prismD
  , prismDOrFail
  , prismDOrFail'
  , json
  , int
  , scientific
  , integral
  , string
  , strictByteString
  , lazyByteString
  , unboundedChar
  , boundedChar
  , text
  , bool
  , null
  , nonemptyAt
  , nonempty
  , listAt
  , list
  , objectAsKeyValuesAt
  , objectAsKeyValues
  , withDefault
  , maybeOrNull
  , either
  , oneOf
  , passKeysToValues

  ) where

import           GHC.Word                                       (Word64)

import           Control.Lens                                   (Cons, Lens',
                                                                 Prism', Snoc,
                                                                 cons, lens,
                                                                 matching,
                                                                 modifying,
                                                                 preview, snoc,
                                                                 traverseOf,
                                                                 view, ( # ),
                                                                 (.~), (^.),
                                                                 _Wrapped)
import           Control.Monad.Error.Lens                       (throwing)

import           Prelude                                        (Bool, Bounded,
                                                                 Char, Eq, Int,
                                                                 Integral,
                                                                 String, (-),
                                                                 (==), fromIntegral)

import           Control.Applicative                            (Applicative (..))
import           Control.Category                               ((.))
import           Control.Monad                                  (Monad (..),
                                                                 (=<<), (>=>))
import           Control.Monad.Morph                            (embed,
                                                                 generalize)

import           Control.Monad.Except                           (catchError,
                                                                 lift,
                                                                 liftEither)
import           Control.Monad.Reader                           (ReaderT (..),
                                                                 ask,
                                                                 runReaderT)
import           Control.Monad.State                            (MonadState)

import           Control.Error.Util                             (note)
import           Control.Monad.Error.Hoist                      ((<!?>), (<?>))

import           Data.Either                                    (Either (..))
import qualified Data.Either                                    as Either (either)
import           Data.Foldable                                  (Foldable, elem,
                                                                 foldl, foldr)
import           Data.Function                                  (const, flip,
                                                                 ($), (&))
import           Data.Functor                                   (fmap, (<$),
                                                                 (<$>))
import           Data.Functor.Alt                               ((<!>))
import           Data.Functor.Identity                          (Identity)
import           Data.Monoid                                    (mempty)
import           Data.Scientific                                (Scientific)

import           Data.List.NonEmpty                             (NonEmpty ((:|)))
import           Data.Maybe                                     (Maybe (..),
                                                                 fromMaybe,
                                                                 maybe)
import           Natural                                        (Natural,
                                                                 replicate,
                                                                 successor',
                                                                 zero')

import           Data.Text                                      (Text)

import           Data.ByteString                                (ByteString)
import qualified Data.ByteString                                as BS
import qualified Data.ByteString.Lazy                           as BL

import           HaskellWorks.Data.Positioning                  (Count)
import qualified HaskellWorks.Data.Positioning                  as Pos

import qualified HaskellWorks.Data.BalancedParens.FindOpen      as BP

import           HaskellWorks.Data.Bits                         ((.?.))
import           HaskellWorks.Data.TreeCursor                   (TreeCursor (..))

import           HaskellWorks.Data.Json.Standard.Cursor.Fast (Cursor)
import qualified HaskellWorks.Data.Json.Standard.Cursor.Generic as JC

import           Waargonaut.Decode.Error                        (AsDecodeError (..),
                                                                 DecodeError (..),
                                                                 Err (..))
import           Waargonaut.Decode.ZipperMove                   (ZipperMove (..))
import           Waargonaut.Types                               (Json)

import qualified Waargonaut.Decode.Internal                     as DI

import           Waargonaut.Decode.Runners

import           Waargonaut.Decode.Types                        (CursorHistory, DecodeResult (..),
                                                                 Decoder (..),
                                                                 JCurs (..),
                                                                 JsonType (..),
                                                                 jsonTypeAt,
                                                                 mkCursor)

-- | Function to define a 'Waargonaut.Decode.Decoder' for a specific data type.
--
-- For example, given the following data type:
--
-- @
-- data Image = Image
--   { _imageW        :: Int
--   , _imageH        :: Int
--   , _imageTitle    :: Text
--   , _imageAnimated :: Bool
--   , _imageIDs      :: [Int]
--   }
-- @
--
-- We can use 'Waargonaut.Decode.withCursor' to write a decoder that
-- will be given a cursor that we can use to build the data types that
-- we need.
--
-- @
-- imageDecoder :: Monad f => Decoder f Image
-- imageDecoder = withCursor $ \\curs -> D.down curs >>= Image
--   \<$> D.fromKey \"Width\" D.int curs
--   \<*> D.fromKey \"Height\" D.int curs
--   \<*> D.fromKey \"Title\" D.text curs
--   \<*> D.fromKey \"Animated\" D.bool curs
--   \<*> D.fromKey \"IDs\" intArray curs
-- @
--
-- It's up to you to provide a cursor that is at the correct position for a
-- 'Waargonaut.Decode.Decoder' to operate, but building decoders in this way simplifies creating
-- decoders for larger structures, as the smaller pieces contain fewer
-- assumptions. This encourages greater reuse of decoders and simplifies the
-- debugging process.
--
withCursor
  :: (JCurs -> DecodeResult f a)
  -> Decoder f a
withCursor :: (JCurs -> DecodeResult f a) -> Decoder f a
withCursor JCurs -> DecodeResult f a
g = (ParseFn -> JCurs -> DecodeResultT Count DecodeError f a)
-> Decoder f a
forall (f :: * -> *) a.
(ParseFn -> JCurs -> DecodeResultT Count DecodeError f a)
-> Decoder f a
Decoder ((ParseFn -> JCurs -> DecodeResultT Count DecodeError f a)
 -> Decoder f a)
-> (ParseFn -> JCurs -> DecodeResultT Count DecodeError f a)
-> Decoder f a
forall a b. (a -> b) -> a -> b
$ \ParseFn
p ->
  Decoder' JCurs Count DecodeError f a
-> JCurs -> DecodeResultT Count DecodeError f a
forall c i e (f :: * -> *) a.
Decoder' c i e f a -> c -> DecodeResultT i e f a
DI.runDecoder' (Decoder' JCurs Count DecodeError f a
 -> JCurs -> DecodeResultT Count DecodeError f a)
-> Decoder' JCurs Count DecodeError f a
-> JCurs
-> DecodeResultT Count DecodeError f a
forall a b. (a -> b) -> a -> b
$ (JCurs -> DecodeResultT Count DecodeError f a)
-> Decoder' JCurs Count DecodeError f a
forall c i e (f :: * -> *) a.
(c -> DecodeResultT i e f a) -> Decoder' c i e f a
DI.withCursor' ((ReaderT ParseFn (DecodeResultT Count DecodeError f) a
 -> ParseFn -> DecodeResultT Count DecodeError f a)
-> ParseFn
-> ReaderT ParseFn (DecodeResultT Count DecodeError f) a
-> DecodeResultT Count DecodeError f a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT ParseFn (DecodeResultT Count DecodeError f) a
-> ParseFn -> DecodeResultT Count DecodeError f a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ParseFn
p (ReaderT ParseFn (DecodeResultT Count DecodeError f) a
 -> DecodeResultT Count DecodeError f a)
-> (JCurs -> ReaderT ParseFn (DecodeResultT Count DecodeError f) a)
-> JCurs
-> DecodeResultT Count DecodeError f a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. DecodeResult f a
-> ReaderT ParseFn (DecodeResultT Count DecodeError f) a
forall (f :: * -> *) a.
DecodeResult f a
-> ReaderT ParseFn (DecodeResultT Count DecodeError f) a
unDecodeResult (DecodeResult f a
 -> ReaderT ParseFn (DecodeResultT Count DecodeError f) a)
-> (JCurs -> DecodeResult f a)
-> JCurs
-> ReaderT ParseFn (DecodeResultT Count DecodeError f) a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. JCurs -> DecodeResult f a
g)

-- | Lens for accessing the 'rank' of the 'JsonCursor'. The 'rank' forms part of
-- the calculation that is the cursors current position in the index.
--
cursorRankL :: Lens' Cursor Count
cursorRankL :: (Count -> f Count) -> Cursor -> f Cursor
cursorRankL = (Cursor -> Count)
-> (Cursor -> Count -> Cursor) -> Lens Cursor Cursor Count Count
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Cursor -> Count
forall t v w. GenericCursor t v w -> Count
JC.cursorRank (\Cursor
c Count
r -> Cursor
c { cursorRank :: Count
JC.cursorRank = Count
r })

-- | Execute the given function @n@ times.
manyMoves :: Monad m => Natural -> (b -> m b) -> b -> m b
manyMoves :: Natural -> (b -> m b) -> b -> m b
manyMoves Natural
i b -> m b
g = ((b -> m b) -> (b -> m b) -> b -> m b)
-> (b -> m b) -> [b -> m b] -> b -> m b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (b -> m b) -> (b -> m b) -> b -> m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
(>=>) b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> (b -> m b) -> [b -> m b]
forall a. Natural -> a -> [a]
replicate Natural
i b -> m b
g)

-- | Generalise a 'Decoder' that has been specialised to 'Identity' back to some 'Monad f'.
generaliseDecoder :: Monad f => Decoder Identity a -> Decoder f a
generaliseDecoder :: Decoder Identity a -> Decoder f a
generaliseDecoder Decoder Identity a
dr = (ParseFn -> JCurs -> DecodeResultT Count DecodeError f a)
-> Decoder f a
forall (f :: * -> *) a.
(ParseFn -> JCurs -> DecodeResultT Count DecodeError f a)
-> Decoder f a
Decoder (\ParseFn
p -> (forall a. Identity a -> DecodeResultT Count DecodeError f a)
-> DecodeResultT Count DecodeError Identity a
-> DecodeResultT Count DecodeError f a
forall (t :: (* -> *) -> * -> *) (n :: * -> *) (m :: * -> *) b.
(MMonad t, Monad n) =>
(forall a. m a -> t n a) -> t m b -> t n b
embed forall a. Identity a -> DecodeResultT Count DecodeError f a
forall (m :: * -> *) a. Monad m => Identity a -> m a
generalize (DecodeResultT Count DecodeError Identity a
 -> DecodeResultT Count DecodeError f a)
-> (JCurs -> DecodeResultT Count DecodeError Identity a)
-> JCurs
-> DecodeResultT Count DecodeError f a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Decoder Identity a
-> ParseFn -> JCurs -> DecodeResultT Count DecodeError Identity a
forall (f :: * -> *) a.
Decoder f a
-> ParseFn -> JCurs -> DecodeResultT Count DecodeError f a
runDecoder Decoder Identity a
dr ParseFn
p)
{-# INLINE generaliseDecoder #-}

-- | Execute the given cursor movement function, throwing a 'FailedToMove' error
-- if it is unsuccessful, recording the new position in history if it is
-- successful.
moveCursBasic
  :: Monad f
  => (Cursor -> Maybe Cursor)
  -> ZipperMove
  -> JCurs
  -> DecodeResult f JCurs
moveCursBasic :: (Cursor -> Maybe Cursor)
-> ZipperMove -> JCurs -> DecodeResult f JCurs
moveCursBasic Cursor -> Maybe Cursor
f ZipperMove
m JCurs
c =
  LensLike Maybe JCurs JCurs Cursor Cursor
-> LensLike Maybe JCurs JCurs Cursor Cursor
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike Maybe JCurs JCurs Cursor Cursor
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped Cursor -> Maybe Cursor
f JCurs
c Maybe JCurs -> DecodeError -> DecodeResult f JCurs
forall (m :: * -> *) (t :: * -> *) e e' a.
HoistError m t e e' =>
t a -> e' -> m a
<?> ZipperMove -> DecodeError
FailedToMove ZipperMove
m DecodeResult f JCurs
-> (JCurs -> DecodeResult f JCurs) -> DecodeResult f JCurs
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipperMove -> JCurs -> DecodeResult f JCurs
forall (f :: * -> *).
MonadState CursorHistory f =>
ZipperMove -> JCurs -> f JCurs
recordRank ZipperMove
m

-- | Move the cursor down or into the child of the current cursor position.
--
-- The following examples use "*" to represent the cursor position.
--
-- Starting position:
--
-- @ *{"fred": 33, "sally": 44 } @
--
-- After moving 'down':
--
-- @ { *"fred": 33, "sally": 44 } @
--
-- This function will also move into the elements in an array:
--
-- Starting position:
--
-- @ *[1,2,3] @
--
-- After moving 'down':
--
-- @ [*1,2,3] @
--
-- This function is essential when dealing with the inner elements of objects or
-- arrays. As you must first move 'down' into the focus. However, you cannot
-- move down into an empty list or empty object. The reason for this is that
-- there will be nothing in the index for the element at the first position.
-- Thus the movement will be considered invalid.
--
-- These will fail if you attempt to move 'down':
--
-- @ *[] @
--
-- @ *{} @
--
down
  :: Monad f
  => JCurs
  -> DecodeResult f JCurs
down :: JCurs -> DecodeResult f JCurs
down =
  (Cursor -> Maybe Cursor)
-> ZipperMove -> JCurs -> DecodeResult f JCurs
forall (f :: * -> *).
Monad f =>
(Cursor -> Maybe Cursor)
-> ZipperMove -> JCurs -> DecodeResult f JCurs
moveCursBasic Cursor -> Maybe Cursor
forall k. TreeCursor k => k -> Maybe k
firstChild ZipperMove
D

-- | Move the cursor up into the parent of the current cursor position.
--
-- The following examples use "*" to represent the cursor position.
--
-- Starting position:
--
-- @ { "fred": 33, *"sally": 44 } @
--
-- After moving 'up':
--
-- @ *{"fred": 33, "sally": 44 } @
--
up
  :: Monad f
  => JCurs
  -> DecodeResult f JCurs
up :: JCurs -> DecodeResult f JCurs
up =
  (Cursor -> Maybe Cursor)
-> ZipperMove -> JCurs -> DecodeResult f JCurs
forall (f :: * -> *).
Monad f =>
(Cursor -> Maybe Cursor)
-> ZipperMove -> JCurs -> DecodeResult f JCurs
moveCursBasic Cursor -> Maybe Cursor
forall k. TreeCursor k => k -> Maybe k
parent ZipperMove
U

-- | Given a 'rank' value, attempt to move the cursor directly to that position.
--
-- Returns a 'InputOutOfBounds' error if that position is invalid.
--
moveToRankN
  :: Monad f
  => Word64
  -> JCurs
  -> DecodeResult f JCurs
moveToRankN :: Count -> JCurs -> DecodeResult f JCurs
moveToRankN Count
newRank JCurs
c =
  if Cursor -> RangeMin CsPoppy1
forall t v w. GenericCursor t v w -> w
JC.balancedParens (JCurs
c JCurs -> Getting Cursor JCurs Cursor -> Cursor
forall s a. s -> Getting a s a -> a
^. Getting Cursor JCurs Cursor
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped) RangeMin CsPoppy1 -> Position -> Bool
forall a. TestBit a => a -> Position -> Bool
.?. Count -> Position
Pos.lastPositionOf Count
newRank
  then JCurs -> DecodeResult f JCurs
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JCurs -> DecodeResult f JCurs) -> JCurs -> DecodeResult f JCurs
forall a b. (a -> b) -> a -> b
$ JCurs
c JCurs -> (JCurs -> JCurs) -> JCurs
forall a b. a -> (a -> b) -> b
& (Cursor -> Identity Cursor) -> JCurs -> Identity JCurs
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped ((Cursor -> Identity Cursor) -> JCurs -> Identity JCurs)
-> ((Count -> Identity Count) -> Cursor -> Identity Cursor)
-> (Count -> Identity Count)
-> JCurs
-> Identity JCurs
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Count -> Identity Count) -> Cursor -> Identity Cursor
Lens Cursor Cursor Count Count
cursorRankL ((Count -> Identity Count) -> JCurs -> Identity JCurs)
-> Count -> JCurs -> JCurs
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Count
newRank
  else AReview DecodeError Count -> Count -> DecodeResult f JCurs
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview DecodeError Count
forall r. AsDecodeError r => Prism' r Count
_InputOutOfBounds Count
newRank

-- | Move the cursor rightwards @n@ times.
--
-- Starting position:
--
-- @ [*1, 2, 3] @
--
-- After @moveRightN 2@:
--
-- @ [1, 2, *3] @
--
moveRightN
  :: Monad f
  => Natural
  -> JCurs
  -> DecodeResult f JCurs
moveRightN :: Natural -> JCurs -> DecodeResult f JCurs
moveRightN Natural
i =
  (Cursor -> Maybe Cursor)
-> ZipperMove -> JCurs -> DecodeResult f JCurs
forall (f :: * -> *).
Monad f =>
(Cursor -> Maybe Cursor)
-> ZipperMove -> JCurs -> DecodeResult f JCurs
moveCursBasic (Natural -> (Cursor -> Maybe Cursor) -> Cursor -> Maybe Cursor
forall (m :: * -> *) b.
Monad m =>
Natural -> (b -> m b) -> b -> m b
manyMoves Natural
i Cursor -> Maybe Cursor
forall k. TreeCursor k => k -> Maybe k
nextSibling) (Natural -> ZipperMove
R Natural
i)

-- | Helper function to move right once.
moveRight1
  :: Monad f
  => JCurs
  -> DecodeResult f JCurs
moveRight1 :: JCurs -> DecodeResult f JCurs
moveRight1 =
  Natural -> JCurs -> DecodeResult f JCurs
forall (f :: * -> *).
Monad f =>
Natural -> JCurs -> DecodeResult f JCurs
moveRightN (Natural -> Natural
successor' Natural
zero')

-- | Helper function to move left once.
--
-- Starting position:
--
-- @ [1, 2, *3] @
--
-- Ater 'moveLeft1':
--
-- @ [1, *2, 3] @
moveLeft1
  :: Monad f
  => JCurs
  -> DecodeResult f JCurs
moveLeft1 :: JCurs -> DecodeResult f JCurs
moveLeft1 JCurs
jc =
  let
    c :: Cursor
c         = JCurs
jc JCurs -> Getting Cursor JCurs Cursor -> Cursor
forall s a. s -> Getting a s a -> a
^. Getting Cursor JCurs Cursor
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped
    rnk :: Count
rnk       = Cursor
c Cursor -> Getting Count Cursor Count -> Count
forall s a. s -> Getting a s a -> a
^. Getting Count Cursor Count
Lens Cursor Cursor Count Count
cursorRankL
    setRank :: Count -> JCurs
setRank Count
r = JCurs
jc JCurs -> (JCurs -> JCurs) -> JCurs
forall a b. a -> (a -> b) -> b
& (Cursor -> Identity Cursor) -> JCurs -> Identity JCurs
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped ((Cursor -> Identity Cursor) -> JCurs -> Identity JCurs)
-> ((Count -> Identity Count) -> Cursor -> Identity Cursor)
-> (Count -> Identity Count)
-> JCurs
-> Identity JCurs
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Count -> Identity Count) -> Cursor -> Identity Cursor
Lens Cursor Cursor Count Count
cursorRankL ((Count -> Identity Count) -> JCurs -> Identity JCurs)
-> Count -> JCurs -> JCurs
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Count
r
    prev :: Count
prev      = Count
rnk Count -> Count -> Count
forall a. Num a => a -> a -> a
- Count
1
  in
    Count -> JCurs
setRank (Count -> JCurs) -> DecodeResult f Count -> DecodeResult f JCurs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RangeMin CsPoppy1 -> Count -> Maybe Count
forall v. FindOpen v => v -> Count -> Maybe Count
BP.findOpen (Cursor -> RangeMin CsPoppy1
forall t v w. GenericCursor t v w -> w
JC.balancedParens Cursor
c) Count
prev Maybe Count -> DecodeError -> DecodeResult f Count
forall (m :: * -> *) (t :: * -> *) e e' a.
HoistError m t e e' =>
t a -> e' -> m a
<?> Count -> DecodeError
InputOutOfBounds Count
prev

-- | Move the cursor leftwards @n@ times.
moveLeftN
  :: Monad f
  => Natural
  -> JCurs
  -> DecodeResult f JCurs
moveLeftN :: Natural -> JCurs -> DecodeResult f JCurs
moveLeftN Natural
i =
  Natural
-> (JCurs -> DecodeResult f JCurs) -> JCurs -> DecodeResult f JCurs
forall (m :: * -> *) b.
Monad m =>
Natural -> (b -> m b) -> b -> m b
manyMoves Natural
i JCurs -> DecodeResult f JCurs
forall (f :: * -> *). Monad f => JCurs -> DecodeResult f JCurs
moveLeft1

-- | Using the given parsing function, attempt to decode the value of the
-- 'ByteString' at the current cursor position.
jsonAtCursor
  :: Monad f
  => (ByteString -> Either DecodeError a)
  -> JCurs
  -> DecodeResult f a
jsonAtCursor :: (ByteString -> Either DecodeError a) -> JCurs -> DecodeResult f a
jsonAtCursor ByteString -> Either DecodeError a
p JCurs
jc = do
  let
    c :: Cursor
c   = JCurs
jc JCurs -> Getting Cursor JCurs Cursor -> Cursor
forall s a. s -> Getting a s a -> a
^. Getting Cursor JCurs Cursor
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped
    rnk :: Count
rnk = Cursor
c Cursor -> Getting Count Cursor Count -> Count
forall s a. s -> Getting a s a -> a
^. Getting Count Cursor Count
Lens Cursor Cursor Count Count
cursorRankL

    leading :: Count
leading = Position -> Count
forall a. ToCount a => a -> Count
Pos.toCount (Position -> Count) -> Position -> Count
forall a b. (a -> b) -> a -> b
$ Cursor -> Position
forall w v s.
(Rank1 w, Select1 v) =>
GenericCursor s v w -> Position
JC.jsonCursorPos Cursor
c
    txt :: ByteString
txt = Int -> ByteString -> ByteString
BS.drop (Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Count
leading) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Cursor -> ByteString
forall t v w. GenericCursor t v w -> t
JC.cursorText Cursor
c

  if Cursor -> RangeMin CsPoppy1
forall t v w. GenericCursor t v w -> w
JC.balancedParens Cursor
c RangeMin CsPoppy1 -> Position -> Bool
forall a. TestBit a => a -> Position -> Bool
.?. Count -> Position
Pos.lastPositionOf Count
rnk
    then Either DecodeError a -> DecodeResult f a
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (ByteString -> Either DecodeError a
p ByteString
txt)
    else AReview DecodeError Count -> Count -> DecodeResult f a
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview DecodeError Count
forall r. AsDecodeError r => Prism' r Count
_InputOutOfBounds Count
rnk

-- Internal function to record the current rank of the cursor into the zipper history
recordRank
  :: MonadState CursorHistory f
  => ZipperMove
  -> JCurs
  -> f JCurs
recordRank :: ZipperMove -> JCurs -> f JCurs
recordRank ZipperMove
mv JCurs
c =
  JCurs
c JCurs -> f () -> f JCurs
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ASetter
  CursorHistory
  CursorHistory
  (Seq (ZipperMove, Count))
  (Seq (ZipperMove, Count))
-> (Seq (ZipperMove, Count) -> Seq (ZipperMove, Count)) -> f ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ASetter
  CursorHistory
  CursorHistory
  (Seq (ZipperMove, Count))
  (Seq (ZipperMove, Count))
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped (Seq (ZipperMove, Count)
-> (ZipperMove, Count) -> Seq (ZipperMove, Count)
forall s a. Snoc s s a a => s -> a -> s
`snoc` (ZipperMove
mv, JCurs
c JCurs -> Getting Count JCurs Count -> Count
forall s a. s -> Getting a s a -> a
^. (Cursor -> Const Count Cursor) -> JCurs -> Const Count JCurs
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped ((Cursor -> Const Count Cursor) -> JCurs -> Const Count JCurs)
-> Getting Count Cursor Count -> Getting Count JCurs Count
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Getting Count Cursor Count
Lens Cursor Cursor Count Count
cursorRankL))

-- | Using the given 'Decoder', try to decode the current focus.
--
-- @
-- myIntList <- focus (list int) cursor
-- @
--
focus
  :: Monad f
  => Decoder f a
  -> JCurs
  -> DecodeResult f a
focus :: Decoder f a -> JCurs -> DecodeResult f a
focus Decoder f a
decoder JCurs
curs = ReaderT ParseFn (DecodeResultT Count DecodeError f) a
-> DecodeResult f a
forall (f :: * -> *) a.
ReaderT ParseFn (DecodeResultT Count DecodeError f) a
-> DecodeResult f a
DecodeResult (ReaderT ParseFn (DecodeResultT Count DecodeError f) a
 -> DecodeResult f a)
-> ReaderT ParseFn (DecodeResultT Count DecodeError f) a
-> DecodeResult f a
forall a b. (a -> b) -> a -> b
$ do
  ParseFn
p <- ReaderT ParseFn (DecodeResultT Count DecodeError f) ParseFn
forall r (m :: * -> *). MonadReader r m => m r
ask
  DecodeResultT Count DecodeError f a
-> ReaderT ParseFn (DecodeResultT Count DecodeError f) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DecodeResultT Count DecodeError f a
 -> ReaderT ParseFn (DecodeResultT Count DecodeError f) a)
-> DecodeResultT Count DecodeError f a
-> ReaderT ParseFn (DecodeResultT Count DecodeError f) a
forall a b. (a -> b) -> a -> b
$ Decoder f a
-> ParseFn -> JCurs -> DecodeResultT Count DecodeError f a
forall (f :: * -> *) a.
Decoder f a
-> ParseFn -> JCurs -> DecodeResultT Count DecodeError f a
runDecoder Decoder f a
decoder ParseFn
p JCurs
curs

-- | Attempt to move to the value at a given key on the current JSON object.
-- This will only work if you have already moved 'down' into the JSON object,
-- because the cursor allows you to step over an entire object in a single. It has
-- to be told to move into the object first, otherwise it will not look in the
-- correct location for keys.
--
-- Cursor position indicated by "*".
--
-- Assuming cursor positioned here:
--
-- @ *{ "foo": 33, "fieldB": "pew pew" } @
--
-- This won't work, because we're AT the object, not IN the object:
-- @
-- moveToKey "foo" cursor
-- @
--
-- This will work, because we've moved 'down' INTO the object:
-- @
-- down cursor >>= moveToKey "foo"
-- @
--
moveToKey
  :: Monad f
  => Text
  -> JCurs
  -> DecodeResult f JCurs
moveToKey :: Text -> JCurs -> DecodeResult f JCurs
moveToKey Text
k JCurs
c = do
  -- Tease out the key
  Text
k' <- DecodeResult f Text -> DecodeResult f (Maybe Text)
forall e (m :: * -> *) a. MonadError e m => m a -> m (Maybe a)
DI.try (Decoder f Text -> JCurs -> DecodeResult f Text
forall (f :: * -> *) a.
Monad f =>
Decoder f a -> JCurs -> DecodeResult f a
focus Decoder f Text
forall (f :: * -> *). Monad f => Decoder f Text
text JCurs
c) DecodeResult f (Maybe Text) -> DecodeError -> DecodeResult f Text
forall (m :: * -> *) (t :: * -> *) e e' a.
HoistError m t e e' =>
m (t a) -> e' -> m a
<!?> (Tagged () (Identity ())
-> Tagged DecodeError (Identity DecodeError)
forall r. AsDecodeError r => Prism' r ()
_KeyDecodeFailed (Tagged () (Identity ())
 -> Tagged DecodeError (Identity DecodeError))
-> () -> DecodeError
forall t b. AReview t b -> b -> t
# ())

  -- Are we at the key we want to be at ?
  if Text
k' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
k
    -- Then move into the THING at the key
    then ZipperMove -> JCurs -> DecodeResult f JCurs
forall (f :: * -> *).
MonadState CursorHistory f =>
ZipperMove -> JCurs -> f JCurs
recordRank (Text -> ZipperMove
DAt Text
k) JCurs
c DecodeResult f JCurs
-> DecodeResult f JCurs -> DecodeResult f JCurs
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JCurs -> DecodeResult f JCurs
forall (f :: * -> *). Monad f => JCurs -> DecodeResult f JCurs
moveRight1 JCurs
c
    -- Try jump to the next key index
    else ( DecodeResult f JCurs -> DecodeResult f (Maybe JCurs)
forall e (m :: * -> *) a. MonadError e m => m a -> m (Maybe a)
DI.try (Natural -> JCurs -> DecodeResult f JCurs
forall (f :: * -> *).
Monad f =>
Natural -> JCurs -> DecodeResult f JCurs
moveRightN (Natural -> Natural
successor' (Natural -> Natural
successor' Natural
zero')) JCurs
c) DecodeResult f (Maybe JCurs) -> DecodeError -> DecodeResult f JCurs
forall (m :: * -> *) (t :: * -> *) e e' a.
HoistError m t e e' =>
m (t a) -> e' -> m a
<!?> (Tagged Text (Identity Text)
-> Tagged DecodeError (Identity DecodeError)
forall r. AsDecodeError r => Prism' r Text
_KeyNotFound (Tagged Text (Identity Text)
 -> Tagged DecodeError (Identity DecodeError))
-> Text -> DecodeError
forall t b. AReview t b -> b -> t
# Text
k) ) DecodeResult f JCurs
-> (JCurs -> DecodeResult f JCurs) -> DecodeResult f JCurs
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> JCurs -> DecodeResult f JCurs
forall (f :: * -> *).
Monad f =>
Text -> JCurs -> DecodeResult f JCurs
moveToKey Text
k

-- | Move to the first occurence of this key, as per 'moveToKey' and then
-- attempt to run the given 'Decoder' on that value, returning the result.
--
-- This decoder does not assume you have moved into the object.
--
-- @
-- ...
-- txtVal <- fromKey "foo" text c
-- ...
-- @
--
fromKey
  :: ( Monad f
     )
  => Text
  -> Decoder f b
  -> JCurs
  -> DecodeResult f b
fromKey :: Text -> Decoder f b -> JCurs -> DecodeResult f b
fromKey Text
k Decoder f b
d =
  Text -> JCurs -> DecodeResult f JCurs
forall (f :: * -> *).
Monad f =>
Text -> JCurs -> DecodeResult f JCurs
moveToKey Text
k (JCurs -> DecodeResult f JCurs)
-> (JCurs -> DecodeResult f b) -> JCurs -> DecodeResult f b
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Decoder f b -> JCurs -> DecodeResult f b
forall (f :: * -> *) a.
Monad f =>
Decoder f a -> JCurs -> DecodeResult f a
focus Decoder f b
d

-- | A simplified version of 'fromKey' that takes a 'Text' value indicating a
-- key to be moved to and decoded using the given 'Decoder f a'. If you don't
-- need any special cursor movements to reach the list of keys you require, you
-- could use this function to build a trivial 'Decoder' for a record type:
--
-- This decoder assumes it is positioned at the top of an object and will move
-- 'down' each time, before attempting to find the given key.
--
-- @
-- data MyRec = MyRec { fieldA :: Text, fieldB :: Int }
--
-- myRecDecoder :: Decoder f MyRec
-- myRecDecoder = MyRec
--   \<$> atKey \"field_a\" text
--   \<*> atKey \"field_b\" int
-- @
--
atKey
  :: Monad f
  => Text
  -> Decoder f a
  -> Decoder f a
atKey :: Text -> Decoder f a -> Decoder f a
atKey Text
k Decoder f a
d =
  (JCurs -> DecodeResult f a) -> Decoder f a
forall (f :: * -> *) a. (JCurs -> DecodeResult f a) -> Decoder f a
withCursor (JCurs -> DecodeResult f JCurs
forall (f :: * -> *). Monad f => JCurs -> DecodeResult f JCurs
down (JCurs -> DecodeResult f JCurs)
-> (JCurs -> DecodeResult f a) -> JCurs -> DecodeResult f a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Decoder f a -> JCurs -> DecodeResult f a
forall (f :: * -> *) b.
Monad f =>
Text -> Decoder f b -> JCurs -> DecodeResult f b
fromKey Text
k Decoder f a
d)

-- | A version of 'fromKey' that returns its result in 'Maybe'. If the key is
-- not present in the object, 'Nothing' is returned. If the key is present,
-- decoding will be performed as with 'fromKey'.
fromKeyOptional
  :: Monad f
  => Text
  -> Decoder f b
  -> JCurs
  -> DecodeResult f (Maybe b)
fromKeyOptional :: Text -> Decoder f b -> JCurs -> DecodeResult f (Maybe b)
fromKeyOptional Text
k Decoder f b
d JCurs
c =
  Maybe JCurs -> DecodeResult f (Maybe b)
focus' (Maybe JCurs -> DecodeResult f (Maybe b))
-> DecodeResult f (Maybe JCurs) -> DecodeResult f (Maybe b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DecodeResult f (Maybe JCurs)
-> (DecodeError -> DecodeResult f (Maybe JCurs))
-> DecodeResult f (Maybe JCurs)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (JCurs -> Maybe JCurs
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JCurs -> Maybe JCurs)
-> DecodeResult f JCurs -> DecodeResult f (Maybe JCurs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> JCurs -> DecodeResult f JCurs
forall (f :: * -> *).
Monad f =>
Text -> JCurs -> DecodeResult f JCurs
moveToKey Text
k JCurs
c) (\DecodeError
de -> case DecodeError
de of
    KeyNotFound Text
_ -> Maybe JCurs -> DecodeResult f (Maybe JCurs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe JCurs
forall a. Maybe a
Nothing
    DecodeError
_             -> AReview DecodeError DecodeError
-> DecodeError -> DecodeResult f (Maybe JCurs)
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview DecodeError DecodeError
forall r. AsDecodeError r => Prism' r DecodeError
_DecodeError DecodeError
de)
  where
    focus' :: Maybe JCurs -> DecodeResult f (Maybe b)
focus' = DecodeResult f (Maybe b)
-> (JCurs -> DecodeResult f (Maybe b))
-> Maybe JCurs
-> DecodeResult f (Maybe b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe b -> DecodeResult f (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing) ((b -> Maybe b) -> DecodeResult f b -> DecodeResult f (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Maybe b
forall a. a -> Maybe a
Just (DecodeResult f b -> DecodeResult f (Maybe b))
-> (JCurs -> DecodeResult f b) -> JCurs -> DecodeResult f (Maybe b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Decoder f b -> JCurs -> DecodeResult f b
forall (f :: * -> *) a.
Monad f =>
Decoder f a -> JCurs -> DecodeResult f a
focus Decoder f b
d)

-- | A version of 'atKey' that returns its result in 'Maybe'. If the key is
-- not present in the object, 'Nothing' is returned. If the key is present,
-- decoding will be performed as with 'atKey'.
--
-- For example, if a key could be absent and could be null if present,
-- it could be decoded as follows:
--
-- @
-- join \<$> atKeyOptional \"key\" (maybeOrNull text)
-- @
atKeyOptional
  :: Monad f
  => Text
  -> Decoder f b
  -> Decoder f (Maybe b)
atKeyOptional :: Text -> Decoder f b -> Decoder f (Maybe b)
atKeyOptional Text
k Decoder f b
d = (JCurs -> DecodeResult f (Maybe b)) -> Decoder f (Maybe b)
forall (f :: * -> *) a. (JCurs -> DecodeResult f a) -> Decoder f a
withCursor (JCurs -> DecodeResult f JCurs
forall (f :: * -> *). Monad f => JCurs -> DecodeResult f JCurs
down (JCurs -> DecodeResult f JCurs)
-> (JCurs -> DecodeResult f (Maybe b))
-> JCurs
-> DecodeResult f (Maybe b)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Decoder f b -> JCurs -> DecodeResult f (Maybe b)
forall (f :: * -> *) b.
Monad f =>
Text -> Decoder f b -> JCurs -> DecodeResult f (Maybe b)
fromKeyOptional Text
k Decoder f b
d)

-- | Used internally in the construction of the basic 'Decoder's. Takes a 'Text'
-- description of the thing you expect to find at the current cursor, and a
-- function to convert the 'Json' structure found there into something else.
--
-- Useful if you want to decide how a 'Json' value is converted to another type.
--
atCursor
  :: Monad f
  => Text
  -> (Json -> Maybe c)
  -> Decoder f c
atCursor :: Text -> (Json -> Maybe c) -> Decoder f c
atCursor Text
m Json -> Maybe c
c = (JCurs -> DecodeResult f c) -> Decoder f c
forall (f :: * -> *) a. (JCurs -> DecodeResult f a) -> Decoder f a
withCursor ((JCurs -> DecodeResult f c) -> Decoder f c)
-> (JCurs -> DecodeResult f c) -> Decoder f c
forall a b. (a -> b) -> a -> b
$ \JCurs
curs -> do
  ParseFn
p <- DecodeResult f ParseFn
forall r (m :: * -> *). MonadReader r m => m r
ask
  ParseFn -> JCurs -> DecodeResult f Json
forall (f :: * -> *) a.
Monad f =>
(ByteString -> Either DecodeError a) -> JCurs -> DecodeResult f a
jsonAtCursor ParseFn
p JCurs
curs DecodeResult f Json
-> (Json -> DecodeResult f c) -> DecodeResult f c
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    Either DecodeError c -> DecodeResult f c
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either DecodeError c -> DecodeResult f c)
-> (Json -> Either DecodeError c) -> Json -> DecodeResult f c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. DecodeError -> Maybe c -> Either DecodeError c
forall a b. a -> Maybe b -> Either a b
note (Text -> DecodeError
ConversionFailure Text
m) (Maybe c -> Either DecodeError c)
-> (Json -> Maybe c) -> Json -> Either DecodeError c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Json -> Maybe c
c

-- | Attempt to work with a 'JCurs' provided the type of 'Json' at the current
-- position matches your expectations.
--
-- Such as:
--
-- @
-- withType JsonTypeArray d
-- @
--
-- @d@ will only be entered if the cursor at the current position is a JSON
-- array: '[]'.
--
withType
  :: Monad f
  => JsonType
  -> (JCurs -> DecodeResult f a)
  -> JCurs
  -> DecodeResult f a
withType :: JsonType
-> (JCurs -> DecodeResult f a) -> JCurs -> DecodeResult f a
withType JsonType
t JCurs -> DecodeResult f a
d JCurs
c =
  if JsonType -> Maybe JsonType -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem JsonType
t (Maybe JsonType -> Bool) -> Maybe JsonType -> Bool
forall a b. (a -> b) -> a -> b
$ Cursor -> Maybe JsonType
forall a. JsonTypeAt a => a -> Maybe JsonType
jsonTypeAt (JCurs -> Cursor
unJCurs JCurs
c) then JCurs -> DecodeResult f a
d JCurs
c
  else AReview DecodeError JsonType -> JsonType -> DecodeResult f a
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview DecodeError JsonType
forall r. AsDecodeError r => Prism' r JsonType
_TypeMismatch JsonType
t

-- | Higher order function for combining a folding function with repeated cursor
-- movements. This lets you combine arbitrary cursor movements with an accumulating
-- function.
--
-- The functions 'leftwardCons' and 'rightwardSnoc' are both implemented using
-- this function.
--
-- @
-- leftwardCons = foldCursor (flip cons) moveLeft1
-- @
--
-- @
-- rightwardSnoc = foldCursor snoc moveRight1
-- @
--
foldCursor
  :: Monad f
  => (b -> a -> b)
  -> (JCurs -> DecodeResult f JCurs)
  -> b
  -> Decoder f a
  -> JCurs
  -> DecodeResult f b
foldCursor :: (b -> a -> b)
-> (JCurs -> DecodeResult f JCurs)
-> b
-> Decoder f a
-> JCurs
-> DecodeResult f b
foldCursor b -> a -> b
nom JCurs -> DecodeResult f JCurs
f b
s Decoder f a
elemD JCurs
curs = ReaderT ParseFn (DecodeResultT Count DecodeError f) b
-> DecodeResult f b
forall (f :: * -> *) a.
ReaderT ParseFn (DecodeResultT Count DecodeError f) a
-> DecodeResult f a
DecodeResult (ReaderT ParseFn (DecodeResultT Count DecodeError f) b
 -> DecodeResult f b)
-> ((ParseFn -> DecodeResultT Count DecodeError f b)
    -> ReaderT ParseFn (DecodeResultT Count DecodeError f) b)
-> (ParseFn -> DecodeResultT Count DecodeError f b)
-> DecodeResult f b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (ParseFn -> DecodeResultT Count DecodeError f b)
-> ReaderT ParseFn (DecodeResultT Count DecodeError f) b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((ParseFn -> DecodeResultT Count DecodeError f b)
 -> DecodeResult f b)
-> (ParseFn -> DecodeResultT Count DecodeError f b)
-> DecodeResult f b
forall a b. (a -> b) -> a -> b
$ \ParseFn
p ->
  b
-> (b -> a -> b)
-> (JCurs -> DecodeResultT Count DecodeError f JCurs)
-> Decoder' JCurs Count DecodeError f a
-> JCurs
-> DecodeResultT Count DecodeError f b
forall (f :: * -> *) b a c i e.
Monad f =>
b
-> (b -> a -> b)
-> (c -> DecodeResultT i e f c)
-> Decoder' c i e f a
-> c
-> DecodeResultT i e f b
DI.foldCursor' b
s b -> a -> b
nom
    ((ReaderT ParseFn (DecodeResultT Count DecodeError f) JCurs
 -> ParseFn -> DecodeResultT Count DecodeError f JCurs)
-> ParseFn
-> ReaderT ParseFn (DecodeResultT Count DecodeError f) JCurs
-> DecodeResultT Count DecodeError f JCurs
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT ParseFn (DecodeResultT Count DecodeError f) JCurs
-> ParseFn -> DecodeResultT Count DecodeError f JCurs
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ParseFn
p (ReaderT ParseFn (DecodeResultT Count DecodeError f) JCurs
 -> DecodeResultT Count DecodeError f JCurs)
-> (JCurs
    -> ReaderT ParseFn (DecodeResultT Count DecodeError f) JCurs)
-> JCurs
-> DecodeResultT Count DecodeError f JCurs
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. DecodeResult f JCurs
-> ReaderT ParseFn (DecodeResultT Count DecodeError f) JCurs
forall (f :: * -> *) a.
DecodeResult f a
-> ReaderT ParseFn (DecodeResultT Count DecodeError f) a
unDecodeResult (DecodeResult f JCurs
 -> ReaderT ParseFn (DecodeResultT Count DecodeError f) JCurs)
-> (JCurs -> DecodeResult f JCurs)
-> JCurs
-> ReaderT ParseFn (DecodeResultT Count DecodeError f) JCurs
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. JCurs -> DecodeResult f JCurs
f)
    ((JCurs -> DecodeResultT Count DecodeError f a)
-> Decoder' JCurs Count DecodeError f a
forall c i e (f :: * -> *) a.
(c -> DecodeResultT i e f a) -> Decoder' c i e f a
DI.Decoder' ((JCurs -> DecodeResultT Count DecodeError f a)
 -> Decoder' JCurs Count DecodeError f a)
-> (JCurs -> DecodeResultT Count DecodeError f a)
-> Decoder' JCurs Count DecodeError f a
forall a b. (a -> b) -> a -> b
$ Decoder f a
-> ParseFn -> JCurs -> DecodeResultT Count DecodeError f a
forall (f :: * -> *) a.
Decoder f a
-> ParseFn -> JCurs -> DecodeResultT Count DecodeError f a
runDecoder Decoder f a
elemD ParseFn
p)
    JCurs
curs

-- | A specialised decoder for moving over a JSON object where the keys are
-- values that you would like to have as part of the value at the different
-- keys.
--
-- An example of such an input is:
--
-- @
-- { \"Collection\" : {
--   \"BobsInput_ce43dff22\": {
--     \"someValue\": \"Some data\"
--   },
--   \"FredsInput_a4b32def\": {
--     \"someValue\": \"Some different data\"
--   }
-- }
-- @
--
-- Where those key values like \"XInput_YYYY\" are to be included in the object.
--
-- Given a type like this:
--
-- @
-- data ContainsItsKey = ContainsItsKey
--   { _containsItsKey_KeyValue :: Text
--   , _containsItsKey_SomeValue :: Text
--   }
-- @
--
-- To decode the above you would use this function like so:
--
-- @
-- takesKeyDecoder :: Monad f => Text -> Decoder f ContainsItsKey
-- takesKeyDecoder k = ContainsItsKey k \<$\> D.atKey \"someValue\" D.text
--
-- collectionDecoder :: Monad f => Decoder f [ContainsItsKey]
-- collectionDecoder = D.atKey \"Collection\" $ D.passKeysToValues [] D.text takesKeyDecoder
-- @
--
passKeysToValues
  :: ( Snoc c c v v
     , Monad f
     )
  => c
  -> Decoder f k
  -> (k -> Decoder f v)
  -> Decoder f c
passKeysToValues :: c -> Decoder f k -> (k -> Decoder f v) -> Decoder f c
passKeysToValues c
empty Decoder f k
dK k -> Decoder f v
kDV = (JCurs -> DecodeResult f c) -> Decoder f c
forall (f :: * -> *) a. (JCurs -> DecodeResult f a) -> Decoder f a
withCursor ((JCurs -> DecodeResult f c) -> Decoder f c)
-> (JCurs -> DecodeResult f c) -> Decoder f c
forall a b. (a -> b) -> a -> b
$ JCurs -> DecodeResult f JCurs
forall (f :: * -> *). Monad f => JCurs -> DecodeResult f JCurs
down (JCurs -> DecodeResult f JCurs)
-> (JCurs -> DecodeResult f c) -> JCurs -> DecodeResult f c
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (c -> v -> c)
-> (JCurs -> DecodeResult f JCurs)
-> c
-> Decoder f v
-> JCurs
-> DecodeResult f c
forall (f :: * -> *) b a.
Monad f =>
(b -> a -> b)
-> (JCurs -> DecodeResult f JCurs)
-> b
-> Decoder f a
-> JCurs
-> DecodeResult f b
foldCursor c -> v -> c
forall s a. Snoc s s a a => s -> a -> s
snoc
  (Natural -> JCurs -> DecodeResult f JCurs
forall (f :: * -> *).
Monad f =>
Natural -> JCurs -> DecodeResult f JCurs
moveRightN (Natural -> Natural
successor' (Natural -> Natural
successor' Natural
zero'))) c
empty
  ((JCurs -> DecodeResult f v) -> Decoder f v
forall (f :: * -> *) a. (JCurs -> DecodeResult f a) -> Decoder f a
withCursor ((JCurs -> DecodeResult f v) -> Decoder f v)
-> (JCurs -> DecodeResult f v) -> Decoder f v
forall a b. (a -> b) -> a -> b
$ \JCurs
c' -> Decoder f k -> JCurs -> DecodeResult f k
forall (f :: * -> *) a.
Monad f =>
Decoder f a -> JCurs -> DecodeResult f a
focus Decoder f k
dK JCurs
c' DecodeResult f k -> (k -> DecodeResult f v) -> DecodeResult f v
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \k
k -> JCurs -> DecodeResult f JCurs
forall (f :: * -> *). Monad f => JCurs -> DecodeResult f JCurs
moveRight1 JCurs
c' DecodeResult f JCurs
-> (JCurs -> DecodeResult f v) -> DecodeResult f v
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Decoder f v -> JCurs -> DecodeResult f v
forall (f :: * -> *) a.
Monad f =>
Decoder f a -> JCurs -> DecodeResult f a
focus (k -> Decoder f v
kDV k
k))

-- | Helper function for "pattern matching" on a decoded value to some Haskell
-- value. The 'Text' argument is used in the error message should this decoder
-- fail. Normally it would simply be the name of the type you are writing the
-- decoder for.
--
-- This is useful for decoding sum types, such as:
--
-- @
-- data MyEnum
--   = A
--   | B
--   | C
--
-- decodeMyEnum :: Monad f => Decoder f MyEnum
-- decodeMyEnum = D.oneOf D.text \"MyEnum\"
--   [ (\"a\", A)
--   , (\"b\", B)
--   , (\"c\", C)
--   ]
--
-- decodeMyEnumFromInt :: Monad f => Decoder f MyEnum
-- decodeMyEnumFromInt = D.oneOf D.int \"MyEnum\"
--   [ (1, A)
--   , (2, B)
--   , (3, C)
--   ]
-- @
--
oneOf
  :: ( Foldable g
     , Monad f
     , Eq a
     )
  => Decoder f a
  -> Text
  -> g (a, b)
  -> Decoder f b
oneOf :: Decoder f a -> Text -> g (a, b) -> Decoder f b
oneOf Decoder f a
d Text
l =
  ((a, b) -> Decoder f b -> Decoder f b)
-> Decoder f b -> g (a, b) -> Decoder f b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(a, b)
i Decoder f b
x -> (a, b) -> Decoder f b
g (a, b)
i Decoder f b -> Decoder f b -> Decoder f b
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> Decoder f b
x) Decoder f b
err
  where
    g :: (a, b) -> Decoder f b
g (a
a,b
b) = Decoder f a
d Decoder f a -> (a -> Decoder f b) -> Decoder f b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
t -> if a
t a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a then b -> Decoder f b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b else Decoder f b
err
    err :: Decoder f b
err = (Tagged Text (Identity Text)
 -> Tagged DecodeError (Identity DecodeError))
-> Text -> Decoder f b
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing Tagged Text (Identity Text)
-> Tagged DecodeError (Identity DecodeError)
forall r. AsDecodeError r => Prism' r Text
_ConversionFailure Text
l

-- | From the current cursor position, move leftwards one position at a time and
-- push each @a@ onto the front of some 'Cons' structure.
leftwardCons
  :: ( Monad f
     , Cons s s a a
     )
  => s
  -> Decoder f a
  -> JCurs
  -> DecodeResult f s
leftwardCons :: s -> Decoder f a -> JCurs -> DecodeResult f s
leftwardCons =
  (s -> a -> s)
-> (JCurs -> DecodeResult f JCurs)
-> s
-> Decoder f a
-> JCurs
-> DecodeResult f s
forall (f :: * -> *) b a.
Monad f =>
(b -> a -> b)
-> (JCurs -> DecodeResult f JCurs)
-> b
-> Decoder f a
-> JCurs
-> DecodeResult f b
foldCursor ((a -> s -> s) -> s -> a -> s
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> s -> s
forall s a. Cons s s a a => a -> s -> s
cons) JCurs -> DecodeResult f JCurs
forall (f :: * -> *). Monad f => JCurs -> DecodeResult f JCurs
moveLeft1

-- | From the current cursor position, move rightwards one position at a time,
-- and append the @a@ to some 'Snoc' structure.
rightwardSnoc
  :: ( Monad f
     , Snoc s s a a
     )
  => s
  -> Decoder f a
  -> JCurs
  -> DecodeResult f s
rightwardSnoc :: s -> Decoder f a -> JCurs -> DecodeResult f s
rightwardSnoc =
  (s -> a -> s)
-> (JCurs -> DecodeResult f JCurs)
-> s
-> Decoder f a
-> JCurs
-> DecodeResult f s
forall (f :: * -> *) b a.
Monad f =>
(b -> a -> b)
-> (JCurs -> DecodeResult f JCurs)
-> b
-> Decoder f a
-> JCurs
-> DecodeResult f b
foldCursor s -> a -> s
forall s a. Snoc s s a a => s -> a -> s
snoc JCurs -> DecodeResult f JCurs
forall (f :: * -> *). Monad f => JCurs -> DecodeResult f JCurs
moveRight1

-- | Decoder for some 'Integral' type. This conversion is walked through Mayan,
-- I mean, 'Scientific' to try to avoid numeric explosion issues.
integral :: (Monad f, Integral n, Bounded n) => Decoder f n
integral :: Decoder f n
integral = Text -> (Json -> Maybe n) -> Decoder f n
forall (f :: * -> *) c.
Monad f =>
Text -> (Json -> Maybe c) -> Decoder f c
atCursor Text
"integral" Json -> Maybe n
forall i a ws.
(Bounded i, Integral i, AsJType a ws a) =>
a -> Maybe i
DI.integral'

-- | At the given cursor position, return the 'Count' or 'rank' of that
-- position. Useful if you want to build a map of a complicated structure such that
-- you're able to optimise your 'Decoder' by using 'moveToRankN' instead of
-- individual cursor movements.
rank :: Monad f => Decoder f Count
rank :: Decoder f Count
rank = (JCurs -> DecodeResult f Count) -> Decoder f Count
forall (f :: * -> *) a. (JCurs -> DecodeResult f a) -> Decoder f a
withCursor (Count -> DecodeResult f Count
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Count -> DecodeResult f Count)
-> (JCurs -> Count) -> JCurs -> DecodeResult f Count
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Getting Count Cursor Count -> Cursor -> Count
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Count Cursor Count
Lens Cursor Cursor Count Count
cursorRankL (Cursor -> Count) -> (JCurs -> Cursor) -> JCurs -> Count
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. JCurs -> Cursor
unJCurs)

-- | Create a 'Decoder' from a 'Control.Lens.Prism''.
--
prismD
  :: Monad f
  => Prism' a b
  -> Decoder f a
  -> Decoder f (Maybe b)
prismD :: Prism' a b -> Decoder f a -> Decoder f (Maybe b)
prismD Prism' a b
p =
  (a -> Maybe b) -> Decoder f a -> Decoder f (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting (First b) a b -> a -> Maybe b
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First b) a b
Prism' a b
p)

-- | As per 'prismD' but fail the 'Decoder' if unsuccessful.
prismDOrFail
  :: Monad f
  => DecodeError
  -> Prism' a b
  -> Decoder f a
  -> Decoder f b
prismDOrFail :: DecodeError -> Prism' a b -> Decoder f a -> Decoder f b
prismDOrFail DecodeError
e = (a -> DecodeError) -> Prism' a b -> Decoder f a -> Decoder f b
forall (f :: * -> *) a b.
Monad f =>
(a -> DecodeError) -> Prism' a b -> Decoder f a -> Decoder f b
prismDOrFail' (DecodeError -> a -> DecodeError
forall a b. a -> b -> a
const DecodeError
e)

-- | Like 'prismDOrFail', but lets you use the @a@ to construct the error.
prismDOrFail'
  :: Monad f
  => (a -> DecodeError)
  -> Prism' a b
  -> Decoder f a
  -> Decoder f b
prismDOrFail' :: (a -> DecodeError) -> Prism' a b -> Decoder f a -> Decoder f b
prismDOrFail' a -> DecodeError
e Prism' a b
p Decoder f a
d = (JCurs -> DecodeResult f b) -> Decoder f b
forall (f :: * -> *) a. (JCurs -> DecodeResult f a) -> Decoder f a
withCursor ((JCurs -> DecodeResult f b) -> Decoder f b)
-> (JCurs -> DecodeResult f b) -> Decoder f b
forall a b. (a -> b) -> a -> b
$
  Decoder f a -> JCurs -> DecodeResult f a
forall (f :: * -> *) a.
Monad f =>
Decoder f a -> JCurs -> DecodeResult f a
focus Decoder f a
d (JCurs -> DecodeResult f a)
-> (a -> DecodeResult f b) -> JCurs -> DecodeResult f b
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (a -> DecodeResult f b)
-> (b -> DecodeResult f b) -> Either a b -> DecodeResult f b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Either.either (AReview DecodeError DecodeError -> DecodeError -> DecodeResult f b
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview DecodeError DecodeError
forall r. AsDecodeError r => Prism' r DecodeError
_DecodeError (DecodeError -> DecodeResult f b)
-> (a -> DecodeError) -> a -> DecodeResult f b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> DecodeError
e) b -> DecodeResult f b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a b -> DecodeResult f b)
-> (a -> Either a b) -> a -> DecodeResult f b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. APrism a a b b -> a -> Either a b
forall s t a b. APrism s t a b -> s -> Either t a
matching APrism a a b b
Prism' a b
p

-- | Decode an 'Int'.
int :: Monad f => Decoder f Int
int :: Decoder f Int
int = Decoder f Int
forall (f :: * -> *) n.
(Monad f, Integral n, Bounded n) =>
Decoder f n
integral

-- | Decode a 'Scientific' number value.
scientific :: Monad f => Decoder f Scientific
scientific :: Decoder f Scientific
scientific = Text -> (Json -> Maybe Scientific) -> Decoder f Scientific
forall (f :: * -> *) c.
Monad f =>
Text -> (Json -> Maybe c) -> Decoder f c
atCursor Text
"scientific" Json -> Maybe Scientific
forall a ws. AsJType a ws a => a -> Maybe Scientific
DI.scientific'

-- | Decode a 'String' value.
string :: Monad f => Decoder f String
string :: Decoder f String
string = Text -> (Json -> Maybe String) -> Decoder f String
forall (f :: * -> *) c.
Monad f =>
Text -> (Json -> Maybe c) -> Decoder f c
atCursor Text
"string" Json -> Maybe String
forall a ws. AsJType a ws a => a -> Maybe String
DI.string'

-- | Decode a strict 'ByteString' value.
strictByteString :: Monad f => Decoder f ByteString
strictByteString :: Decoder f ByteString
strictByteString = Text -> (Json -> Maybe ByteString) -> Decoder f ByteString
forall (f :: * -> *) c.
Monad f =>
Text -> (Json -> Maybe c) -> Decoder f c
atCursor Text
"strict bytestring" Json -> Maybe ByteString
forall a ws. AsJType a ws a => a -> Maybe ByteString
DI.strictByteString'

-- | Decode a lazy 'ByteString' value.
lazyByteString :: Monad f => Decoder f BL.ByteString
lazyByteString :: Decoder f ByteString
lazyByteString = Text -> (Json -> Maybe ByteString) -> Decoder f ByteString
forall (f :: * -> *) c.
Monad f =>
Text -> (Json -> Maybe c) -> Decoder f c
atCursor Text
"lazy bytestring" Json -> Maybe ByteString
forall a ws. AsJType a ws a => a -> Maybe ByteString
DI.lazyByteString'

-- | Decode a 'Char' value that is equivalent to a Haskell 'Char' value, as Haskell 'Char' supports a wider range than JSON.
unboundedChar :: Monad f => Decoder f Char
unboundedChar :: Decoder f Char
unboundedChar = Text -> (Json -> Maybe Char) -> Decoder f Char
forall (f :: * -> *) c.
Monad f =>
Text -> (Json -> Maybe c) -> Decoder f c
atCursor Text
"unbounded char" Json -> Maybe Char
forall a ws. AsJType a ws a => a -> Maybe Char
DI.unboundedChar'

-- | Decode a 'Char' that will fail if the 'Char' is outside of the range U+D800 to U+DFFF.
boundedChar :: Monad f => Decoder f Char
boundedChar :: Decoder f Char
boundedChar = Text -> (Json -> Maybe Char) -> Decoder f Char
forall (f :: * -> *) c.
Monad f =>
Text -> (Json -> Maybe c) -> Decoder f c
atCursor Text
"bounded char" Json -> Maybe Char
forall a ws. AsJType a ws a => a -> Maybe Char
DI.boundedChar'

-- | Decode the 'Json' structure at the cursor. Useful if you don't have a need
-- to convert the Json and only want to make changes before sending it on its way.
json :: Monad f => Decoder f Json
json :: Decoder f Json
json = Text -> (Json -> Maybe Json) -> Decoder f Json
forall (f :: * -> *) c.
Monad f =>
Text -> (Json -> Maybe c) -> Decoder f c
atCursor Text
"json" Json -> Maybe Json
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Decode 'Text'
text :: Monad f => Decoder f Text
text :: Decoder f Text
text = Text -> (Json -> Maybe Text) -> Decoder f Text
forall (f :: * -> *) c.
Monad f =>
Text -> (Json -> Maybe c) -> Decoder f c
atCursor Text
"text" Json -> Maybe Text
forall a ws. AsJType a ws a => a -> Maybe Text
DI.text'

-- | Decode an explicit 'null' value at the current cursor position.
null :: Monad f => Decoder f ()
null :: Decoder f ()
null = Text -> (Json -> Maybe ()) -> Decoder f ()
forall (f :: * -> *) c.
Monad f =>
Text -> (Json -> Maybe c) -> Decoder f c
atCursor Text
"null" Json -> Maybe ()
forall a ws. AsJType a ws a => a -> Maybe ()
DI.null'

-- | Decode a 'Bool' value.
bool :: Monad f => Decoder f Bool
bool :: Decoder f Bool
bool = Text -> (Json -> Maybe Bool) -> Decoder f Bool
forall (f :: * -> *) c.
Monad f =>
Text -> (Json -> Maybe c) -> Decoder f c
atCursor Text
"bool" Json -> Maybe Bool
forall a ws. AsJType a ws a => a -> Maybe Bool
DI.bool'

-- | Given a 'Decoder' for @a@, attempt to decode a 'NonEmpty' list of @a@ at
-- the current cursor position.
nonemptyAt
  :: Monad f
  => Decoder f a
  -> JCurs
  -> DecodeResult f (NonEmpty a)
nonemptyAt :: Decoder f a -> JCurs -> DecodeResult f (NonEmpty a)
nonemptyAt Decoder f a
elemD = JsonType
-> (JCurs -> DecodeResult f (NonEmpty a))
-> JCurs
-> DecodeResult f (NonEmpty a)
forall (f :: * -> *) a.
Monad f =>
JsonType
-> (JCurs -> DecodeResult f a) -> JCurs -> DecodeResult f a
withType JsonType
JsonTypeArray ((JCurs -> DecodeResult f (NonEmpty a))
 -> JCurs -> DecodeResult f (NonEmpty a))
-> (JCurs -> DecodeResult f (NonEmpty a))
-> JCurs
-> DecodeResult f (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ JCurs -> DecodeResult f JCurs
forall (f :: * -> *). Monad f => JCurs -> DecodeResult f JCurs
down (JCurs -> DecodeResult f JCurs)
-> (JCurs -> DecodeResult f (NonEmpty a))
-> JCurs
-> DecodeResult f (NonEmpty a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \JCurs
curs -> do
  a
h <- Decoder f a -> JCurs -> DecodeResult f a
forall (f :: * -> *) a.
Monad f =>
Decoder f a -> JCurs -> DecodeResult f a
focus Decoder f a
elemD JCurs
curs
  DecodeResult f JCurs -> DecodeResult f (Maybe JCurs)
forall e (m :: * -> *) a. MonadError e m => m a -> m (Maybe a)
DI.try (JCurs -> DecodeResult f JCurs
forall (f :: * -> *). Monad f => JCurs -> DecodeResult f JCurs
moveRight1 JCurs
curs) DecodeResult f (Maybe JCurs)
-> (Maybe JCurs -> DecodeResult f (NonEmpty a))
-> DecodeResult f (NonEmpty a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DecodeResult f (NonEmpty a)
-> (JCurs -> DecodeResult f (NonEmpty a))
-> Maybe JCurs
-> DecodeResult f (NonEmpty a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (NonEmpty a -> DecodeResult f (NonEmpty a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty a -> DecodeResult f (NonEmpty a))
-> NonEmpty a -> DecodeResult f (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ a
h a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [])
    (([a] -> NonEmpty a)
-> DecodeResult f [a] -> DecodeResult f (NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
h a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:|) (DecodeResult f [a] -> DecodeResult f (NonEmpty a))
-> (JCurs -> DecodeResult f [a])
-> JCurs
-> DecodeResult f (NonEmpty a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [a] -> Decoder f a -> JCurs -> DecodeResult f [a]
forall (f :: * -> *) s a.
(Monad f, Snoc s s a a) =>
s -> Decoder f a -> JCurs -> DecodeResult f s
rightwardSnoc [] Decoder f a
elemD)

-- | Helper to create a 'NonEmpty a' 'Decoder'.
nonempty :: Monad f => Decoder f a -> Decoder f (NonEmpty a)
nonempty :: Decoder f a -> Decoder f (NonEmpty a)
nonempty Decoder f a
d = (JCurs -> DecodeResult f (NonEmpty a)) -> Decoder f (NonEmpty a)
forall (f :: * -> *) a. (JCurs -> DecodeResult f a) -> Decoder f a
withCursor (Decoder f a -> JCurs -> DecodeResult f (NonEmpty a)
forall (f :: * -> *) a.
Monad f =>
Decoder f a -> JCurs -> DecodeResult f (NonEmpty a)
nonemptyAt Decoder f a
d)

-- | Like 'nonemptyAt', this takes a 'Decoder' of @a@ and at the given cursor
-- will try to decode a '[a]'.
listAt
  :: Monad f
  => Decoder f a
  -> JCurs
  -> DecodeResult f [a]
listAt :: Decoder f a -> JCurs -> DecodeResult f [a]
listAt Decoder f a
elemD = JsonType
-> (JCurs -> DecodeResult f [a]) -> JCurs -> DecodeResult f [a]
forall (f :: * -> *) a.
Monad f =>
JsonType
-> (JCurs -> DecodeResult f a) -> JCurs -> DecodeResult f a
withType JsonType
JsonTypeArray ((JCurs -> DecodeResult f [a]) -> JCurs -> DecodeResult f [a])
-> (JCurs -> DecodeResult f [a]) -> JCurs -> DecodeResult f [a]
forall a b. (a -> b) -> a -> b
$ \JCurs
c ->
  DecodeResult f JCurs -> DecodeResult f (Maybe JCurs)
forall e (m :: * -> *) a. MonadError e m => m a -> m (Maybe a)
DI.try (JCurs -> DecodeResult f JCurs
forall (f :: * -> *). Monad f => JCurs -> DecodeResult f JCurs
down JCurs
c) DecodeResult f (Maybe JCurs)
-> (Maybe JCurs -> DecodeResult f [a]) -> DecodeResult f [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DecodeResult f [a]
-> (JCurs -> DecodeResult f [a])
-> Maybe JCurs
-> DecodeResult f [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([a] -> DecodeResult f [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
forall a. Monoid a => a
mempty) ([a] -> Decoder f a -> JCurs -> DecodeResult f [a]
forall (f :: * -> *) s a.
(Monad f, Snoc s s a a) =>
s -> Decoder f a -> JCurs -> DecodeResult f s
rightwardSnoc [a]
forall a. Monoid a => a
mempty Decoder f a
elemD)

-- | Helper function to simplify writing a '[]' decoder.
list :: Monad f => Decoder f a -> Decoder f [a]
list :: Decoder f a -> Decoder f [a]
list Decoder f a
d = (JCurs -> DecodeResult f [a]) -> Decoder f [a]
forall (f :: * -> *) a. (JCurs -> DecodeResult f a) -> Decoder f a
withCursor (Decoder f a -> JCurs -> DecodeResult f [a]
forall (f :: * -> *) a.
Monad f =>
Decoder f a -> JCurs -> DecodeResult f [a]
listAt Decoder f a
d)

-- | Try to decode an object using the given key and value 'Decoder's at the
-- given cursor.
objectAsKeyValuesAt
  :: Monad f
  => Decoder f k
  -> Decoder f v
  -> JCurs
  -> DecodeResult f [(k,v)]
objectAsKeyValuesAt :: Decoder f k -> Decoder f v -> JCurs -> DecodeResult f [(k, v)]
objectAsKeyValuesAt Decoder f k
keyD Decoder f v
valueD = JsonType
-> (JCurs -> DecodeResult f [(k, v)])
-> JCurs
-> DecodeResult f [(k, v)]
forall (f :: * -> *) a.
Monad f =>
JsonType
-> (JCurs -> DecodeResult f a) -> JCurs -> DecodeResult f a
withType JsonType
JsonTypeObject ((JCurs -> DecodeResult f [(k, v)])
 -> JCurs -> DecodeResult f [(k, v)])
-> (JCurs -> DecodeResult f [(k, v)])
-> JCurs
-> DecodeResult f [(k, v)]
forall a b. (a -> b) -> a -> b
$ \JCurs
curs ->
  DecodeResult f JCurs -> DecodeResult f (Maybe JCurs)
forall e (m :: * -> *) a. MonadError e m => m a -> m (Maybe a)
DI.try (JCurs -> DecodeResult f JCurs
forall (f :: * -> *). Monad f => JCurs -> DecodeResult f JCurs
down JCurs
curs) DecodeResult f (Maybe JCurs)
-> (Maybe JCurs -> DecodeResult f [(k, v)])
-> DecodeResult f [(k, v)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DecodeResult f [(k, v)]
-> (JCurs -> DecodeResult f [(k, v)])
-> Maybe JCurs
-> DecodeResult f [(k, v)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    ([(k, v)] -> DecodeResult f [(k, v)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(k, v)]
forall a. Monoid a => a
mempty)
    (([(k, v)] -> (k, v) -> [(k, v)])
-> (JCurs -> DecodeResult f JCurs)
-> [(k, v)]
-> Decoder f (k, v)
-> JCurs
-> DecodeResult f [(k, v)]
forall (f :: * -> *) b a.
Monad f =>
(b -> a -> b)
-> (JCurs -> DecodeResult f JCurs)
-> b
-> Decoder f a
-> JCurs
-> DecodeResult f b
foldCursor [(k, v)] -> (k, v) -> [(k, v)]
forall s a. Snoc s s a a => s -> a -> s
snoc (JCurs -> DecodeResult f JCurs
forall (f :: * -> *). Monad f => JCurs -> DecodeResult f JCurs
moveRight1 (JCurs -> DecodeResult f JCurs)
-> (JCurs -> DecodeResult f JCurs) -> JCurs -> DecodeResult f JCurs
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> JCurs -> DecodeResult f JCurs
forall (f :: * -> *). Monad f => JCurs -> DecodeResult f JCurs
moveRight1) [(k, v)]
forall a. Monoid a => a
mempty ((JCurs -> DecodeResult f (k, v)) -> Decoder f (k, v)
forall (f :: * -> *) a. (JCurs -> DecodeResult f a) -> Decoder f a
withCursor ((JCurs -> DecodeResult f (k, v)) -> Decoder f (k, v))
-> (JCurs -> DecodeResult f (k, v)) -> Decoder f (k, v)
forall a b. (a -> b) -> a -> b
$ \JCurs
c -> do
      k
k <- Decoder f k -> JCurs -> DecodeResult f k
forall (f :: * -> *) a.
Monad f =>
Decoder f a -> JCurs -> DecodeResult f a
focus Decoder f k
keyD JCurs
c
      v
v <- JCurs -> DecodeResult f JCurs
forall (f :: * -> *). Monad f => JCurs -> DecodeResult f JCurs
moveRight1 JCurs
c DecodeResult f JCurs
-> (JCurs -> DecodeResult f v) -> DecodeResult f v
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Decoder f v -> JCurs -> DecodeResult f v
forall (f :: * -> *) a.
Monad f =>
Decoder f a -> JCurs -> DecodeResult f a
focus Decoder f v
valueD
      (k, v) -> DecodeResult f (k, v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (k
k,v
v)
    ))

-- | Helper function to simplify writing a '{}' decoder.
objectAsKeyValues :: Monad f => Decoder f k -> Decoder f v -> Decoder f [(k,v)]
objectAsKeyValues :: Decoder f k -> Decoder f v -> Decoder f [(k, v)]
objectAsKeyValues Decoder f k
k Decoder f v
v = (JCurs -> DecodeResult f [(k, v)]) -> Decoder f [(k, v)]
forall (f :: * -> *) a. (JCurs -> DecodeResult f a) -> Decoder f a
withCursor (Decoder f k -> Decoder f v -> JCurs -> DecodeResult f [(k, v)]
forall (f :: * -> *) k v.
Monad f =>
Decoder f k -> Decoder f v -> JCurs -> DecodeResult f [(k, v)]
objectAsKeyValuesAt Decoder f k
k Decoder f v
v)

-- | Try to decode an optional value, returning the given default value if
-- 'Nothing' is returned.
withDefault
  :: Monad f
  => a
  -> Decoder f (Maybe a)
  -> Decoder f a
withDefault :: a -> Decoder f (Maybe a) -> Decoder f a
withDefault a
def Decoder f (Maybe a)
hasD =
  a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a) -> Decoder f (Maybe a) -> Decoder f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder f (Maybe a)
hasD

-- | Named to match it's 'Waargonaut.Encode.Encoder' counterpart, this function will decode an
-- optional value.
maybeOrNull
  :: Monad f
  => Decoder f a
  -> Decoder f (Maybe a)
maybeOrNull :: Decoder f a -> Decoder f (Maybe a)
maybeOrNull Decoder f a
a =
  (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Decoder f a -> Decoder f (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder f a
a) Decoder f (Maybe a) -> Decoder f (Maybe a) -> Decoder f (Maybe a)
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> (Maybe a
forall a. Maybe a
Nothing Maybe a -> Decoder f () -> Decoder f (Maybe a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Decoder f ()
forall (f :: * -> *). Monad f => Decoder f ()
null)

-- | Decode either an @a@ or a @b@, failing if neither 'Decoder' succeeds. The
-- 'Right' decoder is attempted first.
either
  :: Monad f
  => Decoder f a
  -> Decoder f b
  -> Decoder f (Either a b)
either :: Decoder f a -> Decoder f b -> Decoder f (Either a b)
either Decoder f a
leftD Decoder f b
rightD =
  (b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> Decoder f b -> Decoder f (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder f b
rightD) Decoder f (Either a b)
-> Decoder f (Either a b) -> Decoder f (Either a b)
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> (a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> Decoder f a -> Decoder f (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder f a
leftD)