{-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances #-}
-- | Serialising Haskell values to and from JSON5 values.
module Text.JSON5 (
    -- * JSON5 Types
    JSValue(..)

    -- * Serialization to and from JSValues
  , JSON5(..)

    -- * Encoding and Decoding
  , Result(..)
  , encode -- :: JSON5 a => a -> String
  , decode -- :: JSON5 a => String -> Either String a
  , encodeStrict -- :: JSON5 a => a -> String
  , decodeStrict -- :: JSON5 a => String -> Either String a

    -- * Wrapper Types
  , JSString
  , toJSString
  , fromJSString

  , JSObject
  , toJSObject
  , fromJSObject
  , resultToEither

    -- * Serialization to and from Strings.
    -- ** Reading JSON5
  , readJSNull, readJSBool, readJSString, readJSRational
  , readJSArray, readJSObject, readJSValue

    -- ** Writing JSON5
  , showJSNull, showJSBool, showJSArray
  , showJSRational, showJSInfNaN
  , showJSObject, showJSValue

    -- ** Instance helpers
  , makeObj, valFromObj
  , JSKey(..), encJSDict, decJSDict

  ) where

import Text.JSON5.Types
import Text.JSON5.String

import Data.Int
import Data.Word
import Control.Monad(liftM, ap, MonadPlus(..))
import Control.Applicative

import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.IntSet as I
import qualified Data.Set as Set
import qualified Data.Map as M
import qualified Data.IntMap as IntMap

import qualified Data.Array as Array
import qualified Data.Text as T

------------------------------------------------------------------------

-- | Decode a String representing a JSON5 value
-- (either an object, array, bool, number, null)
--
-- This is a superset of JSON5, as types other than
-- Array and Object are allowed at the top level.
--
decode :: (JSON5 a) => String -> Result a
decode :: String -> Result a
decode String
s = case GetJSON JSValue -> String -> Either String JSValue
forall a. GetJSON a -> String -> Either String a
runGetJSON GetJSON JSValue
readJSValue String
s of
             Right JSValue
a  -> JSValue -> Result a
forall a. JSON5 a => JSValue -> Result a
readJSON JSValue
a
             Left String
err -> String -> Result a
forall a. String -> Result a
Error String
err

-- | Encode a Haskell value into a string, in JSON5 format.
--
-- This is a superset of JSON5, as types other than
-- Array and Object are allowed at the top level.
--
encode :: (JSON5 a) => a -> String
encode :: a -> String
encode = ((JSValue -> String -> String) -> String -> JSValue -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip JSValue -> String -> String
showJSValue [] (JSValue -> String) -> (a -> JSValue) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> JSValue
forall a. JSON5 a => a -> JSValue
showJSON)

------------------------------------------------------------------------

-- | Decode a String representing a strict JSON value.
-- This follows the spec, and requires top level
-- JSON5 types to be an Array or Object.
decodeStrict :: (JSON5 a) => String -> Result a
decodeStrict :: String -> Result a
decodeStrict String
s = case GetJSON JSValue -> String -> Either String JSValue
forall a. GetJSON a -> String -> Either String a
runGetJSON GetJSON JSValue
readJSTopType String
s of
     Right JSValue
a  -> JSValue -> Result a
forall a. JSON5 a => JSValue -> Result a
readJSON JSValue
a
     Left String
err -> String -> Result a
forall a. String -> Result a
Error String
err

-- | Encode a value as a String in strict JSON format.
-- This follows the spec, and requires all values
-- at the top level to be wrapped in either an Array or Object.
-- JSON5 types to be an Array or Object.
encodeStrict :: (JSON5 a) => a -> String
encodeStrict :: a -> String
encodeStrict = ((JSValue -> String -> String) -> String -> JSValue -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip JSValue -> String -> String
showJSTopType [] (JSValue -> String) -> (a -> JSValue) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> JSValue
forall a. JSON5 a => a -> JSValue
showJSON)

------------------------------------------------------------------------

-- | The class of types serialisable to and from JSON5
class JSON5 a where
  readJSON  :: JSValue -> Result a
  showJSON  :: a -> JSValue

  readJSONs :: JSValue -> Result [a]
  readJSONs (JSArray [JSValue]
as) = (JSValue -> Result a) -> [JSValue] -> Result [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM JSValue -> Result a
forall a. JSON5 a => JSValue -> Result a
readJSON [JSValue]
as
  readJSONs JSValue
_            = String -> Result [a]
forall a. String -> Result a
mkError String
"Unable to read list"

  showJSONs :: [a] -> JSValue
  showJSONs = [JSValue] -> JSValue
JSArray ([JSValue] -> JSValue) -> ([a] -> [JSValue]) -> [a] -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> JSValue) -> [a] -> [JSValue]
forall a b. (a -> b) -> [a] -> [b]
map a -> JSValue
forall a. JSON5 a => a -> JSValue
showJSON

-- | A type for parser results
data Result a = Ok a | Error String
  deriving (Result a -> Result a -> Bool
(Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool) -> Eq (Result a)
forall a. Eq a => Result a -> Result a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result a -> Result a -> Bool
$c/= :: forall a. Eq a => Result a -> Result a -> Bool
== :: Result a -> Result a -> Bool
$c== :: forall a. Eq a => Result a -> Result a -> Bool
Eq,Int -> Result a -> String -> String
[Result a] -> String -> String
Result a -> String
(Int -> Result a -> String -> String)
-> (Result a -> String)
-> ([Result a] -> String -> String)
-> Show (Result a)
forall a. Show a => Int -> Result a -> String -> String
forall a. Show a => [Result a] -> String -> String
forall a. Show a => Result a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Result a] -> String -> String
$cshowList :: forall a. Show a => [Result a] -> String -> String
show :: Result a -> String
$cshow :: forall a. Show a => Result a -> String
showsPrec :: Int -> Result a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> Result a -> String -> String
Show)

