----------------------------------------------------------------------------
{-# LANGUAGE LambdaCase #-}
----------------------------------------------------------------------------
-- |
-- Module      :  Miso.JSON.Parser
-- Copyright   :  (C) 2016-2026 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- A Parser for the JSON specification. Meant to be used on the server w/ SSR.
--
-- This was ported from <https://github.com/dmjio/json-test> by [@ners](https://github.com/ners)
-- 
----------------------------------------------------------------------------
module Miso.JSON.Parser (decodePure) where
----------------------------------------------------------------------------
import           Data.Bifunctor (Bifunctor(first))
import           Data.Functor (void)
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Prelude hiding (null)
----------------------------------------------------------------------------
import           Miso.JSON.Types
import           Miso.JSON.Lexer (Token (..), tokens)
import           Miso.String (MisoString)
import           Miso.Util (sepBy, oneOf)
import           Miso.Util.Parser
import           Miso.Util.Lexer (runLexer, mkStream)
----------------------------------------------------------------------------
number :: Parser Token Double
number :: Parser Token Double
number = do
  TokenNumber Double
d <- ParserT () [Token] [] Token
forall r a. ParserT r [a] [] a
anyToken
  Double -> Parser Token Double
forall a. a -> ParserT () [Token] [] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
d
----------------------------------------------------------------------------
bool :: Parser Token Bool
bool :: Parser Token Bool
bool = do
  TokenBool Bool
b <- ParserT () [Token] [] Token
forall r a. ParserT r [a] [] a
anyToken
  Bool -> Parser Token Bool
forall a. a -> ParserT () [Token] [] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
b
----------------------------------------------------------------------------
string' :: Parser Token MisoString
string' :: Parser Token MisoString
string' = do
  TokenString MisoString
s <- ParserT () [Token] [] Token
forall r a. ParserT r [a] [] a
anyToken
  MisoString -> Parser Token MisoString
forall a. a -> ParserT () [Token] [] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MisoString
s
----------------------------------------------------------------------------
array :: Parser Token [Value]
array :: Parser Token [Value]
array = do
  ParserT () [Token] [] Token -> ParserT () [Token] [] ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParserT () [Token] [] Token -> ParserT () [Token] [] ())
-> (Token -> ParserT () [Token] [] Token)
-> Token
-> ParserT () [Token] [] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> ParserT () [Token] [] Token
forall token. Eq token => token -> Parser token token
token_ (Token -> ParserT () [Token] [] ())
-> Token -> ParserT () [Token] [] ()
forall a b. (a -> b) -> a -> b
$ Char -> Token
TokenPunctuator Char
'['
  [Value]
values <- ParserT () [Token] [] Token
-> ParserT () [Token] [] Value -> Parser Token [Value]
forall (m :: * -> *) sep a. Alternative m => m sep -> m a -> m [a]
sepBy (Token -> ParserT () [Token] [] Token
forall token. Eq token => token -> Parser token token
token_ (Token -> ParserT () [Token] [] Token)
-> Token -> ParserT () [Token] [] Token
forall a b. (a -> b) -> a -> b
$ Char -> Token
TokenPunctuator Char
',') ParserT () [Token] [] Value
value
  ParserT () [Token] [] Token -> ParserT () [Token] [] ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParserT () [Token] [] Token -> ParserT () [Token] [] ())
-> (Token -> ParserT () [Token] [] Token)
-> Token
-> ParserT () [Token] [] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> ParserT () [Token] [] Token
forall token. Eq token => token -> Parser token token
token_ (Token -> ParserT () [Token] [] ())
-> Token -> ParserT () [Token] [] ()
forall a b. (a -> b) -> a -> b
$ Char -> Token
TokenPunctuator Char
']'
  [Value] -> Parser Token [Value]
forall a. a -> ParserT () [Token] [] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Value]
values
----------------------------------------------------------------------------
object :: Parser Token (Map MisoString Value)
object :: Parser Token (Map MisoString Value)
object = do
  ParserT () [Token] [] Token -> ParserT () [Token] [] ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParserT () [Token] [] Token -> ParserT () [Token] [] ())
-> (Token -> ParserT () [Token] [] Token)
-> Token
-> ParserT () [Token] [] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> ParserT () [Token] [] Token
forall token. Eq token => token -> Parser token token
token_ (Token -> ParserT () [Token] [] ())
-> Token -> ParserT () [Token] [] ()
forall a b. (a -> b) -> a -> b
$ Char -> Token
TokenPunctuator Char
'{'
  [(MisoString, Value)]
fields <- ParserT () [Token] [] Token
-> ParserT () [Token] [] (MisoString, Value)
-> ParserT () [Token] [] [(MisoString, Value)]
forall (m :: * -> *) sep a. Alternative m => m sep -> m a -> m [a]
sepBy (Token -> ParserT () [Token] [] Token
forall token. Eq token => token -> Parser token token
token_ (Token -> ParserT () [Token] [] Token)
-> Token -> ParserT () [Token] [] Token
forall a b. (a -> b) -> a -> b
$ Char -> Token
TokenPunctuator Char
',') (ParserT () [Token] [] (MisoString, Value)
 -> ParserT () [Token] [] [(MisoString, Value)])
-> ParserT () [Token] [] (MisoString, Value)
-> ParserT () [Token] [] [(MisoString, Value)]
forall a b. (a -> b) -> a -> b
$ do
    MisoString
key <- Parser Token MisoString
string'
    ParserT () [Token] [] Token -> ParserT () [Token] [] ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParserT () [Token] [] Token -> ParserT () [Token] [] ())
