{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}

-- | Derulo parses and renders JSON simply. It aims to provide an RFC 7159
-- compliant parser and renderer without incurring any dependencies. It is
-- intended to be used either for learning or in situations where dependencies
-- are unwanted. In normal usage, prefer a faster, more robust library like
-- [Aeson](https://hackage.haskell.org/package/aeson).
--
-- Derulo does not export any identifiers that conflict with the prelude and
-- can be imported unqualified.
--
-- >>> import Derulo
--
-- Use 'readJSON' to parse a 'String' into a 'JSON' value.
--
-- >>> readJSON " null "
-- Just Null
--
-- Use 'showJSON' to render a 'JSON' value as a 'String'.
--
-- >>> showJSON Null
-- "null"
module Derulo
  ( JSON(..)
  , readJSON
  , showJSON
  ) where

import qualified Control.Monad as Monad
import qualified Data.Data as Data
import qualified Data.Functor as Functor
import qualified Data.List as List
import qualified Data.Maybe as Maybe
import qualified GHC.Generics as Generics
import qualified Text.ParserCombinators.ReadP as ReadP

-- * Types
-- | A JSON value as described by RFC 7159.
data JSON
  = Null
  | Boolean Bool
  | Number Integer
           Integer
  | String String
  | Array [JSON]
  | Object [(String, JSON)]
  deriving (Typeable JSON
DataType
Constr
Typeable JSON
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> JSON -> c JSON)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c JSON)
-> (JSON -> Constr)
-> (JSON -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c JSON))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JSON))
-> ((forall b. Data b => b -> b) -> JSON -> JSON)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JSON -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JSON -> r)
-> (forall u. (forall d. Data d => d -> u) -> JSON -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> JSON -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> JSON -> m JSON)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JSON -> m JSON)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JSON -> m JSON)
-> Data JSON
JSON -> DataType
JSON -> Constr
(forall b. Data b => b -> b) -> JSON -> JSON
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JSON -> c JSON
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JSON
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> JSON -> u
forall u. (forall d. Data d => d -> u) -> JSON -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JSON -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JSON -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JSON -> m JSON
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JSON -> m JSON
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JSON
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JSON -> c JSON
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JSON)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JSON)
$cObject :: Constr
$cArray :: Constr
$cString :: Constr
$cNumber :: Constr
$cBoolean :: Constr
$cNull :: Constr
$tJSON :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> JSON -> m JSON
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JSON -> m JSON
gmapMp :: (forall d. Data d => d -> m d) -> JSON -> m JSON
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JSON -> m JSON
gmapM :: (forall d. Data d => d -> m d) -> JSON -> m JSON
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JSON -> m JSON
gmapQi :: Int -> (forall d. Data d => d -> u) -> JSON -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JSON -> u
gmapQ :: (forall d. Data d => d -> u) -> JSON -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JSON -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JSON -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JSON -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JSON -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JSON -> r
gmapT :: (forall b. Data b => b -> b) -> JSON -> JSON
$cgmapT :: (forall b. Data b => b -> b) -> JSON -> JSON
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JSON)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JSON)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c JSON)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JSON)
dataTypeOf :: JSON -> DataType
$cdataTypeOf :: JSON -> DataType
toConstr :: JSON -> Constr
$ctoConstr :: JSON -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JSON
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JSON
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JSON -> c JSON
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JSON -> c JSON
$cp1Data :: Typeable JSON
Data.Data, 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, (forall x. JSON -> Rep JSON x)
-> (forall x. Rep JSON x -> JSON) -> Generic JSON
forall x. Rep JSON x -> JSON
forall x. JSON -> Rep JSON x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JSON x -> JSON
$cfrom :: forall x. JSON -> Rep JSON x
Generics.Generic, Eq JSON
Eq JSON
-> (JSON -> JSON -> Ordering)
-> (JSON -> JSON -> Bool)
-> (JSON -> JSON -> Bool)
-> (JSON -> JSON -> Bool)
-> (JSON -> JSON -> Bool)
-> (JSON -> JSON -> JSON)
-> (JSON -> JSON -> JSON)
-> Ord JSON
JSON -> JSON -> Bool
JSON -> JSON -> Ordering
JSON -> JSON -> JSON
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: JSON -> JSON -> JSON
$cmin :: JSON -> JSON -> JSON
max :: JSON -> JSON -> JSON
$cmax :: JSON -> JSON -> JSON
>= :: JSON -> JSON -> Bool
$c>= :: JSON -> JSON -> Bool
> :: JSON -> JSON -> Bool
$c> :: JSON -> JSON -> Bool
<= :: JSON -> JSON -> Bool
$c<= :: JSON -> JSON -> Bool
< :: JSON -> JSON -> Bool
$c< :: JSON -> JSON -> Bool
compare :: JSON -> JSON -> Ordering
$ccompare :: JSON -> JSON -> Ordering
$cp1Ord :: Eq JSON
Ord, ReadPrec [JSON]
ReadPrec JSON
Int -> ReadS JSON
ReadS [JSON]
(Int -> ReadS JSON)
-> ReadS [JSON] -> ReadPrec JSON -> ReadPrec [JSON] -> Read JSON
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [JSON]
$creadListPrec :: ReadPrec [JSON]
readPrec :: ReadPrec JSON
$creadPrec :: ReadPrec JSON
readList :: ReadS [JSON]
$creadList :: ReadS [JSON]
readsPrec :: Int -> ReadS JSON
$creadsPrec :: Int -> ReadS JSON
Read, 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)