-- | Map Results to Eithers
resultToEither :: Result a -> Either String a
resultToEither :: Result a -> Either String a
resultToEither (Ok a
a)    = a -> Either String a
forall a b. b -> Either a b
Right a
a
resultToEither (Error String
s) = String -> Either String a
forall a b. a -> Either a b
Left  String
s

instance Functor Result where
  fmap :: (a -> b) -> Result a -> Result b
fmap = (a -> b) -> Result a -> Result b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Applicative Result where
  <*> :: Result (a -> b) -> Result a -> Result b
(<*>) = Result (a -> b) -> Result a -> Result b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
  pure :: a -> Result a
pure  = a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return

instance Alternative Result where
  Ok a
a    <|> :: Result a -> Result a -> Result a
<|> Result a
_ = a -> Result a
forall a. a -> Result a
Ok a
a
  Error String
_ <|> Result a
b = Result a
b
  empty :: Result a
empty         = String -> Result a
forall a. String -> Result a
Error String
"empty"

instance MonadPlus Result where
  Ok a
a mplus :: Result a -> Result a -> Result a
`mplus` Result a
_ = a -> Result a
forall a. a -> Result a
Ok a
a
  Result a
_ `mplus` Result a
x    = Result a
x
  mzero :: Result a
mzero          = String -> Result a
forall a. String -> Result a
Error String
"Result: MonadPlus.empty"

instance Monad Result where
  return :: a -> Result a
return a
x      = a -> Result a
forall a. a -> Result a
Ok a
x
  Ok a
a >>= :: Result a -> (a -> Result b) -> Result b
>>= a -> Result b
f    = a -> Result b
f a
a
  Error String
x >>= a -> Result b
_ = String -> Result b
forall a. String -> Result a
Error String
x

instance MonadFail Result where
  fail :: String -> Result a
fail String
x        = String -> Result a
forall a. String -> Result a
Error String
x

mkError :: String -> Result a
mkError :: String -> Result a
mkError String
s = String -> Result a
forall a. String -> Result a
Error String
s

--------------------------------------------------------------------
--
-- | To ensure we generate valid JSON5, we map Haskell types to JSValue
-- internally, then pretty print that.
--
instance JSON5 JSValue where
    showJSON :: JSValue -> JSValue
showJSON = JSValue -> JSValue
forall a. a -> a
id
    readJSON :: JSValue -> Result JSValue
readJSON = JSValue -> Result JSValue
forall (m :: * -> *) a. Monad m => a -> m a
return

second :: (a -> b) -> (x,a) -> (x,b)
second :: (a -> b) -> (x, a) -> (x, b)
second a -> b
f (x
a,a
b) = (x
a, a -> b
f a
b)

--------------------------------------------------------------------
-- Some simple JSON5 wrapper types, to avoid overlapping instances

-- instance JSON5 JSNumber where
--   readJSON (JSRational r) = return r
--   readJSON (JSInfNaN n)   = return n
--   readJSON _              = mkError "Unable to read JSNumber"
--   showJSON = JSNumber

instance JSON5 JSString where
  readJSON :: JSValue -> Result JSString
readJSON (JSString JSString
s) = JSString -> Result JSString
forall (m :: * -> *) a. Monad m => a -> m a
return JSString
s
  readJSON JSValue
_            = String -> Result JSString
forall a. String -> Result a
mkError String
"Unable to read JSString"
  showJSON :: JSString -> JSValue
showJSON = JSString -> JSValue
JSString

instance (JSON5 a) => JSON5 (JSObject a) where
  readJSON :: JSValue -> Result (JSObject a)
readJSON (JSObject JSObject JSValue
o) =
      let f :: (a, JSValue) -> Result (a, b)
