{-# LANGUAGE OverloadedStrings #-}

-- | Parses JSON documents
module SimpleParser.Examples.Direct.Json
  ( Json (..)
  , JsonF (..)
  , JsonParserC
  , JsonParserM
  , jsonParser
  ) where

import Control.Monad (void)
import Data.Scientific (Scientific)
import Data.Sequence (Seq)
import Data.Text (Text)
import Data.Void (Void)
import SimpleParser (MatchBlock (..), MatchCase (..), Parser, Stream (..), TextLabel, TextualChunked (..),
                     TextualStream, anyToken, betweenParser, escapedStringParser, lexemeParser, lookAheadMatch,
                     matchChunk, matchToken, orParser, scientificParser, sepByParser, signedNumStartPred, spaceParser)

data JsonF a =
    JsonObject !(Seq (Text, a))
  | JsonArray !(Seq a)
  | JsonString !Text
  | JsonBool !Bool
  | JsonNum !Scientific
  | JsonNull
  deriving (JsonF a -> JsonF a -> Bool
forall a. Eq a => JsonF a -> JsonF a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsonF a -> JsonF a -> Bool
$c/= :: forall a. Eq a => JsonF a -> JsonF a -> Bool
== :: JsonF a -> JsonF a -> Bool
$c== :: forall a. Eq a => JsonF a -> JsonF a -> Bool
Eq, Int -> JsonF a -> ShowS
forall a. Show a => Int -> JsonF a -> ShowS
forall a. Show a => [JsonF a] -> ShowS
forall a. Show a => JsonF a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsonF a] -> ShowS
$cshowList :: forall a. Show a => [JsonF a] -> ShowS
show :: JsonF a -> String
$cshow :: forall a. Show a => JsonF a -> String
showsPrec :: Int -> JsonF a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> JsonF a -> ShowS
Show, forall a b. a -> JsonF b -> JsonF a
forall a b. (a -> b) -> JsonF a -> JsonF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> JsonF b -> JsonF a
$c<$ :: forall a b. a -> JsonF b -> JsonF a
fmap :: forall a b. (a -> b) -> JsonF a -> JsonF b
$cfmap :: forall a b. (a -> b) -> JsonF a -> JsonF b
Functor, forall a. Eq a => a -> JsonF a -> Bool
forall a. Num a => JsonF a -> a
forall a. Ord a => JsonF a -> a
forall m. Monoid m => JsonF m -> m
forall a. JsonF a -> Bool
forall a. JsonF a -> Int
forall a. JsonF a -> [a]
forall a. (a -> a -> a) -> JsonF a -> a
forall m a. Monoid m => (a -> m) -> JsonF a -> m
forall b a. (b -> a -> b) -> b -> JsonF a -> b
forall a b. (a -> b -> b) -> b -> JsonF 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 :: forall a. Num a => JsonF a -> a
$cproduct :: forall a. Num a => JsonF a -> a
sum :: forall a. Num a => JsonF a -> a
$csum :: forall a. Num a => JsonF a -> a
minimum :: forall a. Ord a => JsonF a -> a
$cminimum :: forall a. Ord a => JsonF a -> a
maximum :: forall a. Ord a => JsonF a -> a
$cmaximum :: forall a. Ord a => JsonF a -> a
elem :: forall a. Eq a => a -> JsonF a -> Bool
$celem :: forall a. Eq a => a -> JsonF a -> Bool
length :: forall a. JsonF a -> Int
$clength :: forall a. JsonF a -> Int
null :: forall a. JsonF a -> Bool
$cnull :: forall a. JsonF a -> Bool
toList :: forall a. JsonF a -> [a]
$ctoList :: forall a. JsonF a -> [a]
foldl1 :: forall a. (a -> a -> a) -> JsonF a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> JsonF a -> a
foldr1 :: forall a. (a -> a -> a) -> JsonF a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> JsonF a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> JsonF a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> JsonF a -> b
foldl :: forall b a. (b -> a -> b) -> b -> JsonF a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> JsonF a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> JsonF a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> JsonF a -> b
foldr :: forall a b. (a -> b -> b) -> b -> JsonF a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> JsonF a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> JsonF a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> JsonF a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> JsonF a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> JsonF a -> m
fold :: forall m. Monoid m => JsonF m -> m
$cfold :: forall m. Monoid m => JsonF m -> m
Foldable, Functor JsonF
Foldable JsonF
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 => JsonF (m a) -> m (JsonF a)
forall (f :: * -> *) a. Applicative f => JsonF (f a) -> f (JsonF a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> JsonF a -> m (JsonF b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> JsonF a -> f (JsonF b)
sequence :: forall (m :: * -> *) a. Monad m => JsonF (m a) -> m (JsonF a)
$csequence :: forall (m :: * -> *) a. Monad m => JsonF (m a) -> m (JsonF a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> JsonF a -> m (JsonF b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> JsonF a -> m (JsonF b)
sequenceA :: forall (f :: * -> *) a. Applicative f => JsonF (f a) -> f (JsonF a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => JsonF (f a) -> f (JsonF a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> JsonF a -> f (JsonF b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> JsonF a -> f (JsonF b)
Traversable)

newtype Json = Json { Json -> JsonF Json
unJson :: JsonF Json } deriving (Json -> Json -> Bool
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
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)

type JsonParserC s = (TextualStream s, Eq (Chunk s))

type JsonParserM s a = Parser TextLabel s Void a

jsonParser :: JsonParserC s => JsonParserM s Json
jsonParser :: forall s. JsonParserC s => JsonParserM s Json
jsonParser = let p :: ParserT TextLabel s Void Identity Json
p = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JsonF Json -> Json
Json (forall s a.
JsonParserC s =>
JsonParserM s a -> JsonParserM s (JsonF a)
recJsonParser ParserT TextLabel s Void Identity Json
p) in ParserT TextLabel s Void Identity Json
p

isBoolStartPred :: Char -> Bool
isBoolStartPred :: Char -> Bool
isBoolStartPred Char
c = Char
c forall a. Eq a => a -> a -> Bool
== Char
't' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'f'

recJsonParser :: JsonParserC s => JsonParserM s a -> JsonParserM s (JsonF a)
recJsonParser :: forall s a.
JsonParserC s =>
JsonParserM s a -> JsonParserM s (JsonF a)
recJsonParser JsonParserM s a
root = forall s a. JsonParserC s => JsonParserM s a -> JsonParserM s a
lexP (forall (m :: * -> *) l s e a b.
Monad m =>
MatchBlock l s e m a b -> ParserT l s e m b
lookAheadMatch MatchBlock TextLabel s Void Identity Char (JsonF a)
block) where
  block :: MatchBlock TextLabel s Void Identity Char (JsonF a)
block = forall l s e (m :: * -> *) a b.
ParserT l s e m a
-> ParserT l s e m b
-> [MatchCase l s e m a b]
-> MatchBlock l s e m a b
MatchBlock forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
ParserT l s e m (Token s)
anyToken (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse json document")
    [ forall l s e (m :: * -> *) a b.
Maybe l
-> (a -> Bool) -> ParserT l s e m b -> MatchCase l s e m a b
MatchCase forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
== Char
'{') (forall s a.
JsonParserC s =>
JsonParserM s (Text, a) -> JsonParserM s (JsonF a)
objectP (forall s a.
JsonParserC s =>
JsonParserM s a -> JsonParserM s (Text, a)
objectPairP JsonParserM s a
root))
    , forall l s e (m :: * -> *) a b.
Maybe l
-> (a -> Bool) -> ParserT l s e m b -> MatchCase l s e m a b
MatchCase forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
== Char
'[') (forall s a.
JsonParserC s =>
JsonParserM s a -> JsonParserM s (JsonF a)
arrayP JsonParserM s a
root)
    , forall l s e (m :: * -> *) a b.
Maybe l
-> (a -> Bool) -> ParserT l s e m b -> MatchCase l s e m a b
MatchCase forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
== Char
'"') forall s a. JsonParserC s => JsonParserM s (JsonF a)
stringP
    , forall l s e (m :: * -> *) a b.
Maybe l
-> (a -> Bool) -> ParserT l s e m b -> MatchCase l s e m a b
MatchCase forall a. Maybe a
Nothing Char -> Bool
signedNumStartPred forall s a. JsonParserC s => JsonParserM s (JsonF a)
numP
    , forall l s e (m :: * -> *) a b.
Maybe l
-> (a -> Bool) -> ParserT l s e m b -> MatchCase l s e m a b
MatchCase forall a. Maybe a
Nothing Char -> Bool
isBoolStartPred forall s a. JsonParserC s => JsonParserM s (JsonF a)
boolP
    , forall l s e (m :: * -> *) a b.
Maybe l
-> (a -> Bool) -> ParserT l s e m b -> MatchCase l s e m a b
MatchCase forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
== Char
'n') forall s a. JsonParserC s => JsonParserM s (JsonF a)
nullP
    ]

spaceP :: JsonParserC s => JsonParserM s ()
spaceP :: forall s. JsonParserC s => JsonParserM s ()
spaceP = forall s (m :: * -> *) l e.
(Stream s, Token s ~ Char, Monad m) =>
ParserT l s e m ()
spaceParser

lexP :: JsonParserC s => JsonParserM s a -> JsonParserM s a
lexP :: forall s a. JsonParserC s => JsonParserM s a -> JsonParserM s a
lexP = forall (m :: * -> *) l s e a.
Monad m =>
ParserT l s e m () -> ParserT l s e m a -> ParserT l s e m a
lexemeParser forall s. JsonParserC s => JsonParserM s ()
spaceP

tokL :: JsonParserC s => Char -> JsonParserM s ()
tokL :: forall s. JsonParserC s => Char -> JsonParserM s ()
tokL Char
c = forall s a. JsonParserC s => JsonParserM s a -> JsonParserM s a
lexP (forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) l e.
(Stream s, Monad m, Eq (Token s)) =>
Token s -> ParserT l s e m (Token s)
matchToken Char
c))

chunkL :: JsonParserC s => Text -> JsonParserM s ()
chunkL :: forall s. JsonParserC s => Text -> JsonParserM s ()
chunkL Text
cs = forall s a. JsonParserC s => JsonParserM s a -> JsonParserM s a
lexP (forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) l e.
(Stream s, Monad m, Eq (Chunk s)) =>
Chunk s -> ParserT l s e m (Chunk s)
matchChunk (forall chunk. TextualChunked chunk => Text -> chunk
unpackChunk Text
cs)))

