{-# LANGUAGE BangPatterns
           , RankNTypes
           , UnboxedTuples #-}

{-# OPTIONS_HADDOCK hide #-}

module Codec.JSON.Decoder.Stream.Internal
  ( Stream (..)
  , chainStream
  , unfoldStream
  , mapStream
  , foldStream
  , foldStream'

  , Source (..)
  , sourceObjectP
  , sourceObjectP_
  , sourceArrayP
  ) where

import           Codec.JSON.Decoder.Composite.Internal
import           Codec.JSON.Decoder.JSON.Internal
import           Codec.JSON.Decoder.Internal
import           Codec.JSON.Decoder.String.Internal
import           Data.JSON.Internal

import           Parser.Lathe



-- | A list parametrized by an element type @a@, an  effect type @m@
--   and the return type @r@.
data Stream a m r = Yield a (Stream a m r)
                  | Effect (m (Stream a m r))
                  | Return r

instance Functor m => Functor (Stream a m) where
  fmap :: forall a b. (a -> b) -> Stream a m a -> Stream a m b
fmap a -> b
f = Stream a m a -> Stream a m b
forall {m :: * -> *} {a}. Functor m => Stream a m a -> Stream a m b
go
    where
      go :: Stream a m a -> Stream a m b
go Stream a m a
s =
        case Stream a m a
s of
          Yield a
a Stream a m a
s' -> a -> Stream a m b -> Stream a m b
forall a (m :: * -> *) r. a -> Stream a m r -> Stream a m r
Yield a
a (Stream a m a -> Stream a m b
go Stream a m a
s')
          Effect m (Stream a m a)
m   -> m (Stream a m b) -> Stream a m b
forall a (m :: * -> *) r. m (Stream a m r) -> Stream a m r
Effect (Stream a m a -> Stream a m b
go (Stream a m a -> Stream a m b)
-> m (Stream a m a) -> m (Stream a m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Stream a m a)
m)
          Return a
r   -> b -> Stream a m b
forall a (m :: * -> *) r. r -> Stream a m r
Return (a -> b
f a
r)



chainStream
  :: Stream a (Parser e) r
  -> (r -> Stream a (Parser e) o)
  -> Stream a (Parser e) o
chainStream :: forall a e r o.
Stream a (Parser e) r
-> (r -> Stream a (Parser e) o) -> Stream a (Parser e) o
chainStream Stream a (Parser e) r
x r -> Stream a (Parser e) o
next = Stream a (Parser e) r -> Stream a (Parser e) o
go Stream a (Parser e) r
x
  where
    go :: Stream a (Parser e) r -> Stream a (Parser e) o
go Stream a (Parser e) r
s =
      case Stream a (Parser e) r
s of
        Yield a
a Stream a (Parser e) r
s' -> a -> Stream a (Parser e) o -> Stream a (Parser e) o
forall a (m :: * -> *) r. a -> Stream a m r -> Stream a m r
Yield a
a (Stream a (Parser e) r -> Stream a (Parser e) o
go Stream a (Parser e) r
s')
        Effect Parser e (Stream a (Parser e) r)
one -> Parser e (Stream a (Parser e) o) -> Stream a (Parser e) o
forall a (m :: * -> *) r. m (Stream a m r) -> Stream a m r
Effect (Stream a (Parser e) r -> Stream a (Parser e) o
go (Stream a (Parser e) r -> Stream a (Parser e) o)
-> Parser e (Stream a (Parser e) r)
-> Parser e (Stream a (Parser e) o)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser e (Stream a (Parser e) r)
one)
        Return r
r   -> r -> Stream a (Parser e) o
next r
r


unfoldStream
  :: Blank
  -> Stream a (Parser (Path, Error)) r
  -> Stream a Partial (Blank, Either (Path, Error) r)
unfoldStream :: forall a r.
Blank
-> Stream a (Parser (Path, Error)) r
-> Stream a Partial (Blank, Either (Path, Error) r)
unfoldStream Blank
b Stream a (Parser (Path, Error)) r
s =
  case Stream a (Parser (Path, Error)) r
s of
    Yield a
a Stream a (Parser (Path, Error)) r
s' -> a
-> Stream a Partial (Blank, Either (Path, Error) r)
-> Stream a Partial (Blank, Either (Path, Error) r)
forall a (m :: * -> *) r. a -> Stream a m r -> Stream a m r
Yield a
a (Blank
-> Stream a (Parser (Path, Error)) r
-> Stream a Partial (Blank, Either (Path, Error) r)
forall a r.
Blank
-> Stream a (Parser (Path, Error)) r
-> Stream a Partial (Blank, Either (Path, Error) r)
unfoldStream Blank
b Stream a (Parser (Path, Error)) r
s')
    Effect Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
m   -> Partial (Stream a Partial (Blank, Either (Path, Error) r))
-> Stream a Partial (Blank, Either (Path, Error) r)
forall a (m :: * -> *) r. m (Stream a m r) -> Stream a m r
Effect (Partial (Stream a Partial (Blank, Either (Path, Error) r))
 -> Stream a Partial (Blank, Either (Path, Error) r))
-> Partial (Stream a Partial (Blank, Either (Path, Error) r))
-> Stream a Partial (Blank, Either (Path, Error) r)
forall a b. (a -> b) -> a -> b
$ Partial
  (Blank, Either (Path, Error) (Stream a (Parser (Path, Error)) r))
-> Partial (Stream a Partial (Blank, Either (Path, Error) r))
forall {a} {r}.
Partial
  (Blank, Either (Path, Error) (Stream a (Parser (Path, Error)) r))
-> Partial (Stream a Partial (Blank, Either (Path, Error) r))
go (Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
-> Blank
-> Partial
     (Blank, Either (Path, Error) (Stream a (Parser (Path, Error)) r))
forall e a. Parser e a -> Blank -> Partial (Blank, Either e a)
draw Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
m Blank
b)
      where
        go :: Partial
  (Blank, Either (Path, Error) (Stream a (Parser (Path, Error)) r))
-> Partial (Stream a Partial (Blank, Either (Path, Error) r))
go Partial
  (Blank, Either (Path, Error) (Stream a (Parser (Path, Error)) r))
x =
          case Partial
  (Blank, Either (Path, Error) (Stream a (Parser (Path, Error)) r))
x of
            Partial Resupply
-> Partial
     (Blank, Either (Path, Error) (Stream a (Parser (Path, Error)) r))
re    -> (Resupply
 -> Partial (Stream a Partial (Blank, Either (Path, Error) r)))
-> Partial (Stream a Partial (Blank, Either (Path, Error) r))
forall a. (Resupply -> Partial a) -> Partial a
Partial ((Resupply
  -> Partial (Stream a Partial (Blank, Either (Path, Error) r)))
 -> Partial (Stream a Partial (Blank, Either (Path, Error) r)))
-> (Resupply
    -> Partial (Stream a Partial (Blank, Either (Path, Error) r)))
-> Partial (Stream a Partial (Blank, Either (Path, Error) r))
forall a b. (a -> b) -> a -> b
$ \Resupply
supply -> Partial
  (Blank, Either (Path, Error) (Stream a (Parser (Path, Error)) r))
-> Partial (Stream a Partial (Blank, Either (Path, Error) r))
go (Resupply
-> Partial
     (Blank, Either (Path, Error) (Stream a (Parser (Path, Error)) r))
re Resupply
supply)
            Done (Blank
b', Either (Path, Error) (Stream a (Parser (Path, Error)) r)
ei) ->
              let !(# Stream a Partial (Blank, Either (Path, Error) r)
r #) = case Either (Path, Error) (Stream a (Parser (Path, Error)) r)
ei of
                               Right Stream a (Parser (Path, Error)) r
s' -> (# Blank
-> Stream a (Parser (Path, Error)) r
-> Stream a Partial (Blank, Either (Path, Error) r)
forall a r.
Blank
-> Stream a (Parser (Path, Error)) r
-> Stream a Partial (Blank, Either (Path, Error) r)
unfoldStream Blank
b' Stream a (Parser (Path, Error)) r
s' #)
                               Left (Path, Error)
e   -> (# (Blank, Either (Path, Error) r)
-> Stream a Partial (Blank, Either (Path, Error) r)
forall a (m :: * -> *) r. r -> Stream a m r
Return (Blank
b', (Path, Error) -> Either (Path, Error) r
forall a b. a -> Either a b
Left (Path, Error)
e) #)

              in Stream a Partial (Blank, Either (Path, Error) r)
-> Partial (Stream a Partial (Blank, Either (Path, Error) r))
forall a. a -> Partial a
Done Stream a Partial (Blank, Either (Path, Error) r)
r

    Return r
r   -> (Blank, Either (Path, Error) r)
-> Stream a Partial (Blank, Either (Path, Error) r)
forall a (m :: * -> *) r. r -> Stream a m r
Return (Blank
b, r -> Either (Path, Error) r
forall a b. b -> Either a b
Right r
r)



mapStream :: Functor m => (a -> b) -> Stream a m r -> Stream b m r
mapStream :: forall (m :: * -> *) a b r.
Functor m =>
(a -> b) -> Stream a m r -> Stream b m r
mapStream a -> b
f = Stream a m r -> Stream b m r
forall {m :: * -> *} {r}. Functor m => Stream a m r -> Stream b m r
go
  where
    go :: Stream a m r -> Stream b m r
go Stream a m r
s =
      case Stream a m r
s of
        Yield a
a Stream a m r
s' -> b -> Stream b m r -> Stream b m r
forall a (m :: * -> *) r. a -> Stream a m r -> Stream a m r
Yield (a -> b
f a
a) (Stream b m r -> Stream b m r) -> Stream b m r -> Stream b m r
forall a b. (a -> b) -> a -> b
$ Stream a m r -> Stream b m r
go Stream a m r
s'
        Effect m (Stream a m r)
m   -> m (Stream b m r) -> Stream b m r
forall a (m :: * -> *) r. m (Stream a m r) -> Stream a m r
Effect (Stream a m r -> Stream b m r
go (Stream a m r -> Stream b m r)
-> m (Stream a m r) -> m (Stream b m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Stream a m r)
m)
        Return r
r   -> r -> Stream b m r
forall a (m :: * -> *) r. r -> Stream a m r
Return r
r



foldStream
  :: (b -> a -> b)
  -> (b -> r -> b)
  -> b
  -> Stream a (Parser (Path, Error)) r
  -> Parser (Path, Error) b
foldStream :: forall b a r.
(b -> a -> b)
-> (b -> r -> b)
-> b
-> Stream a (Parser (Path, Error)) r
-> Parser (Path, Error) b
foldStream b -> a -> b
f b -> r -> b
g = b -> Stream a (Parser (Path, Error)) r -> Parser (Path, Error) b
forall {m :: * -> *}. Monad m => b -> Stream a m r -> m b
go
  where
    go :: b -> Stream a m r -> m b
go b
z Stream a m r
s =
      case Stream a m r
s of
        Yield a
a Stream a m r
s' -> b -> Stream a m r -> m b
go (b -> a -> b
f b
z a
a) Stream a m r
s'
        Effect m (Stream a m r)
m   -> b -> Stream a m r -> m b
go b
z (Stream a m r -> m b) -> m (Stream a m r) -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (Stream a m r)
m
        Return r
r   -> b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> r -> b
g b
z r
r)


foldStream'
  :: (b -> a -> b)
  -> (b -> r -> b)
  -> b
  -> Stream a (Parser (Path, Error)) r
  -> Parser (Path, Error) b
foldStream' :: forall b a r.
(b -> a -> b)
-> (b -> r -> b)
-> b
-> Stream a (Parser (Path, Error)) r
-> Parser (Path, Error) b
foldStream' b -> a -> b
f b -> r -> b
g = b -> Stream a (Parser (Path, Error)) r -> Parser (Path, Error) b
forall {m :: * -> *}. Monad m => b -> Stream a m r -> m b
go
  where
    go :: b -> Stream a m r -> m b
go !b
z Stream a m r
s =
      case Stream a m r
s of
        Yield a
a Stream a m r
s' -> let !z' :: b
z' = b -> a -> b
f b
z a
a in b -> Stream a m r -> m b
go b
z' Stream a m r
s'
        Effect m (Stream a m r)
m   -> b -> Stream a m r -> m b
go b
z (Stream a m r -> m b) -> m (Stream a m r) -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (Stream a m r)
m
        Return r
r   -> b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$! b -> r -> b
g b
z r
r



-- | Decoder type for streams.
newtype Source a r =
          Source
            { forall a r.
Source a r
-> Path -> Bitmask -> K -> Stream a (Parser (Path, Error)) r
runSource :: Path -> Bitmask -> K -> Stream a (Parser (Path, Error)) r }

instance Functor (Source a) where
  fmap :: forall a b. (a -> b) -> Source a a -> Source a b
fmap a -> b
f (Source Path -> Bitmask -> K -> Stream a (Parser (Path, Error)) a
source) =
    (Path -> Bitmask -> K -> Stream a (Parser (Path, Error)) b)
-> Source a b
forall a r.
(Path -> Bitmask -> K -> Stream a (Parser (Path, Error)) r)
-> Source a r
Source ((Path -> Bitmask -> K -> Stream a (Parser (Path, Error)) b)
 -> Source a b)
-> (Path -> Bitmask -> K -> Stream a (Parser (Path, Error)) b)
-> Source a b
forall a b. (a -> b) -> a -> b
$ \Path
path Bitmask
bits K
k ->
      (a -> b)
-> Stream a (Parser (Path, Error)) a
-> Stream a (Parser (Path, Error)) b
forall a b.
(a -> b)
-> Stream a (Parser (Path, Error)) a
-> Stream a (Parser (Path, Error)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Stream a (Parser (Path, Error)) a
 -> Stream a (Parser (Path, Error)) b)
-> Stream a (Parser (Path, Error)) a
-> Stream a (Parser (Path, Error)) b
forall a b. (a -> b) -> a -> b
$ Path -> Bitmask -> K -> Stream a (Parser (Path, Error)) a
source Path
path Bitmask
bits K
k



sourceObjectP
  :: Path
  -> KeyDecoder k
  -> (k -> r -> Source a r)
  -> r
  -> Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
sourceObjectP :: forall k r a.
Path
-> KeyDecoder k
-> (k -> r -> Source a r)
-> r
-> Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
sourceObjectP Path
path (KeyDecoder (Decoder Path -> Bitmask -> K -> Parser (Path, Error) k
keyP)) k -> r -> Source a r
f r
r0 = do
  Parser (Path, Error) ()
forall never. Parser never ()
skipEndOr1
  nonempty <- Path -> Parser (Path, Error) Bool
firstKeyP Path
path
  if nonempty
    then go r0
    else pure $ Return r0
      where
        go :: r -> Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
go r
r = do
          Path -> Parser (Path, Error) ()
nextKeyP Path
path
          (raw, key) <- Parser (Path, Error) k -> Parser (Path, Error) (ByteString, k)
forall e a. Parser e a -> Parser e (ByteString, a)
match (Parser (Path, Error) k -> Parser (Path, Error) (ByteString, k))
-> Parser (Path, Error) k -> Parser (Path, Error) (ByteString, k)
forall a b. (a -> b) -> a -> b
$ Path -> Bitmask -> K -> Parser (Path, Error) k
keyP Path
path Bitmask
EmptyBitmask K
S
          nextColonP path
          k' <- nextValueP (Key path (JSONKey (JSON raw)))
          pure $
            chainStream
              (runSource (f key r) (Key path (JSONKey (JSON raw))) EmptyBitmask k')
              ( \r
r' ->
                  Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
-> Stream a (Parser (Path, Error)) r
forall a (m :: * -> *) r. m (Stream a m r) -> Stream a m r
Effect (Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
 -> Stream a (Parser (Path, Error)) r)
-> Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
-> Stream a (Parser (Path, Error)) r
forall a b. (a -> b) -> a -> b
$ do
                    more <- Path -> Parser (Path, Error) Bool
nextPairP Path
path
                    if more
                      then go r'
                      else pure (Return r')
              )



sourceObjectP_
  :: Path
  -> (JSONKey -> r -> Source a r)
  -> r
  -> Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
sourceObjectP_ :: forall r a.
Path
-> (JSONKey -> r -> Source a r)
-> r
-> Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
sourceObjectP_ Path
path JSONKey -> r -> Source a r
f r
r0 = do
  Parser (Path, Error) ()
forall never. Parser never ()
skipEndOr1
  nonempty <- Path -> Parser (Path, Error) Bool
firstKeyP Path
path
  if nonempty
    then go r0
    else pure $ Return r0
      where
        go :: r -> Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
go r
r = do
          Path -> Parser (Path, Error) ()
nextKeyP Path
path
          (raw, _) <- Parser (Path, Error) () -> Parser (Path, Error) (ByteString, ())
forall e a. Parser e a -> Parser e (ByteString, a)
match (Parser (Path, Error) () -> Parser (Path, Error) (ByteString, ()))
-> Parser (Path, Error) () -> Parser (Path, Error) (ByteString, ())
forall a b. (a -> b) -> a -> b
$ SurrogateHandling_ -> Path -> Parser (Path, Error) ()
jsonStringP SurrogateHandling_
Complain_ Path
path
          let key = JSON -> JSONKey
JSONKey (ByteString -> JSON
JSON ByteString
raw)
          nextColonP path
          k' <- nextValueP (Key path (JSONKey (JSON raw)))
          pure $
            chainStream
              (runSource (f key r) (Key path key) EmptyBitmask k')
              ( \r
r' ->
                  Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
-> Stream a (Parser (Path, Error)) r
forall a (m :: * -> *) r. m (Stream a m r) -> Stream a m r
Effect (Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
 -> Stream a (Parser (Path, Error)) r)
-> Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
-> Stream a (Parser (Path, Error)) r
forall a b. (a -> b) -> a -> b
$ do
                    more <- Path -> Parser (Path, Error) Bool
nextPairP Path
path
                    if more
                      then do
                        nextKeyP path
                        go r'

                      else pure (Return r')
              )



sourceArrayP
  :: Path
  -> (Word -> r -> Source a r)
  -> r
  -> Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
sourceArrayP :: forall r a.
Path
-> (Word -> r -> Source a r)
-> r
-> Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
sourceArrayP Path
path Word -> r -> Source a r
f r
r0 = do
  Parser (Path, Error) ()
forall never. Parser never ()
skipEndOr1
  mayK1 <- Path -> Parser (Path, Error) (Maybe K)
firstElementP Path
path
  case mayK1 of
    Maybe K
Nothing -> Stream a (Parser (Path, Error)) r
-> Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
forall a. a -> Parser (Path, Error) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stream a (Parser (Path, Error)) r
 -> Parser (Path, Error) (Stream a (Parser (Path, Error)) r))
-> Stream a (Parser (Path, Error)) r
-> Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
forall a b. (a -> b) -> a -> b
$ r -> Stream a (Parser (Path, Error)) r
forall a (m :: * -> *) r. r -> Stream a m r
Return r
r0
    Just K
k1 -> Word
-> K
-> r
-> Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
go Word
0 K
k1 r
r0
      where
        go :: Word
-> K
-> r
-> Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
go !Word
n !K
k r
r =
          Stream a (Parser (Path, Error)) r
-> Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
forall a. a -> Parser (Path, Error) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stream a (Parser (Path, Error)) r
 -> Parser (Path, Error) (Stream a (Parser (Path, Error)) r))
-> Stream a (Parser (Path, Error)) r
-> Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
forall a b. (a -> b) -> a -> b
$
            Stream a (Parser (Path, Error)) r
-> (r -> Stream a (Parser (Path, Error)) r)
-> Stream a (Parser (Path, Error)) r
forall a e r o.
Stream a (Parser e) r
-> (r -> Stream a (Parser e) o) -> Stream a (Parser e) o
chainStream
              (Source a r
-> Path -> Bitmask -> K -> Stream a (Parser (Path, Error)) r
forall a r.
Source a r
-> Path -> Bitmask -> K -> Stream a (Parser (Path, Error)) r
runSource (Word -> r -> Source a r
f Word
n r
r) (Path -> Word -> Path
Index Path
path Word
n) Bitmask
EmptyBitmask K
k)
              ( \r
r' ->
                  Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
-> Stream a (Parser (Path, Error)) r
forall a (m :: * -> *) r. m (Stream a m r) -> Stream a m r
Effect (Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
 -> Stream a (Parser (Path, Error)) r)
-> Parser (Path, Error) (Stream a (Parser (Path, Error)) r)
-> Stream a (Parser (Path, Error)) r
forall a b. (a -> b) -> a -> b
$ do
                    more <- Path -> Parser (Path, Error) Bool
nextElementP Path
path
                    if more
                      then do
                        k' <- nextValueP path
                        go (n + 1) k' r'

                      else pure (Return r')
              )