f (a
x,JSValue
y) = do b
y' <- JSValue -> Result b
forall a. JSON5 a => JSValue -> Result a
readJSON JSValue
y; (a, b) -> Result (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x,b
y')
      in [(String, a)] -> JSObject a
forall a. [(String, a)] -> JSObject a
toJSObject ([(String, a)] -> JSObject a)
-> Result [(String, a)] -> Result (JSObject a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ((String, JSValue) -> Result (String, a))
-> [(String, JSValue)] -> Result [(String, a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String, JSValue) -> Result (String, a)
forall b a. JSON5 b => (a, JSValue) -> Result (a, b)
f (JSObject JSValue -> [(String, JSValue)]
forall a. JSObject a -> [(String, a)]
fromJSObject JSObject JSValue
o)
  readJSON JSValue
_ = String -> Result (JSObject a)
forall a. String -> Result a
mkError String
"Unable to read JSObject"
  showJSON :: JSObject a -> JSValue
showJSON = JSObject JSValue -> JSValue
JSObject (JSObject JSValue -> JSValue)
-> (JSObject a -> JSObject JSValue) -> JSObject a -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, JSValue)] -> JSObject JSValue
forall a. [(String, a)] -> JSObject a
toJSObject ([(String, JSValue)] -> JSObject JSValue)
-> (JSObject a -> [(String, JSValue)])
-> JSObject a
-> JSObject JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, a) -> (String, JSValue))
-> [(String, a)] -> [(String, JSValue)]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> JSValue) -> (String, a) -> (String, JSValue)
forall a b x. (a -> b) -> (x, a) -> (x, b)
second a -> JSValue
forall a. JSON5 a => a -> JSValue
showJSON) ([(String, a)] -> [(String, JSValue)])
-> (JSObject a -> [(String, a)])
-> JSObject a
-> [(String, JSValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSObject a -> [(String, a)]
forall a. JSObject a -> [(String, a)]
fromJSObject


-- -----------------------------------------------------------------
-- Instances
--

instance JSON5 Bool where
  showJSON :: Bool -> JSValue
showJSON = Bool -> JSValue
JSBool
  readJSON :: JSValue -> Result Bool
readJSON (JSBool Bool
b) = Bool -> Result Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
b
  readJSON JSValue
_          = String -> Result Bool
forall a. String -> Result a
mkError String
"Unable to read Bool"

instance JSON5 Char where
  showJSON :: Char -> JSValue
showJSON  = JSString -> JSValue
JSString (JSString -> JSValue) -> (Char -> JSString) -> Char -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> JSString
toJSString (String -> JSString) -> (Char -> String) -> Char -> JSString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> String
forall a. a -> [a] -> [a]
:[])
  showJSONs :: String -> JSValue
showJSONs = JSString -> JSValue
JSString (JSString -> JSValue) -> (String -> JSString) -> String -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> JSString
toJSString

  readJSON :: JSValue -> Result Char
readJSON (JSString JSString
s) = case JSString -> String
fromJSString JSString
s of
                            [Char
c] -> Char -> Result Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
                            String
_ -> String -> Result Char
forall a. String -> Result a
mkError String
"Unable to read Char"
  readJSON JSValue
_            = String -> Result Char
forall a. String -> Result a
mkError String
"Unable to read Char"

  readJSONs :: JSValue -> Result String
readJSONs (JSString JSString
s)  = String -> Result String
forall (m :: * -> *) a. Monad m => a -> m a
return (JSString -> String
fromJSString JSString
s)
  readJSONs (JSArray [JSValue]
a)   = (JSValue -> Result Char) -> [JSValue] -> Result String
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM JSValue -> Result Char
forall a. JSON5 a => JSValue -> Result a
readJSON [JSValue]
a
  readJSONs JSValue
_             = String -> Result String
forall a. String -> Result a
mkError String
"Unable to read String"

instance JSON5 Ordering where
  showJSON :: Ordering -> JSValue
showJSON = (Ordering -> String) -> Ordering -> JSValue
forall a. (a -> String) -> a -> JSValue
encJSString Ordering -> String
forall a. Show a => a -> String
show
  readJSON :: JSValue -> Result Ordering
readJSON = String -> (String -> Result Ordering) -> JSValue -> Result Ordering
forall a. String -> (String -> Result a) -> JSValue -> Result a
decJSString String
"Ordering" String -> Result Ordering
readOrd
    where
     readOrd :: String -> Result Ordering
readOrd String
x =
       case String
x of
         String
"LT" -> Ordering -> Result Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
Prelude.LT
         String
"EQ" -> Ordering -> Result Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
Prelude.EQ
         String
"GT" -> Ordering -> Result Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
Prelude.GT
         String
_    -> String -> Result Ordering
forall a. String -> Result a
mkError (String
"Unable to read Ordering")

-- -----------------------------------------------------------------
-- Integral types

instance JSON5 Integer where
  showJSON :: Integer -> JSValue
showJSON = Rational -> JSValue
fromJSRational (Rational -> JSValue)
-> (Integer -> Rational) -> Integer -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  readJSON :: JSValue -> Result Integer
readJSON (JSNumber (JSRational Rational
i)) = Integer -> Result Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Result Integer) -> Integer -> Result Integer
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round Rational
i
  readJSON JSValue
_ = String -> Result Integer
forall a. String -> Result a
mkError String
"Unable to read Integer"

-- constrained:
instance JSON5 Int where
  showJSON :: Int -> JSValue
showJSON = Rational -> JSValue
fromJSRational (Rational -> JSValue) -> (Int -> Rational) -> Int -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  readJSON :: JSValue -> Result Int
readJSON (JSNumber (JSRational Rational
i)) = Int -> Result Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Result Int) -> Int -> Result Int
forall a b. (a -> b) -> a -> b
$ Rational -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Rational
i
  readJSON JSValue
_ = String -> Result Int
forall a. String -> Result a
mkError String
"Unable to read Int"

-- constrained:
instance JSON5 Word where
  showJSON :: Word -> JSValue
showJSON = Rational -> JSValue
fromJSRational (Rational -> JSValue) -> (Word -> Rational) -> Word -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Rational
forall a. Real a => a -> Rational
toRational
  readJSON :: JSValue -> Result Word
readJSON (JSNumber (JSRational Rational
i)) = Word -> Result Word
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> Result Word) -> Word -> Result Word
forall a b. (a -> b) -> a -> b
$ Rational -> Word
forall a b. (RealFrac a, Integral b) => a -> b
truncate Rational
i
  readJSON JSValue
_ = String -> Result Word
forall a. String -> Result a
mkError String
"Unable to read Word"

-- -----------------------------------------------------------------

instance JSON5 Word8 where
  showJSON :: Word8 -> JSValue
showJSON = Rational -> JSValue
fromJSRational (Rational -> JSValue) -> (Word8 -> Rational) -> Word8 -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  readJSON :: JSValue -> Result Word8
readJSON (JSNumber (JSRational Rational
i)) = Word8 -> Result Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> Result Word8) -> Word8 -> Result Word8
forall a b. (a -> b) -> a -> b
$ Rational -> Word8
forall a b. (RealFrac a, Integral b) => a -> b
truncate Rational
i
  readJSON JSValue
_ = String -> Result Word8
forall a. String -> Result a
mkError String
"Unable to read Word8"

instance JSON5 Word16 where
  showJSON :: Word16 -> JSValue