openBraceP, closeBraceP, commaP, colonP, openBracketP, closeBracketP, closeQuoteP :: JsonParserC s => JsonParserM s ()
openBraceP :: forall s. JsonParserC s => JsonParserM s ()
openBraceP = forall s. JsonParserC s => Char -> JsonParserM s ()
tokL Char
'{'
closeBraceP :: forall s. JsonParserC s => JsonParserM s ()
closeBraceP = forall s. JsonParserC s => Char -> JsonParserM s ()
tokL Char
'}'
commaP :: forall s. JsonParserC s => JsonParserM s ()
commaP = forall s. JsonParserC s => Char -> JsonParserM s ()
tokL Char
','
colonP :: forall s. JsonParserC s => JsonParserM s ()
colonP = forall s. JsonParserC s => Char -> JsonParserM s ()
tokL Char
':'
openBracketP :: forall s. JsonParserC s => JsonParserM s ()
openBracketP = forall s. JsonParserC s => Char -> JsonParserM s ()
tokL Char
'['
closeBracketP :: forall s. JsonParserC s => JsonParserM s ()
closeBracketP = forall s. JsonParserC s => Char -> JsonParserM s ()
tokL Char
']'
closeQuoteP :: forall s. JsonParserC s => JsonParserM s ()
closeQuoteP = forall s. JsonParserC s => Char -> JsonParserM s ()
tokL Char
'"'

