{-# LANGUAGE DeriveTraversable #-}
-- | Token definitions.
module Data.Aeson.Decoding.Tokens (
    -- * Types
    Tokens (..),
    Lit (..),
    Number (..),
    TkArray (..),
    TkRecord (..),
) where

import           Data.Aeson.Key            (Key)
import           Data.Bifoldable.Compat    (Bifoldable (..))
import           Data.Bifunctor.Compat     (Bifunctor (..))
import           Data.Bitraversable.Compat (Bitraversable (..), bifoldMapDefault, bimapDefault)
import           Data.Scientific           (Scientific)
import           Data.Text                 (Text)

-- | A well-formed JSON token stream.
--
-- /Note/: 'Lit' exists to make 'Tokens' have only 6 constructors.
-- This may or may not have impact on performance.
--
-- @since 2.1.2.0
--
data Tokens k e
    = TkLit !Lit k
    | TkText !Text k
    | TkNumber !Number k
    | TkArrayOpen (TkArray k e)
    | TkRecordOpen (TkRecord k e)
    | TkErr e
  deriving (Tokens k e -> Tokens k e -> Bool
(Tokens k e -> Tokens k e -> Bool)
-> (Tokens k e -> Tokens k e -> Bool) -> Eq (Tokens k e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k e. (Eq k, Eq e) => Tokens k e -> Tokens k e -> Bool
$c== :: forall k e. (Eq k, Eq e) => Tokens k e -> Tokens k e -> Bool
== :: Tokens k e -> Tokens k e -> Bool
$c/= :: forall k e. (Eq k, Eq e) => Tokens k e -> Tokens k e -> Bool
/= :: Tokens k e -> Tokens k e -> Bool
Eq, Int -> Tokens k e -> ShowS
[Tokens k e] -> ShowS
Tokens k e -> String
(Int -> Tokens k e -> ShowS)
-> (Tokens k e -> String)
-> ([Tokens k e] -> ShowS)
-> Show (Tokens k e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k e. (Show k, Show e) => Int -> Tokens k e -> ShowS
forall k e. (Show k, Show e) => [Tokens k e] -> ShowS
forall k e. (Show k, Show e) => Tokens k e -> String
$cshowsPrec :: forall k e. (Show k, Show e) => Int -> Tokens k e -> ShowS
showsPrec :: Int -> Tokens k e -> ShowS
$cshow :: forall k e. (Show k, Show e) => Tokens k e -> String
show :: Tokens k e -> String
$cshowList :: forall k e. (Show k, Show e) => [Tokens k e] -> ShowS
showList :: [Tokens k e] -> ShowS
Show)

-- | Literals. @null@, @true@, @false@.
data Lit = LitNull | LitTrue | LitFalse
  deriving (Lit -> Lit -> Bool
(Lit -> Lit -> Bool) -> (Lit -> Lit -> Bool) -> Eq Lit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Lit -> Lit -> Bool
== :: Lit -> Lit -> Bool
$c/= :: Lit -> Lit -> Bool
/= :: Lit -> Lit -> Bool
Eq, Int -> Lit -> ShowS
[Lit] -> ShowS
Lit -> String
(Int -> Lit -> ShowS)
-> (Lit -> String) -> ([Lit] -> ShowS) -> Show Lit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Lit -> ShowS
showsPrec :: Int -> Lit -> ShowS
$cshow :: Lit -> String
show :: Lit -> String
$cshowList :: [Lit] -> ShowS
showList :: [Lit] -> ShowS
Show)

-- | Numbers
--
-- We preserve whether the number was integral, decimal or in scientific form.
data Number
    = NumInteger !Integer  -- ^ e.g. @123@
    | NumDecimal !Scientific  -- ^ e.g. @123.456@
    | NumScientific !Scientific -- ^ e.g. @123e456@, @123e-456@ or @123.456E-967@
  deriving (Number -> Number -> Bool
(Number -> Number -> Bool)
-> (Number -> Number -> Bool) -> Eq Number
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Number -> Number -> Bool
== :: Number -> Number -> Bool
$c/= :: Number -> Number -> Bool
/= :: Number -> Number -> Bool
Eq, Int -> Number -> ShowS
[Number] -> ShowS
Number -> String
(Int -> Number -> ShowS)
-> (Number -> String) -> ([Number] -> ShowS) -> Show Number
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Number -> ShowS
showsPrec :: Int -> Number -> ShowS
$cshow :: Number -> String
show :: Number -> String
$cshowList :: [Number] -> ShowS
showList :: [Number] -> ShowS
Show)

-- | Array tokens.
data TkArray k e
    = TkItem (Tokens (TkArray k e) e)
    | TkArrayEnd k
    | TkArrayErr e
  deriving (TkArray k e -> TkArray k e -> Bool
(TkArray k e -> TkArray k e -> Bool)
-> (TkArray k e -> TkArray k e -> Bool) -> Eq (TkArray k e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k e. (Eq k, Eq e) => TkArray k e -> TkArray k e -> Bool
$c== :: forall k e. (Eq k, Eq e) => TkArray k e -> TkArray k e -> Bool
== :: TkArray k e -> TkArray k e -> Bool
$c/= :: forall k e. (Eq k, Eq e) => TkArray k e -> TkArray k e -> Bool
/= :: TkArray k e -> TkArray k e -> Bool
Eq, Int -> TkArray k e -> ShowS
[TkArray k e] -> ShowS
TkArray k e -> String
(Int -> TkArray k e -> ShowS)
-> (TkArray k e -> String)
-> ([TkArray k e] -> ShowS)
-> Show (TkArray k e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k e. (Show k, Show e) => Int -> TkArray k e -> ShowS
forall k e. (Show k, Show e) => [TkArray k e] -> ShowS
forall k e. (Show k, Show e) => TkArray k e -> String
$cshowsPrec :: forall k e. (Show k, Show e) => Int -> TkArray k e -> ShowS
showsPrec :: Int -> TkArray k e -> ShowS
$cshow :: forall k e. (Show k, Show e) => TkArray k e -> String
show :: TkArray k e -> String
$cshowList :: forall k e. (Show k, Show e) => [TkArray k e] -> ShowS
showList :: [TkArray k e] -> ShowS
Show)

-- | Record tokens.
data TkRecord k e
    = TkPair !Key (Tokens (TkRecord k e) e)
    | TkRecordEnd k
    | TkRecordErr e
  deriving (TkRecord k e -> TkRecord k e -> Bool
(TkRecord k e -> TkRecord k e -> Bool)
-> (TkRecord k e -> TkRecord k e -> Bool) -> Eq (TkRecord k e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k e. (Eq k, Eq e) => TkRecord k e -> TkRecord k e -> Bool
$c== :: forall k e. (Eq k, Eq e) => TkRecord k e -> TkRecord k e -> Bool
== :: TkRecord k e -> TkRecord k e -> Bool
$c/= :: forall k e. (Eq k, Eq e) => TkRecord k e -> TkRecord k e -> Bool
/= :: TkRecord k e -> TkRecord k e -> Bool
Eq, Int -> TkRecord k e -> ShowS
[TkRecord k e] -> ShowS
TkRecord k e -> String
(Int -> TkRecord k e -> ShowS)
-> (TkRecord k e -> String)
-> ([TkRecord k e] -> ShowS)
-> Show (TkRecord k e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k e. (Show k, Show e) => Int -> TkRecord k e -> ShowS
forall k e. (Show k, Show e) => [TkRecord k e] -> ShowS
forall k e. (Show k, Show e) => TkRecord k e -> String
$cshowsPrec :: forall k e. (Show k, Show e) => Int -> TkRecord k e -> ShowS
showsPrec :: Int -> TkRecord k e -> ShowS
$cshow :: forall k e. (Show k, Show e) => TkRecord k e -> String
show :: TkRecord k e -> String
$cshowList :: forall k e. (Show k, Show e) => [TkRecord k e] -> ShowS
showList :: [TkRecord k e] -> ShowS
Show)

instance Functor (Tokens k) where fmap :: forall a b. (a -> b) -> Tokens k a -> Tokens k b
fmap = (a -> b) -> Tokens k a -> Tokens k b
forall b c a. (b -> c) -> Tokens a b -> Tokens a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second
instance Functor (TkArray k) where fmap :: forall a b. (a -> b) -> TkArray k a -> TkArray k b
fmap = (a -> b) -> TkArray k a -> TkArray k b
forall b c a. (b -> c) -> TkArray a b -> TkArray a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second
instance Functor (TkRecord k) where fmap :: forall a b. (a -> b) -> TkRecord k a -> TkRecord k b
fmap = (a -> b) -> TkRecord k a -> TkRecord k b
forall b c a. (b -> c) -> TkRecord a b -> TkRecord a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second

instance Foldable (Tokens k) where foldMap :: forall m a. Monoid m => (a -> m) -> Tokens k a -> m
foldMap = (k -> m) -> (a -> m) -> Tokens k a -> m
forall m a b. Monoid m => (a -> m) -> (b -> m) -> Tokens a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap (m -> k -> m
forall a b. a -> b -> a
const m
forall a. Monoid a => a
mempty)
instance Foldable (TkArray k) where foldMap :: forall m a. Monoid m => (a -> m) -> TkArray k a -> m
foldMap = (k -> m) -> (a -> m) -> TkArray k a -> m
forall m a b. Monoid m => (a -> m) -> (b -> m) -> TkArray a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap (m -> k -> m
forall a b. a -> b -> a
const m
forall a. Monoid a => a
mempty)
instance Foldable (TkRecord k) where foldMap :: forall m a. Monoid m => (a -> m) -> TkRecord k a -> m
foldMap = (k -> m) -> (a -> m) -> TkRecord k a -> m
forall m a b. Monoid m => (a -> m) -> (b -> m) -> TkRecord a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap (m -> k -> m
forall a b. a -> b -> a
const m
forall a. Monoid a => a
mempty)

instance Traversable (Tokens k) where traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Tokens k a -> f (Tokens k b)
traverse = (k -> f k) -> (a -> f b) -> Tokens k a -> f (Tokens k b)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Tokens a b -> f (Tokens 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 k -> f k
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance Traversable (TkArray k) where traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TkArray k a -> f (TkArray k b)
traverse = (k -> f k) -> (a -> f b) -> TkArray k a -> f (TkArray k b)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> TkArray a b -> f (TkArray 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 k -> f k
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance Traversable (TkRecord k) where traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TkRecord k a -> f (TkRecord k b)
traverse = (k -> f k) -> (a -> f b) -> TkRecord k a -> f (TkRecord k b)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> TkRecord a b -> f (TkRecord 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 k -> f k
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance Bifunctor Tokens where bimap :: forall a b c d. (a -> b) -> (c -> d) -> Tokens a c -> Tokens b d
bimap = (a -> b) -> (c -> d) -> Tokens a c -> Tokens b d
forall (t :: * -> * -> *) a b c d.
Bitraversable t =>
(a -> b) -> (c -> d) -> t a c -> t b d
bimapDefault
instance Bifunctor TkArray where bimap :: forall a b c d. (a -> b) -> (c -> d) -> TkArray a c -> TkArray b d
bimap = (a -> b) -> (c -> d) -> TkArray a c -> TkArray b d
forall (t :: * -> * -> *) a b c d.
Bitraversable t =>
(a -> b) -> (c -> d) -> t a c -> t b d
bimapDefault
instance Bifunctor TkRecord where bimap :: forall a b c d.
(a -> b) -> (c -> d) -> TkRecord a c -> TkRecord b d
bimap = (a -> b) -> (c -> d) -> TkRecord a c -> TkRecord b d
forall (t :: * -> * -> *) a b c d.
Bitraversable t =>
(a -> b) -> (c -> d) -> t a c -> t b d
bimapDefault

instance Bifoldable Tokens where bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> Tokens a b -> m
bifoldMap = (a -> m) -> (b -> m) -> Tokens a b -> m
forall (t :: * -> * -> *) m a b.
(Bitraversable t, Monoid m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMapDefault
instance Bifoldable TkArray where bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> TkArray a b -> m
bifoldMap = (a -> m) -> (b -> m) -> TkArray a b -> m
forall (t :: * -> * -> *) m a b.
(Bitraversable t, Monoid m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMapDefault
instance Bifoldable TkRecord where bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> TkRecord a b -> m
bifoldMap = (a -> m) -> (b -> m) -> TkRecord a b -> m
forall (t :: * -> * -> *) m a b.
(Bitraversable t, Monoid m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMapDefault

instance Bitraversable Tokens where
    bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Tokens a b -> f (Tokens c d)
bitraverse a -> f c
f b -> f d
_ (TkLit Lit
l a
k)       = Lit -> c -> Tokens c d
forall k e. Lit -> k -> Tokens k e
TkLit Lit
l (c -> Tokens c d) -> f c -> f (Tokens c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
k
    bitraverse a -> f c
f b -> f d
_ (TkText Text
t a
k)      = Text -> c -> Tokens c d
forall k e. Text -> k -> Tokens k e
TkText Text
t (c -> Tokens c d) -> f c -> f (Tokens c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
k
    bitraverse a -> f c
f b -> f d
_ (TkNumber Number
n a
k)    = Number -> c -> Tokens c d
forall k e. Number -> k -> Tokens k e
TkNumber Number
n (c -> Tokens c d) -> f c -> f (Tokens c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
k
    bitraverse a -> f c
f b -> f d
g (TkArrayOpen TkArray a b
ts)  = TkArray c d -> Tokens c d
forall k e. TkArray k e -> Tokens k e
TkArrayOpen (TkArray c d -> Tokens c d) -> f (TkArray c d) -> f (Tokens c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f c) -> (b -> f d) -> TkArray a b -> f (TkArray c d)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> TkArray a b -> f (TkArray 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 TkArray a b
ts
    bitraverse a -> f c
f b -> f d
g (TkRecordOpen TkRecord a b
ts) = TkRecord c d -> Tokens c d
forall k e. TkRecord k e -> Tokens k e
TkRecordOpen (TkRecord c d -> Tokens c d) -> f (TkRecord c d) -> f (Tokens c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f c) -> (b -> f d) -> TkRecord a b -> f (TkRecord c d)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> TkRecord a b -> f (TkRecord 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 TkRecord a b
ts
    bitraverse a -> f c
_ b -> f d
g (TkErr b
e)         = d -> Tokens c d
forall k e. e -> Tokens k e
TkErr (d -> Tokens c d) -> f d -> f (Tokens c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
e

instance Bitraversable TkArray where
    bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> TkArray a b -> f (TkArray c d)
bitraverse a -> f c
f b -> f d
g (TkItem Tokens (TkArray a b) b
ts)    = Tokens (TkArray c d) d -> TkArray c d
forall k e. Tokens (TkArray k e) e -> TkArray k e
TkItem (Tokens (TkArray c d) d -> TkArray c d)
-> f (Tokens (TkArray c d) d) -> f (TkArray c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TkArray a b -> f (TkArray c d))
-> (b -> f d)
-> Tokens (TkArray a b) b
-> f (Tokens (TkArray c d) d)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Tokens a b -> f (Tokens 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) -> (b -> f d) -> TkArray a b -> f (TkArray c d)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> TkArray a b -> f (TkArray 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) b -> f d
g Tokens (TkArray a b) b
ts
    bitraverse a -> f c
f b -> f d
_ (TkArrayEnd a
k) = c -> TkArray c d
forall k e. k -> TkArray k e
TkArrayEnd (c -> TkArray c d) -> f c -> f (TkArray c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
k
    bitraverse a -> f c
_ b -> f d
g (TkArrayErr b
e) = d -> TkArray c d
forall k e. e -> TkArray k e
TkArrayErr (d -> TkArray c d) -> f d -> f (TkArray c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
e

instance Bitraversable TkRecord where
    bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> TkRecord a b -> f (TkRecord c d)
bitraverse a -> f c
f b -> f d
g (TkPair Key
k Tokens (TkRecord a b) b
ts)   = Key -> Tokens (TkRecord c d) d -> TkRecord c d
forall k e. Key -> Tokens (TkRecord k e) e -> TkRecord k e
TkPair Key
k (Tokens (TkRecord c d) d -> TkRecord c d)
-> f (Tokens (TkRecord c d) d) -> f (TkRecord c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TkRecord a b -> f (TkRecord c d))
-> (b -> f d)
-> Tokens (TkRecord a b) b
-> f (Tokens (TkRecord c d) d)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Tokens a b -> f (Tokens 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) -> (b -> f d) -> TkRecord a b -> f (TkRecord c d)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> TkRecord a b -> f (TkRecord 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) b -> f d
g Tokens (TkRecord a b) b
ts
    bitraverse a -> f c
f b -> f d
_ (TkRecordEnd a
k) = c -> TkRecord c d
forall k e. k -> TkRecord k e
TkRecordEnd (c -> TkRecord c d) -> f c -> f (TkRecord c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
k
    bitraverse a -> f c
_ b -> f d
g (TkRecordErr b
e) = d -> TkRecord c d
forall k e. e -> TkRecord k e
TkRecordErr (d -> TkRecord c d) -> f d -> f (TkRecord c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
e