-- * Parsing
-- | Parses a string as JSON.
readJSON :: String -> Maybe JSON
readJSON :: String -> Maybe JSON
readJSON = ReadP JSON -> String -> Maybe JSON
forall a. ReadP a -> String -> Maybe a
runParser ReadP JSON
pJSON

pJSON :: ReadP.ReadP JSON
pJSON :: ReadP JSON
pJSON = do
  ReadP ()
pWhitespaces
  JSON
value <- ReadP JSON
pValue
  ReadP ()
ReadP.eof
  JSON -> ReadP JSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSON
value

pValue :: ReadP.ReadP JSON
pValue :: ReadP JSON
pValue = [ReadP JSON] -> ReadP JSON
forall a. [ReadP a] -> ReadP a
ReadP.choice [ReadP JSON
pNull, ReadP JSON
pBoolean, ReadP JSON
pNumber, ReadP JSON
pString, ReadP JSON
pArray, ReadP JSON
pObject]

pNull :: ReadP.ReadP JSON
pNull :: ReadP JSON
pNull = do
  String -> ReadP ()
pSymbol String
"null"
  JSON -> ReadP JSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSON
Null

pBoolean :: ReadP.ReadP JSON
pBoolean :: ReadP JSON
pBoolean = ReadP JSON
pTrue ReadP JSON -> ReadP JSON -> ReadP JSON
forall a. ReadP a -> ReadP a -> ReadP a
ReadP.+++ ReadP JSON
pFalse

pTrue :: ReadP.ReadP JSON
pTrue :: ReadP JSON
pTrue = do
  String -> ReadP ()
pSymbol String
"true"
  JSON -> ReadP JSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> JSON
Boolean Bool
True)

pFalse :: ReadP.ReadP JSON
pFalse :: ReadP JSON
pFalse = do
  String -> ReadP ()
pSymbol String
"false"
  JSON -> ReadP JSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> JSON
Boolean Bool
False)

pNumber :: ReadP.ReadP JSON
pNumber :: ReadP JSON
pNumber = do
  Integer
integer <- ReadP Integer
pInteger
  (Integer
fraction, Integer
precision) <- (Integer, Integer)
-> ReadP (Integer, Integer) -> ReadP (Integer, Integer)
forall a. a -> ReadP a -> ReadP a
ReadP.option (Integer
0, Integer
0) ReadP (Integer, Integer)
pFraction
  Integer
power <- Integer -> ReadP Integer -> ReadP Integer
forall a. a -> ReadP a -> ReadP a
ReadP.option Integer
0 ReadP Integer
pPower
  ReadP ()
pWhitespaces
  let mantissa :: Integer
mantissa = Integer
integer Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
precision Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Bool -> Integer -> Integer
negateIf (Integer
integer Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0) Integer
fraction
  let magnitude :: Integer
magnitude = Integer
power Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
precision
  JSON -> ReadP JSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Integer -> JSON
Number Integer
mantissa Integer
magnitude)

