{-# LANGUAGE DeriveFoldable         #-}
{-# LANGUAGE DeriveFunctor          #-}
{-# LANGUAGE DeriveTraversable      #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE NoImplicitPrelude      #-}
{-# LANGUAGE OverloadedStrings      #-}
{-# LANGUAGE RankNTypes             #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TypeFamilies           #-}
-- | Top level types and functions for Waargonaut 'Json' types.
module Waargonaut.Types.Json
  (
    -- * Inner JSON types
    JType (..)
  , AsJType (..)

    -- * Top level JSON type
  , Json (..)

    -- * Parser
  , parseWaargonaut

  -- * Traversals
  , jsonTraversal
  , jsonWSTraversal
  , jtypeTraversal
  , jtypeWSTraversal

  -- * Optics
  , oat
  , oix
  , aix
  ) where

import           Prelude                     (Eq, Int, Show)

import           Control.Applicative         (pure, (<$>), (<*>), (<|>))
import           Control.Category            (id, (.))
import           Control.Lens                (Prism', Rewrapped, Traversal,
                                              Traversal', Wrapped (..), at, iso,
                                              ix, prism, traverseOf, _1,
                                              _Wrapped)

import           Control.Monad               (Monad)

import           Data.Bifoldable             (Bifoldable (bifoldMap))
import           Data.Bifunctor              (Bifunctor (bimap))
import           Data.Bitraversable          (Bitraversable (bitraverse))
import           Data.Bool                   (Bool (..))
import           Data.Distributive           (distribute)
import           Data.Either                 (Either (..))
import           Data.Foldable               (Foldable (..), asum)
import           Data.Function               (flip)
import           Data.Functor                (Functor (..))
import           Data.Monoid                 (Monoid (..))
import           Data.Semigroup              (Semigroup)
import           Data.Traversable            (Traversable (..))
import           Data.Tuple                  (uncurry)

import           Data.Maybe                  (Maybe)
import           Data.Text                   (Text)

import           Text.Parser.Char            (CharParsing, text)

import           Waargonaut.Types.JArray     (JArray (..), parseJArray)
import           Waargonaut.Types.JNumber    (JNumber, parseJNumber)
import           Waargonaut.Types.JObject    (JObject (..), parseJObject,
                                              _MapLikeObj)
import           Waargonaut.Types.JString    (JString, parseJString)
import           Waargonaut.Types.Whitespace (WS (..), parseWhitespace)

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Utils
-- >>> import Control.Lens
-- >>> import Control.Monad (return)
-- >>> import Data.Either (Either (..), isLeft)
-- >>> import Data.Function (($))
-- >>> import Waargonaut.Decode.Error (DecodeError)
-- >>> import Waargonaut.Types.JChar.Unescaped (Unescaped (..))
-- >>> import Data.Digit (HeXDigit)
-- >>> import qualified Waargonaut.Encode as E
-- >>> let intList = E.asJson' (E.list E.int) [1,2,3]
-- >>> data Foo = Foo { fooA :: Int, fooB :: Text } deriving Show
-- >>> let encodeFoo = E.mapLikeObj $ \(Foo i t) -> E.atKey' "a" E.int i . E.atKey' "b" E.text t
-- >>> let obj = E.asJson' encodeFoo (Foo 33 "Fred")
----

-- | Individual JSON Types and their trailing whitespace.
data JType ws a
  = JNull ws
  | JBool Bool ws
  | JNum JNumber ws
  | JStr JString ws
  | JArr (JArray ws a) ws
  | JObj (JObject ws a) ws
  deriving (JType ws a -> JType ws a -> Bool
(JType ws a -> JType ws a -> Bool)
-> (JType ws a -> JType ws a -> Bool) -> Eq (JType ws a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ws a. (Eq ws, Eq a) => JType ws a -> JType ws a -> Bool
/= :: JType ws a -> JType ws a -> Bool
$c/= :: forall ws a. (Eq ws, Eq a) => JType ws a -> JType ws a -> Bool
== :: JType ws a -> JType ws a -> Bool
$c== :: forall ws a. (Eq ws, Eq a) => JType ws a -> JType ws a -> Bool
Eq, Int -> JType ws a -> ShowS
[JType ws a] -> ShowS
JType ws a -> String
(Int -> JType ws a -> ShowS)
-> (JType ws a -> String)
-> ([JType ws a] -> ShowS)
-> Show (JType ws a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ws a. (Show ws, Show a) => Int -> JType ws a -> ShowS
forall ws a. (Show ws, Show a) => [JType ws a] -> ShowS
forall ws a. (Show ws, Show a) => JType ws a -> String
showList :: [JType ws a] -> ShowS
$cshowList :: forall ws a. (Show ws, Show a) => [JType ws a] -> ShowS
show :: JType ws a -> String
$cshow :: forall ws a. (Show ws, Show a) => JType ws a -> String
showsPrec :: Int -> JType ws a -> ShowS
$cshowsPrec :: forall ws a. (Show ws, Show a) => Int -> JType ws a -> ShowS
Show, a -> JType ws b -> JType ws a
(a -> b) -> JType ws a -> JType ws b
(forall a b. (a -> b) -> JType ws a -> JType ws b)
-> (forall a b. a -> JType ws b -> JType ws a)
-> Functor (JType ws)
forall a b. a -> JType ws b -> JType ws a
forall a b. (a -> b) -> JType ws a -> JType ws b
forall ws a b. a -> JType ws b -> JType ws a
forall ws a b. (a -> b) -> JType ws a -> JType ws b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> JType ws b -> JType ws a
$c<$ :: forall ws a b. a -> JType ws b -> JType ws a
fmap :: (a -> b) -> JType ws a -> JType ws b
$cfmap :: forall ws a b. (a -> b) -> JType ws a -> JType ws b
Functor, JType ws a -> Bool
(a -> m) -> JType ws a -> m
(a -> b -> b) -> b -> JType ws a -> b
(forall m. Monoid m => JType ws m -> m)
-> (forall m a. Monoid m => (a -> m) -> JType ws a -> m)
-> (forall m a. Monoid m => (a -> m) -> JType ws a -> m)
-> (forall a b. (a -> b -> b) -> b -> JType ws a -> b)
-> (forall a b. (a -> b -> b) -> b -> JType ws a -> b)
-> (forall b a. (b -> a -> b) -> b -> JType ws a -> b)
-> (forall b a. (b -> a -> b) -> b -> JType ws a -> b)
-> (forall a. (a -> a -> a) -> JType ws a -> a)
-> (forall a. (a -> a -> a) -> JType ws a -> a)
-> (forall a. JType ws a -> [a])
-> (forall a. JType ws a -> Bool)
-> (forall a. JType ws a -> Int)
-> (forall a. Eq a => a -> JType ws a -> Bool)
-> (forall a. Ord a => JType ws a -> a)
-> (forall a. Ord a => JType ws a -> a)
-> (forall a. Num a => JType ws a -> a)
-> (forall a. Num a => JType ws a -> a)
-> Foldable (JType ws)
forall a. Eq a => a -> JType ws a -> Bool
forall a. Num a => JType ws a -> a
forall a. Ord a => JType ws a -> a
forall m. Monoid m => JType ws m -> m
forall a. JType ws a -> Bool
forall a. JType ws a -> Int
forall a. JType ws a -> [a]
forall a. (a -> a -> a) -> JType ws a -> a
forall ws a. Eq a => a -> JType ws a -> Bool
forall ws a. Num a => JType ws a -> a
forall ws a. Ord a => JType ws a -> a
forall m a. Monoid m => (a -> m) -> JType ws a -> m
forall ws m. Monoid m => JType ws m -> m
forall ws a. JType ws a -> Bool
forall ws a. JType ws a -> Int
forall ws a. JType ws a -> [a]
forall b a. (b -> a -> b) -> b -> JType ws a -> b
forall a b. (a -> b -> b) -> b -> JType ws a -> b
forall ws a. (a -> a -> a) -> JType ws a -> a
forall ws m a. Monoid m => (a -> m) -> JType ws a -> m
forall ws b a. (b -> a -> b) -> b -> JType ws a -> b
forall ws a b. (a -> b -> b) -> b -> JType ws a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: JType ws a -> a
$cproduct :: forall ws a. Num a => JType ws a -> a
sum :: JType ws a -> a
$csum :: forall ws a. Num a => JType ws a -> a
minimum :: JType ws a -> a
$cminimum :: forall ws a. Ord a => JType ws a -> a
maximum :: JType ws a -> a
$cmaximum :: forall ws a. Ord a => JType ws a -> a
elem :: a -> JType ws a -> Bool
$celem :: forall ws a. Eq a => a -> JType ws a -> Bool
length :: JType ws a -> Int
$clength :: forall ws a. JType ws a -> Int
null :: JType ws a -> Bool
$cnull :: forall ws a. JType ws a -> Bool
toList :: JType ws a -> [a]
$ctoList :: forall ws a. JType ws a -> [a]
foldl1 :: (a -> a -> a) -> JType ws a -> a
$cfoldl1 :: forall ws a. (a -> a -> a) -> JType ws a -> a
foldr1 :: (a -> a -> a) -> JType ws a -> a
$cfoldr1 :: forall ws a. (a -> a -> a) -> JType ws a -> a
foldl' :: (b -> a -> b) -> b -> JType ws a -> b
$cfoldl' :: forall ws b a. (b -> a -> b) -> b -> JType ws a -> b
foldl :: (b -> a -> b) -> b -> JType ws a -> b
$cfoldl :: forall ws b a. (b -> a -> b) -> b -> JType ws a -> b
foldr' :: (a -> b -> b) -> b -> JType ws a -> b
$cfoldr' :: forall ws a b. (a -> b -> b) -> b -> JType ws a -> b
foldr :: (a -> b -> b) -> b -> JType ws a -> b
$cfoldr :: forall ws a b. (a -> b -> b) -> b -> JType ws a -> b
foldMap' :: (a -> m) -> JType ws a -> m
$cfoldMap' :: forall ws m a. Monoid m => (a -> m) -> JType ws a -> m
foldMap :: (a -> m) -> JType ws a -> m
$cfoldMap :: forall ws m a. Monoid m => (a -> m) -> JType ws a -> m
fold :: JType ws m -> m
$cfold :: forall ws m. Monoid m => JType ws m -> m
Foldable, Functor (JType ws)
Foldable (JType ws)
Functor (JType ws)
-> Foldable (JType ws)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> JType ws a -> f (JType ws b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    JType ws (f a) -> f (JType ws a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> JType ws a -> m (JType ws b))
-> (forall (m :: * -> *) a.
    Monad m =>
    JType ws (m a) -> m (JType ws a))
-> Traversable (JType ws)
(a -> f b) -> JType ws a -> f (JType ws b)
forall ws. Functor (JType ws)
forall ws. Foldable (JType ws)
forall ws (m :: * -> *) a.
Monad m =>
JType ws (m a) -> m (JType ws a)
forall ws (f :: * -> *) a.
Applicative f =>
JType ws (f a) -> f (JType ws a)
forall ws (m :: * -> *) a b.
Monad m =>
(a -> m b) -> JType ws a -> m (JType ws b)
forall ws (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> JType ws a -> f (JType ws b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => JType ws (m a) -> m (JType ws a)
forall (f :: * -> *) a.
Applicative f =>
JType ws (f a) -> f (JType ws a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> JType ws a -> m (JType ws b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> JType ws a -> f (JType ws b)
sequence :: JType ws (m a) -> m (JType ws a)
$csequence :: forall ws (m :: * -> *) a.
Monad m =>
JType ws (m a) -> m (JType ws a)
mapM :: (a -> m b) -> JType ws a -> m (JType ws b)
$cmapM :: forall ws (m :: * -> *) a b.
Monad m =>
(a -> m b) -> JType ws a -> m (JType ws b)
sequenceA :: JType ws (f a) -> f (JType ws a)
$csequenceA :: forall ws (f :: * -> *) a.
Applicative f =>
JType ws (f a) -> f (JType ws a)
traverse :: (a -> f b) -> JType ws a -> f (JType ws b)
$ctraverse :: forall ws (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> JType ws a -> f (JType ws b)
$cp2Traversable :: forall ws. Foldable (JType ws)
$cp1Traversable :: forall ws. Functor (JType ws)
Traversable)

instance Bifunctor JType where
  bimap :: (a -> b) -> (c -> d) -> JType a c -> JType b d
bimap a -> b
f c -> d
g JType a c
jt = case JType a c
jt of
    JNull a
ws   -> b -> JType b d
forall ws a. ws -> JType ws a
JNull (a -> b
f a
ws)
    JBool Bool
b a
ws -> Bool -> b -> JType b d
forall ws a. Bool -> ws -> JType ws a
JBool Bool
b (a -> b
f a
ws)
    JNum JNumber
n a
ws  -> JNumber -> b -> JType b d
forall ws a. JNumber -> ws -> JType ws a
JNum JNumber
n (a -> b
f a
ws)
    JStr JString
s a
ws  -> JString -> b -> JType b d
forall ws a. JString -> ws -> JType ws a
JStr JString
s (a -> b
f a
ws)
    JArr JArray a c
a a
ws  -> JArray b d -> b -> JType b d
forall ws a. JArray ws a -> ws -> JType ws a
JArr ((a -> b) -> (c -> d) -> JArray a c -> JArray b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g JArray a c
a) (a -> b
f a
ws)
    JObj JObject a c
o a
ws  -> JObject b d -> b -> JType b d
forall ws a. JObject ws a -> ws -> JType ws a
JObj ((a -> b) -> (c -> d) -> JObject a c -> JObject b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g JObject a c
o) (a -> b
f a
ws)

instance Bifoldable JType where
  bifoldMap :: (a -> m) -> (b -> m) -> JType a b -> m
bifoldMap a -> m
f b -> m
g JType a b
jt = case JType a b
jt of
    JNull a
ws   -> a -> m
f a
ws
    JBool Bool
_ a
ws -> a -> m
f a
ws
    JNum JNumber
_ a
ws  -> a -> m
f a
ws
    JStr JString
_ a
ws  -> a -> m
f a
ws
    JArr JArray a b
a a
ws  -> (a -> m) -> (b -> m) -> JArray a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g JArray a b
a m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` a -> m
f a
ws
    JObj JObject a b
o a
ws  -> (a -> m) -> (b -> m) -> JObject a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g JObject a b
o m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` a -> m
f a
ws

instance Bitraversable JType where
  bitraverse :: (a -> f c) -> (b -> f d) -> JType a b -> f (JType c d)
bitraverse a -> f c
f b -> f d
g JType a b
jt = case JType a b
jt of
    JNull a
ws   -> c -> JType c d
forall ws a. ws -> JType ws a
JNull (c -> JType c d) -> f c -> f (JType c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
ws
    JBool Bool
b a
ws -> Bool -> c -> JType c d
forall ws a. Bool -> ws -> JType ws a
JBool Bool
b (c -> JType c d) -> f c -> f (JType c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
ws
    JNum JNumber
n a
ws  -> JNumber -> c -> JType c d
forall ws a. JNumber -> ws -> JType ws a
JNum JNumber
n (c -> JType c d) -> f c -> f (JType c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
ws
    JStr JString
s a
ws  -> JString -> c -> JType c d
forall ws a. JString -> ws -> JType ws a
JStr JString
s (c -> JType c d) -> f c -> f (JType c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
ws
    JArr JArray a b
a a
ws  -> JArray c d -> c -> JType c d
forall ws a. JArray ws a -> ws -> JType ws a
JArr (JArray c d -> c -> JType c d)
-> f (JArray c d) -> f (c -> JType c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f c) -> (b -> f d) -> JArray a b -> f (JArray c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g JArray a b
a f (c -> JType c d) -> f c -> f (JType c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f c
f a
ws
    JObj JObject a b
o a
ws  -> JObject c d -> c -> JType c d
forall ws a. JObject ws a -> ws -> JType ws a
JObj (JObject c d -> c -> JType c d)
-> f (JObject c d) -> f (c -> JType c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f c) -> (b -> f d) -> JObject a b -> f (JObject c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g JObject a b
o f (c -> JType c d) -> f c -> f (JType c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f c
f a
ws

-- | Typeclass for things that can represent a 'JType'
class AsJType r ws a | r -> ws a where
  _JType :: Prism' r (JType ws a)
  _JNull  :: Prism' r ws
  _JBool  :: Prism' r (Bool, ws)
  _JNum   :: Prism' r (JNumber, ws)
  _JStr   :: Prism' r (JString, ws)
  _JArr   :: Prism' r (JArray ws a, ws)
  _JObj   :: Prism' r (JObject ws a, ws)

  _JNull = p (JType ws a) (f (JType ws a)) -> p r (f r)
forall r ws a. AsJType r ws a => Prism' r (JType ws a)
_JType (p (JType ws a) (f (JType ws a)) -> p r (f r))
-> (p ws (f ws) -> p (JType ws a) (f (JType ws a)))
-> p ws (f ws)
-> p r (f r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. p ws (f ws) -> p (JType ws a) (f (JType ws a))
forall r ws a. AsJType r ws a => Prism' r ws
_JNull
  _JBool = p (JType ws a) (f (JType ws a)) -> p r (f r)
forall r ws a. AsJType r ws a => Prism' r (JType ws a)
_JType (p (JType ws a) (f (JType ws a)) -> p r (f r))
-> (p (Bool, ws) (f (Bool, ws)) -> p (JType ws a) (f (JType ws a)))
-> p (Bool, ws) (f (Bool, ws))
-> p r (f r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. p (Bool, ws) (f (Bool, ws)) -> p (JType ws a) (f (JType ws a))
forall r ws a. AsJType r ws a => Prism' r (Bool, ws)
_JBool
  _JNum  = p (JType ws a) (f (JType ws a)) -> p r (f r)
forall r ws a. AsJType r ws a => Prism' r (JType ws a)
_JType (p (JType ws a) (f (JType ws a)) -> p r (f r))
-> (p (JNumber, ws) (f (JNumber, ws))
    -> p (JType ws a) (f (JType ws a)))
-> p (JNumber, ws) (f (JNumber, ws))
-> p r (f r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. p (JNumber, ws) (f (JNumber, ws))
-> p (JType ws a) (f (JType ws a))
forall r ws a. AsJType r ws a => Prism' r (JNumber, ws)
_JNum
  _JStr  = p (JType ws a) (f (JType ws a)) -> p r (f r)
forall r ws a. AsJType r ws a => Prism' r (JType ws a)
_JType (p (JType ws a) (f (JType ws a)) -> p r (f r))
-> (p (JString, ws) (f (JString, ws))
    -> p (JType ws a) (f (JType ws a)))
-> p (JString, ws) (f (JString, ws))
-> p r (f r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. p (JString, ws) (f (JString, ws))
-> p (JType ws a) (f (JType ws a))
forall r ws a. AsJType r ws a => Prism' r (JString, ws)
_JStr
  _JArr  = p (JType ws a) (f (JType ws a)) -> p r (f r)
forall r ws a. AsJType r ws a => Prism' r (JType ws a)
_JType (p (JType ws a) (f (JType ws a)) -> p r (f r))
-> (p (JArray ws a, ws) (f (JArray ws a, ws))
    -> p (JType ws a) (f (JType ws a)))
-> p (JArray ws a, ws) (f (JArray ws a, ws))
-> p r (f r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. p (JArray ws a, ws) (f (JArray ws a, ws))
-> p (JType ws a) (f (JType ws a))
forall r ws a. AsJType r ws a => Prism' r (JArray ws a, ws)
_JArr
  _JObj  = p (JType ws a) (f (JType ws a)) -> p r (f r)
forall r ws a. AsJType r ws a => Prism' r (JType ws a)
_JType (p (JType ws a) (f (JType ws a)) -> p r (f r))
-> (p (JObject ws a, ws) (f (JObject ws a, ws))
    -> p (JType ws a) (f (JType ws a)))
-> p (JObject ws a, ws) (f (JObject ws a, ws))
-> p r (f r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. p (JObject ws a, ws) (f (JObject ws a, ws))
-> p (JType ws a) (f (JType ws a))
forall r ws a. AsJType r ws a => Prism' r (JObject ws a, ws)
_JObj

instance AsJType (JType ws a) ws a where
 _JType :: p (JType ws a) (f (JType ws a)) -> p (JType ws a) (f (JType ws a))
_JType = p (JType ws a) (f (JType ws a)) -> p (JType ws a) (f (JType ws a))
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
 _JNull :: p ws (f ws) -> p (JType ws a) (f (JType ws a))
_JNull = (ws -> JType ws a)
-> (JType ws a -> Either (JType ws a) ws) -> Prism' (JType ws a) ws
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ws -> JType ws a
forall ws a. ws -> JType ws a
JNull
       (\ JType ws a
x -> case JType ws a
x of
               JNull ws
ws -> ws -> Either (JType ws a) ws
forall a b. b -> Either a b
Right ws
ws
               JType ws a
_        -> JType ws a -> Either (JType ws a) ws
forall a b. a -> Either a b
Left JType ws a
x
       )
 _JBool :: p (Bool, ws) (f (Bool, ws)) -> p (JType ws a) (f (JType ws a))
_JBool = ((Bool, ws) -> JType ws a)
-> (JType ws a -> Either (JType ws a) (Bool, ws))
-> Prism' (JType ws a) (Bool, ws)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((Bool -> ws -> JType ws a) -> (Bool, ws) -> JType ws a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> ws -> JType ws a
forall ws a. Bool -> ws -> JType ws a
JBool)
       (\ JType ws a
x -> case JType ws a
x of
               JBool Bool
j ws
ws -> (Bool, ws) -> Either (JType ws a) (Bool, ws)
forall a b. b -> Either a b
Right (Bool
j, ws
ws)
               JType ws a
_          -> JType ws a -> Either (JType ws a) (Bool, ws)
forall a b. a -> Either a b
Left JType ws a
x
       )
 _JNum :: p (JNumber, ws) (f (JNumber, ws))
-> p (JType ws a) (f (JType ws a))
_JNum = ((JNumber, ws) -> JType ws a)
-> (JType ws a -> Either (JType ws a) (JNumber, ws))
-> Prism' (JType ws a) (JNumber, ws)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((JNumber -> ws -> JType ws a) -> (JNumber, ws) -> JType ws a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry JNumber -> ws -> JType ws a
forall ws a. JNumber -> ws -> JType ws a
JNum)
       (\ JType ws a
x -> case JType ws a
x of
               JNum JNumber
j ws
ws -> (JNumber, ws) -> Either (JType ws a) (JNumber, ws)
forall a b. b -> Either a b
Right (JNumber
j, ws
ws)
               JType ws a
_         -> JType ws a -> Either (JType ws a) (JNumber, ws)
forall a b. a -> Either a b
Left JType ws a
x
       )
 _JStr :: p (JString, ws) (f (JString, ws))
-> p (JType ws a) (f (JType ws a))
_JStr = ((JString, ws) -> JType ws a)
-> (JType ws a -> Either (JType ws a) (JString, ws))
-> Prism' (JType ws a) (JString, ws)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((JString -> ws -> JType ws a) -> (JString, ws) -> JType ws a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry JString -> ws -> JType ws a
forall ws a. JString -> ws -> JType ws a
JStr)
       (\ JType ws a
x -> case JType ws a
x of
               JStr JString
j ws
ws -> (JString, ws) -> Either (JType ws a) (JString, ws)
forall a b. b -> Either a b
Right (JString
j, ws
ws)
               JType ws a
_         -> JType ws a -> Either (JType ws a) (JString, ws)
forall a b. a -> Either a b
Left JType ws a
x
       )
 _JArr :: p (JArray ws a, ws) (f (JArray ws a, ws))
-> p (JType ws a) (f (JType ws a))
_JArr = ((JArray ws a, ws) -> JType ws a)
-> (JType ws a -> Either (JType ws a) (JArray ws a, ws))
-> Prism' (JType ws a) (JArray ws a, ws)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((JArray ws a -> ws -> JType ws a)
-> (JArray ws a, ws) -> JType ws a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry JArray ws a -> ws -> JType ws a
forall ws a. JArray ws a -> ws -> JType ws a
JArr)
       (\ JType ws a
x -> case JType ws a
x of
               JArr JArray ws a
j ws
ws -> (JArray ws a, ws) -> Either (JType ws a) (JArray ws a, ws)
forall a b. b -> Either a b
Right (JArray ws a
j, ws
ws)
               JType ws a
_         -> JType ws a -> Either (JType ws a) (JArray ws a, ws)
forall a b. a -> Either a b
Left JType ws a
x
       )
 _JObj :: p (JObject ws a, ws) (f (JObject ws a, ws))
-> p (JType ws a) (f (JType ws a))
_JObj = ((JObject ws a, ws) -> JType ws a)
-> (JType ws a -> Either (JType ws a) (JObject ws a, ws))
-> Prism' (JType ws a) (JObject ws a, ws)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((JObject ws a -> ws -> JType ws a)
-> (JObject ws a, ws) -> JType ws a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry JObject ws a -> ws -> JType ws a
forall ws a. JObject ws a -> ws -> JType ws a
JObj)
       (\ JType ws a
x -> case JType ws a
x of
               JObj JObject ws a
j ws
ws -> (JObject ws a, ws) -> Either (JType ws a) (JObject ws a, ws)
forall a b. b -> Either a b
Right (JObject ws a
j, ws
ws)
               JType ws a
_         -> JType ws a -> Either (JType ws a) (JObject ws a, ws)
forall a b. a -> Either a b
Left JType ws a
x
       )

-- | Top level Json type, we specialise the whitespace to 'WS' and the @digit@
-- type to 'Data.Digit.Digit'. Also defining that our structures can recursively only contain
-- 'Json' types.
newtype Json
  = Json (JType WS Json)
  deriving (Json -> Json -> Bool
(Json -> Json -> Bool) -> (Json -> Json -> Bool) -> Eq Json
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Json -> Json -> Bool
$c/= :: Json -> Json -> Bool
== :: Json -> Json -> Bool
$c== :: Json -> Json -> Bool
Eq, Int -> Json -> ShowS
[Json] -> ShowS
Json -> String
(Int -> Json -> ShowS)
-> (Json -> String) -> ([Json] -> ShowS) -> Show Json
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Json] -> ShowS
$cshowList :: [Json] -> ShowS
show :: Json -> String
$cshow :: Json -> String
showsPrec :: Int -> Json -> ShowS
$cshowsPrec :: Int -> Json -> ShowS
Show)

instance Json ~ t => Rewrapped Json t
instance Wrapped Json where
  type Unwrapped Json = JType WS Json
  _Wrapped' :: p (Unwrapped Json) (f (Unwrapped Json)) -> p Json (f Json)
_Wrapped' = (Json -> JType WS Json)
-> (JType WS Json -> Json)
-> Iso Json Json (JType WS Json) (JType WS Json)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(Json JType WS Json
x) -> JType WS Json
x) JType WS Json -> Json
Json

-- | 'Json' is comprised of the different 'JType' types.
instance AsJType Json WS Json where
  _JType :: p (JType WS Json) (f (JType WS Json)) -> p Json (f Json)
_JType = p (JType WS Json) (f (JType WS Json)) -> p Json (f Json)
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped (p (JType WS Json) (f (JType WS Json)) -> p Json (f Json))
-> (p (JType WS Json) (f (JType WS Json))
    -> p (JType WS Json) (f (JType WS Json)))
-> p (JType WS Json) (f (JType WS Json))
-> p Json (f Json)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. p (JType WS Json) (f (JType WS Json))
-> p (JType WS Json) (f (JType WS Json))
forall r ws a. AsJType r ws a => Prism' r (JType ws a)
_JType

-- | Ignoring whitespace, traverse a 'Json' structure.
jsonTraversal :: Traversal' Json Json
jsonTraversal :: (Json -> f Json) -> Json -> f Json
jsonTraversal = ((Json -> f Json) -> Json -> f Json)
-> (Json -> f Json) -> Json -> f Json
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf ((JType WS Json -> f (JType WS Json)) -> Json -> f Json
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped ((JType WS Json -> f (JType WS Json)) -> Json -> f Json)
-> ((Json -> f Json) -> JType WS Json -> f (JType WS Json))
-> (Json -> f Json)
-> Json
-> f Json
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Json -> f Json) -> JType WS Json -> f (JType WS Json)
forall ws a a'. Traversal (JType ws a) (JType ws a') a a'
jtypeTraversal)

-- | Traverse the trailing whitespace of this 'Json' structure.
jsonWSTraversal :: Traversal Json Json WS WS
jsonWSTraversal :: (WS -> f WS) -> Json -> f Json
jsonWSTraversal = ((WS -> f WS) -> Json -> f Json) -> (WS -> f WS) -> Json -> f Json
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf ((JType WS Json -> f (JType WS Json)) -> Json -> f Json
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped ((JType WS Json -> f (JType WS Json)) -> Json -> f Json)
-> ((WS -> f WS) -> JType WS Json -> f (JType WS Json))
-> (WS -> f WS)
-> Json
-> f Json
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (WS -> f WS) -> JType WS Json -> f (JType WS Json)
forall ws a ws'. Traversal (JType ws a) (JType ws' a) ws ws'
jtypeWSTraversal)

-- | Traverse all of the whitespace of this 'Json' structure and every element
-- in the tree.
jtypeWSTraversal :: Traversal (JType ws a) (JType ws' a) ws ws'
jtypeWSTraversal :: (ws -> f ws') -> JType ws a -> f (JType ws' a)
jtypeWSTraversal = ((ws -> f ws') -> (a -> f a) -> JType ws a -> f (JType ws' a))
-> (a -> f a) -> (ws -> f ws') -> JType ws a -> f (JType ws' a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ws -> f ws') -> (a -> f a) -> JType ws a -> f (JType ws' a)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Traverse the possible values of a 'JType', skipping whitespace.
jtypeTraversal :: Traversal (JType ws a) (JType ws a') a a'
jtypeTraversal :: (a -> f a') -> JType ws a -> f (JType ws a')
jtypeTraversal = (ws -> f ws) -> (a -> f a') -> JType ws a -> f (JType ws a')
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse ws -> f ws
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- |
-- A 'Control.Lens.Traversal'' over the @a@ at the given 'Text' key on a JSON object.
--
-- >>> E.simplePureEncodeTextNoSpaces E.json (obj & oat "c" ?~ E.asJson' E.int 33)
-- "{\"c\":33,\"a\":33,\"b\":\"Fred\"}"
-- >>> E.simplePureEncodeTextNoSpaces E.json (obj & oat "d" ?~ E.asJson' E.text "sally")
-- "{\"d\":\"sally\",\"a\":33,\"b\":\"Fred\"}"
--
oat :: (AsJType r ws a, Semigroup ws, Monoid ws) => Text -> Traversal' r (Maybe a)
oat :: Text -> Traversal' r (Maybe a)
oat Text
k = ((JObject ws a, ws) -> f (JObject ws a, ws)) -> r -> f r
forall r ws a. AsJType r ws a => Prism' r (JObject ws a, ws)
_JObj (((JObject ws a, ws) -> f (JObject ws a, ws)) -> r -> f r)
-> ((Maybe a -> f (Maybe a))
    -> (JObject ws a, ws) -> f (JObject ws a, ws))
-> (Maybe a -> f (Maybe a))
-> r
-> f r
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (JObject ws a -> f (JObject ws a))
-> (JObject ws a, ws) -> f (JObject ws a, ws)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((JObject ws a -> f (JObject ws a))
 -> (JObject ws a, ws) -> f (JObject ws a, ws))
-> ((Maybe a -> f (Maybe a)) -> JObject ws a -> f (JObject ws a))
-> (Maybe a -> f (Maybe a))
-> (JObject ws a, ws)
-> f (JObject ws a, ws)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (MapLikeObj ws a -> f (MapLikeObj ws a))
-> JObject ws a -> f (JObject ws a)
forall ws a.
(Semigroup ws, Monoid ws) =>
Prism' (JObject ws a) (MapLikeObj ws a)
_MapLikeObj ((MapLikeObj ws a -> f (MapLikeObj ws a))
 -> JObject ws a -> f (JObject ws a))
-> ((Maybe a -> f (Maybe a))
    -> MapLikeObj ws a -> f (MapLikeObj ws a))
-> (Maybe a -> f (Maybe a))
-> JObject ws a
-> f (JObject ws a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Index (MapLikeObj ws a)
-> Lens' (MapLikeObj ws a) (Maybe (IxValue (MapLikeObj ws a)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
Index (MapLikeObj ws a)
k

-- |
-- A 'Control.Lens.Traversal'' over the @a@ at the given 'Int' position in a JSON object.
--
-- >>> E.simplePureEncodeTextNoSpaces E.json (obj & oix 0 .~ E.asJson' E.int 1)
-- "{\"a\":1,\"b\":\"Fred\"}"
-- >>> E.simplePureEncodeTextNoSpaces E.json (obj & oix 1 .~ E.asJson' E.text "sally")
-- "{\"a\":33,\"b\":\"sally\"}"
oix :: (Semigroup ws, Monoid ws, AsJType r ws a) => Int -> Traversal' r a
oix :: Int -> Traversal' r a
oix Int
i = ((JObject ws a, ws) -> f (JObject ws a, ws)) -> r -> f r
forall r ws a. AsJType r ws a => Prism' r (JObject ws a, ws)
_JObj (((JObject ws a, ws) -> f (JObject ws a, ws)) -> r -> f r)
-> ((a -> f a) -> (JObject ws a, ws) -> f (JObject ws a, ws))
-> (a -> f a)
-> r
-> f r
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (JObject ws a -> f (JObject ws a))
-> (JObject ws a, ws) -> f (JObject ws a, ws)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((JObject ws a -> f (JObject ws a))
 -> (JObject ws a, ws) -> f (JObject ws a, ws))
-> ((a -> f a) -> JObject ws a -> f (JObject ws a))
-> (a -> f a)
-> (JObject ws a, ws)
-> f (JObject ws a, ws)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Index (JObject ws a)
-> Traversal' (JObject ws a) (IxValue (JObject ws a))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (JObject ws a)
i

-- |
-- A 'Control.Lens.Traversal'' over the @a@ at the given 'Int' position in a JSON array.
--
-- >>> E.simplePureEncodeTextNoSpaces E.json ((E.asJson' (E.list E.int) [1,2,3]) & aix 0 .~ E.asJson' E.int 99)
-- "[99,2,3]"
-- >>> E.simplePureEncodeTextNoSpaces E.json ((E.asJson' (E.list E.int) [1,2,3]) & aix 2 .~ E.asJson' E.int 44)
-- "[1,2,44]"
aix :: (AsJType r ws a, Semigroup ws, Monoid ws) => Int -> Traversal' r a
aix :: Int -> Traversal' r a
aix Int
i = ((JArray ws a, ws) -> f (JArray ws a, ws)) -> r -> f r
forall r ws a. AsJType r ws a => Prism' r (JArray ws a, ws)
_JArr (((JArray ws a, ws) -> f (JArray ws a, ws)) -> r -> f r)
-> ((a -> f a) -> (JArray ws a, ws) -> f (JArray ws a, ws))
-> (a -> f a)
-> r
-> f r
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (JArray ws a -> f (JArray ws a))
-> (JArray ws a, ws) -> f (JArray ws a, ws)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((JArray ws a -> f (JArray ws a))
 -> (JArray ws a, ws) -> f (JArray ws a, ws))
-> ((a -> f a) -> JArray ws a -> f (JArray ws a))
-> (a -> f a)
-> (JArray ws a, ws)
-> f (JArray ws a, ws)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Index (JArray ws a)
-> Traversal' (JArray ws a) (IxValue (JArray ws a))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (JArray ws a)
i


-- | Parse a 'null' value.
--
-- >>> testparse (parseJNull (return ())) "null"
-- Right (JNull ())
--
-- >>> testparsetheneof (parseJNull (return ())) "null"
-- Right (JNull ())
--
-- >>> testparsethennoteof (parseJNull (return ())) "nullx"
-- Right (JNull ())
--
parseJNull
  :: ( CharParsing f
     )
  => f ws
  -> f (JType ws a)
parseJNull :: f ws -> f (JType ws a)
parseJNull f ws
ws = ws -> JType ws a
forall ws a. ws -> JType ws a
JNull
  (ws -> JType ws a) -> f Text -> f (ws -> JType ws a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> f Text
forall (m :: * -> *). CharParsing m => Text -> m Text
text Text
"null"
  f (ws -> JType ws a) -> f ws -> f (JType ws a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f ws
ws

-- | Parse a @true@ or @false@.
--
-- >>> testparse (parseJBool (return ())) "true"
-- Right (JBool True ())
--
-- >>> testparse (parseJBool (return ())) "false"
-- Right (JBool False ())
--
-- >>> testparsetheneof (parseJBool (return ())) "true"
-- Right (JBool True ())
--
-- >>> testparsetheneof (parseJBool (return ())) "false"
-- Right (JBool False ())
--
-- >>> testparsethennoteof (parseJBool (return ())) "truex"
-- Right (JBool True ())
--
-- >>> testparsethennoteof (parseJBool (return ())) "falsex"
-- Right (JBool False ())
--
parseJBool
  :: ( CharParsing f
     )
  => f ws
  -> f (JType ws a)
parseJBool :: f ws -> f (JType ws a)
parseJBool f ws
ws =
  let
    b :: Bool -> Text -> f (ws -> JType ws a)
b Bool
q Text
t = Bool -> ws -> JType ws a
forall ws a. Bool -> ws -> JType ws a
JBool Bool
q (ws -> JType ws a) -> f Text -> f (ws -> JType ws a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> f Text
forall (m :: * -> *). CharParsing m => Text -> m Text
text Text
t
  in
    (Bool -> Text -> f (ws -> JType ws a)
forall (f :: * -> *) ws a.
CharParsing f =>
Bool -> Text -> f (ws -> JType ws a)
b Bool
False Text
"false" f (ws -> JType ws a)
-> f (ws -> JType ws a) -> f (ws -> JType ws a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Text -> f (ws -> JType ws a)
forall (f :: * -> *) ws a.
CharParsing f =>
Bool -> Text -> f (ws -> JType ws a)
b Bool
True Text
"true") f (ws -> JType ws a) -> f ws -> f (JType ws a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f ws
ws

-- | Parse a JSON numeric value.
parseJNum
  :: ( Monad f
     , CharParsing f
     )
  => f ws
  -> f (JType ws a)
parseJNum :: f ws -> f (JType ws a)
parseJNum f ws
ws =
  JNumber -> ws -> JType ws a
forall ws a. JNumber -> ws -> JType ws a
JNum (JNumber -> ws -> JType ws a) -> f JNumber -> f (ws -> JType ws a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f JNumber
forall (f :: * -> *). (Monad f, CharParsing f) => f JNumber
parseJNumber f (ws -> JType ws a) -> f ws -> f (JType ws a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f ws
ws

-- | Parse a JSON string.
--
-- >>> testparse (parseJStr (return ())) "\"\""
-- Right (JStr (JString' []) ())
--
-- >>> testparse (parseJStr (return ())) "\"abc\""
-- Right (JStr (JString' [UnescapedJChar (Unescaped 'a'),UnescapedJChar (Unescaped 'b'),UnescapedJChar (Unescaped 'c')]) ())
--
-- >>> testparse (parseJStr (return ())) "\"a\\rbc\""
-- Right (JStr (JString' [UnescapedJChar (Unescaped 'a'),EscapedJChar (WhiteSpace CarriageReturn),UnescapedJChar (Unescaped 'b'),UnescapedJChar (Unescaped 'c')]) ())
--
-- >>> testparse (parseJStr (return ())) "\"a\\rbc\\uab12\\ndef\\\"\"" :: Either DecodeError (JType () a)
-- Right (JStr (JString' [UnescapedJChar (Unescaped 'a'),EscapedJChar (WhiteSpace CarriageReturn),UnescapedJChar (Unescaped 'b'),UnescapedJChar (Unescaped 'c'),EscapedJChar (Hex (HexDigit4 HeXDigita HeXDigitb HeXDigit1 HeXDigit2)),EscapedJChar (WhiteSpace NewLine),UnescapedJChar (Unescaped 'd'),UnescapedJChar (Unescaped 'e'),UnescapedJChar (Unescaped 'f'),EscapedJChar QuotationMark]) ())
--
-- >>> testparsetheneof (parseJStr (return ())) "\"\""
-- Right (JStr (JString' []) ())
--
-- >>> testparsetheneof (parseJStr (return ())) "\"abc\""
-- Right (JStr (JString' [UnescapedJChar (Unescaped 'a'),UnescapedJChar (Unescaped 'b'),UnescapedJChar (Unescaped 'c')]) ())
--
-- >>> testparsethennoteof (parseJStr (return ())) "\"a\"\\u"
-- Right (JStr (JString' [UnescapedJChar (Unescaped 'a')]) ())
--
-- >>> testparsethennoteof (parseJStr (return ())) "\"a\"\t"
-- Right (JStr (JString' [UnescapedJChar (Unescaped 'a')]) ())
parseJStr
  :: CharParsing f
  => f ws
  -> f (JType ws a)
parseJStr :: f ws -> f (JType ws a)
parseJStr f ws
ws =
  JString -> ws -> JType ws a
forall ws a. JString -> ws -> JType ws a
JStr (JString -> ws -> JType ws a) -> f JString -> f (ws -> JType ws a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f JString
forall (f :: * -> *). CharParsing f => f JString
parseJString f (ws -> JType ws a) -> f ws -> f (JType ws a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f ws
ws

-- | Parse a JSON array.
parseJArr
  :: ( Monad f
     , CharParsing f
     )
  => f ws
  -> f (JType ws Json)
parseJArr :: f ws -> f (JType ws Json)
parseJArr f ws
ws =
  JArray ws Json -> ws -> JType ws Json
forall ws a. JArray ws a -> ws -> JType ws a
JArr (JArray ws Json -> ws -> JType ws Json)
-> f (JArray ws Json) -> f (ws -> JType ws Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f ws -> f Json -> f (JArray ws Json)
forall (f :: * -> *) ws a.
(Monad f, CharParsing f) =>
f ws -> f a -> f (JArray ws a)
parseJArray f ws
ws f Json
forall (f :: * -> *). (Monad f, CharParsing f) => f Json
parseWaargonaut f (ws -> JType ws Json) -> f ws -> f (JType ws Json)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f ws
ws

-- | Parse a JSON object.
parseJObj
  :: ( Monad f
     , CharParsing f
     )
  => f ws
  -> f (JType ws Json)
parseJObj :: f ws -> f (JType ws Json)
parseJObj f ws
ws =
  JObject ws Json -> ws -> JType ws Json
forall ws a. JObject ws a -> ws -> JType ws a
JObj (JObject ws Json -> ws -> JType ws Json)
-> f (JObject ws Json) -> f (ws -> JType ws Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f ws -> f Json -> f (JObject ws Json)
forall (f :: * -> *) ws a.
(Monad f, CharParsing f) =>
f ws -> f a -> f (JObject ws a)
parseJObject f ws
ws f Json
forall (f :: * -> *). (Monad f, CharParsing f) => f Json
parseWaargonaut f (ws -> JType ws Json) -> f ws -> f (JType ws Json)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f ws
ws

-- | Try to parse each of our 'JType' possibilities.
parseJType
  :: ( Monad f
     , CharParsing f
     )
  => f ws
  -> f (JType ws Json)
parseJType :: f ws -> f (JType ws Json)
parseJType =
  [f (JType ws Json)] -> f (JType ws Json)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([f (JType ws Json)] -> f (JType ws Json))
-> (f ws -> [f (JType ws Json)]) -> f ws -> f (JType ws Json)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [f ws -> f (JType ws Json)] -> f ws -> [f (JType ws Json)]
forall (g :: * -> *) (f :: * -> *) a.
(Distributive g, Functor f) =>
f (g a) -> g (f a)
distribute
    [ f ws -> f (JType ws Json)
forall (f :: * -> *) ws a. CharParsing f => f ws -> f (JType ws a)
parseJNull
    , f ws -> f (JType ws Json)
forall (f :: * -> *) ws a. CharParsing f => f ws -> f (JType ws a)
parseJBool
    , f ws -> f (JType ws Json)
forall (f :: * -> *) ws a.
(Monad f, CharParsing f) =>
f ws -> f (JType ws a)
parseJNum
    , f ws -> f (JType ws Json)
forall (f :: * -> *) ws a. CharParsing f => f ws -> f (JType ws a)
parseJStr
    , f ws -> f (JType ws Json)
forall (f :: * -> *) ws.
(Monad f, CharParsing f) =>
f ws -> f (JType ws Json)
parseJArr
    , f ws -> f (JType ws Json)
forall (f :: * -> *) ws.
(Monad f, CharParsing f) =>
f ws -> f (JType ws Json)
parseJObj
    ]

-- | Parse to a 'Json' value, keeping all of the information about the leading
-- and trailing whitespace.
parseWaargonaut
  :: ( Monad f
     , CharParsing f
     )
  => f Json
parseWaargonaut :: f Json
parseWaargonaut =
  JType WS Json -> Json
Json (JType WS Json -> Json) -> f (JType WS Json) -> f Json
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f WS -> f (JType WS Json)
forall (f :: * -> *) ws.
(Monad f, CharParsing f) =>
f ws -> f (JType ws Json)
parseJType f WS
forall (f :: * -> *). CharParsing f => f WS
parseWhitespace