showJSON = Rational -> JSValue
fromJSRational (Rational -> JSValue) -> (Word16 -> Rational) -> Word16 -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  readJSON :: JSValue -> Result Word16
readJSON (JSNumber (JSRational Rational
i)) = Word16 -> Result Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> Result Word16) -> Word16 -> Result Word16
forall a b. (a -> b) -> a -> b
$ Rational -> Word16
forall a b. (RealFrac a, Integral b) => a -> b
truncate Rational
i
  readJSON JSValue
_ = String -> Result Word16
forall a. String -> Result a
mkError String
"Unable to read Word16"

instance JSON5 Word32 where
  showJSON :: Word32 -> JSValue
showJSON = Rational -> JSValue
fromJSRational (Rational -> JSValue) -> (Word32 -> Rational) -> Word32 -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  readJSON :: JSValue -> Result Word32
readJSON (JSNumber (JSRational Rational
i)) = Word32 -> Result Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Result Word32) -> Word32 -> Result Word32
forall a b. (a -> b) -> a -> b
$ Rational -> Word32
forall a b. (RealFrac a, Integral b) => a -> b
truncate Rational
i
  readJSON JSValue
_ = String -> Result Word32
forall a. String -> Result a
mkError String
"Unable to read Word32"

instance JSON5 Word64 where
  showJSON :: Word64 -> JSValue
showJSON = Rational -> JSValue
fromJSRational (Rational -> JSValue) -> (Word64 -> Rational) -> Word64 -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  readJSON :: JSValue -> Result Word64
readJSON (JSNumber (JSRational Rational
i)) = Word64 -> Result Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Result Word64) -> Word64 -> Result Word64
forall a b. (a -> b) -> a -> b
$ Rational -> Word64
forall a b. (RealFrac a, Integral b) => a -> b
truncate Rational
i
  readJSON JSValue
_ = String -> Result Word64
forall a. String -> Result a
mkError String
"Unable to read Word64"

instance JSON5 Int8 where
  showJSON :: Int8 -> JSValue
showJSON = Rational -> JSValue
fromJSRational (Rational -> JSValue) -> (Int8 -> Rational) -> Int8 -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  readJSON :: JSValue -> Result Int8
readJSON (JSNumber (JSRational Rational
i)) = Int8 -> Result Int8
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> Result Int8) -> Int8 -> Result Int8
forall a b. (a -> b) -> a -> b
$ Rational -> Int8
forall a b. (RealFrac a, Integral b) => a -> b
truncate Rational
i
  readJSON JSValue
_ = String -> Result Int8
forall a. String -> Result a
mkError String
"Unable to read Int8"

instance JSON5 Int16 where
  showJSON :: Int16 -> JSValue
showJSON = Rational -> JSValue
fromJSRational (Rational -> JSValue) -> (Int16 -> Rational) -> Int16 -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  readJSON :: JSValue -> Result Int16
readJSON (JSNumber (JSRational Rational
i)) = Int16 -> Result Int16
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16 -> Result Int16) -> Int16 -> Result Int16
forall a b. (a -> b) -> a -> b
$ Rational -> Int16
forall a b. (RealFrac a, Integral b) => a -> b
truncate Rational
i
  readJSON JSValue
_ = String -> Result Int16
forall a. String -> Result a
mkError String
"Unable to read Int16"

instance JSON5 Int32 where
  showJSON :: Int32 -> JSValue
showJSON = Rational -> JSValue
fromJSRational (Rational -> JSValue) -> (Int32 -> Rational) -> Int32 -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  readJSON :: JSValue -> Result Int32
readJSON (JSNumber (JSRational Rational
i)) = Int32 -> Result Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> Result Int32) -> Int32 -> Result Int32
forall a b. (a -> b) -> a -> b
$ Rational -> Int32
forall a b. (RealFrac a, Integral b) => a -> b
truncate Rational
i
  readJSON JSValue
_ = String -> Result Int32
forall a. String -> Result a
mkError String
"Unable to read Int32"

instance JSON5 Int64 where
  showJSON :: Int64 -> JSValue
showJSON = Rational -> JSValue
fromJSRational (Rational -> JSValue) -> (Int64 -> Rational) -> Int64 -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  readJSON :: JSValue -> Result Int64
readJSON (JSNumber (JSRational Rational
i)) = Int64 -> Result Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Result Int64) -> Int64 -> Result Int64
forall a b. (a -> b) -> a -> b
$ Rational -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
truncate Rational
i
  readJSON JSValue
_ = String -> Result Int64
forall a. String -> Result a
mkError String
"Unable to read Int64"

-- -----------------------------------------------------------------

instance JSON5 Double where
  showJSON :: Double -> JSValue
showJSON = Rational -> JSValue
fromJSRational (Rational -> JSValue) -> (Double -> Rational) -> Double -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational
  readJSON :: JSValue -> Result Double
readJSON (JSNumber (JSRational Rational
r)) = Double -> Result Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Result Double) -> Double -> Result Double
forall a b. (a -> b) -> a -> b
$ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r
  readJSON JSValue
_ = String -> Result Double
forall a. String -> Result a
mkError String
"Unable to read Double"
    -- can't use JSRational here, due to ambiguous '0' parse
    -- it will parse as Integer.

instance JSON5 Float where
  showJSON :: Float -> JSValue
showJSON = Rational -> JSValue
fromJSRational (Rational -> JSValue) -> (Float -> Rational) -> Float -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Rational
forall a. Real a => a -> Rational
toRational
  readJSON :: JSValue -> Result Float
readJSON (JSNumber (JSRational Rational
r)) = Float -> Result Float
forall (m :: * -> *) a. Monad m => a -> m a
return (Float -> Result Float) -> Float -> Result Float
forall a b. (a -> b) -> a -> b
$ Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
r
  readJSON (JSNumber (JSInfNaN Float
n))   = Float -> Result Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
n
  readJSON JSValue