pInteger :: ReadP.ReadP Integer
pInteger :: ReadP Integer
pInteger = ReadP Integer
pZero ReadP Integer -> ReadP Integer -> ReadP Integer
forall a. ReadP a -> ReadP a -> ReadP a
ReadP.+++ ReadP Integer
pNonZero

pZero :: ReadP.ReadP Integer
pZero :: ReadP Integer
pZero = do
  ReadP Char -> ReadP ()
forall a. ReadP a -> ReadP ()
ReadP.optional (Char -> ReadP Char
ReadP.char Char
'-')
  ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Functor.void (Char -> ReadP Char
ReadP.char Char
'0')
  Integer -> ReadP Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0

pNonZero :: ReadP.ReadP Integer
pNonZero :: ReadP Integer
pNonZero = do
  Char
sign <- Char -> ReadP Char -> ReadP Char
forall a. a -> ReadP a -> ReadP a
ReadP.option Char
'+' (Char -> ReadP Char
ReadP.char Char
'-')
  Char
first <- (Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
isNonZeroDigit
  String
rest <- (Char -> Bool) -> ReadP String
ReadP.munch Char -> Bool
isDecimalDigit
  case String -> Maybe Integer
fromDecimal (Char
first Char -> ShowS
forall a. a -> [a] -> [a]
: String
rest) of
    Maybe Integer
Nothing -> ReadP Integer
forall a. ReadP a
ReadP.pfail
    Just Integer
nonZero -> Integer -> ReadP Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Integer -> Integer
negateIf (Char
sign Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') Integer
nonZero)

pFraction :: ReadP.ReadP (Integer, Integer)
pFraction :: ReadP (Integer, Integer)
pFraction = do
  ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Functor.void (Char -> ReadP Char
ReadP.char Char
'.')
  String
digits <- (Char -> Bool) -> ReadP String
ReadP.munch1 Char -> Bool
isDecimalDigit
  case String -> Maybe Integer
fromDecimal String
digits of
    Maybe Integer
Nothing -> ReadP (Integer, Integer)
forall a. ReadP a
ReadP.pfail
    Just Integer
fraction -> (Integer, Integer) -> ReadP (Integer, Integer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
fraction, String -> Integer
forall i a. Num i => [a] -> i
List.genericLength String
digits)

pPower :: ReadP.ReadP Integer
pPower :: ReadP Integer
pPower = do
  ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Functor.void (Char -> ReadP Char
ReadP.char Char
'E' ReadP Char -> ReadP Char -> ReadP Char
forall a. ReadP a -> ReadP a -> ReadP a
ReadP.+++ Char -> ReadP Char
ReadP.char Char
'e')
  Char
sign <- Char -> ReadP Char -> ReadP Char
forall a. a -> ReadP a -> ReadP a
ReadP.option Char
'+' (Char -> ReadP Char
ReadP.char Char
'+' ReadP Char -> ReadP Char -> ReadP Char
forall a. ReadP a -> ReadP a -> ReadP a
ReadP.+++ Char -> ReadP Char
ReadP.char Char
'-')
  String
digits <- (Char -> Bool) -> ReadP String
ReadP.munch1 Char -> Bool
isDecimalDigit
  case String -> Maybe Integer
fromDecimal String
digits of
    Maybe Integer
Nothing -> ReadP Integer
forall a. ReadP a
ReadP.pfail
    Just Integer
magnitude -> Integer -> ReadP Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Integer -> Integer
negateIf (Char
sign Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') Integer
magnitude)

pString :: ReadP.ReadP JSON
pString :: ReadP JSON
pString = do
  JSON
string <- ReadP Char -> ReadP Char -> ReadP JSON -> ReadP JSON
forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
ReadP.between
    (Char -> ReadP Char
ReadP.char Char
'"')
    (Char -> ReadP Char
ReadP.char Char
'"')
    (do
      String
characters <- ReadP Char -> ReadP String
forall a. ReadP a -> ReadP [a]
ReadP.many ReadP Char
pCharacter
      JSON -> ReadP JSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> JSON
String String
characters)
    )
  ReadP ()
pWhitespaces
  JSON -> ReadP JSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSON
string

pCharacter :: ReadP.ReadP Char
pCharacter :: ReadP Char
pCharacter = ReadP Char
pLiteral ReadP Char -> ReadP Char -> ReadP Char
forall a. ReadP a -> ReadP a -> ReadP a
ReadP.+++ ReadP Char
pEscape