openQuoteP :: JsonParserC s => JsonParserM s ()
openQuoteP :: forall s. JsonParserC s => JsonParserM s ()
openQuoteP = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) l e.
(Stream s, Monad m, Eq (Token s)) =>
Token s -> ParserT l s e m (Token s)
matchToken Char
'"')

nullTokP, trueTokP, falseTokP :: JsonParserC s => JsonParserM s ()
nullTokP :: forall s. JsonParserC s => JsonParserM s ()
nullTokP = forall s. JsonParserC s => Text -> JsonParserM s ()
chunkL Text
"null"
trueTokP :: forall s. JsonParserC s => JsonParserM s ()
trueTokP = forall s. JsonParserC s => Text -> JsonParserM s ()
chunkL Text
"true"
falseTokP :: forall s. JsonParserC s => JsonParserM s ()
falseTokP = forall s. JsonParserC s => Text -> JsonParserM s ()
chunkL Text
"false"

rawStringP :: JsonParserC s => JsonParserM s Text
rawStringP :: forall s. JsonParserC s => JsonParserM s Text
rawStringP = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall chunk. TextualChunked chunk => chunk -> Text
packChunk (forall s (m :: * -> *) l e.
(Stream s, Token s ~ Char, Monad m) =>
Char -> ParserT l s e m (Chunk s)
escapedStringParser Char
'"')