_ = String -> Result Float
forall a. String -> Result a
mkError String
"Unable to read Float"

-- -----------------------------------------------------------------
-- Sums

instance (JSON5 a) => JSON5 (Maybe a) where
  readJSON :: JSValue -> Result (Maybe a)
readJSON (JSObject JSObject JSValue
o) = case String
"Just" String -> [(String, JSValue)] -> Maybe JSValue
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(String, JSValue)]
as of
      Just JSValue
x -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Result a -> Result (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> Result a
forall a. JSON5 a => JSValue -> Result a
readJSON JSValue
x
      Maybe JSValue
_      -> case (String
"Nothing" String -> [(String, JSValue)] -> Maybe JSValue
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(String, JSValue)]
as) of
          Just JSValue
JSNull -> Maybe a -> Result (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
          Maybe JSValue
_           -> String -> Result (Maybe a)
forall a. String -> Result a
mkError String
"Unable to read Maybe"
    where as :: [(String, JSValue)]
as = JSObject JSValue -> [(String, JSValue)]
forall a. JSObject a -> [(String, a)]
fromJSObject JSObject JSValue
o
  readJSON JSValue
_ = String -> Result (Maybe a)
forall a. String -> Result a
mkError String
"Unable to read Maybe"
  showJSON :: Maybe a -> JSValue
showJSON (Just a
x) = JSObject JSValue -> JSValue
JSObject (JSObject JSValue -> JSValue) -> JSObject JSValue -> JSValue
forall a b. (a -> b) -> a -> b
$ [(String, JSValue)] -> JSObject JSValue
forall a. [(String, a)] -> JSObject a
toJSObject [(String
"Just", a -> JSValue
forall a. JSON5 a => a -> JSValue
showJSON a
x)]
  showJSON Maybe a
Nothing  = JSObject JSValue -> JSValue
JSObject (JSObject JSValue -> JSValue) -> JSObject JSValue -> JSValue
forall a b. (a -> b) -> a -> b
$ [(String, JSValue)] -> JSObject JSValue
forall a. [(String, a)] -> JSObject a
toJSObject [(String
"Nothing", JSValue
JSNull)]

instance (JSON5 a, JSON5 b) => JSON5 (Either a b) where
  readJSON :: JSValue -> Result (Either a b)
readJSON (JSObject JSObject JSValue
o) = case String
"Left" String -> [(String, JSValue)] -> Maybe JSValue
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(String, JSValue)]
as of
      Just JSValue
a  -> a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> Result a -> Result (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> Result a
forall a. JSON5 a => JSValue -> Result a
readJSON JSValue
a
      Maybe JSValue
Nothing -> case String
"Right" String -> [(String, JSValue)] -> Maybe JSValue
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(String, JSValue)]
as of
          Just JSValue