pLiteral :: ReadP.ReadP Char
pLiteral :: ReadP Char
pLiteral = (Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
isLiteral

pEscape :: ReadP.ReadP Char
pEscape :: ReadP Char
pEscape = do
  ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Functor.void (Char -> ReadP Char
ReadP.char Char
'\\')
  Char
escape <- ReadP Char
ReadP.get
  case Char
escape of
    Char
'"' -> Char -> ReadP Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'"'
    Char
'/' -> Char -> ReadP Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'/'
    Char
'\\' -> Char -> ReadP Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\\'
    Char
'b' -> Char -> ReadP Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\b'
    Char
'f' -> Char -> ReadP Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\f'
    Char
'n' -> Char -> ReadP Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\n'
    Char
'r' -> Char -> ReadP Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\r'
    Char
't' -> Char -> ReadP Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\t'
    Char
'u' -> do
      String
digits <- Int -> ReadP Char -> ReadP String
forall a. Int -> ReadP a -> ReadP [a]
ReadP.count Int
4 ((Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
isHexadecimalDigit)
      case String -> Maybe Integer
fromHexadecimal String
digits of
        Maybe Integer
Nothing -> ReadP Char
forall a. ReadP a
ReadP.pfail
        Just Integer
point -> Char -> ReadP Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Char
forall a. Enum a => Int -> a
toEnum (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
point))
    Char
_ -> ReadP Char
forall a. ReadP a
ReadP.pfail

pArray :: ReadP.ReadP JSON
pArray :: ReadP JSON
pArray = ReadP () -> ReadP () -> ReadP JSON -> ReadP JSON
forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
ReadP.between
  (String -> ReadP ()
pSymbol String
"[")
  (String -> ReadP ()
pSymbol String
"]")
  (do
    [JSON]
values <- ReadP JSON -> ReadP () -> ReadP [JSON]
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
ReadP.sepBy ReadP JSON
pValue (String -> ReadP ()
pSymbol String
",")
    JSON -> ReadP JSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([JSON] -> JSON
Array [JSON]
values)
  )

pObject :: ReadP.ReadP JSON
pObject :: ReadP JSON
pObject = ReadP () -> ReadP () -> ReadP JSON -> ReadP JSON
forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
ReadP.between
  (String -> ReadP ()
pSymbol String
"{")
  (String -> ReadP ()
pSymbol String
"}")
  (do
    [(String, JSON)]
pairs <- ReadP (String, JSON) -> ReadP () -> ReadP [(String, JSON)]
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
ReadP.sepBy ReadP (String, JSON)
pPair (String -> ReadP ()
pSymbol String
",")
    JSON -> ReadP JSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(String, JSON)] -> JSON
Object [(String, JSON)]
pairs)
  )

pPair :: ReadP.ReadP (String, JSON)
pPair :: ReadP (String, JSON)
pPair = do
  String String
key <- ReadP JSON
pString
  String -> ReadP ()
pSymbol String
":"
  JSON
value <- ReadP JSON
pValue
  (String, JSON) -> ReadP (String, JSON)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
key, JSON
value)

-- * Rendering
-- | Renders JSON as a string.
showJSON :: JSON -> String
showJSON :: JSON -> String
showJSON JSON
json = JSON -> ShowS
sJSON JSON
json String
""

sJSON :: JSON -> ShowS
sJSON :: JSON -> ShowS
sJSON JSON
json = case JSON
json of
  JSON
Null -> ShowS
sNull
  Boolean Bool
boolean -> Bool -> ShowS
sBoolean Bool
boolean
  Number Integer
mantissa Integer
magnitude -> Integer -> Integer -> ShowS
sNumber Integer
mantissa Integer
magnitude
  String String
string -> String -> ShowS
sString String
string
  Array [JSON]
array -> [JSON] -> ShowS
sArray [JSON]
array
  Object [(String, JSON)]
object -> [(String, JSON)] -> ShowS
sObject [(String, JSON)]
object

sNull :: ShowS
sNull :: ShowS
sNull = String -> ShowS
showString String
"null"

sBoolean :: Bool -> ShowS
sBoolean :: Bool -> ShowS
sBoolean Bool
boolean = if Bool
boolean then ShowS
sTrue else ShowS
sFalse

sTrue :: ShowS
sTrue :: ShowS
sTrue = String -> ShowS
showString String
"true"

