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

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

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

        -- * Wrapper Types
      , JSString
      , toJSString
      , fromJSString

      , JSObject
      , toJSObject
      , fromJSObject
      , resultToEither

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

        -- ** Writing JSON
      , showJSNull, showJSBool, showJSArray
      , showJSRational, showJSRational'
      , showJSObject, showJSValue

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

      ) where

    import Text.JSON.Types
    import Text.JSON.String

    import Data.Int
    import Data.Word
    import qualified Control.Monad.Fail as Fail
    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 JSON value
    -- (either an object, array, bool, number, null)
    --
    -- This is a superset of JSON, as types other than
    -- Array and Object are allowed at the top level.
    --
    decode :: (JSON a) => String -> Result a
    decode :: String -> Result a
    decode s :: 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 a :: JSValue
    a  -> JSValue -> Result a
    forall a. JSON a => JSValue -> Result a
    readJSON JSValue
    a
                 Left err :: String
    err -> String -> Result a
    forall a. String -> Result a
    Error String
    err

    -- | Encode a Haskell value into a string, in JSON format.
    --
    -- This is a superset of JSON, as types other than
    -- Array and Object are allowed at the top level.
    --
    encode :: (JSON 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. JSON a => a -> JSValue
    showJSON)

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

    -- | Decode a String representing a strict JSON value.
    -- This follows the spec, and requires top level
    -- JSON types to be an Array or Object.
    decodeStrict :: (JSON a) => String -> Result a
    decodeStrict :: String -> Result a
    decodeStrict s :: 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 a :: JSValue
    a  -> JSValue -> Result a
    forall a. JSON a => JSValue -> Result a
    readJSON JSValue
    a
         Left err :: 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.
    -- JSON types to be an Array or Object.
    encodeStrict :: (JSON 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. JSON a => a -> JSValue
    showJSON)

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

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

      readJSONs :: JSValue -> Result [a]
      readJSONs (JSArray as :: [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. JSON a => JSValue -> Result a
    readJSON [JSValue]
    as
      readJSONs _            = String -> Result [a]
    forall a. String -> Result a
    mkError "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. JSON 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)    = a -> Either String a
    forall a b. b -> Either a b
    Right a
    a
    resultToEither (Error s :: 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
    a    <|> :: Result a -> Result a -> Result a
    <|> _ = a -> Result a
    forall a. a -> Result a
    Ok a
    a
      Error _ <|> b :: Result a
    b = Result a
    b
      empty :: Result a
    empty         = String -> Result a
    forall a. String -> Result a
    Error "empty"

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

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

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

    -- | Convenient error generation
    mkError :: String -> Result a
    mkError :: String -> Result a
    mkError s :: String
    s = String -> Result a
    forall a. String -> Result a
    Error String
    s

    --------------------------------------------------------------------
    --
    -- | To ensure we generate valid JSON, we map Haskell types to JSValue
    -- internally, then pretty print that.
    --
    instance JSON 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 f :: a -> b
    f (a :: x
    a,b :: a
    b) = (x
    a, a -> b
    f a
    b)

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

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

    instance (JSON a) => JSON (JSObject a) where
      readJSON :: JSValue -> Result (JSObject a)
    readJSON (JSObject o :: JSObject JSValue
    o) =
          let f :: (a, JSValue) -> Result (a, b)
    f (x :: a
    x,y :: JSValue
    y) = do b
    y' <- JSValue -> Result b
    forall a. JSON 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. JSON b => (a, JSValue) -> Result (a, b)
    f (JSObject JSValue -> [(String, JSValue)]
    forall e. JSObject e -> [(String, e)]
    fromJSObject JSObject JSValue
    o)
      readJSON _ = String -> Result (JSObject a)
    forall a. String -> Result a
    mkError "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. JSON 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 e. JSObject e -> [(String, e)]
    fromJSObject

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

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

    instance JSON 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 s :: JSString
    s) = case JSString -> String
    fromJSString JSString
    s of
                                [c :: Char
    c] -> Char -> Result Char
    forall (m :: * -> *) a. Monad m => a -> m a
    return Char
    c
                                _ -> String -> Result Char
    forall a. String -> Result a
    mkError "Unable to read Char"
      readJSON _            = String -> Result Char
    forall a. String -> Result a
    mkError "Unable to read Char"

      readJSONs :: JSValue -> Result String
    readJSONs (JSString s :: JSString
    s)  = String -> Result String
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JSString -> String
    fromJSString JSString
    s)
      readJSONs (JSArray a :: [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. JSON a => JSValue -> Result a
    readJSON [JSValue]
    a
      readJSONs _             = String -> Result String
    forall a. String -> Result a
    mkError "Unable to read String"

    instance JSON 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 "Ordering" String -> Result Ordering
    readOrd
        where
         readOrd :: String -> Result Ordering
    readOrd x :: String
    x =
           case String
    x of
             "LT" -> Ordering -> Result Ordering
    forall (m :: * -> *) a. Monad m => a -> m a
    return Ordering
    Prelude.LT
             "EQ" -> Ordering -> Result Ordering
    forall (m :: * -> *) a. Monad m => a -> m a
    return Ordering
    Prelude.EQ
             "GT" -> Ordering -> Result Ordering
    forall (m :: * -> *) a. Monad m => a -> m a
    return Ordering
    Prelude.GT
             _    -> String -> Result Ordering
    forall a. String -> Result a
    mkError ("Unable to read Ordering")

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

    instance JSON Integer where
      showJSON :: Integer -> JSValue
    showJSON = Bool -> Rational -> JSValue
    JSRational Bool
    False (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 (JSRational _ i :: 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 _             = String -> Result Integer
    forall a. String -> Result a
    mkError "Unable to read Integer"

    -- constrained:
    instance JSON Int where
      showJSON :: Int -> JSValue
    showJSON = Bool -> Rational -> JSValue
    JSRational Bool
    False (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 (JSRational _ i :: 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 _              = String -> Result Int
    forall a. String -> Result a
    mkError "Unable to read Int"

    -- constrained:
    instance JSON Word where
      showJSON :: Word -> JSValue
    showJSON = Bool -> Rational -> JSValue
    JSRational Bool
    False (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 (JSRational _ i :: 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 _             = String -> Result Word
    forall a. String -> Result a
    mkError "Unable to read Word"

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

    instance JSON Word8 where
      showJSON :: Word8 -> JSValue
    showJSON = Bool -> Rational -> JSValue
    JSRational Bool
    False (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 (JSRational _ i :: 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 _             = String -> Result Word8
    forall a. String -> Result a
    mkError "Unable to read Word8"

    instance JSON Word16 where
      showJSON :: Word16 -> JSValue
    showJSON = Bool -> Rational -> JSValue
    JSRational Bool
    False (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 (JSRational _ i :: 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 _             = String -> Result Word16
    forall a. String -> Result a
    mkError "Unable to read Word16"

    instance JSON Word32 where
      showJSON :: Word32 -> JSValue
    showJSON = Bool -> Rational -> JSValue
    JSRational Bool
    False (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 (JSRational _ i :: 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 _             = String -> Result Word32
    forall a. String -> Result a
    mkError "Unable to read Word32"

    instance JSON Word64 where
      showJSON :: Word64 -> JSValue
    showJSON = Bool -> Rational -> JSValue
    JSRational Bool
    False (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 (JSRational _ i :: 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 _             = String -> Result Word64
    forall a. String -> Result a
    mkError "Unable to read Word64"

    instance JSON Int8 where
      showJSON :: Int8 -> JSValue
    showJSON = Bool -> Rational -> JSValue
    JSRational Bool
    False (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 (JSRational _ i :: 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 _             = String -> Result Int8
    forall a. String -> Result a
    mkError "Unable to read Int8"

    instance JSON Int16 where
      showJSON :: Int16 -> JSValue
    showJSON = Bool -> Rational -> JSValue
    JSRational Bool
    False (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 (JSRational _ i :: 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 _             = String -> Result Int16
    forall a. String -> Result a
    mkError "Unable to read Int16"

    instance JSON Int32 where
      showJSON :: Int32 -> JSValue
    showJSON = Bool -> Rational -> JSValue
    JSRational Bool
    False (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 (JSRational _ i :: 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 _             = String -> Result Int32
    forall a. String -> Result a
    mkError "Unable to read Int32"

    instance JSON Int64 where
      showJSON :: Int64 -> JSValue
    showJSON = Bool -> Rational -> JSValue
    JSRational Bool
    False (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 (JSRational _ i :: 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 _                = String -> Result Int64
    forall a. String -> Result a
    mkError "Unable to read Int64"

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

    instance JSON Double where
      showJSON :: Double -> JSValue
    showJSON = Bool -> Rational -> JSValue
    JSRational Bool
    False (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 (JSRational _ r :: 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 _                = String -> Result Double
    forall a. String -> Result a
    mkError "Unable to read Double"
        -- can't use JSRational here, due to ambiguous '0' parse
        -- it will parse as Integer.

    instance JSON Float where
      showJSON :: Float -> JSValue
    showJSON = Bool -> Rational -> JSValue
    JSRational Bool
    True (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 (JSRational _ r :: 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 _                = String -> Result Float
    forall a. String -> Result a
    mkError "Unable to read Float"

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

    instance (JSON a) => JSON (Maybe a) where
      readJSON :: JSValue -> Result (Maybe a)
    readJSON (JSObject o :: JSObject JSValue
    o) = case "Just" String -> [(String, JSValue)] -> Maybe JSValue
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    `lookup` [(String, JSValue)]
    as of
          Just x :: 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. JSON a => JSValue -> Result a
    readJSON JSValue
    x
          _      -> case ("Nothing" String -> [(String, JSValue)] -> Maybe JSValue
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    `lookup` [(String, JSValue)]
    as) of
              Just JSNull -> Maybe a -> Result (Maybe a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing
              _           -> String -> Result (Maybe a)
    forall a. String -> Result a
    mkError "Unable to read Maybe"
        where as :: [(String, JSValue)]
    as = JSObject JSValue -> [(String, JSValue)]
    forall e. JSObject e -> [(String, e)]
    fromJSObject JSObject JSValue
    o
      readJSON _ = String -> Result (Maybe a)
    forall a. String -> Result a
    mkError "Unable to read Maybe"
      showJSON :: Maybe a -> JSValue
    showJSON (Just x :: 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 [("Just", a -> JSValue
    forall a. JSON a => a -> JSValue
    showJSON a
    x)]
      showJSON 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 [("Nothing", JSValue
    JSNull)]

    instance (JSON a, JSON b) => JSON (Either a b) where
      readJSON :: JSValue -> Result (Either a b)
    readJSON (JSObject o :: JSObject JSValue
    o) = case "Left" String -> [(String, JSValue)] -> Maybe JSValue
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    `lookup` [(String, JSValue)]
    as of
          Just a :: 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. JSON a => JSValue -> Result a
    readJSON JSValue
    a
          Nothing -> case "Right" String -> [(String, JSValue)] -> Maybe JSValue
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    `lookup` [(String, JSValue)]
    as of
              Just b :: 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. JSON a => JSValue -> Result a
    readJSON JSValue
    b
              Nothing -> String -> Result (Either a b)
    forall a. String -> Result a
    mkError "Unable to read Either"
        where as :: [(String, JSValue)]
    as = JSObject JSValue -> [(String, JSValue)]
    forall e. JSObject e -> [(String, e)]
    fromJSObject JSObject JSValue
    o
      readJSON _ = String -> Result (Either a b)
    forall a. String -> Result a
    mkError "Unable to read Either"
      showJSON :: Either a b -> JSValue
    showJSON (Left a :: 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 [("Left",  a -> JSValue
    forall a. JSON a => a -> JSValue
    showJSON a
    a)]
      showJSON (Right b :: 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 [("Right", b -> JSValue
    forall a. JSON a => a -> JSValue
    showJSON b
    b)]

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

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

    instance (JSON a, JSON b) => JSON (a,b) where
      showJSON :: (a, b) -> JSValue
    showJSON (a :: a
    a,b :: b
    b) = [JSValue] -> JSValue
    JSArray [ a -> JSValue
    forall a. JSON a => a -> JSValue
    showJSON a
    a, b -> JSValue
    forall a. JSON a => a -> JSValue
    showJSON b
    b ]
      readJSON :: JSValue -> Result (a, b)
    readJSON (JSArray [a :: JSValue
    a,b :: 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. JSON 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. JSON a => JSValue -> Result a
    readJSON JSValue
    b
      readJSON _ = String -> Result (a, b)
    forall a. String -> Result a
    mkError "Unable to read Pair"

    instance (JSON a, JSON b, JSON c) => JSON (a,b,c) where
      showJSON :: (a, b, c) -> JSValue
    showJSON (a :: a
    a,b :: b
    b,c :: c
    c) = [JSValue] -> JSValue
    JSArray [ a -> JSValue
    forall a. JSON a => a -> JSValue
    showJSON a
    a, b -> JSValue
    forall a. JSON a => a -> JSValue
    showJSON b
    b, c -> JSValue
    forall a. JSON a => a -> JSValue
    showJSON c
    c ]
      readJSON :: JSValue -> Result (a, b, c)
    readJSON (JSArray [a :: JSValue
    a,b :: JSValue
    b,c :: 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. JSON 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. JSON 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. JSON a => JSValue -> Result a
    readJSON JSValue
    c
      readJSON _ = String -> Result (a, b, c)
    forall a. String -> Result a
    mkError "Unable to read Triple"

    instance (JSON a, JSON b, JSON c, JSON d) => JSON (a,b,c,d) where
      showJSON :: (a, b, c, d) -> JSValue
    showJSON (a :: a
    a,b :: b
    b,c :: c
    c,d :: d
    d) = [JSValue] -> JSValue
    JSArray [a -> JSValue
    forall a. JSON a => a -> JSValue
    showJSON a
    a, b -> JSValue
    forall a. JSON a => a -> JSValue
    showJSON b
    b, c -> JSValue
    forall a. JSON a => a -> JSValue
    showJSON c
    c, d -> JSValue
    forall a. JSON a => a -> JSValue
    showJSON d
    d]
      readJSON :: JSValue -> Result (a, b, c, d)
    readJSON (JSArray [a :: JSValue
    a,b :: JSValue
    b,c :: JSValue
    c,d :: 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. JSON 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. JSON 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. JSON 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. JSON a => JSValue -> Result a
    readJSON JSValue
    d

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

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

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

    -- container types:

    #if !defined(MAP_AS_DICT)
    instance (Ord a, JSON a, JSON b) => JSON (M.Map a b) where
      showJSON :: Map a b -> JSValue
    showJSON = (Map a b -> [(a, b)]) -> Map a b -> JSValue
    forall a b. JSON 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. JSON a => String -> ([a] -> b) -> JSValue -> Result b
    decJSArray "Map" [(a, b)] -> Map a b
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList

    instance (JSON a) => JSON (IntMap.IntMap a) where
      showJSON :: IntMap a -> JSValue
    showJSON = (IntMap a -> [(Int, a)]) -> IntMap a -> JSValue
    forall a b. JSON 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. JSON a => String -> ([a] -> b) -> JSValue -> Result b
    decJSArray "IntMap" [(Int, a)] -> IntMap a
    forall a. [(Int, a)] -> IntMap a
    IntMap.fromList

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

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

    instance (Ord a, JSON a) => JSON (Set.Set a) where
      showJSON :: Set a -> JSValue
    showJSON = (Set a -> [a]) -> Set a -> JSValue
    forall a b. JSON 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. JSON a => String -> ([a] -> b) -> JSValue -> Result b
    decJSArray "Set" [a] -> Set a
    forall a. Ord a => [a] -> Set a
    Set.fromList

    instance (Array.Ix i, JSON i, JSON e) => JSON (Array.Array i e) where
      showJSON :: Array i e -> JSValue
    showJSON = (Array i e -> [(i, e)]) -> Array i e -> JSValue
    forall a b. JSON 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. JSON a => String -> ([a] -> b) -> JSValue -> Result b
    decJSArray "Array" [(i, e)] -> Array i e
    forall i e. Ix i => [(i, e)] -> Array i e
    arrayFromList

    instance JSON I.IntSet where
      showJSON :: IntSet -> JSValue
    showJSON = (IntSet -> [Int]) -> IntSet -> JSValue
    forall a b. JSON a => (b -> [a]) -> b -> JSValue
    encJSArray IntSet -> [Int]
    I.toList
      readJSON :: JSValue -> Result IntSet
    readJSON = String -> ([Int] -> IntSet) -> JSValue -> Result IntSet
    forall a b. JSON a => String -> ([a] -> b) -> JSValue -> Result b
    decJSArray "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
    i,_):xs :: [(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 (ix :: b
    ix,_) (mi :: b
    mi,ma :: 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)
    forall a b. a -> b -> b
    `seq` b
    ma1 b -> (b, b) -> (b, b)
    forall a b. a -> b -> b
    `seq` (b
    mi1,b
    ma1)

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

    instance JSON 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 "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 JSON 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 "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 JSON T.Text where
      readJSON :: JSValue -> Result Text
    readJSON (JSString s :: 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 _            = String -> Result Text
    forall a. String -> Result a
    mkError "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 JSON object.
    valFromObj :: JSON a => String -> JSObject JSValue -> Result a
    valFromObj :: String -> JSObject JSValue -> Result a
    valFromObj k :: String
    k o :: 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
    $ "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. JSON 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 e. JSObject e -> [(String, e)]
    fromJSObject JSObject JSValue
    o))

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

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

    decJSArray :: (JSON a) => String -> ([a] -> b) -> JSValue -> Result b
    decJSArray :: String -> ([a] -> b) -> JSValue -> Result b
    decJSArray _ f :: [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. JSON a => JSValue -> Result a
    readJSON JSValue
    a
    decJSArray l :: String
    l _ _ = String -> Result b
    forall a. String -> Result a
    mkError ("readJSON{"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    lString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++"}: unable to parse array value")

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

    instance JSKey JSString where
      toJSKey :: JSString -> String
    toJSKey x :: JSString
    x   = JSString -> String
    fromJSString JSString
    x
      fromJSKey :: String -> Maybe JSString
    fromJSKey x :: 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 key :: String
    key = case ReadS Int
    forall a. Read a => ReadS a
    reads String
    key of
                        [(a :: Int
    a,"")] -> Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    a
                        _        -> 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, JSON b) => [(a,b)] -> JSValue
    encJSDict :: [(a, b)] -> JSValue
    encJSDict v :: [(a, b)]
    v = [(String, JSValue)] -> JSValue
    makeObj [ (a -> String
    forall a. JSKey a => a -> String
    toJSKey a
    x, b -> JSValue
    forall a. JSON a => a -> JSValue
    showJSON b
    y) | (x :: a
    x,y :: b
    y) <- [(a, b)]
    v ]

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

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