b  -> b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> Result b -> Result (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> Result b
forall a. JSON5 a => JSValue -> Result a
readJSON JSValue
b
          Maybe JSValue
Nothing -> String -> Result (Either a b)
forall a. String -> Result a
mkError String
"Unable to read Either"
    where as :: [(String, JSValue)]
as = JSObject JSValue -> [(String, JSValue)]
forall a. JSObject a -> [(String, a)]
fromJSObject JSObject JSValue
o
  readJSON JSValue
_ = String -> Result (Either a b)
forall a. String -> Result a
mkError String
"Unable to read Either"
  showJSON :: Either a b -> JSValue
showJSON (Left a
a)  = JSObject JSValue -> JSValue
JSObject (JSObject JSValue -> JSValue) -> JSObject JSValue -> JSValue
forall a b. (a -> b) -> a -> b
$ [(String, JSValue)] -> JSObject JSValue
forall a. [(String, a)] -> JSObject a
toJSObject [(String
"Left",  a -> JSValue
forall a. JSON5 a => a -> JSValue
showJSON a
a)]
  showJSON (Right b
b) = JSObject JSValue -> JSValue
JSObject (JSObject JSValue -> JSValue) -> JSObject JSValue -> JSValue
forall a b. (a -> b) -> a -> b
$ [(String, JSValue)] -> JSObject JSValue
forall a. [(String, a)] -> JSObject a
toJSObject [(String
"Right", b -> JSValue
forall a. JSON5 a => a -> JSValue
showJSON b
b)]

-- -----------------------------------------------------------------
-- Products

instance JSON5 () where
  showJSON :: () -> JSValue
showJSON ()
_ = [JSValue] -> JSValue
JSArray []
  readJSON :: JSValue -> Result ()
readJSON (JSArray []) = () -> Result ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  readJSON JSValue
_      = String -> Result ()
forall a. String -> Result a
mkError String
"Unable to read ()"

instance (JSON5 a, JSON5 b) => JSON5 (a,b) where
  showJSON :: (a, b) -> JSValue
showJSON (a
a,b
b) = [JSValue] -> JSValue
JSArray [ a -> JSValue
forall a. JSON5 a => a -> JSValue
showJSON a
a, b -> JSValue
forall a. JSON5 a => a -> JSValue
showJSON b
b ]
  readJSON :: JSValue -> Result (a, b)
readJSON (JSArray [JSValue
a,JSValue
b]) = (,) (a -> b -> (a, b)) -> Result a -> Result (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` JSValue -> Result a
forall a. JSON5 a => JSValue -> Result a
readJSON JSValue
a Result (b -> (a, b)) -> Result b -> Result (a, b)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` JSValue -> Result b
forall a. JSON5 a => JSValue -> Result a
readJSON JSValue
b
  readJSON JSValue
_ = String -> Result (a, b)
forall a. String -> Result a
mkError String
"Unable to read Pair"

instance (JSON5 a, JSON5 b, JSON5 c) => JSON5 (a,b,c) where
  showJSON :: (a, b, c) -> JSValue
showJSON (a
a,b
b,c
c) = [JSValue] -> JSValue
JSArray [ a -> JSValue
forall a. JSON5 a => a -> JSValue
showJSON a
a, b -> JSValue
forall a. JSON5 a => a -> JSValue
showJSON b
b, c -> JSValue
forall a. JSON5 a => a -> JSValue
showJSON c
c ]
  readJSON :: JSValue -> Result (a, b, c)
readJSON (JSArray [JSValue
a,JSValue
b,JSValue
c]) = (,,) (a -> b -> c -> (a, b, c))
-> Result a -> Result (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
                                  JSValue -> Result a
forall a. JSON5 a => JSValue -> Result a
readJSON JSValue
a Result (b -> c -> (a, b, c)) -> Result b -> Result (c -> (a, b, c))
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap`
                                  JSValue -> Result b
forall a. JSON5 a => JSValue -> Result a
readJSON JSValue
b Result (c -> (a, b, c)) -> Result c -> Result (a, b, c)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap`
                                  JSValue -> Result c
forall a. JSON5 a => JSValue -> Result a
readJSON JSValue
c
  readJSON JSValue
_ = String -> Result (a, b, c)
forall a. String -> Result a
mkError String
"Unable to read Triple"

instance (JSON5 a, JSON5 b, JSON5 c, JSON5 d) => JSON5 (a,b,c,d) where
  showJSON :: (a, b, c, d) -> JSValue
showJSON (a
a,b
b,c
c,d
d) = [JSValue] -> JSValue
JSArray [a -> JSValue
forall a. JSON5 a => a -> JSValue
showJSON a
a, b -> JSValue
forall a. JSON5 a => a -> JSValue
showJSON b
b, c -> JSValue
forall a. JSON5 a => a -> JSValue
showJSON c
c, d -> JSValue
forall a. JSON5 a => a -> JSValue
showJSON d
d]
  readJSON :: JSValue -> Result (a, b, c, d)
readJSON (JSArray [JSValue
a,JSValue
b,JSValue
c,JSValue
d]) = (,,,) (a -> b -> c -> d -> (a, b, c, d))
-> Result a -> Result (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
                                  JSValue -> Result a
forall a. JSON5 a => JSValue -> Result a
readJSON JSValue
a Result (b -> c -> d -> (a, b, c, d))
-> Result b -> Result (c -> d -> (a, b, c, d))
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap`
                                  JSValue -> Result b
forall a. JSON5 a => JSValue -> Result a
readJSON JSValue
b Result (c -> d -> (a, b, c, d))
-> Result c -> Result (d -> (a, b, c, d))
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap`
                                  JSValue -> Result c
forall a. JSON5 a => JSValue -> Result a
readJSON JSValue
c Result (d -> (a, b, c, d)) -> Result d -> Result (a, b, c, d)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap`
                                  JSValue -> Result d
forall a. JSON5 a => JSValue -> Result a
readJSON JSValue
d

  readJSON JSValue
_ = String -> Result (a, b, c, d)
forall a. String -> Result a
mkError String
"Unable to read 4 tuple"

-- -----------------------------------------------------------------
-- List-like types


instance JSON5 a => JSON5 [a] where
  showJSON :: [a] -> JSValue
showJSON = [a] -> JSValue
forall a. JSON5 a => [a] -> JSValue
showJSONs
  readJSON :: JSValue -> Result [a]
readJSON = JSValue -> Result [a]
forall a. JSON5 a => JSValue -> Result [a]
readJSONs

-- container types:

#if !defined(MAP_AS_DICT)
instance (Ord a, JSON5 a, JSON5 b) => JSON5 (M.Map a b) where
  showJSON :: Map a b -> JSValue
showJSON = (Map a b -> [(a, b)]) -> Map a b -> JSValue
forall a b. JSON5 a => (b -> [a]) -> b -> JSValue
encJSArray Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
M.toList
  readJSON :: JSValue -> Result (Map a b)
readJSON = String -> ([(a, b)] -> Map a b) -> JSValue -> Result (Map a b)
forall a b. JSON5 a => String -> ([a] -> b) -> JSValue -> Result b
decJSArray String
"Map" [(a, b)] -> Map a b
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList

instance (JSON5 a) => JSON5 (IntMap.IntMap a) where
  showJSON :: IntMap a -> JSValue
showJSON = (IntMap a -> [(Int, a)]) -> IntMap a -> JSValue
forall a b. JSON5 a => (b -> [a]) -> b -> JSValue
encJSArray IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList
  readJSON :: JSValue -> Result (IntMap a)
readJSON = String -> ([(Int, a)] -> IntMap a) -> JSValue -> Result (IntMap a)
forall a b. JSON5 a => String -> ([a] -> b) -> JSValue -> Result b
decJSArray String
"IntMap" [(Int, a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
IntMap.fromList

#else
instance (Ord a, JSKey a, JSON5 b) => JSON5 (M.Map a b) where
  showJSON    = encJSDict . M.toList
  readJSON o  = M.fromList <$> decJSDict "Map" o

instance (JSON5 a) => JSON5 (IntMap.IntMap a) where
  {- alternate (dict) mapping: -}
  showJSON    = encJSDict . IntMap.toList
  readJSON o  = IntMap.fromList <$> decJSDict "IntMap" o
#endif


instance (Ord a, JSON5 a) => JSON5 (Set.Set a) where
  showJSON :: Set a -> JSValue
showJSON = (Set a -> [a]) -> Set a -> JSValue
forall a b. JSON5 a => (b -> [a]) -> b -> JSValue
encJSArray Set a -> [a]
forall a. Set a -> [a]
Set.toList
  readJSON :: JSValue -> Result (Set a)
readJSON = String -> ([a] -> Set a) -> JSValue -> Result (Set a)
forall a b. JSON5 a => String -> ([a] -> b) -> JSValue -> Result b
decJSArray String
"Set" [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList

instance (Array.Ix i, JSON5 i, JSON5 e) => JSON5 (Array.Array i e) where
  showJSON :: Array i e -> JSValue
showJSON = (Array i e -> [(i, e)]) -> Array i e -> JSValue
forall a b. JSON5 a => (b -> [a]) -> b -> JSValue
encJSArray Array i e -> [(i, e)]
forall i e. Ix i => Array i e -> [(i, e)]
Array.assocs
  readJSON :: JSValue -> Result (Array i e)
readJSON = String -> ([(i, e)] -> Array i e) -> JSValue -> Result (Array i e)
forall a b. JSON5 a => String -> ([a] -> b) -> JSValue -> Result b
decJSArray String
"Array" [(i, e)] -> Array i e
forall i e. Ix i => [(i, e)] -> Array i e
arrayFromList

instance JSON5 I.IntSet where
  showJSON :: IntSet -> JSValue
showJSON = (IntSet -> [Int]) -> IntSet -> JSValue
forall a b. JSON5 a => (b -> [a]) -> b -> JSValue
encJSArray IntSet -> [Int]
I.toList
  readJSON :: JSValue -> Result IntSet
readJSON = String -> ([Int] -> IntSet) -> JSValue -> Result IntSet
forall a b. JSON5 a => String -> ([a] -> b) -> JSValue -> Result b
decJSArray String
"IntSet" [Int] -> IntSet
I.fromList

-- helper functions for array / object serializers:
arrayFromList :: (Array.Ix i) => [(i,e)] -> Array.Array i e
arrayFromList :: [(i, e)] -> Array i e
arrayFromList [] = (i, i) -> [(i, e)] -> Array i e
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
Array.array (i, i)
forall a. HasCallStack => a
undefined []
arrayFromList ls :: [(i, e)]
ls@((i
i,e
_):[(i, e)]
xs) = (i, i) -> [(i, e)] -> Array i e
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
Array.array (i, i)
bnds [(i, e)]
ls
  where
  bnds :: (i, i)
bnds = ((i, e) -> (i, i) -> (i, i)) -> (i, i) -> [(i, e)] -> (i, i)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (i, e) -> (i, i) -> (i, i)
forall b b. Ord b => (b, b) -> (b, b) -> (b, b)
step (i
i,i
i) [(i, e)]
xs

  step :: (b, b) -> (b, b) -> (b, b)
step (b
ix,b
_) (b
mi,b
ma) =
    let mi1 :: b
mi1 = b -> b -> b
forall a. Ord a => a -> a -> a
min b
ix b
mi
        ma1 :: b
ma1 = b -> b -> b
forall a. Ord a => a -> a -> a
max b
ix b
ma
    in b
mi1 b -> (b, b) -> (b, b)
`seq` b
ma1 b -> (b, b) -> (b, b)
`seq` (b
mi1,b
ma1)


-- -----------------------------------------------------------------
-- ByteStrings

instance JSON5 S.ByteString where
  showJSON :: ByteString -> JSValue
showJSON = (ByteString -> String) -> ByteString -> JSValue
forall a. (a -> String) -> a -> JSValue
encJSString ByteString -> String
S.unpack
  readJSON :: JSValue -> Result ByteString
readJSON = String
-> (String -> Result ByteString) -> JSValue -> Result ByteString
forall a. String -> (String -> Result a) -> JSValue -> Result a
decJSString String
"ByteString" (ByteString -> Result ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Result ByteString)
-> (String -> ByteString) -> String -> Result ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
S.pack)

instance JSON5 L.ByteString where
  showJSON :: ByteString -> JSValue
showJSON = (ByteString -> String) -> ByteString -> JSValue
forall a. (a -> String) -> a -> JSValue
encJSString ByteString -> String
L.unpack
  readJSON :: JSValue -> Result ByteString
readJSON = String
-> (String -> Result ByteString) -> JSValue -> Result ByteString
forall a. String -> (String -> Result a) -> JSValue -> Result a
decJSString String
"Lazy.ByteString" (ByteString -> Result ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Result ByteString)
-> (String -> ByteString) -> String -> Result ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
L.pack)

-- -----------------------------------------------------------------
-- Data.Text

instance JSON5 T.Text where
  readJSON :: JSValue -> Result Text
readJSON (JSString JSString
s) = Text -> Result Text
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
T.pack (String -> Text) -> (JSString -> String) -> JSString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSString -> String
fromJSString (JSString -> Text) -> JSString -> Text
forall a b. (a -> b) -> a -> b
$ JSString
s)
  readJSON JSValue
_            = String -> Result Text
forall a. String -> Result a
mkError String
"Unable to read JSString"
  showJSON :: Text -> JSValue
showJSON              = JSString -> JSValue
JSString (JSString -> JSValue) -> (Text -> JSString) -> Text -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> JSString
toJSString (String -> JSString) -> (Text -> String) -> Text -> JSString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack


-- -----------------------------------------------------------------
-- Instance Helpers

makeObj :: [(String, JSValue)] -> JSValue
makeObj :: [(String, JSValue)] -> JSValue
makeObj = JSObject JSValue -> JSValue
JSObject (JSObject JSValue -> JSValue)
-> ([(String, JSValue)] -> JSObject JSValue)
-> [(String, JSValue)]
-> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, JSValue)] -> JSObject JSValue
forall a. [(String, a)] -> JSObject a
toJSObject

-- | Pull a value out of a JSON5 object.
valFromObj :: JSON5 a => String -> JSObject JSValue -> Result a
valFromObj :: String -> JSObject JSValue -> Result a
valFromObj String
k JSObject JSValue
o = Result a -> (JSValue -> Result a) -> Maybe JSValue -> Result a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Result a
forall a. String -> Result a
Error (String -> Result a) -> String -> Result a
forall a b. (a -> b) -> a -> b
$ String
"valFromObj: Could not find key: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
k)
                       JSValue -> Result a
forall a. JSON5 a => JSValue -> Result a
readJSON
                       (String -> [(String, JSValue)] -> Maybe JSValue
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
k (JSObject JSValue -> [(String, JSValue)]
forall a. JSObject a -> [(String, a)]
fromJSObject JSObject JSValue
o))

encJSString :: (a -> String) -> a -> JSValue
encJSString :: (a -> String) -> a -> JSValue
encJSString a -> String
f a
v = JSString -> JSValue
JSString (String -> JSString
toJSString (a -> String
f a
v))

decJSString :: String -> (String -> Result a) -> JSValue -> Result a
decJSString :: String -> (String -> Result a) -> JSValue -> Result a
decJSString String
_ String -> Result a
f (JSString JSString
s) = String -> Result a
f (JSString -> String
fromJSString JSString
s)
decJSString String
l String -> Result a
_ JSValue
_ = String -> Result a
forall a. String -> Result a
mkError (String
"readJSON{"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
lString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"}: unable to parse string value")

encJSArray :: (JSON5 a) => (b -> [a]) -> b -> JSValue
encJSArray :: (b -> [a]) -> b -> JSValue
encJSArray b -> [a]
f b
v = [a] -> JSValue
forall a. JSON5 a => a -> JSValue
showJSON (b -> [a]
f b
v)

decJSArray :: (JSON5 a) => String -> ([a] -> b) -> JSValue -> Result b
decJSArray :: String -> ([a] -> b) -> JSValue -> Result b
decJSArray String
_ [a] -> b
f a :: JSValue
a@JSArray{} = [a] -> b
f ([a] -> b) -> Result [a] -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> Result [a]
forall a. JSON5 a => JSValue -> Result a
readJSON JSValue
a
decJSArray String
l [a] -> b
_ JSValue
_ = String -> Result b
forall a. String -> Result a
mkError (String
"readJSON{"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
lString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"}: unable to parse array value")

-- | Haskell types that can be used as keys in JSON5 objects.
class JSKey a where
  toJSKey   :: a -> String
  fromJSKey :: String -> Maybe a

instance JSKey JSString where
  toJSKey :: JSString -> String
toJSKey JSString
x   = JSString -> String
fromJSString JSString
x
  fromJSKey :: String -> Maybe JSString
fromJSKey String
x = JSString -> Maybe JSString
forall a. a -> Maybe a
Just (String -> JSString
toJSString String
x)

instance JSKey Int where
  toJSKey :: Int -> String
toJSKey   = Int -> String
forall a. Show a => a -> String
show
  fromJSKey :: String -> Maybe Int
fromJSKey String
key = case ReadS Int
forall a. Read a => ReadS a
reads String
key of
                    [(Int
a,String
"")] -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
a
                    [(Int, String)]
_        -> Maybe Int
forall a. Maybe a
Nothing

-- NOTE: This prevents us from making other instances for lists but,
-- our guess is that strings are used as keys more often then other list types.
instance JSKey String where
  toJSKey :: String -> String
toJSKey   = String -> String
forall a. a -> a
id
  fromJSKey :: String -> Maybe String
fromJSKey = String -> Maybe String
forall a. a -> Maybe a
Just

-- | Encode an association list as 'JSObject' value.
encJSDict :: (JSKey a, JSON5 b) => [(a,b)] -> JSValue
encJSDict :: [(a, b)] -> JSValue
encJSDict [(a, b)]
v = [(String, JSValue)] -> JSValue
makeObj [ (a -> String
forall a. JSKey a => a -> String
toJSKey a
x, b -> JSValue
forall a. JSON5 a => a -> JSValue
showJSON b
y) | (a
x,b
y) <- [(a, b)]
v ]

-- | Decode a 'JSObject' value into an association list.
decJSDict :: (JSKey a, JSON5 b)
          => String
          -> JSValue
          -> Result [(a,b)]
decJSDict :: String -> JSValue -> Result [(a, b)]
decJSDict String
l (JSObject JSObject JSValue
o) = ((String, JSValue) -> Result (a, b))
-> [(String, JSValue)] -> Result [(a, b)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String, JSValue) -> Result (a, b)
forall a b.
(JSKey a, JSON5 b) =>
(String, JSValue) -> Result (a, b)
rd (JSObject JSValue -> [(String, JSValue)]
forall a. JSObject a -> [(String, a)]
fromJSObject JSObject JSValue
o)
  where rd :: (String, JSValue) -> Result (a, b)
rd (String
a,JSValue
b) = case String -> Maybe a
forall a. JSKey a => String -> Maybe a
fromJSKey String
a of
                     Just a
pa -> JSValue -> Result b
forall a. JSON5 a => JSValue -> Result a
readJSON JSValue
b Result b -> (b -> Result (a, b)) -> Result (a, b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
pb -> (a, b) -> Result (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
pa,b
pb)
                     Maybe a
Nothing -> String -> Result (a, b)
forall a. String -> Result a
mkError (String
"readJSON{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}:" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                    String
"unable to read dict; invalid object key")

decJSDict String
l JSValue
_ = String -> Result [(a, b)]
forall a. String -> Result a
mkError (String
"readJSON{"String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}: unable to read dict; expected JSON5 object")