-> (Token -> ParserT () [Token] [] Token)
-> Token
-> ParserT () [Token] [] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> ParserT () [Token] [] Token
forall token. Eq token => token -> Parser token token
token_ (Token -> ParserT () [Token] [] ())
-> Token -> ParserT () [Token] [] ()
forall a b. (a -> b) -> a -> b
$ Char -> Token
TokenPunctuator Char
':'
    Value
val <- ParserT () [Token] [] Value
value
    (MisoString, Value) -> ParserT () [Token] [] (MisoString, Value)
forall a. a -> ParserT () [Token] [] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MisoString
key, Value
val)
  ParserT () [Token] [] Token -> ParserT () [Token] [] ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParserT () [Token] [] Token -> ParserT () [Token] [] ())
-> (Token -> ParserT () [Token] [] Token)
-> Token
-> ParserT () [Token] [] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> ParserT () [Token] [] Token
forall token. Eq token => token -> Parser token token
token_ (Token -> ParserT () [Token] [] ())
-> Token -> ParserT () [Token] [] ()
forall a b. (a -> b) -> a -> b
$ Char -> Token
TokenPunctuator Char
'}'
  Map MisoString Value -> Parser Token (Map MisoString Value)
forall a. a -> ParserT () [Token] [] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map MisoString Value -> Parser Token (Map MisoString Value))
-> Map MisoString Value -> Parser Token (Map MisoString Value)
forall a b. (a -> b) -> a -> b
$ [(MisoString, Value)] -> Map MisoString Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(MisoString, Value)]
fields
----------------------------------------------------------------------------
null :: Parser Token ()
null :: ParserT () [Token] [] ()
null = ParserT () [Token] [] Token -> ParserT () [Token] [] ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParserT () [Token] [] Token -> ParserT () [Token] [] ())
-> ParserT () [Token] [] Token -> ParserT () [Token] [] ()
forall a b. (a -> b) -> a -> b
$ Token -> ParserT () [Token] [] Token
forall token. Eq token => token -> Parser token token
token_ Token
TokenNull
----------------------------------------------------------------------------
value :: Parser Token Value
value :: ParserT () [Token] [] Value
value = [ParserT () [Token] [] Value] -> ParserT () [Token] [] Value
forall (f :: * -> *) a. Alternative f => [f a] -> f a
oneOf
  [ Double -> Value
Number (Double -> Value)
-> Parser Token Double -> ParserT () [Token] [] Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Token Double
number
  , Bool -> Value
Bool (Bool -> Value) -> Parser Token Bool -> ParserT () [Token] [] Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Token Bool
bool
  , MisoString -> Value
String (MisoString -> Value)
-> Parser Token MisoString -> ParserT () [Token] [] Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Token MisoString
string'
  , [Value] -> Value
Array ([Value] -> Value)
-> Parser Token [Value] -> ParserT () [Token] [] Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Token [Value]
array
  , Map MisoString Value -> Value
Object (Map MisoString Value -> Value)
-> Parser Token (Map MisoString Value)
-> ParserT () [Token] [] Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Token (Map MisoString Value)
object
  , Value
Null Value -> ParserT () [Token] [] () -> ParserT () [Token] [] Value
forall a b. a -> ParserT () [Token] [] b -> ParserT () [Token] [] a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParserT () [Token] [] ()
null
  ]
----------------------------------------------------------------------------
decodePure :: MisoString -> Either String Value
decodePure :: MisoString -> Either String Value
decodePure = (ParseError Value Token -> String)
-> Either (ParseError Value Token) Value -> Either String Value
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseError Value Token -> String
forall a. Show a => a -> String
show
  (Either (ParseError Value Token) Value -> Either String Value)
-> (MisoString -> Either (ParseError Value Token) Value)
-> MisoString
-> Either String Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LexerError -> Either (ParseError Value Token) Value)
-> (([Token], Stream) -> Either (ParseError Value Token) Value)
-> Either LexerError ([Token], Stream)
-> Either (ParseError Value Token) Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ParseError Value Token -> Either (ParseError Value Token) Value
forall a b. a -> Either a b
Left (ParseError Value Token -> Either (ParseError Value Token) Value)
-> (LexerError -> ParseError Value Token)
-> LexerError
-> Either (ParseError Value Token) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LexerError -> ParseError Value Token
forall a token. LexerError -> ParseError a token
LexicalError) (ParserT () [Token] [] Value
-> [Token] -> Either (ParseError Value Token) Value
forall token a.
Parser token a -> [token] -> Either (ParseError a token) a
parse ParserT () [Token] [] Value
value ([Token] -> Either (ParseError Value Token) Value)
-> (([Token], Stream) -> [Token])
-> ([Token], Stream)
-> Either (ParseError Value Token) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Token], Stream) -> [Token]
forall a b. (a, b) -> a
fst)
  (Either LexerError ([Token], Stream)
 -> Either (ParseError Value Token) Value)
-> (MisoString -> Either LexerError ([Token], Stream))
-> MisoString
-> Either (ParseError Value Token) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexer [Token] -> Stream -> Either LexerError ([Token], Stream)
forall token.
Lexer token -> Stream -> Either LexerError (token, Stream)
runLexer Lexer [Token]
tokens
  (Stream -> Either LexerError ([Token], Stream))
-> (MisoString -> Stream)
-> MisoString
-> Either LexerError ([Token], Stream)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Stream
mkStream
----------------------------------------------------------------------------