sFalse :: ShowS
sFalse :: ShowS
sFalse = String -> ShowS
showString String
"false"

sNumber :: Integer -> Integer -> ShowS
sNumber :: Integer -> Integer -> ShowS
sNumber Integer
mantissa Integer
magnitude = Integer -> ShowS
forall a. Show a => a -> ShowS
shows Integer
mantissa ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'e' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ShowS
forall a. Show a => a -> ShowS
shows Integer
magnitude

sString :: String -> ShowS
sString :: String -> ShowS
sString = ShowS -> ShowS -> ShowS -> (Char -> ShowS) -> String -> ShowS
forall element.
ShowS -> ShowS -> ShowS -> (element -> ShowS) -> [element] -> ShowS
sSeparatedBetween (Char -> ShowS
showChar Char
'"') (Char -> ShowS
showChar Char
'"') ShowS
forall a. a -> a
id Char -> ShowS
sCharacter

sCharacter :: Char -> ShowS
sCharacter :: Char -> ShowS
sCharacter Char
character = case Char
character of
  Char
'"' -> String -> ShowS
showString String
"\\\""
  Char
'\\' -> String -> ShowS
showString String
"\\\\"
  Char
'\b' -> String -> ShowS
showString String
"\\b"
  Char
'\f' -> String -> ShowS
showString String
"\\f"
  Char
'\n' -> String -> ShowS
showString String
"\\n"
  Char
'\r' -> String -> ShowS
showString String
"\\r"
  Char
'\t' -> String -> ShowS
showString String
"\\t"
  Char
_ -> if Char -> Bool
isControl Char
character
    then String -> ShowS
showString String
"\\u" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString
      (Integer -> Char -> ShowS
forall a. Integer -> a -> [a] -> [a]
padLeft Integer
4 Char
'0' (Integer -> String
toHexadecimal (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
character))))
    else Char -> ShowS
showChar Char
character

sArray :: [JSON] -> ShowS
sArray :: [JSON] -> ShowS
sArray = ShowS -> ShowS -> ShowS -> (JSON -> ShowS) -> [JSON] -> ShowS
forall element.
ShowS -> ShowS -> ShowS -> (element -> ShowS) -> [element] -> ShowS
sSeparatedBetween (Char -> ShowS
showChar Char
'[') (Char -> ShowS
showChar Char
']') (Char -> ShowS
showChar Char
',') JSON -> ShowS
sJSON

sObject :: [(String, JSON)] -> ShowS
sObject :: [(String, JSON)] -> ShowS
sObject = ShowS
-> ShowS
-> ShowS
-> ((String, JSON) -> ShowS)
-> [(String, JSON)]
-> ShowS
forall element.
ShowS -> ShowS -> ShowS -> (element -> ShowS) -> [element] -> ShowS
sSeparatedBetween (Char -> ShowS
showChar Char
'{') (Char -> ShowS
showChar Char
'}') (Char -> ShowS
showChar Char
',') (String, JSON) -> ShowS
sPair

sPair :: (String, JSON) -> ShowS
sPair :: (String, JSON) -> ShowS
sPair (String
key, JSON
value) = String -> ShowS
sString String
key ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
':' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSON -> ShowS
sJSON JSON
value

-- * Helpers
fromBase :: Integer -> (Char -> Maybe Integer) -> String -> Maybe Integer
fromBase :: Integer -> (Char -> Maybe Integer) -> String -> Maybe Integer
fromBase Integer
b Char -> Maybe Integer
f = (Integer -> Char -> Maybe Integer)
-> Integer -> String -> Maybe Integer
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
Monad.foldM
  (\Integer
n Char
c -> do
    Integer
d <- Char -> Maybe Integer
f Char
c
    Integer -> Maybe Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
d)
  )
  Integer
0

fromDecimal :: String -> Maybe Integer
fromDecimal :: String -> Maybe Integer
fromDecimal = Integer -> (Char -> Maybe Integer) -> String -> Maybe Integer
fromBase Integer
10 Char -> Maybe Integer
fromDecimalDigit

fromDecimalDigit :: Char -> Maybe Integer
fromDecimalDigit :: Char -> Maybe Integer
fromDecimalDigit Char
c = case Char
c of
  Char
'0' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0
  Char
'1' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
1
  Char
'2' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
2
  Char