stringP :: JsonParserC s => JsonParserM s (JsonF a)
stringP :: forall s a. JsonParserC s => JsonParserM s (JsonF a)
stringP = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Text -> JsonF a
JsonString forall s. JsonParserC s => JsonParserM s Text
rawStringP

nullP :: JsonParserC s => JsonParserM s (JsonF a)
nullP :: forall s a. JsonParserC s => JsonParserM s (JsonF a)
nullP = forall a. JsonF a
JsonNull forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s. JsonParserC s => JsonParserM s ()
nullTokP

boolP :: JsonParserC s => JsonParserM s (JsonF a)
boolP :: forall s a. JsonParserC s => JsonParserM s (JsonF a)
boolP = forall (m :: * -> *) l s e a.
Monad m =>
ParserT l s e m a -> ParserT l s e m a -> ParserT l s e m a
orParser (forall a. Bool -> JsonF a
JsonBool Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s. JsonParserC s => JsonParserM s ()
trueTokP) (forall a. Bool -> JsonF a
JsonBool Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s. JsonParserC s => JsonParserM s ()
falseTokP)

numP :: JsonParserC s => JsonParserM s (JsonF a)
numP :: forall s a. JsonParserC s => JsonParserM s (JsonF a)
numP = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Scientific -> JsonF a
JsonNum forall l s (m :: * -> *) e.
(EmbedTextLabel l, Stream s, Token s ~ Char, Monad m) =>
ParserT l s e m Scientific
scientificParser

objectPairP :: JsonParserC s => JsonParserM s a -> JsonParserM s (Text, a)
objectPairP :: forall s a.
JsonParserC s =>
JsonParserM s a -> JsonParserM s (Text, a)
objectPairP JsonParserM s a
root = do
  Text
name <- forall s. JsonParserC s => JsonParserM s Text
rawStringP
  forall s. JsonParserC s => JsonParserM s ()
colonP
  a
value <- JsonParserM s a
root
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
name, a
value)

objectP :: JsonParserC s => JsonParserM s (Text, a) -> JsonParserM s (JsonF a)
objectP :: forall s a.
JsonParserC s =>
JsonParserM s (Text, a) -> JsonParserM s (JsonF a)
objectP JsonParserM s (Text, a)
pairP = forall (m :: * -> *) l s e a.
Monad m =>
ParserT l s e m ()
-> ParserT l s e m () -> ParserT l s e m a -> ParserT l s e m a
betweenParser forall s. JsonParserC s => JsonParserM s ()
openBraceP forall s. JsonParserC s => JsonParserM s ()
closeBraceP (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Seq (Text, a) -> JsonF a
JsonObject (forall seq elem (m :: * -> *) l s e.
(Chunked seq elem, Monad m) =>
ParserT l s e m elem -> ParserT l s e m () -> ParserT l s e m seq
sepByParser JsonParserM s (Text, a)
pairP forall s. JsonParserC s => JsonParserM s ()
commaP))

arrayP :: JsonParserC s => JsonParserM s a -> JsonParserM s (JsonF a)
arrayP :: forall s a.
JsonParserC s =>
JsonParserM s a -> JsonParserM s (JsonF a)
arrayP JsonParserM s a
root = forall (m :: * -> *) l s e a.
Monad m =>
ParserT l s e m ()
-> ParserT l s e m () -> ParserT l s e m a -> ParserT l s e m a
betweenParser forall s. JsonParserC s => JsonParserM s ()
openBracketP forall s. JsonParserC s => JsonParserM s ()
closeBracketP (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Seq a -> JsonF a
JsonArray (forall seq elem (m :: * -> *) l s e.
(Chunked seq elem, Monad m) =>
ParserT l s e m elem -> ParserT l s e m () -> ParserT l s e m seq
sepByParser JsonParserM s a
root forall s. JsonParserC s => JsonParserM s ()
commaP))