{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeFamilies               #-}
-- | Internal types and functions for building Decoder infrastructure.
module Waargonaut.Decode.Internal
  ( CursorHistory' (..)
  , ppCursorHistory
  , compressHistory

  , DecodeResultT (..)
  , Decoder' (..)

  , withCursor'
  , runDecoderResultT
  , try
  , recordZipperMove

    -- * Generalised Decoder Functions
  , null'
  , int'
  , text'
  , string'
  , lazyByteString'
  , strictByteString'
  , unboundedChar'
  , boundedChar'
  , bool'
  , array'
  , integral'
  , scientific'
  , objTuples'
  , foldCursor'
  , prismDOrFail'

    -- * JSON Object to Map Functions
  , mapKeepingF
  , mapKeepingFirst
  , mapKeepingLast

    -- * Re-exports
  , module Waargonaut.Decode.Error
  , module Waargonaut.Decode.ZipperMove
  ) where

import           Control.Applicative             (liftA2, (<|>))
import           Control.Lens                    (Rewrapped, Wrapped (..), (%=),
                                                  _1, _Wrapped)
import qualified Control.Lens                    as L
import           Control.Monad                   ((>=>))
import           Control.Monad.Except            (ExceptT (..), MonadError (..),
                                                  liftEither, runExceptT)
import           Control.Monad.State             (MonadState (..), StateT (..))
import           Control.Monad.Trans.Class       (MonadTrans (lift))

import           Control.Monad.Error.Hoist       ((<!?>))
import           Control.Monad.Morph             (MFunctor (..), MMonad (..))

import           Data.Bifunctor                  (first)
import qualified Data.Foldable                   as F
import           Data.Functor                    (($>))
#if !MIN_VERSION_base(4,11,0)
import           Data.Semigroup                  ((<>))
#endif
import           Data.Sequence                   (Seq, fromList)

import           Data.ByteString                 (ByteString)
import qualified Data.ByteString.Lazy            as BL
import qualified Data.ByteString.Builder         as BB
import           Data.Text                       (Text)

import           Data.Map                        (Map)
import qualified Data.Map                        as Map

import qualified Data.Vector                     as V

import qualified Data.Witherable                 as Wither

import           Data.Scientific                 (Scientific)
import qualified Data.Scientific                 as Sci

import           Natural                         (Natural, _Natural)

import           Waargonaut.Types                (AsJType (..), JString,
                                                  jNumberToScientific,
                                                  jsonAssocKey, jsonAssocVal,
                                                  _JStringText)

import           Waargonaut.Types.CommaSep       (toList)
import           Waargonaut.Types.JChar          (jCharToChar, jCharToUtf8Char)

import           Text.PrettyPrint.Annotated.WL   (Doc, (<+>))

import           Waargonaut.Decode.Error         (AsDecodeError (..),
                                                  DecodeError (..))
import           Waargonaut.Decode.ZipperMove    (ZipperMove (..), ppZipperMove)

-- Track the history of the cursor as we move around the zipper.
--
-- It is indexed over the type of the index used to navigate the zipper.
newtype CursorHistory' i = CursorHistory'
  { CursorHistory' i -> Seq (ZipperMove, i)
unCursorHistory' :: Seq (ZipperMove, i)
  }
  deriving (Int -> CursorHistory' i -> ShowS
[CursorHistory' i] -> ShowS
CursorHistory' i -> String
(Int -> CursorHistory' i -> ShowS)
-> (CursorHistory' i -> String)
-> ([CursorHistory' i] -> ShowS)
-> Show (CursorHistory' i)
forall i. Show i => Int -> CursorHistory' i -> ShowS
forall i. Show i => [CursorHistory' i] -> ShowS
forall i. Show i => CursorHistory' i -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CursorHistory' i] -> ShowS
$cshowList :: forall i. Show i => [CursorHistory' i] -> ShowS
show :: CursorHistory' i -> String
$cshow :: forall i. Show i => CursorHistory' i -> String
showsPrec :: Int -> CursorHistory' i -> ShowS
$cshowsPrec :: forall i. Show i => Int -> CursorHistory' i -> ShowS
Show, CursorHistory' i -> CursorHistory' i -> Bool
(CursorHistory' i -> CursorHistory' i -> Bool)
-> (CursorHistory' i -> CursorHistory' i -> Bool)
-> Eq (CursorHistory' i)
forall i. Eq i => CursorHistory' i -> CursorHistory' i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CursorHistory' i -> CursorHistory' i -> Bool
$c/= :: forall i. Eq i => CursorHistory' i -> CursorHistory' i -> Bool
== :: CursorHistory' i -> CursorHistory' i -> Bool
$c== :: forall i. Eq i => CursorHistory' i -> CursorHistory' i -> Bool
Eq)

switchbackMoves
  :: (Natural -> a)
  -> (Natural -> a)
  -> Natural
  -> Natural
  -> b
  -> b
  -> [(a, b)]
  -> [(a, b)]
switchbackMoves :: (Natural -> a)
-> (Natural -> a)
-> Natural
-> Natural
-> b
-> b
-> [(a, b)]
-> [(a, b)]
switchbackMoves Natural -> a
a Natural -> a
b Natural
n Natural
m b
i b
i' [(a, b)]
sq =
  let
    n' :: Int
n' = Tagged Natural (Identity Natural) -> Tagged Int (Identity Int)
forall a. AsNatural a => Prism' a Natural
_Natural (Tagged Natural (Identity Natural) -> Tagged Int (Identity Int))
-> Natural -> Int
forall t b. AReview t b -> b -> t
L.# Natural
n :: Int
    m' :: Int
m' = Tagged Natural (Identity Natural) -> Tagged Int (Identity Int)
forall a. AsNatural a => Prism' a Natural
_Natural (Tagged Natural (Identity Natural) -> Tagged Int (Identity Int))
-> Natural -> Int
forall t b. AReview t b -> b -> t
L.# Natural
m
  in
    if Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
m'
    then (Natural -> a
a (Natural -> a) -> Natural -> a
forall a b. (a -> b) -> a -> b
$ (Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m') Int -> Getting Natural Int Natural -> Natural
forall s a. s -> Getting a s a -> a
L.^. Getting Natural Int Natural
forall a. AsNatural a => Prism' a Natural
_Natural, b
i)  (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
sq
    else (Natural -> a
b (Natural -> a) -> Natural -> a
forall a b. (a -> b) -> a -> b
$ (Int
m' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n') Int -> Getting Natural Int Natural -> Natural
forall s a. s -> Getting a s a -> a
L.^. Getting Natural Int Natural
forall a. AsNatural a => Prism' a Natural
_Natural, b
i') (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
sq

rmKeyJumps :: [(ZipperMove, i)] -> [(ZipperMove, i)]
rmKeyJumps :: [(ZipperMove, i)] -> [(ZipperMove, i)]
rmKeyJumps (d :: (ZipperMove, i)
d@(DAt Text
_, i
_) : (R Natural
_, i
_) : [(ZipperMove, i)]
sq) = (ZipperMove, i)
d(ZipperMove, i) -> [(ZipperMove, i)] -> [(ZipperMove, i)]
forall a. a -> [a] -> [a]
:[(ZipperMove, i)]
sq
rmKeyJumps [(ZipperMove, i)]
s                              = [(ZipperMove, i)]
s

combineLRMoves :: [(ZipperMove, i)] -> [(ZipperMove, i)]
combineLRMoves :: [(ZipperMove, i)] -> [(ZipperMove, i)]
combineLRMoves ((R Natural
n, i
_) : (R Natural
m, i
i)  : [(ZipperMove, i)]
sq) = (Natural -> ZipperMove
R (Natural
n Natural -> Natural -> Natural
forall a. Semigroup a => a -> a -> a
<> Natural
m), i
i) (ZipperMove, i) -> [(ZipperMove, i)] -> [(ZipperMove, i)]
forall a. a -> [a] -> [a]
: [(ZipperMove, i)]
sq
combineLRMoves ((L Natural
n, i
_) : (L Natural
m, i
i)  : [(ZipperMove, i)]
sq) = (Natural -> ZipperMove
L (Natural
n Natural -> Natural -> Natural
forall a. Semigroup a => a -> a -> a
<> Natural
m), i
i) (ZipperMove, i) -> [(ZipperMove, i)] -> [(ZipperMove, i)]
forall a. a -> [a] -> [a]
: [(ZipperMove, i)]
sq
combineLRMoves ((L Natural
n, i
i) : (R Natural
m, i
i') : [(ZipperMove, i)]
sq) = (Natural -> ZipperMove)
-> (Natural -> ZipperMove)
-> Natural
-> Natural
-> i
-> i
-> [(ZipperMove, i)]
-> [(ZipperMove, i)]
forall a b.
(Natural -> a)
-> (Natural -> a)
-> Natural
-> Natural
-> b
-> b
-> [(a, b)]
-> [(a, b)]
switchbackMoves Natural -> ZipperMove
L Natural -> ZipperMove
R Natural
n Natural
m i
i i
i' [(ZipperMove, i)]
sq
combineLRMoves ((R Natural
n, i
i) : (L Natural
m, i
i') : [(ZipperMove, i)]
sq) = (Natural -> ZipperMove)
-> (Natural -> ZipperMove)
-> Natural
-> Natural
-> i
-> i
-> [(ZipperMove, i)]
-> [(ZipperMove, i)]
forall a b.
(Natural -> a)
-> (Natural -> a)
-> Natural
-> Natural
-> b
-> b
-> [(a, b)]
-> [(a, b)]
switchbackMoves Natural -> ZipperMove
R Natural -> ZipperMove
L Natural
n Natural
m i
i i
i' [(ZipperMove, i)]
sq
combineLRMoves [(ZipperMove, i)]
s                           = [(ZipperMove, i)]
s

-- | This function will condense incidental movements, reducing the amount of
-- noise in the error output.
--
-- The rules that are currently applied are:
--
-- * [R n, R m]   = [R (n + m)]
-- * [L n, R m]   = [L (n + m)]
-- * [R n, L m]   = [R (n - m)] where n > m
-- * [R n, L m]   = [L (m - n)] where n < m
-- * [L n, R m]   = [L (n - m)] where n > m
-- * [L n, R m]   = [R (m - n)] where n < m
-- * [DAt k, R n] = [DAt k]
--
-- This function is automatically applied when using the 'ppCursorHistory'
-- function to render the cursor movements.
compressHistory :: CursorHistory' i -> CursorHistory' i
compressHistory :: CursorHistory' i -> CursorHistory' i
compressHistory = ASetter
  (CursorHistory' i)
  (CursorHistory' i)
  (Seq (ZipperMove, i))
  (Seq (ZipperMove, i))
-> (Seq (ZipperMove, i) -> Seq (ZipperMove, i))
-> CursorHistory' i
-> CursorHistory' i
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over ASetter
  (CursorHistory' i)
  (CursorHistory' i)
  (Seq (ZipperMove, i))
  (Seq (ZipperMove, i))
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped ([(ZipperMove, i)] -> Seq (ZipperMove, i)
forall a. [a] -> Seq a
fromList ([(ZipperMove, i)] -> Seq (ZipperMove, i))
-> (Seq (ZipperMove, i) -> [(ZipperMove, i)])
-> Seq (ZipperMove, i)
-> Seq (ZipperMove, i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(ZipperMove, i)] -> [(ZipperMove, i)])
-> [(ZipperMove, i)] -> [(ZipperMove, i)]
forall a. Plated a => (a -> a) -> a -> a
L.transform ([(ZipperMove, i)] -> [(ZipperMove, i)]
forall i. [(ZipperMove, i)] -> [(ZipperMove, i)]
combineLRMoves ([(ZipperMove, i)] -> [(ZipperMove, i)])
-> ([(ZipperMove, i)] -> [(ZipperMove, i)])
-> [(ZipperMove, i)]
-> [(ZipperMove, i)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ZipperMove, i)] -> [(ZipperMove, i)]
forall i. [(ZipperMove, i)] -> [(ZipperMove, i)]
rmKeyJumps) ([(ZipperMove, i)] -> [(ZipperMove, i)])
-> (Seq (ZipperMove, i) -> [(ZipperMove, i)])
-> Seq (ZipperMove, i)
-> [(ZipperMove, i)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (ZipperMove, i) -> [(ZipperMove, i)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList)

-- |
-- Pretty print the given 'CursorHistory'' to a more useful format compared to a 'Seq' of @i@.
ppCursorHistory
  :: CursorHistory' i
  -> Doc a
ppCursorHistory :: CursorHistory' i -> Doc a
ppCursorHistory =
  (Doc a -> Doc a -> Doc a) -> Doc a -> Seq (Doc a) -> Doc a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
(<+>) Doc a
forall a. Monoid a => a
mempty
  (Seq (Doc a) -> Doc a)
-> (CursorHistory' i -> Seq (Doc a)) -> CursorHistory' i -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ZipperMove, i) -> Doc a) -> Seq (ZipperMove, i) -> Seq (Doc a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ZipperMove -> Doc a
forall a. ZipperMove -> Doc a
ppZipperMove (ZipperMove -> Doc a)
-> ((ZipperMove, i) -> ZipperMove) -> (ZipperMove, i) -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ZipperMove, i) -> ZipperMove
forall a b. (a, b) -> a
fst)
  (Seq (ZipperMove, i) -> Seq (Doc a))
-> (CursorHistory' i -> Seq (ZipperMove, i))
-> CursorHistory' i
-> Seq (Doc a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CursorHistory' i -> Seq (ZipperMove, i)
forall i. CursorHistory' i -> Seq (ZipperMove, i)
unCursorHistory'
  (CursorHistory' i -> Seq (ZipperMove, i))
-> (CursorHistory' i -> CursorHistory' i)
-> CursorHistory' i
-> Seq (ZipperMove, i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CursorHistory' i -> CursorHistory' i
forall i. CursorHistory' i -> CursorHistory' i
compressHistory

instance CursorHistory' i ~ t => Rewrapped (CursorHistory' i) t

instance Wrapped (CursorHistory' i) where
  type Unwrapped (CursorHistory' i) = Seq (ZipperMove, i)
  _Wrapped' :: p (Unwrapped (CursorHistory' i)) (f (Unwrapped (CursorHistory' i)))
-> p (CursorHistory' i) (f (CursorHistory' i))
_Wrapped' = (CursorHistory' i -> Seq (ZipperMove, i))
-> (Seq (ZipperMove, i) -> CursorHistory' i)
-> Iso
     (CursorHistory' i)
     (CursorHistory' i)
     (Seq (ZipperMove, i))
     (Seq (ZipperMove, i))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
L.iso (\(CursorHistory' Seq (ZipperMove, i)
x) -> Seq (ZipperMove, i)
x) Seq (ZipperMove, i) -> CursorHistory' i
forall i. Seq (ZipperMove, i) -> CursorHistory' i
CursorHistory'
  {-# INLINE _Wrapped' #-}

-- |
-- The general structure used to maintain the history of the moves around the
-- zipper, as well as handle the decoding or movement errors that may occur.
-- This structure is generalised of the inner @f@ to allow you to interleave the
-- decoding with your own actions. As well as the error type @e@ so that you may
-- provide your own error type.
--
-- If you use the provided `Waargonaut.Decode` module then you probably won't
-- need to care about this type. It is provided so that you're not limited to
-- how we decide you should be running your decoder.
--
newtype DecodeResultT i e f a = DecodeResultT
  { DecodeResultT i e f a -> ExceptT e (StateT (CursorHistory' i) f) a
runDecodeResult :: ExceptT e (StateT (CursorHistory' i) f) a
  }
  deriving ( a -> DecodeResultT i e f b -> DecodeResultT i e f a
(a -> b) -> DecodeResultT i e f a -> DecodeResultT i e f b
(forall a b.
 (a -> b) -> DecodeResultT i e f a -> DecodeResultT i e f b)
-> (forall a b.
    a -> DecodeResultT i e f b -> DecodeResultT i e f a)
-> Functor (DecodeResultT i e f)
forall a b. a -> DecodeResultT i e f b -> DecodeResultT i e f a
forall a b.
(a -> b) -> DecodeResultT i e f a -> DecodeResultT i e f b
forall i e (f :: * -> *) a b.
Functor f =>
a -> DecodeResultT i e f b -> DecodeResultT i e f a
forall i e (f :: * -> *) a b.
Functor f =>
(a -> b) -> DecodeResultT i e f a -> DecodeResultT i e f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> DecodeResultT i e f b -> DecodeResultT i e f a
$c<$ :: forall i e (f :: * -> *) a b.
Functor f =>
a -> DecodeResultT i e f b -> DecodeResultT i e f a
fmap :: (a -> b) -> DecodeResultT i e f a -> DecodeResultT i e f b
$cfmap :: forall i e (f :: * -> *) a b.
Functor f =>
(a -> b) -> DecodeResultT i e f a -> DecodeResultT i e f b
Functor
           , Functor (DecodeResultT i e f)
a -> DecodeResultT i e f a
Functor (DecodeResultT i e f)
-> (forall a. a -> DecodeResultT i e f a)
-> (forall a b.
    DecodeResultT i e f (a -> b)
    -> DecodeResultT i e f a -> DecodeResultT i e f b)
-> (forall a b c.
    (a -> b -> c)
    -> DecodeResultT i e f a
    -> DecodeResultT i e f b
    -> DecodeResultT i e f c)
-> (forall a b.
    DecodeResultT i e f a
    -> DecodeResultT i e f b -> DecodeResultT i e f b)
-> (forall a b.
    DecodeResultT i e f a
    -> DecodeResultT i e f b -> DecodeResultT i e f a)
-> Applicative (DecodeResultT i e f)
DecodeResultT i e f a
-> DecodeResultT i e f b -> DecodeResultT i e f b
DecodeResultT i e f a
-> DecodeResultT i e f b -> DecodeResultT i e f a
DecodeResultT i e f (a -> b)
-> DecodeResultT i e f a -> DecodeResultT i e f b
(a -> b -> c)
-> DecodeResultT i e f a
-> DecodeResultT i e f b
-> DecodeResultT i e f c
forall a. a -> DecodeResultT i e f a
forall a b.
DecodeResultT i e f a
-> DecodeResultT i e f b -> DecodeResultT i e f a
forall a b.
DecodeResultT i e f a
-> DecodeResultT i e f b -> DecodeResultT i e f b
forall a b.
DecodeResultT i e f (a -> b)
-> DecodeResultT i e f a -> DecodeResultT i e f b
forall a b c.
(a -> b -> c)
-> DecodeResultT i e f a
-> DecodeResultT i e f b
-> DecodeResultT i e f c
forall i e (f :: * -> *). Monad f => Functor (DecodeResultT i e f)
forall i e (f :: * -> *) a. Monad f => a -> DecodeResultT i e f a
forall i e (f :: * -> *) a b.
Monad f =>
DecodeResultT i e f a
-> DecodeResultT i e f b -> DecodeResultT i e f a
forall i e (f :: * -> *) a b.
Monad f =>
DecodeResultT i e f a
-> DecodeResultT i e f b -> DecodeResultT i e f b
forall i e (f :: * -> *) a b.
Monad f =>
DecodeResultT i e f (a -> b)
-> DecodeResultT i e f a -> DecodeResultT i e f b
forall i e (f :: * -> *) a b c.
Monad f =>
(a -> b -> c)
-> DecodeResultT i e f a
-> DecodeResultT i e f b
-> DecodeResultT i e f c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: DecodeResultT i e f a
-> DecodeResultT i e f b -> DecodeResultT i e f a
$c<* :: forall i e (f :: * -> *) a b.
Monad f =>
DecodeResultT i e f a
-> DecodeResultT i e f b -> DecodeResultT i e f a
*> :: DecodeResultT i e f a
-> DecodeResultT i e f b -> DecodeResultT i e f b
$c*> :: forall i e (f :: * -> *) a b.
Monad f =>
DecodeResultT i e f a
-> DecodeResultT i e f b -> DecodeResultT i e f b
liftA2 :: (a -> b -> c)
-> DecodeResultT i e f a
-> DecodeResultT i e f b
-> DecodeResultT i e f c
$cliftA2 :: forall i e (f :: * -> *) a b c.
Monad f =>
(a -> b -> c)
-> DecodeResultT i e f a
-> DecodeResultT i e f b
-> DecodeResultT i e f c
<*> :: DecodeResultT i e f (a -> b)
-> DecodeResultT i e f a -> DecodeResultT i e f b
$c<*> :: forall i e (f :: * -> *) a b.
Monad f =>
DecodeResultT i e f (a -> b)
-> DecodeResultT i e f a -> DecodeResultT i e f b
pure :: a -> DecodeResultT i e f a
$cpure :: forall i e (f :: * -> *) a. Monad f => a -> DecodeResultT i e f a
$cp1Applicative :: forall i e (f :: * -> *). Monad f => Functor (DecodeResultT i e f)
Applicative
           , Applicative (DecodeResultT i e f)
a -> DecodeResultT i e f a
Applicative (DecodeResultT i e f)
-> (forall a b.
    DecodeResultT i e f a
    -> (a -> DecodeResultT i e f b) -> DecodeResultT i e f b)
-> (forall a b.
    DecodeResultT i e f a
    -> DecodeResultT i e f b -> DecodeResultT i e f b)
-> (forall a. a -> DecodeResultT i e f a)
-> Monad (DecodeResultT i e f)
DecodeResultT i e f a
-> (a -> DecodeResultT i e f b) -> DecodeResultT i e f b
DecodeResultT i e f a
-> DecodeResultT i e f b -> DecodeResultT i e f b
forall a. a -> DecodeResultT i e f a
forall a b.
DecodeResultT i e f a
-> DecodeResultT i e f b -> DecodeResultT i e f b
forall a b.
DecodeResultT i e f a
-> (a -> DecodeResultT i e f b) -> DecodeResultT i e f b
forall i e (f :: * -> *).
Monad f =>
Applicative (DecodeResultT i e f)
forall i e (f :: * -> *) a. Monad f => a -> DecodeResultT i e f a
forall i e (f :: * -> *) a b.
Monad f =>
DecodeResultT i e f a
-> DecodeResultT i e f b -> DecodeResultT i e f b
forall i e (f :: * -> *) a b.
Monad f =>
DecodeResultT i e f a
-> (a -> DecodeResultT i e f b) -> DecodeResultT i e f b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> DecodeResultT i e f a
$creturn :: forall i e (f :: * -> *) a. Monad f => a -> DecodeResultT i e f a
>> :: DecodeResultT i e f a
-> DecodeResultT i e f b -> DecodeResultT i e f b
$c>> :: forall i e (f :: * -> *) a b.
Monad f =>
DecodeResultT i e f a
-> DecodeResultT i e f b -> DecodeResultT i e f b
>>= :: DecodeResultT i e f a
-> (a -> DecodeResultT i e f b) -> DecodeResultT i e f b
$c>>= :: forall i e (f :: * -> *) a b.
Monad f =>
DecodeResultT i e f a
-> (a -> DecodeResultT i e f b) -> DecodeResultT i e f b
$cp1Monad :: forall i e (f :: * -> *).
Monad f =>
Applicative (DecodeResultT i e f)
Monad
           , MonadState (CursorHistory' i)
           , MonadError e
           )

instance MonadTrans (DecodeResultT i e) where
  lift :: m a -> DecodeResultT i e m a
lift = ExceptT e (StateT (CursorHistory' i) m) a -> DecodeResultT i e m a
forall i e (f :: * -> *) a.
ExceptT e (StateT (CursorHistory' i) f) a -> DecodeResultT i e f a
DecodeResultT (ExceptT e (StateT (CursorHistory' i) m) a
 -> DecodeResultT i e m a)
-> (m a -> ExceptT e (StateT (CursorHistory' i) m) a)
-> m a
-> DecodeResultT i e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT (CursorHistory' i) m a
-> ExceptT e (StateT (CursorHistory' i) m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (CursorHistory' i) m a
 -> ExceptT e (StateT (CursorHistory' i) m) a)
-> (m a -> StateT (CursorHistory' i) m a)
-> m a
-> ExceptT e (StateT (CursorHistory' i) m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> StateT (CursorHistory' i) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance MFunctor (DecodeResultT i e) where
  hoist :: (forall a. m a -> n a)
-> DecodeResultT i e m b -> DecodeResultT i e n b
hoist forall a. m a -> n a
nat (DecodeResultT ExceptT e (StateT (CursorHistory' i) m) b
dr) = ExceptT e (StateT (CursorHistory' i) n) b -> DecodeResultT i e n b
forall i e (f :: * -> *) a.
ExceptT e (StateT (CursorHistory' i) f) a -> DecodeResultT i e f a
DecodeResultT ((forall a.
 StateT (CursorHistory' i) m a -> StateT (CursorHistory' i) n a)
-> ExceptT e (StateT (CursorHistory' i) m) b
-> ExceptT e (StateT (CursorHistory' i) n) b
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist ((forall a. m a -> n a)
-> StateT (CursorHistory' i) m a -> StateT (CursorHistory' i) n a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> n a
nat) ExceptT e (StateT (CursorHistory' i) m) b
dr)

instance MMonad (DecodeResultT i e) where
  embed :: (forall a. m a -> DecodeResultT i e n a)
-> DecodeResultT i e m b -> DecodeResultT i e n b
embed forall a. m a -> DecodeResultT i e n a
t DecodeResultT i e m b
dr = ExceptT e (StateT (CursorHistory' i) n) b -> DecodeResultT i e n b
forall i e (f :: * -> *) a.
ExceptT e (StateT (CursorHistory' i) f) a -> DecodeResultT i e f a
DecodeResultT (ExceptT e (StateT (CursorHistory' i) n) b
 -> DecodeResultT i e n b)
-> ExceptT e (StateT (CursorHistory' i) n) b
-> DecodeResultT i e n b
forall a b. (a -> b) -> a -> b
$ do
    (Either e b
e, CursorHistory' i
hist) <- DecodeResultT i e n (Either e b, CursorHistory' i)
-> ExceptT
     e (StateT (CursorHistory' i) n) (Either e b, CursorHistory' i)
forall i e (f :: * -> *) a.
DecodeResultT i e f a -> ExceptT e (StateT (CursorHistory' i) f) a
runDecodeResult (m (Either e b, CursorHistory' i)
-> DecodeResultT i e n (Either e b, CursorHistory' i)
forall a. m a -> DecodeResultT i e n a
t (DecodeResultT i e m b -> m (Either e b, CursorHistory' i)
forall i e (m :: * -> *) a.
DecodeResultT i e m a -> m (Either e a, CursorHistory' i)
runner DecodeResultT i e m b
dr))
    CursorHistory' i -> ExceptT e (StateT (CursorHistory' i) n) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put CursorHistory' i
hist
    Either e b -> ExceptT e (StateT (CursorHistory' i) n) b
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither Either e b
e
      where
        runner :: DecodeResultT i e m a -> m (Either e a, CursorHistory' i)
runner = (StateT (CursorHistory' i) m (Either e a)
 -> CursorHistory' i -> m (Either e a, CursorHistory' i))
-> CursorHistory' i
-> StateT (CursorHistory' i) m (Either e a)
-> m (Either e a, CursorHistory' i)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (CursorHistory' i) m (Either e a)
-> CursorHistory' i -> m (Either e a, CursorHistory' i)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Seq (ZipperMove, i) -> CursorHistory' i
forall i. Seq (ZipperMove, i) -> CursorHistory' i
CursorHistory' Seq (ZipperMove, i)
forall a. Monoid a => a
mempty)
          (StateT (CursorHistory' i) m (Either e a)
 -> m (Either e a, CursorHistory' i))
-> (DecodeResultT i e m a
    -> StateT (CursorHistory' i) m (Either e a))
-> DecodeResultT i e m a
-> m (Either e a, CursorHistory' i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT e (StateT (CursorHistory' i) m) a
-> StateT (CursorHistory' i) m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e (StateT (CursorHistory' i) m) a
 -> StateT (CursorHistory' i) m (Either e a))
-> (DecodeResultT i e m a
    -> ExceptT e (StateT (CursorHistory' i) m) a)
-> DecodeResultT i e m a
-> StateT (CursorHistory' i) m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeResultT i e m a -> ExceptT e (StateT (CursorHistory' i) m) a
forall i e (f :: * -> *) a.
DecodeResultT i e f a -> ExceptT e (StateT (CursorHistory' i) f) a
runDecodeResult

-- |
-- Wrapper type to describe a "Decoder" from something that has a "Json"ish
-- value @c@, to some representation of @a@.
--
newtype Decoder' c i e f a = Decoder'
  { Decoder' c i e f a -> c -> DecodeResultT i e f a
runDecoder' :: c -> DecodeResultT i e f a
  }
  deriving a -> Decoder' c i e f b -> Decoder' c i e f a
(a -> b) -> Decoder' c i e f a -> Decoder' c i e f b
(forall a b. (a -> b) -> Decoder' c i e f a -> Decoder' c i e f b)
-> (forall a b. a -> Decoder' c i e f b -> Decoder' c i e f a)
-> Functor (Decoder' c i e f)
forall a b. a -> Decoder' c i e f b -> Decoder' c i e f a
forall a b. (a -> b) -> Decoder' c i e f a -> Decoder' c i e f b
forall c i e (f :: * -> *) a b.
Functor f =>
a -> Decoder' c i e f b -> Decoder' c i e f a
forall c i e (f :: * -> *) a b.
Functor f =>
(a -> b) -> Decoder' c i e f a -> Decoder' c i e f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Decoder' c i e f b -> Decoder' c i e f a
$c<$ :: forall c i e (f :: * -> *) a b.
Functor f =>
a -> Decoder' c i e f b -> Decoder' c i e f a
fmap :: (a -> b) -> Decoder' c i e f a -> Decoder' c i e f b
$cfmap :: forall c i e (f :: * -> *) a b.
Functor f =>
(a -> b) -> Decoder' c i e f a -> Decoder' c i e f b
Functor

instance Monad f => Applicative (Decoder' c i e f) where
  pure :: a -> Decoder' c i e f a
pure       = a -> Decoder' c i e f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Decoder' c i e f (a -> b)
aToB <*> :: Decoder' c i e f (a -> b)
-> Decoder' c i e f a -> Decoder' c i e f b
<*> Decoder' c i e f a
a = (c -> DecodeResultT i e f b) -> Decoder' c i e f b
forall c i e (f :: * -> *) a.
(c -> DecodeResultT i e f a) -> Decoder' c i e f a
Decoder' ((c -> DecodeResultT i e f b) -> Decoder' c i e f b)
-> (c -> DecodeResultT i e f b) -> Decoder' c i e f b
forall a b. (a -> b) -> a -> b
$ \c
c -> Decoder' c i e f (a -> b) -> c -> DecodeResultT i e f (a -> b)
forall c i e (f :: * -> *) a.
Decoder' c i e f a -> c -> DecodeResultT i e f a
runDecoder' Decoder' c i e f (a -> b)
aToB c
c DecodeResultT i e f (a -> b)
-> DecodeResultT i e f a -> DecodeResultT i e f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder' c i e f a -> c -> DecodeResultT i e f a
forall c i e (f :: * -> *) a.
Decoder' c i e f a -> c -> DecodeResultT i e f a
runDecoder' Decoder' c i e f a
a c
c

instance Monad f => Monad (Decoder' c i e f) where
  return :: a -> Decoder' c i e f a
return      = a -> Decoder' c i e f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Decoder' c i e f a
a >>= :: Decoder' c i e f a
-> (a -> Decoder' c i e f b) -> Decoder' c i e f b
>>= a -> Decoder' c i e f b
aToFb = (c -> DecodeResultT i e f b) -> Decoder' c i e f b
forall c i e (f :: * -> *) a.
(c -> DecodeResultT i e f a) -> Decoder' c i e f a
Decoder' ((c -> DecodeResultT i e f b) -> Decoder' c i e f b)
-> (c -> DecodeResultT i e f b) -> Decoder' c i e f b
forall a b. (a -> b) -> a -> b
$ \c
c -> Decoder' c i e f a -> c -> DecodeResultT i e f a
forall c i e (f :: * -> *) a.
Decoder' c i e f a -> c -> DecodeResultT i e f a
runDecoder' Decoder' c i e f a
a c
c DecodeResultT i e f a
-> (a -> DecodeResultT i e f b) -> DecodeResultT i e f b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((c -> DecodeResultT i e f b) -> c -> DecodeResultT i e f b
forall a b. (a -> b) -> a -> b
$ c
c) ((c -> DecodeResultT i e f b) -> DecodeResultT i e f b)
-> (a -> c -> DecodeResultT i e f b) -> a -> DecodeResultT i e f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decoder' c i e f b -> c -> DecodeResultT i e f b
forall c i e (f :: * -> *) a.
Decoder' c i e f a -> c -> DecodeResultT i e f a
runDecoder' (Decoder' c i e f b -> c -> DecodeResultT i e f b)
-> (a -> Decoder' c i e f b) -> a -> c -> DecodeResultT i e f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Decoder' c i e f b
aToFb

instance MonadTrans (Decoder' c i e) where
  lift :: m a -> Decoder' c i e m a
lift = (c -> DecodeResultT i e m a) -> Decoder' c i e m a
forall c i e (f :: * -> *) a.
(c -> DecodeResultT i e f a) -> Decoder' c i e f a
Decoder' ((c -> DecodeResultT i e m a) -> Decoder' c i e m a)
-> (m a -> c -> DecodeResultT i e m a) -> m a -> Decoder' c i e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeResultT i e m a -> c -> DecodeResultT i e m a
forall a b. a -> b -> a
const (DecodeResultT i e m a -> c -> DecodeResultT i e m a)
-> (m a -> DecodeResultT i e m a)
-> m a
-> c
-> DecodeResultT i e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> DecodeResultT i e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance MFunctor (Decoder' c i e) where
  hoist :: (forall a. m a -> n a) -> Decoder' c i e m b -> Decoder' c i e n b
hoist forall a. m a -> n a
nat (Decoder' c -> DecodeResultT i e m b
f) = (c -> DecodeResultT i e n b) -> Decoder' c i e n b
forall c i e (f :: * -> *) a.
(c -> DecodeResultT i e f a) -> Decoder' c i e f a
Decoder' ((forall a. m a -> n a)
-> DecodeResultT i e m b -> DecodeResultT i e n b
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> n a
nat (DecodeResultT i e m b -> DecodeResultT i e n b)
-> (c -> DecodeResultT i e m b) -> c -> DecodeResultT i e n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> DecodeResultT i e m b
f)

-- |
-- Helper function for constructing a 'Decoder''.
--
-- This function is used by the implemented decoders to simplify constructing a
-- more specific 'Decoder'' type.
--
-- @
-- withCursor' $ \curs ->
--   ...
--   ...
-- @
--
withCursor'
  :: (c -> DecodeResultT i e f a)
  -> Decoder' c i e f a
withCursor' :: (c -> DecodeResultT i e f a) -> Decoder' c i e f a
withCursor' =
  (c -> DecodeResultT i e f a) -> Decoder' c i e f a
forall c i e (f :: * -> *) a.
(c -> DecodeResultT i e f a) -> Decoder' c i e f a
Decoder'

-- |
-- Execute a given 'Waargonaut.Decode.Internal.DecoderResultT'.
--
-- If you're building your own decoder structure, this function will take care
-- of the 'CursorHistory'' and error handling (via 'ExceptT').
--
runDecoderResultT
  :: Monad f
  => DecodeResultT i DecodeError f a
  -> f (Either (DecodeError, CursorHistory' i) a)
runDecoderResultT :: DecodeResultT i DecodeError f a
-> f (Either (DecodeError, CursorHistory' i) a)
runDecoderResultT =
  ((Either DecodeError a, CursorHistory' i)
 -> Either (DecodeError, CursorHistory' i) a)
-> f (Either DecodeError a, CursorHistory' i)
-> f (Either (DecodeError, CursorHistory' i) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Either DecodeError a
e, CursorHistory' i
hist) -> (DecodeError -> (DecodeError, CursorHistory' i))
-> Either DecodeError a -> Either (DecodeError, CursorHistory' i) a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (,CursorHistory' i
hist) Either DecodeError a
e)
  (f (Either DecodeError a, CursorHistory' i)
 -> f (Either (DecodeError, CursorHistory' i) a))
-> (DecodeResultT i DecodeError f a
    -> f (Either DecodeError a, CursorHistory' i))
-> DecodeResultT i DecodeError f a
-> f (Either (DecodeError, CursorHistory' i) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT (CursorHistory' i) f (Either DecodeError a)
 -> CursorHistory' i -> f (Either DecodeError a, CursorHistory' i))
-> CursorHistory' i
-> StateT (CursorHistory' i) f (Either DecodeError a)
-> f (Either DecodeError a, CursorHistory' i)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (CursorHistory' i) f (Either DecodeError a)
-> CursorHistory' i -> f (Either DecodeError a, CursorHistory' i)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Seq (ZipperMove, i) -> CursorHistory' i
forall i. Seq (ZipperMove, i) -> CursorHistory' i
CursorHistory' Seq (ZipperMove, i)
forall a. Monoid a => a
mempty)
  (StateT (CursorHistory' i) f (Either DecodeError a)
 -> f (Either DecodeError a, CursorHistory' i))
-> (DecodeResultT i DecodeError f a
    -> StateT (CursorHistory' i) f (Either DecodeError a))
-> DecodeResultT i DecodeError f a
-> f (Either DecodeError a, CursorHistory' i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT DecodeError (StateT (CursorHistory' i) f) a
-> StateT (CursorHistory' i) f (Either DecodeError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
  (ExceptT DecodeError (StateT (CursorHistory' i) f) a
 -> StateT (CursorHistory' i) f (Either DecodeError a))
-> (DecodeResultT i DecodeError f a
    -> ExceptT DecodeError (StateT (CursorHistory' i) f) a)
-> DecodeResultT i DecodeError f a
-> StateT (CursorHistory' i) f (Either DecodeError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeResultT i DecodeError f a
-> ExceptT DecodeError (StateT (CursorHistory' i) f) a
forall i e (f :: * -> *) a.
DecodeResultT i e f a -> ExceptT e (StateT (CursorHistory' i) f) a
runDecodeResult

-- |
-- Record a move on the zipper and the index of the position where the move
-- occured.
--
recordZipperMove :: MonadState (CursorHistory' i) m => ZipperMove -> i -> m ()
recordZipperMove :: ZipperMove -> i -> m ()
recordZipperMove ZipperMove
dir i
i = (Seq (ZipperMove, i) -> Identity (Seq (ZipperMove, i)))
-> CursorHistory' i -> Identity (CursorHistory' i)
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
L._Wrapped ((Seq (ZipperMove, i) -> Identity (Seq (ZipperMove, i)))
 -> CursorHistory' i -> Identity (CursorHistory' i))
-> (Seq (ZipperMove, i) -> Seq (ZipperMove, i)) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Seq (ZipperMove, i) -> (ZipperMove, i) -> Seq (ZipperMove, i)
forall s a. Snoc s s a a => s -> a -> s
`L.snoc` (ZipperMove
dir, i
i))

-- |
-- Attempt a 'Waargonaut.Decode.Internal.Decoder' action that might fail and return a 'Maybe' value
-- instead.
--
try :: MonadError e m => m a -> m (Maybe a)
try :: m a -> m (Maybe a)
try m a
d = m (Maybe a) -> (e -> m (Maybe a)) -> m (Maybe a)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a) -> m a -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
d) (m (Maybe a) -> e -> m (Maybe a)
forall a b. a -> b -> a
const (Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing))

-- |
-- Build the basis for a 'Waargonaut.Decode.Internal.Decoder' based on a 'Control.Lens.Prism''.
--
prismDOrFail'
  :: ( AsDecodeError e
     , MonadError e f
     )
  => e
  -> L.Prism' a b
  -> Decoder' c i e f a
  -> c
  -> DecodeResultT i e f b
prismDOrFail' :: e -> Prism' a b -> Decoder' c i e f a -> c -> DecodeResultT i e f b
prismDOrFail' e
e Prism' a b
p Decoder' c i e f a
d c
c =
  Decoder' c i e f (Maybe b) -> c -> DecodeResultT i e f (Maybe b)
forall c i e (f :: * -> *) a.
Decoder' c i e f a -> c -> DecodeResultT i e f a
runDecoder' (Getting (First b) a b -> a -> Maybe b
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
L.preview Getting (First b) a b
Prism' a b
p (a -> Maybe b) -> Decoder' c i e f a -> Decoder' c i e f (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder' c i e f a
d) c
c DecodeResultT i e f (Maybe b) -> e -> DecodeResultT i e f b
forall (m :: * -> *) (t :: * -> *) e e' a.
HoistError m t e e' =>
m (t a) -> e' -> m a
<!?> e
e

-- | Try to decode a 'Text' value from some 'Waargonaut.Types.Json.Json' or value. This will fail if
-- the input value is not a valid UTF-8 'Text' value, as checked by the
-- 'Data.Text.Encoding.decodeUtf8'' function.
text' :: AsJType a ws a => a -> Maybe Text
text' :: a -> Maybe Text
text' = Getting (First Text) a Text -> a -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
L.preview (((JString, ws) -> Const (First Text) (JString, ws))
-> a -> Const (First Text) a
forall r ws a. AsJType r ws a => Prism' r (JString, ws)
_JStr (((JString, ws) -> Const (First Text) (JString, ws))
 -> a -> Const (First Text) a)
-> ((Text -> Const (First Text) Text)
    -> (JString, ws) -> Const (First Text) (JString, ws))
-> Getting (First Text) a Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JString -> Const (First Text) JString)
-> (JString, ws) -> Const (First Text) (JString, ws)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((JString -> Const (First Text) JString)
 -> (JString, ws) -> Const (First Text) (JString, ws))
-> ((Text -> Const (First Text) Text)
    -> JString -> Const (First Text) JString)
-> (Text -> Const (First Text) Text)
-> (JString, ws)
-> Const (First Text) (JString, ws)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> JString -> Const (First Text) JString
forall (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Applicative f) =>
p Text (f Text) -> p JString (f JString)
_JStringText)

-- | Try to decode a 'String' value from some 'Waargonaut.Types.Json.Json' or value.
string' :: AsJType a ws a => a -> Maybe String
string' :: a -> Maybe String
string' = Getting (First String) a String -> a -> Maybe String
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
L.preview (((JString, ws) -> Const (First String) (JString, ws))
-> a -> Const (First String) a
forall r ws a. AsJType r ws a => Prism' r (JString, ws)
_JStr (((JString, ws) -> Const (First String) (JString, ws))
 -> a -> Const (First String) a)
-> ((String -> Const (First String) String)
    -> (JString, ws) -> Const (First String) (JString, ws))
-> Getting (First String) a String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JString -> Const (First String) JString)
-> (JString, ws) -> Const (First String) (JString, ws)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((JString -> Const (First String) JString)
 -> (JString, ws) -> Const (First String) (JString, ws))
-> ((String -> Const (First String) String)
    -> JString -> Const (First String) JString)
-> (String -> Const (First String) String)
-> (JString, ws)
-> Const (First String) (JString, ws)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector (JChar HeXDigit)
 -> Const (First String) (Vector (JChar HeXDigit)))
-> JString -> Const (First String) JString
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped ((Vector (JChar HeXDigit)
  -> Const (First String) (Vector (JChar HeXDigit)))
 -> JString -> Const (First String) JString)
-> ((String -> Const (First String) String)
    -> Vector (JChar HeXDigit)
    -> Const (First String) (Vector (JChar HeXDigit)))
-> (String -> Const (First String) String)
-> JString
-> Const (First String) JString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector (JChar HeXDigit) -> String)
-> (String -> Const (First String) String)
-> Vector (JChar HeXDigit)
-> Const (First String) (Vector (JChar HeXDigit))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
L.to (Vector Char -> String
forall a. Vector a -> [a]
V.toList (Vector Char -> String)
-> (Vector (JChar HeXDigit) -> Vector Char)
-> Vector (JChar HeXDigit)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JChar HeXDigit -> Char) -> Vector (JChar HeXDigit) -> Vector Char
forall a b. (a -> b) -> Vector a -> Vector b
V.map JChar HeXDigit -> Char
jCharToChar))

-- | Try to decode a 'Data.ByteString.ByteString' value from some 'Waargonaut.Types.Json.Json' or value.
strictByteString' :: AsJType a ws a => a -> Maybe ByteString
strictByteString' :: a -> Maybe ByteString
strictByteString' = (ByteString -> ByteString) -> Maybe ByteString -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
BL.toStrict (Maybe ByteString -> Maybe ByteString)
-> (a -> Maybe ByteString) -> a -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe ByteString
forall a ws. AsJType a ws a => a -> Maybe ByteString
lazyByteString'

-- | Try to decode a 'Data.ByteString.Lazy.ByteString' value from some 'Waargonaut.Types.Json.Json' or value.
lazyByteString' :: AsJType a ws a => a -> Maybe BL.ByteString
lazyByteString' :: a -> Maybe ByteString
lazyByteString' = Getting (First ByteString) a ByteString -> a -> Maybe ByteString
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
L.preview (((JString, ws) -> Const (First ByteString) (JString, ws))
-> a -> Const (First ByteString) a
forall r ws a. AsJType r ws a => Prism' r (JString, ws)
_JStr (((JString, ws) -> Const (First ByteString) (JString, ws))
 -> a -> Const (First ByteString) a)
-> ((ByteString -> Const (First ByteString) ByteString)
    -> (JString, ws) -> Const (First ByteString) (JString, ws))
-> Getting (First ByteString) a ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JString -> Const (First ByteString) JString)
-> (JString, ws) -> Const (First ByteString) (JString, ws)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((JString -> Const (First ByteString) JString)
 -> (JString, ws) -> Const (First ByteString) (JString, ws))
-> ((ByteString -> Const (First ByteString) ByteString)
    -> JString -> Const (First ByteString) JString)
-> (ByteString -> Const (First ByteString) ByteString)
-> (JString, ws)
-> Const (First ByteString) (JString, ws)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector (JChar HeXDigit)
 -> Const (First ByteString) (Vector (JChar HeXDigit)))
-> JString -> Const (First ByteString) JString
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped ((Vector (JChar HeXDigit)
  -> Const (First ByteString) (Vector (JChar HeXDigit)))
 -> JString -> Const (First ByteString) JString)
-> ((ByteString -> Const (First ByteString) ByteString)
    -> Vector (JChar HeXDigit)
    -> Const (First ByteString) (Vector (JChar HeXDigit)))
-> (ByteString -> Const (First ByteString) ByteString)
-> JString
-> Const (First ByteString) JString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector (JChar HeXDigit) -> ByteString)
-> (ByteString -> Const (First ByteString) ByteString)
-> Vector (JChar HeXDigit)
-> Const (First ByteString) (Vector (JChar HeXDigit))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
L.to Vector (JChar HeXDigit) -> ByteString
mkBS)
  -- This uses the 'Data.ByteString.Builder.char8' function as parsing has
  -- validated our inputs. If we use 'Data.ByteString.Builder.charUtf8' or
  -- 'Waargonaut.Builder.bsBuilder' the input will be incorrectly "double
  -- encoded" and everything will be wrong.
  where mkBS :: Vector (JChar HeXDigit) -> ByteString
mkBS = Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString)
-> (Vector (JChar HeXDigit) -> Builder)
-> Vector (JChar HeXDigit)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JChar HeXDigit -> Builder) -> Vector (JChar HeXDigit) -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Char -> Builder
BB.char8 (Char -> Builder)
-> (JChar HeXDigit -> Char) -> JChar HeXDigit -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JChar HeXDigit -> Char
jCharToChar)

-- | Decoder for a 'Char' value that cannot contain values in the range U+D800
-- to U+DFFF. This decoder will fail if the 'Char' is outside of this range.
boundedChar' :: AsJType a ws a => a -> Maybe Char
boundedChar' :: a -> Maybe Char
boundedChar' = Getting (First (JChar HeXDigit)) a (JChar HeXDigit)
-> a -> Maybe (JChar HeXDigit)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
L.preview (((JString, ws) -> Const (First (JChar HeXDigit)) (JString, ws))
-> a -> Const (First (JChar HeXDigit)) a
forall r ws a. AsJType r ws a => Prism' r (JString, ws)
_JStr (((JString, ws) -> Const (First (JChar HeXDigit)) (JString, ws))
 -> a -> Const (First (JChar HeXDigit)) a)
-> ((JChar HeXDigit
     -> Const (First (JChar HeXDigit)) (JChar HeXDigit))
    -> (JString, ws) -> Const (First (JChar HeXDigit)) (JString, ws))
-> Getting (First (JChar HeXDigit)) a (JChar HeXDigit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JString -> Const (First (JChar HeXDigit)) JString)
-> (JString, ws) -> Const (First (JChar HeXDigit)) (JString, ws)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((JString -> Const (First (JChar HeXDigit)) JString)
 -> (JString, ws) -> Const (First (JChar HeXDigit)) (JString, ws))
-> ((JChar HeXDigit
     -> Const (First (JChar HeXDigit)) (JChar HeXDigit))
    -> JString -> Const (First (JChar HeXDigit)) JString)
-> (JChar HeXDigit
    -> Const (First (JChar HeXDigit)) (JChar HeXDigit))
-> (JString, ws)
-> Const (First (JChar HeXDigit)) (JString, ws)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector (JChar HeXDigit)
 -> Const (First (JChar HeXDigit)) (Vector (JChar HeXDigit)))
-> JString -> Const (First (JChar HeXDigit)) JString
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped ((Vector (JChar HeXDigit)
  -> Const (First (JChar HeXDigit)) (Vector (JChar HeXDigit)))
 -> JString -> Const (First (JChar HeXDigit)) JString)
-> ((JChar HeXDigit
     -> Const (First (JChar HeXDigit)) (JChar HeXDigit))
    -> Vector (JChar HeXDigit)
    -> Const (First (JChar HeXDigit)) (Vector (JChar HeXDigit)))
-> (JChar HeXDigit
    -> Const (First (JChar HeXDigit)) (JChar HeXDigit))
-> JString
-> Const (First (JChar HeXDigit)) JString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JChar HeXDigit -> Const (First (JChar HeXDigit)) (JChar HeXDigit))
-> Vector (JChar HeXDigit)
-> Const (First (JChar HeXDigit)) (Vector (JChar HeXDigit))
forall s a. Cons s s a a => Traversal' s a
L._head) (a -> Maybe (JChar HeXDigit))
-> (JChar HeXDigit -> Maybe Char) -> a -> Maybe Char
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> JChar HeXDigit -> Maybe Char
jCharToUtf8Char

-- | Decoder for a Haskell 'Char' value whose values represent Unicode
-- (or equivalently ISO/IEC 10646) characters
unboundedChar' :: AsJType a ws a => a -> Maybe Char
unboundedChar' :: a -> Maybe Char
unboundedChar' = Getting (First Char) a Char -> a -> Maybe Char
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
L.preview (((JString, ws) -> Const (First Char) (JString, ws))
-> a -> Const (First Char) a
forall r ws a. AsJType r ws a => Prism' r (JString, ws)
_JStr (((JString, ws) -> Const (First Char) (JString, ws))
 -> a -> Const (First Char) a)
-> ((Char -> Const (First Char) Char)
    -> (JString, ws) -> Const (First Char) (JString, ws))
-> Getting (First Char) a Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JString -> Const (First Char) JString)
-> (JString, ws) -> Const (First Char) (JString, ws)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((JString -> Const (First Char) JString)
 -> (JString, ws) -> Const (First Char) (JString, ws))
-> ((Char -> Const (First Char) Char)
    -> JString -> Const (First Char) JString)
-> (Char -> Const (First Char) Char)
-> (JString, ws)
-> Const (First Char) (JString, ws)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector (JChar HeXDigit)
 -> Const (First Char) (Vector (JChar HeXDigit)))
-> JString -> Const (First Char) JString
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped ((Vector (JChar HeXDigit)
  -> Const (First Char) (Vector (JChar HeXDigit)))
 -> JString -> Const (First Char) JString)
-> ((Char -> Const (First Char) Char)
    -> Vector (JChar HeXDigit)
    -> Const (First Char) (Vector (JChar HeXDigit)))
-> (Char -> Const (First Char) Char)
-> JString
-> Const (First Char) JString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JChar HeXDigit -> Const (First Char) (JChar HeXDigit))
-> Vector (JChar HeXDigit)
-> Const (First Char) (Vector (JChar HeXDigit))
forall s a. Cons s s a a => Traversal' s a
L._head ((JChar HeXDigit -> Const (First Char) (JChar HeXDigit))
 -> Vector (JChar HeXDigit)
 -> Const (First Char) (Vector (JChar HeXDigit)))
-> ((Char -> Const (First Char) Char)
    -> JChar HeXDigit -> Const (First Char) (JChar HeXDigit))
-> (Char -> Const (First Char) Char)
-> Vector (JChar HeXDigit)
-> Const (First Char) (Vector (JChar HeXDigit))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JChar HeXDigit -> Char)
-> (Char -> Const (First Char) Char)
-> JChar HeXDigit
-> Const (First Char) (JChar HeXDigit)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
L.to JChar HeXDigit -> Char
jCharToChar)

-- | Try to decode a 'Scientific' value from some 'Waargonaut.Types.Json.Json' or value.
scientific' :: AsJType a ws a => a -> Maybe Scientific
scientific' :: a -> Maybe Scientific
scientific' = Getting (First JNumber) a JNumber -> a -> Maybe JNumber
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
L.preview (((JNumber, ws) -> Const (First JNumber) (JNumber, ws))
-> a -> Const (First JNumber) a
forall r ws a. AsJType r ws a => Prism' r (JNumber, ws)
_JNum (((JNumber, ws) -> Const (First JNumber) (JNumber, ws))
 -> a -> Const (First JNumber) a)
-> ((JNumber -> Const (First JNumber) JNumber)
    -> (JNumber, ws) -> Const (First JNumber) (JNumber, ws))
-> Getting (First JNumber) a JNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JNumber -> Const (First JNumber) JNumber)
-> (JNumber, ws) -> Const (First JNumber) (JNumber, ws)
forall s t a b. Field1 s t a b => Lens s t a b
_1) (a -> Maybe JNumber)
-> (JNumber -> Maybe Scientific) -> a -> Maybe Scientific
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> JNumber -> Maybe Scientific
jNumberToScientific

-- | Try to decode a bounded 'Integral n => n' value from some 'Waargonaut.Types.Json.Json' value.
integral' :: (Bounded i , Integral i , AsJType a ws a) => a -> Maybe i
integral' :: a -> Maybe i
integral' = a -> Maybe Scientific
forall a ws. AsJType a ws a => a -> Maybe Scientific
scientific' (a -> Maybe Scientific) -> (Scientific -> Maybe i) -> a -> Maybe i
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Scientific -> Maybe i
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Sci.toBoundedInteger

-- | Try to decode an 'Int' from some 'Waargonaut.Types.Json.Json' value
int' :: AsJType a ws a => a -> Maybe Int
int' :: a -> Maybe Int
int' = a -> Maybe Int
forall i a ws.
(Bounded i, Integral i, AsJType a ws a) =>
a -> Maybe i
integral'

-- | Try to decode a 'Bool' from some 'Waargonaut.Types.Json.Json' value
bool' :: AsJType a ws a => a -> Maybe Bool
bool' :: a -> Maybe Bool
bool' = Getting (First Bool) a Bool -> a -> Maybe Bool
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
L.preview (((Bool, ws) -> Const (First Bool) (Bool, ws))
-> a -> Const (First Bool) a
forall r ws a. AsJType r ws a => Prism' r (Bool, ws)
_JBool (((Bool, ws) -> Const (First Bool) (Bool, ws))
 -> a -> Const (First Bool) a)
-> ((Bool -> Const (First Bool) Bool)
    -> (Bool, ws) -> Const (First Bool) (Bool, ws))
-> Getting (First Bool) a Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const (First Bool) Bool)
-> (Bool, ws) -> Const (First Bool) (Bool, ws)
forall s t a b. Field1 s t a b => Lens s t a b
_1)

-- | Try to decode a 'null' value from some 'Waargonaut.Types.Json.Json' value
null' :: AsJType a ws a => a -> Maybe ()
null' :: a -> Maybe ()
null' a
a = Getting (First ws) a ws -> a -> Maybe ws
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
L.preview Getting (First ws) a ws
forall r ws a. AsJType r ws a => Prism' r ws
_JNull a
a Maybe ws -> () -> Maybe ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()

-- | Combined with another decoder function @f@, try to decode a list of @a@ values.
--
-- @
-- array' int' :: Json -> [Int]
-- @
--
array' :: AsJType a ws a => (a -> Maybe b) -> a -> [b]
array' :: (a -> Maybe b) -> a -> [b]
array' a -> Maybe b
f a
a = (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
Wither.mapMaybe a -> Maybe b
f (a
a a -> Getting (Endo [a]) a a -> [a]
forall s a. s -> Getting (Endo [a]) s a -> [a]
L.^.. ((JArray ws a, ws) -> Const (Endo [a]) (JArray ws a, ws))
-> a -> Const (Endo [a]) a
forall r ws a. AsJType r ws a => Prism' r (JArray ws a, ws)
_JArr (((JArray ws a, ws) -> Const (Endo [a]) (JArray ws a, ws))
 -> a -> Const (Endo [a]) a)
-> ((a -> Const (Endo [a]) a)
    -> (JArray ws a, ws) -> Const (Endo [a]) (JArray ws a, ws))
-> Getting (Endo [a]) a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JArray ws a -> Const (Endo [a]) (JArray ws a))
-> (JArray ws a, ws) -> Const (Endo [a]) (JArray ws a, ws)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((JArray ws a -> Const (Endo [a]) (JArray ws a))
 -> (JArray ws a, ws) -> Const (Endo [a]) (JArray ws a, ws))
-> ((a -> Const (Endo [a]) a)
    -> JArray ws a -> Const (Endo [a]) (JArray ws a))
-> (a -> Const (Endo [a]) a)
-> (JArray ws a, ws)
-> Const (Endo [a]) (JArray ws a, ws)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Const (Endo [a]) a)
-> JArray ws a -> Const (Endo [a]) (JArray ws a)
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
L.folded)

-- |
-- Try to decode a JSON Object into it's representative list of
-- tuples '(key, value)'. The JSON RFC does not specify that an object must
-- contain unique keys. We do not enforce unique keys during the decoding
-- process and leave it to the user to decide if, and how, they would like to
-- handle this situation.
--
objTuples'
  :: ( Applicative f
     , AsJType a ws a
     )
  => (JString -> f k)
  -> (a -> f b)
  -> a
  -> f [(k, b)]
objTuples' :: (JString -> f k) -> (a -> f b) -> a -> f [(k, b)]
objTuples' JString -> f k
kF a -> f b
vF a
a =
  (JAssoc ws a -> f (k, b)) -> [JAssoc ws a] -> f [(k, b)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse JAssoc ws a -> f (k, b)
g (a
a a -> Getting (Endo [JAssoc ws a]) a (JAssoc ws a) -> [JAssoc ws a]
forall s a. s -> Getting (Endo [a]) s a -> [a]
L.^.. ((JObject ws a, ws)
 -> Const (Endo [JAssoc ws a]) (JObject ws a, ws))
-> a -> Const (Endo [JAssoc ws a]) a
forall r ws a. AsJType r ws a => Prism' r (JObject ws a, ws)
_JObj (((JObject ws a, ws)
  -> Const (Endo [JAssoc ws a]) (JObject ws a, ws))
 -> a -> Const (Endo [JAssoc ws a]) a)
-> ((JAssoc ws a -> Const (Endo [JAssoc ws a]) (JAssoc ws a))
    -> (JObject ws a, ws)
    -> Const (Endo [JAssoc ws a]) (JObject ws a, ws))
-> Getting (Endo [JAssoc ws a]) a (JAssoc ws a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JObject ws a -> Const (Endo [JAssoc ws a]) (JObject ws a))
-> (JObject ws a, ws)
-> Const (Endo [JAssoc ws a]) (JObject ws a, ws)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((JObject ws a -> Const (Endo [JAssoc ws a]) (JObject ws a))
 -> (JObject ws a, ws)
 -> Const (Endo [JAssoc ws a]) (JObject ws a, ws))
-> ((JAssoc ws a -> Const (Endo [JAssoc ws a]) (JAssoc ws a))
    -> JObject ws a -> Const (Endo [JAssoc ws a]) (JObject ws a))
-> (JAssoc ws a -> Const (Endo [JAssoc ws a]) (JAssoc ws a))
-> (JObject ws a, ws)
-> Const (Endo [JAssoc ws a]) (JObject ws a, ws)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommaSeparated ws (JAssoc ws a)
 -> Const (Endo [JAssoc ws a]) (CommaSeparated ws (JAssoc ws a)))
-> JObject ws a -> Const (Endo [JAssoc ws a]) (JObject ws a)
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped ((CommaSeparated ws (JAssoc ws a)
  -> Const (Endo [JAssoc ws a]) (CommaSeparated ws (JAssoc ws a)))
 -> JObject ws a -> Const (Endo [JAssoc ws a]) (JObject ws a))
-> ((JAssoc ws a -> Const (Endo [JAssoc ws a]) (JAssoc ws a))
    -> CommaSeparated ws (JAssoc ws a)
    -> Const (Endo [JAssoc ws a]) (CommaSeparated ws (JAssoc ws a)))
-> (JAssoc ws a -> Const (Endo [JAssoc ws a]) (JAssoc ws a))
-> JObject ws a
-> Const (Endo [JAssoc ws a]) (JObject ws a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommaSeparated ws (JAssoc ws a) -> [JAssoc ws a])
-> Optic'
     (->)
     (Const (Endo [JAssoc ws a]))
     (CommaSeparated ws (JAssoc ws a))
     [JAssoc ws a]
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
L.to CommaSeparated ws (JAssoc ws a) -> [JAssoc ws a]
forall ws a. CommaSeparated ws a -> [a]
toList Optic'
  (->)
  (Const (Endo [JAssoc ws a]))
  (CommaSeparated ws (JAssoc ws a))
  [JAssoc ws a]
-> ((JAssoc ws a -> Const (Endo [JAssoc ws a]) (JAssoc ws a))
    -> [JAssoc ws a] -> Const (Endo [JAssoc ws a]) [JAssoc ws a])
-> (JAssoc ws a -> Const (Endo [JAssoc ws a]) (JAssoc ws a))
-> CommaSeparated ws (JAssoc ws a)
-> Const (Endo [JAssoc ws a]) (CommaSeparated ws (JAssoc ws a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JAssoc ws a -> Const (Endo [JAssoc ws a]) (JAssoc ws a))
-> [JAssoc ws a] -> Const (Endo [JAssoc ws a]) [JAssoc ws a]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
L.folded)
  where
    g :: JAssoc ws a -> f (k, b)
g JAssoc ws a
ja = (k -> b -> (k, b)) -> f k -> f b -> f (k, b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,)
      (JAssoc ws a
ja JAssoc ws a -> Getting (f k) (JAssoc ws a) (f k) -> f k
forall s a. s -> Getting a s a -> a
L.^. (JString -> Const (f k) JString)
-> JAssoc ws a -> Const (f k) (JAssoc ws a)
forall c ws a. HasJAssoc c ws a => Lens' c JString
jsonAssocKey ((JString -> Const (f k) JString)
 -> JAssoc ws a -> Const (f k) (JAssoc ws a))
-> ((f k -> Const (f k) (f k)) -> JString -> Const (f k) JString)
-> Getting (f k) (JAssoc ws a) (f k)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JString -> f k)
-> (f k -> Const (f k) (f k)) -> JString -> Const (f k) JString
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
L.to JString -> f k
kF)
      (JAssoc ws a
ja JAssoc ws a -> Getting (f b) (JAssoc ws a) (f b) -> f b
forall s a. s -> Getting a s a -> a
L.^. (a -> Const (f b) a) -> JAssoc ws a -> Const (f b) (JAssoc ws a)
forall c ws a. HasJAssoc c ws a => Lens' c a
jsonAssocVal ((a -> Const (f b) a) -> JAssoc ws a -> Const (f b) (JAssoc ws a))
-> ((f b -> Const (f b) (f b)) -> a -> Const (f b) a)
-> Getting (f b) (JAssoc ws a) (f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> (f b -> Const (f b) (f b)) -> a -> Const (f b) a
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
L.to a -> f b
vF)

-- | Generalised moving decoder function.
--
-- Starting from the given cursor position, try to move in the direction
-- specified by the given cursor function. Attempting to decode each item at each
-- position using the given 'Waargonaut.Decode.Internal.Decoder', until the movement is unsuccessful.
--
-- The following could be used to leverage the 'Control.Lens.Snoc' instance of '[]' to build '[Int]'.
--
-- @
-- intList :: Monad f => JCurs -> DecodeResult f [Int]
-- intList = directedConsumption' snoc moveRight1 int
-- @
--
foldCursor'
  :: Monad f
  => b
  -> (b -> a -> b)
  -> (c -> DecodeResultT i e f c)
  -> Decoder' c i e f a
  -> c
  -> DecodeResultT i e f b
foldCursor' :: b
-> (b -> a -> b)
-> (c -> DecodeResultT i e f c)
-> Decoder' c i e f a
-> c
-> DecodeResultT i e f b
foldCursor' b
empty b -> a -> b
scons c -> DecodeResultT i e f c
mvCurs Decoder' c i e f a
elemD =
  b -> c -> DecodeResultT i e f b
go b
empty
  where
    go :: b -> c -> DecodeResultT i e f b
go b
acc c
cur = do
      b
acc' <- b -> a -> b
scons b
acc (a -> b) -> DecodeResultT i e f a -> DecodeResultT i e f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder' c i e f a -> c -> DecodeResultT i e f a
forall c i e (f :: * -> *) a.
Decoder' c i e f a -> c -> DecodeResultT i e f a
runDecoder' Decoder' c i e f a
elemD c
cur

      DecodeResultT i e f c -> DecodeResultT i e f (Maybe c)
forall e (m :: * -> *) a. MonadError e m => m a -> m (Maybe a)
try (c -> DecodeResultT i e f c
mvCurs c
cur) DecodeResultT i e f (Maybe c)
-> (Maybe c -> DecodeResultT i e f b) -> DecodeResultT i e f b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DecodeResultT i e f b
-> (c -> DecodeResultT i e f b) -> Maybe c -> DecodeResultT i e f b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (b -> DecodeResultT i e f b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
acc')
        (b -> c -> DecodeResultT i e f b
go b
acc')

-- |
-- Provide a generalised and low level way of turning a JSON object into a
-- 'Map', without enforcing a choice of how we select keys.
--
mapKeepingF
  :: ( Ord k
     , Applicative f
     , AsJType a ws a
     )
  => (t -> Maybe v -> Maybe v)
  -> (JString -> f k)
  -> (a -> f t)
  -> a
  -> f (Map k v)
mapKeepingF :: (t -> Maybe v -> Maybe v)
-> (JString -> f k) -> (a -> f t) -> a -> f (Map k v)
mapKeepingF t -> Maybe v -> Maybe v
f JString -> f k
kF a -> f t
vF a
a =
  ((k, t) -> Map k v -> Map k v) -> Map k v -> [(k, t)] -> Map k v
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(k
k,t
v) -> (Maybe v -> Maybe v) -> k -> Map k v -> Map k v
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (t -> Maybe v -> Maybe v
f t
v) k
k) Map k v
forall k a. Map k a
Map.empty ([(k, t)] -> Map k v) -> f [(k, t)] -> f (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JString -> f k) -> (a -> f t) -> a -> f [(k, t)]
forall (f :: * -> *) a ws k b.
(Applicative f, AsJType a ws a) =>
(JString -> f k) -> (a -> f b) -> a -> f [(k, b)]
objTuples' JString -> f k
kF a -> f t
vF a
a

-- |
-- Turn a JSON object into a 'Map' by keeping the *first* occurence of any
-- duplicate keys that are encountered.
--
mapKeepingFirst
  :: ( Ord k
     , Applicative f
     , AsJType a ws a
     )
  => (JString -> f k)
  -> (a -> f b)
  -> a
  -> f (Map k b)
mapKeepingFirst :: (JString -> f k) -> (a -> f b) -> a -> f (Map k b)
mapKeepingFirst =
  (b -> Maybe b -> Maybe b)
-> (JString -> f k) -> (a -> f b) -> a -> f (Map k b)
forall k (f :: * -> *) a ws t v.
(Ord k, Applicative f, AsJType a ws a) =>
(t -> Maybe v -> Maybe v)
-> (JString -> f k) -> (a -> f t) -> a -> f (Map k v)
mapKeepingF (\b
v -> (Maybe b -> Maybe b -> Maybe b
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> b -> Maybe b
forall a. a -> Maybe a
Just b
v))

-- |
-- Turn a JSON object into a 'Map' by keeping the *last* occurence of any
-- duplicate keys that are encountered.
--
mapKeepingLast
  :: ( Ord k
     , Applicative f
     , AsJType a ws a
     )
  => (JString -> f k)
  -> (a -> f b)
  -> a
  -> f (Map k b)
mapKeepingLast :: (JString -> f k) -> (a -> f b) -> a -> f (Map k b)
mapKeepingLast =
  (b -> Maybe b -> Maybe b)
-> (JString -> f k) -> (a -> f b) -> a -> f (Map k b)
forall k (f :: * -> *) a ws t v.
(Ord k, Applicative f, AsJType a ws a) =>
(t -> Maybe v -> Maybe v)
-> (JString -> f k) -> (a -> f t) -> a -> f (Map k v)
mapKeepingF (\b
v -> (b -> Maybe b
forall a. a -> Maybe a
Just b
v Maybe b -> Maybe b -> Maybe b
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>))