'3' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
3
  Char
'4' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
4
  Char
'5' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
5
  Char
'6' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
6
  Char
'7' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
7
  Char
'8' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
8
  Char
'9' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
9
  Char
_ -> Maybe Integer
forall a. Maybe a
Nothing

fromHexadecimal :: String -> Maybe Integer
fromHexadecimal :: String -> Maybe Integer
fromHexadecimal = Integer -> (Char -> Maybe Integer) -> String -> Maybe Integer
fromBase Integer
16 Char -> Maybe Integer
fromHexadecimalDigit

fromHexadecimalDigit :: Char -> Maybe Integer
fromHexadecimalDigit :: Char -> Maybe Integer
fromHexadecimalDigit Char
c = case Char
c of
  Char
'A' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
10
  Char
'B' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
11
  Char
'C' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
12
  Char
'D' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
13
  Char
'E' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
14
  Char
'F' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
15
  Char
'a' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
10
  Char
'b' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
11
  Char
'c' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
12
  Char
'd' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
13
  Char
'e' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
14
  Char
'f' -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
15
  Char
_ -> Char -> Maybe Integer
fromDecimalDigit Char
c

isControl :: Char -> Bool
isControl :: Char -> Bool
isControl Char
c = Char
'\x00' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x1f'

isDecimalDigit :: Char -> Bool
isDecimalDigit :: Char -> Bool
isDecimalDigit Char
c = Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'

isHexadecimalDigit :: Char -> Bool
isHexadecimalDigit :: Char -> Bool
isHexadecimalDigit Char
c =
  Char -> Bool
isDecimalDigit Char
c Bool -> Bool -> Bool
|| Char
'A' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'F' Bool -> Bool -> Bool
|| Char
'a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'f'

isLiteral :: Char -> Bool
isLiteral :: Char -> Bool
isLiteral Char
c = Bool -> Bool
not (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' Bool -> Bool -> Bool
|| Char -> Bool
isControl Char
c)

isNonZeroDigit :: Char -> Bool
isNonZeroDigit :: Char -> Bool
isNonZeroDigit Char
c = Char
'1' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'

isWhitespace :: Char -> Bool
isWhitespace :: Char -> Bool
isWhitespace Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '

negateIf :: Bool -> Integer -> Integer
negateIf :: Bool -> Integer -> Integer
negateIf Bool
p Integer
n = if Bool
p then Integer -> Integer
forall a. Num a => a -> a
negate Integer
n else Integer
n

pSymbol :: String -> ReadP.ReadP ()
pSymbol :: String -> ReadP ()
pSymbol String
s = do
  ReadP String -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Functor.void (String -> ReadP String
ReadP.string String
s)
  ReadP ()
pWhitespaces

pWhitespaces :: ReadP.ReadP ()
pWhitespaces :: ReadP ()
pWhitespaces = ReadP String -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Functor.void ((Char -> Bool) -> ReadP String
ReadP.munch Char -> Bool
isWhitespace)

padLeft :: Integer -> a -> [a] -> [a]
padLeft :: Integer -> a -> [a] -> [a]
padLeft Integer
n a
x [a]
ys = [a] -> [a]
forall a. [a] -> [a]
reverse (Integer -> a -> [a] -> [a]
forall a. Integer -> a -> [a] -> [a]
padRight Integer
n a
x ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
ys))

padRight :: Integer -> a -> [a] -> [a]
padRight :: Integer -> a -> [a] -> [a]
padRight Integer
n a
x [a]
ys = if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0
  then [a]
ys
  else case [a]
ys of
    [] -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Integer -> a -> [a] -> [a]
forall a. Integer -> a -> [a] -> [a]
padRight (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) a
x [a]
ys
    a
y : [a]
zs -> a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Integer -> a -> [a] -> [a]
forall a. Integer -> a -> [a] -> [a]
padRight (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) a
x [a]
zs

runParser :: ReadP.ReadP a -> String -> Maybe a
runParser :: ReadP a -> String -> Maybe a
runParser ReadP a
p String
s = [a] -> Maybe a
forall a. [a] -> Maybe a
Maybe.listToMaybe
  (((a, String) -> Maybe a) -> [(a, String)] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe
    (\(a
x, String
t) -> if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
t then a -> Maybe a
forall a. a -> Maybe a
Just a
x else Maybe a
forall a. Maybe a
Nothing)
    (ReadP a -> ReadS a
forall a. ReadP a -> ReadS a
ReadP.readP_to_S ReadP a
p String
s)
  )

sBetween :: ShowS -> ShowS -> (anything -> ShowS) -> anything -> ShowS
sBetween :: ShowS -> ShowS -> (anything -> ShowS) -> anything -> ShowS
sBetween ShowS
left ShowS
right anything -> ShowS
render anything
it = ShowS
left ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. anything -> ShowS
render anything
it ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
right

sSeparated :: ShowS -> (element -> ShowS) -> [element] -> ShowS
sSeparated :: ShowS -> (element -> ShowS) -> [element] -> ShowS
sSeparated ShowS
separator element -> ShowS
render [element]
elements = case [element]
elements of
  [] -> ShowS
forall a. a -> a
id
  [element
element] -> element -> ShowS
render element
element
  element
element : [element]
rest ->
    element -> ShowS
render element
element ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
separator ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> (element -> ShowS) -> [element] -> ShowS
forall element. ShowS -> (element -> ShowS) -> [element] -> ShowS
sSeparated ShowS
separator element -> ShowS
render [element]
rest

sSeparatedBetween
  :: ShowS -> ShowS -> ShowS -> (element -> ShowS) -> [element] -> ShowS
sSeparatedBetween :: ShowS -> ShowS -> ShowS -> (element -> ShowS) -> [element] -> ShowS
sSeparatedBetween ShowS
left ShowS
right ShowS
separator element -> ShowS
render =
  ShowS -> ShowS -> ([element] -> ShowS) -> [element] -> ShowS
forall anything.
ShowS -> ShowS -> (anything -> ShowS) -> anything -> ShowS
sBetween ShowS
left ShowS
right (ShowS -> (element -> ShowS) -> [element] -> ShowS
forall element. ShowS -> (element -> ShowS) -> [element] -> ShowS
sSeparated ShowS
separator element -> ShowS
render)

toBase :: Integer -> (Integer -> Maybe Char) -> Integer -> String
toBase :: Integer -> (Integer -> Maybe Char) -> Integer -> String
toBase Integer
b Integer -> Maybe Char
f Integer
n =
  if Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then [Maybe Char -> Char
forall a. HasCallStack => Maybe a -> a
Maybe.fromJust (Integer -> Maybe Char
f Integer
n)] else ShowS
forall a. [a] -> [a]
reverse (Integer -> (Integer -> Maybe Char) -> Integer -> String
toBase' Integer
b Integer -> Maybe Char
f Integer
n)

toBase' :: Integer -> (Integer -> Maybe Char) -> Integer -> String
toBase' :: Integer -> (Integer -> Maybe Char) -> Integer -> String
toBase' Integer
b Integer -> Maybe Char
f Integer
n = case Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem Integer
n Integer
b of
  (Integer
0, Integer
0) -> String
""
  (Integer
q, Integer
r) -> Maybe Char -> Char
forall a. HasCallStack => Maybe a -> a
Maybe.fromJust (Integer -> Maybe Char
f Integer
r) Char -> ShowS
forall a. a -> [a] -> [a]
: Integer -> (Integer -> Maybe Char) -> Integer -> String
toBase' Integer
b Integer -> Maybe Char
f Integer
q

toHexadecimal :: Integer -> String
toHexadecimal :: Integer -> String
toHexadecimal = Integer -> (Integer -> Maybe Char) -> Integer -> String
toBase Integer
16 Integer -> Maybe Char
toHexadecimalDigit

toHexadecimalDigit :: Integer -> Maybe Char
toHexadecimalDigit :: Integer -> Maybe Char
toHexadecimalDigit Integer
n = case Integer
n of
  Integer
0 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'0'
  Integer
1 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'1'
  Integer
2 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'2'
  Integer
3 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'3'
  Integer
4 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'4'
  Integer
5 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'5'
  Integer
6 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'6'
  Integer
7 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'7'
  Integer
8 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'8'
  Integer
9 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'9'
  Integer
10 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'a'
  Integer
11 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'b'
  Integer
12 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'c'
  Integer
13 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'd'
  Integer
14 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'e'
  Integer
15 -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'f'
  Integer
_ -> Maybe Char
forall a. Maybe a
Nothing