-----------------------------------------------------------------------------
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
#if __GLASGOW_HASKELL__ <= 865
{-# LANGUAGE UndecidableInstances       #-}
#endif
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -Wno-orphans #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.JSON
-- Copyright   :  (C) 2016-2025 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- A JSON library specialized to MisoString for performance. Largely based
-- on [microaeson](https://hackage-content.haskell.org/package/microaeson).
--
-- Uses JS runtime primitives `JSON.stringify()` and `JSON.parse()`. 
--
----------------------------------------------------------------------------
module Miso.JSON
  ( -- * JSON
    -- ** Core JSON types
    Value(..)
  , Object
  , Pair
  , Result (..)
    -- ** Constructors
  , (.=)
  , object
  , emptyArray
  , emptyObject
    -- ** Accessors
  , (.:)
  , (.:?)
  , (.:!)
  , (.!=)
    -- * Encoding and decoding
  , encode
  , decode
    -- * Prism-style parsers
  , withObject
  , withText
  , withArray
  , withNumber
  , withBool
    -- * Type conversion
  , FromJSON(parseJSON)
  , Parser (..)
  , parseMaybe
  , ToJSON(toJSON)
  -- * Misc.
  , fromJSON
  , parseEither
  , eitherDecode
  , typeMismatch
  -- * Pretty
  , encodePretty
  , encodePretty'
  , defConfig
  , Config (..)
  -- * FFI
  , fromJSVal_Value
  , toJSVal_Value
  , jsonStringify
  , jsonParse
  -- * Options
  , Options (..)
  , defaultOptions
  -- * Generics
  , GToJSON (..)
  , genericToJSON
  , GFromJSON (..)
  , genericParseJSON
  -- * Modifiers
  , camelTo2
  ) where
----------------------------------------------------------------------------
#ifdef GHCJS_BOTH
import qualified GHCJS.Marshal as Marshal
#endif
----------------------------------------------------------------------------
import           Control.Applicative
import           Control.Monad
#if __GLASGOW_HASKELL__ <= 865
import           Control.Monad.Fail
import           GHC.Natural (Natural)
#endif
import           Data.Char
import qualified Data.Map.Strict as M
import           Data.Map.Strict (Map)
import           Data.Int
import           GHC.Natural (naturalToInteger, naturalFromInteger)
import           GHC.TypeLits
import           Data.Kind
import           Data.Word
import           GHC.Generics
import           System.IO.Unsafe (unsafePerformIO)
----------------------------------------------------------------------------
import           Miso.DSL.FFI
import           Miso.String (FromMisoString, ToMisoString, MisoString, ms, singleton, pack)
import qualified Miso.String as MS
import           Miso.JSON.Types
import qualified Miso.JSON.Parser as Parser
----------------------------------------------------------------------------
#ifndef VANILLA
import           Control.Monad.Trans.Maybe
#endif
----------------------------------------------------------------------------
infixr 8 .=
(.=) :: ToJSON v => MisoString -> v -> Pair
MisoString
k .= :: forall v. ToJSON v => MisoString -> v -> Pair
.= v
v  = (MisoString
k, v -> Value
forall a. ToJSON a => a -> Value
toJSON v
v)
----------------------------------------------------------------------------
-- | Create a 'Value' from a list of name\/value 'Pair's.
object :: [Pair] -> Value
object :: [Pair] -> Value
object = Map MisoString Value -> Value
Object (Map MisoString Value -> Value)
-> ([Pair] -> Map MisoString Value) -> [Pair] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Map MisoString Value
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
----------------------------------------------------------------------------
-- | The empty JSON 'Object' (i.e. @{}@).
emptyObject :: Value
emptyObject :: Value
emptyObject = Map MisoString Value -> Value
Object Map MisoString Value
forall a. Monoid a => a
mempty
----------------------------------------------------------------------------
-- | The empty JSON 'Array' (i.e. @[]@).
emptyArray :: Value
emptyArray :: Value
emptyArray = [Value] -> Value
Array [Value]
forall a. Monoid a => a
mempty
----------------------------------------------------------------------------
(.:) :: FromJSON a => Object -> MisoString -> Parser a
Map MisoString Value
m .: :: forall a.
FromJSON a =>
Map MisoString Value -> MisoString -> Parser a
.: MisoString
k = Parser a -> (Value -> Parser a) -> Maybe Value -> Parser a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MisoString -> Parser a
forall a. MisoString -> Parser a
pfail (MisoString
"Key not found: " MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
k)) Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON (MisoString -> Map MisoString Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MisoString
k Map MisoString Value
m)
----------------------------------------------------------------------------
(.:?) :: FromJSON a => Object -> MisoString -> Parser (Maybe a)
Map MisoString Value
m .:? :: forall a.
FromJSON a =>
Map MisoString Value -> MisoString -> Parser (Maybe a)
.:? MisoString
k = Parser (Maybe a)
-> (Value -> Parser (Maybe a)) -> Maybe Value -> Parser (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a -> Parser (Maybe a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing) Value -> Parser (Maybe a)
forall a. FromJSON a => Value -> Parser a
parseJSON (MisoString -> Map MisoString Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MisoString
k Map MisoString Value
m)
----------------------------------------------------------------------------
(.:!) :: FromJSON a => Object -> MisoString -> Parser (Maybe a)
Map MisoString Value
m .:! :: forall a.
FromJSON a =>
Map MisoString Value -> MisoString -> Parser (Maybe a)
.:! MisoString
k = Parser (Maybe a)
-> (Value -> Parser (Maybe a)) -> Maybe Value -> Parser (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a -> Parser (Maybe a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing) ((a -> Maybe a) -> Parser a -> Parser (Maybe a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Parser a -> Parser (Maybe a))
-> (Value -> Parser a) -> Value -> Parser (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON) (MisoString -> Map MisoString Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MisoString
k Map MisoString Value
m)
----------------------------------------------------------------------------
(.!=) :: Parser (Maybe a) -> a -> Parser a
Parser (Maybe a)
mv .!= :: forall a. Parser (Maybe a) -> a -> Parser a
.!= a
def = (Maybe a -> a) -> Parser (Maybe a) -> Parser a
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
def a -> a
forall a. a -> a
id) Parser (Maybe a)
mv
----------------------------------------------------------------------------
class ToJSON a where
  toJSON :: a -> Value
  default toJSON :: (Generic a, GToJSON (Rep a)) => a -> Value
  toJSON = Options -> a -> Value
forall a. (Generic a, GToJSON (Rep a)) => Options -> a -> Value
genericToJSON Options
defaultOptions
----------------------------------------------------------------------------
genericToJSON :: (Generic a, GToJSON (Rep a)) => Options -> a -> Value
genericToJSON :: forall a. (Generic a, GToJSON (Rep a)) => Options -> a -> Value
genericToJSON Options
opts = [Pair] -> Value
object ([Pair] -> Value) -> (a -> [Pair]) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> [Pair] -> Rep a (ZonkAny 1) -> [Pair]
forall a. Options -> [Pair] -> Rep a a -> [Pair]
forall (f :: * -> *) a.
GToJSON f =>
Options -> [Pair] -> f a -> [Pair]
gToJSON Options
opts [] (Rep a (ZonkAny 1) -> [Pair])
-> (a -> Rep a (ZonkAny 1)) -> a -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a (ZonkAny 1)
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from
----------------------------------------------------------------------------
data Options
  = Options
  { Options -> String -> String
fieldLabelModifier :: String -> String
  }
----------------------------------------------------------------------------
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options { fieldLabelModifier :: String -> String
fieldLabelModifier = \String
x -> String
x }
----------------------------------------------------------------------------
camelTo2 :: Char -> String -> String
camelTo2 :: Char -> String -> String
camelTo2 Char
c = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
Prelude.map Char -> Char
toLower (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
go2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
go1
    where go1 :: String -> String
go1 String
"" = String
""
          go1 (Char
x:Char
u:Char
l:String
xs) | Char -> Bool
isUpper Char
u Bool -> Bool -> Bool
&& Char -> Bool
isLower Char
l = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: Char
u Char -> String -> String
forall a. a -> [a] -> [a]
: Char
l Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go1 String
xs
          go1 (Char
x:String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go1 String
xs
          go2 :: String -> String
go2 String
"" = String
""
          go2 (Char
l:Char
u:String
xs) | Char -> Bool
isLower Char
l Bool -> Bool -> Bool
&& Char -> Bool
isUpper Char
u = Char
l Char -> String -> String
forall a. a -> [a] -> [a]
: Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: Char
u Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go2 String
xs
          go2 (Char
x:String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go2 String
xs
----------------------------------------------------------------------------
class GToJSON (f :: Type -> Type) where
  gToJSON :: Options -> [Pair] -> f a -> [Pair]
----------------------------------------------------------------------------
instance GToJSON a => GToJSON (D1 i a) where
  gToJSON :: forall a. Options -> [Pair] -> D1 i a a -> [Pair]
gToJSON Options
opts [Pair]
acc (M1 a a
x) = Options -> [Pair] -> a a -> [Pair]
forall a. Options -> [Pair] -> a a -> [Pair]
forall (f :: * -> *) a.
GToJSON f =>
Options -> [Pair] -> f a -> [Pair]
gToJSON Options
opts [Pair]
acc a a
x
----------------------------------------------------------------------------
instance GToJSON a => GToJSON (C1 i a) where
  gToJSON :: forall a. Options -> [Pair] -> C1 i a a -> [Pair]
gToJSON Options
opts [Pair]
acc (M1 a a
x) = Options -> [Pair] -> a a -> [Pair]
forall a. Options -> [Pair] -> a a -> [Pair]
forall (f :: * -> *) a.
GToJSON f =>
Options -> [Pair] -> f a -> [Pair]
gToJSON Options
opts [Pair]
acc a a
x
----------------------------------------------------------------------------
instance (GToJSON a, GToJSON b) => GToJSON (a :*: b) where
  gToJSON :: forall a. Options -> [Pair] -> (:*:) a b a -> [Pair]
gToJSON Options
opts [Pair]
acc (a a
x :*: b a
y) = Options -> [Pair] -> a a -> [Pair]
forall a. Options -> [Pair] -> a a -> [Pair]
forall (f :: * -> *) a.
GToJSON f =>
Options -> [Pair] -> f a -> [Pair]
gToJSON Options
opts [Pair]
acc a a
x [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> Options -> [Pair] -> b a -> [Pair]
forall a. Options -> [Pair] -> b a -> [Pair]
forall (f :: * -> *) a.
GToJSON f =>
Options -> [Pair] -> f a -> [Pair]
gToJSON Options
opts [Pair]
acc b a
y
----------------------------------------------------------------------------
instance (TypeError ('Text "Sum types unsupported"), GToJSON a, GToJSON b) => GToJSON (a :+: b) where
  gToJSON :: forall a. Options -> [Pair] -> (:+:) a b a -> [Pair]
gToJSON Options
opts [Pair]
acc = \case
    L1 a a
x -> Options -> [Pair] -> a a -> [Pair]
forall a. Options -> [Pair] -> a a -> [Pair]
forall (f :: * -> *) a.
GToJSON f =>
Options -> [Pair] -> f a -> [Pair]
gToJSON Options
opts [Pair]
acc a a
x
    R1 b a
x -> Options -> [Pair] -> b a -> [Pair]
forall a. Options -> [Pair] -> b a -> [Pair]
forall (f :: * -> *) a.
GToJSON f =>
Options -> [Pair] -> f a -> [Pair]
gToJSON Options
opts [Pair]
acc b a
x
----------------------------------------------------------------------------
instance GToJSON U1 where
  gToJSON :: forall a. Options -> [Pair] -> U1 a -> [Pair]
gToJSON Options
_ [Pair]
acc U1 a
U1 = [Pair]
acc
----------------------------------------------------------------------------
instance GToJSON V1 where
  gToJSON :: forall a. Options -> [Pair] -> V1 a -> [Pair]
gToJSON Options
_ [Pair]
acc V1 a
_ = [Pair]
acc
----------------------------------------------------------------------------
instance (Selector s, ToJSON a) => GToJSON (S1 s (K1 i a)) where
  gToJSON :: forall a. Options -> [Pair] -> S1 s (K1 i a) a -> [Pair]
gToJSON Options
opts [Pair]
acc (M1 (K1 a
x)) = String -> MisoString
forall str. ToMisoString str => str -> MisoString
ms String
field MisoString -> Value -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= a -> Value
forall a. ToJSON a => a -> Value
toJSON a
x Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
acc
    where
      field :: String
      field :: String
field = Options -> String -> String
fieldLabelModifier Options
opts (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ M1 S s (K1 i a) () -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
selName (M1 S s (K1 i a) ()
forall a. HasCallStack => a
undefined :: S1 s (K1 i a) ())
----------------------------------------------------------------------------
instance ToJSON () where
  toJSON :: () -> Value
toJSON () = [Value] -> Value
Array []
----------------------------------------------------------------------------
instance ToJSON Value where
  toJSON :: Value -> Value
toJSON = Value -> Value
forall a. a -> a
id
----------------------------------------------------------------------------
instance ToJSON Char where
  toJSON :: Char -> Value
toJSON Char
c = MisoString -> Value
String (Char -> MisoString
singleton Char
c)
----------------------------------------------------------------------------
instance ToJSON Bool where
  toJSON :: Bool -> Value
toJSON = Bool -> Value
Bool
----------------------------------------------------------------------------
instance ToJSON a => ToJSON [a] where
  toJSON :: [a] -> Value
toJSON = [Value] -> Value
Array ([Value] -> Value) -> ([a] -> [Value]) -> [a] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> [a] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map a -> Value
forall a. ToJSON a => a -> Value
toJSON
----------------------------------------------------------------------------
instance ToJSON v => ToJSON (M.Map MisoString v) where
  toJSON :: Map MisoString v -> Value
toJSON = Map MisoString Value -> Value
Object (Map MisoString Value -> Value)
-> (Map MisoString v -> Map MisoString Value)
-> Map MisoString v
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Value) -> Map MisoString v -> Map MisoString Value
forall a b k. (a -> b) -> Map k a -> Map k b
M.map v -> Value
forall a. ToJSON a => a -> Value
toJSON
----------------------------------------------------------------------------
instance ToJSON a => ToJSON (Maybe a) where
  toJSON :: Maybe a -> Value
toJSON = \case
    Maybe a
Nothing -> Value
Null
    Just a
a -> a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a
----------------------------------------------------------------------------
instance (ToJSON a,ToJSON b) => ToJSON (a,b) where
  toJSON :: (a, b) -> Value
toJSON (a
a,b
b) = [Value] -> Value
Array [a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a, b -> Value
forall a. ToJSON a => a -> Value
toJSON b
b]
----------------------------------------------------------------------------
instance (ToJSON a,ToJSON b,ToJSON c) => ToJSON (a,b,c) where
  toJSON :: (a, b, c) -> Value
toJSON (a
a,b
b,c
c) = [Value] -> Value
Array [a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a, b -> Value
forall a. ToJSON a => a -> Value
toJSON b
b, c -> Value
forall a. ToJSON a => a -> Value
toJSON c
c]
----------------------------------------------------------------------------
instance (ToJSON a,ToJSON b,ToJSON c, ToJSON d) => ToJSON (a,b,c,d) where
  toJSON :: (a, b, c, d) -> Value
toJSON (a
a,b
b,c
c,d
d) = [Value] -> Value
Array [a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a, b -> Value
forall a. ToJSON a => a -> Value
toJSON b
b, c -> Value
forall a. ToJSON a => a -> Value
toJSON c
c, d -> Value
forall a. ToJSON a => a -> Value
toJSON d
d]
----------------------------------------------------------------------------
instance ToJSON MisoString where
  toJSON :: MisoString -> Value
toJSON = MisoString -> Value
String
----------------------------------------------------------------------------
instance ToJSON Float where
  toJSON :: Float -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Float -> Double) -> Float -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
----------------------------------------------------------------------------
instance ToJSON Double where
  toJSON :: Double -> Value
toJSON = Double -> Value
Number
----------------------------------------------------------------------------
instance ToJSON Int    where  toJSON :: Int -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Int -> Double) -> Int -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance ToJSON Int8   where  toJSON :: Int8 -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Int8 -> Double) -> Int8 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance ToJSON Int16  where  toJSON :: Int16 -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Int16 -> Double) -> Int16 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance ToJSON Int32  where  toJSON :: Int32 -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Int32 -> Double) -> Int32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
----------------------------------------------------------------------------
instance ToJSON Word   where  toJSON :: Word -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Word -> Double) -> Word -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance ToJSON Word8  where  toJSON :: Word8 -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Word8 -> Double) -> Word8 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance ToJSON Word16 where  toJSON :: Word16 -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Word16 -> Double) -> Word16 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance ToJSON Word32 where  toJSON :: Word32 -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Word32 -> Double) -> Word32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
----------------------------------------------------------------------------
-- | Possibly lossy due to conversion to 'Double'
instance ToJSON Int64  where  toJSON :: Int64 -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Int64 -> Double) -> Int64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
----------------------------------------------------------------------------
-- | Possibly lossy due to conversion to 'Double'
instance ToJSON Word64 where  toJSON :: Word64 -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Word64 -> Double) -> Word64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
----------------------------------------------------------------------------
-- | Possibly lossy due to conversion to 'Double'
instance ToJSON Integer where toJSON :: Integer -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Integer -> Double) -> Integer -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Double
forall a. Num a => Integer -> a
fromInteger
----------------------------------------------------------------------------
-- | Possibly lossy due to conversion to 'Double'
instance ToJSON Natural where toJSON :: Natural -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Natural -> Double) -> Natural -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Double
forall a. Num a => Integer -> a
fromInteger (Integer -> Double) -> (Natural -> Integer) -> Natural -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
naturalToInteger
----------------------------------------------------------------------------
newtype Parser a = Parser { forall a. Parser a -> Either MisoString a
unParser :: Either MisoString a }
  deriving ((forall a b. (a -> b) -> Parser a -> Parser b)
-> (forall a b. a -> Parser b -> Parser a) -> Functor Parser
forall a b. a -> Parser b -> Parser a
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Parser a -> Parser b
fmap :: forall a b. (a -> b) -> Parser a -> Parser b
$c<$ :: forall a b. a -> Parser b -> Parser a
<$ :: forall a b. a -> Parser b -> Parser a
Functor, Functor Parser
Functor Parser =>
(forall a. a -> Parser a)
-> (forall a b. Parser (a -> b) -> Parser a -> Parser b)
-> (forall a b c.
    (a -> b -> c) -> Parser a -> Parser b -> Parser c)
-> (forall a b. Parser a -> Parser b -> Parser b)
-> (forall a b. Parser a -> Parser b -> Parser a)
-> Applicative Parser
forall a. a -> Parser a
forall a b. Parser a -> Parser b -> Parser a
forall a b. Parser a -> Parser b -> Parser b
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Parser a
pure :: forall a. a -> Parser a
$c<*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
<*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
$cliftA2 :: forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
liftA2 :: forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
$c*> :: forall a b. Parser a -> Parser b -> Parser b
*> :: forall a b. Parser a -> Parser b -> Parser b
$c<* :: forall a b. Parser a -> Parser b -> Parser a
<* :: forall a b. Parser a -> Parser b -> Parser a
Applicative, Applicative Parser
Applicative Parser =>
(forall a b. Parser a -> (a -> Parser b) -> Parser b)
-> (forall a b. Parser a -> Parser b -> Parser b)
-> (forall a. a -> Parser a)
-> Monad Parser
forall a. a -> Parser a
forall a b. Parser a -> Parser b -> Parser b
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
>>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
$c>> :: forall a b. Parser a -> Parser b -> Parser b
>> :: forall a b. Parser a -> Parser b -> Parser b
$creturn :: forall a. a -> Parser a
return :: forall a. a -> Parser a
Monad)
----------------------------------------------------------------------------
instance MonadFail Parser where
  fail :: forall a. String -> Parser a
fail = MisoString -> Parser a
forall a. MisoString -> Parser a
pfail (MisoString -> Parser a)
-> (String -> MisoString) -> String -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> MisoString
pack
----------------------------------------------------------------------------
instance Alternative Parser where
  empty :: forall a. Parser a
empty = Either MisoString a -> Parser a
forall a. Either MisoString a -> Parser a
Parser (MisoString -> Either MisoString a
forall a b. a -> Either a b
Left MisoString
forall a. Monoid a => a
mempty)
  Parser (Left MisoString
_) <|> :: forall a. Parser a -> Parser a -> Parser a
<|> Parser a
r = Parser a
r
  Parser a
l <|> Parser a
_ = Parser a
l
----------------------------------------------------------------------------
instance MonadPlus Parser
----------------------------------------------------------------------------
parseMaybe :: (a -> Parser b) -> a -> Maybe b
parseMaybe :: forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe a -> Parser b
m a
v =
  case (a -> Parser b) -> a -> Either MisoString b
forall a b. (a -> Parser b) -> a -> Either MisoString b
parseEither a -> Parser b
m a
v of
    Left MisoString
_ -> Maybe b
forall a. Maybe a
Nothing
    Right b
r -> b -> Maybe b
forall a. a -> Maybe a
Just b
r 
----------------------------------------------------------------------------
parseEither :: (a -> Parser b) -> a -> Either MisoString b
parseEither :: forall a b. (a -> Parser b) -> a -> Either MisoString b
parseEither a -> Parser b
m a
v = Parser b -> Either MisoString b
forall a. Parser a -> Either MisoString a
unParser (a -> Parser b
m a
v)
----------------------------------------------------------------------------
pfail :: MisoString -> Parser a
pfail :: forall a. MisoString -> Parser a
pfail MisoString
message = Either MisoString a -> Parser a
forall a. Either MisoString a -> Parser a
Parser (MisoString -> Either MisoString a
forall a b. a -> Either a b
Left MisoString
message)
----------------------------------------------------------------------------
class FromJSON a where
  parseJSON :: Value -> Parser a
  default parseJSON :: (Generic a, GFromJSON (Rep a)) => Value -> Parser a
  parseJSON = Options -> Value -> Parser a
forall a.
(Generic a, GFromJSON (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions
----------------------------------------------------------------------------
class GFromJSON (f :: Type -> Type) where
  gParseJSON :: Options -> Value -> Parser (f a)
----------------------------------------------------------------------------
genericParseJSON :: (Generic a, GFromJSON (Rep a)) => Options -> Value -> Parser a
genericParseJSON :: forall a.
(Generic a, GFromJSON (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
opts Value
value = Rep a (ZonkAny 0) -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Rep a (ZonkAny 0) -> a) -> Parser (Rep a (ZonkAny 0)) -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Options -> Value -> Parser (Rep a (ZonkAny 0))
forall a. Options -> Value -> Parser (Rep a a)
forall (f :: * -> *) a.
GFromJSON f =>
Options -> Value -> Parser (f a)
gParseJSON Options
opts Value
value
----------------------------------------------------------------------------
instance GFromJSON a => GFromJSON (D1 i a) where
  gParseJSON :: forall a. Options -> Value -> Parser (D1 i a a)
gParseJSON Options
opts Value
x = a a -> M1 D i a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> M1 D i a a) -> Parser (a a) -> Parser (M1 D i a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Options -> Value -> Parser (a a)
forall a. Options -> Value -> Parser (a a)
forall (f :: * -> *) a.
GFromJSON f =>
Options -> Value -> Parser (f a)
gParseJSON Options
opts Value
x
----------------------------------------------------------------------------
instance GFromJSON a => GFromJSON (C1 i a) where
  gParseJSON :: forall a. Options -> Value -> Parser (C1 i a a)
gParseJSON Options
opts Value
x = a a -> M1 C i a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> M1 C i a a) -> Parser (a a) -> Parser (M1 C i a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Options -> Value -> Parser (a a)
forall a. Options -> Value -> Parser (a a)
forall (f :: * -> *) a.
GFromJSON f =>
Options -> Value -> Parser (f a)
gParseJSON Options
opts Value
x
----------------------------------------------------------------------------
instance (GFromJSON a, GFromJSON b) => GFromJSON (a :*: b) where
  gParseJSON :: forall a. Options -> Value -> Parser ((:*:) a b a)
gParseJSON Options
opts Value
x = a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (a a -> b a -> (:*:) a b a)
-> Parser (a a) -> Parser (b a -> (:*:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Options -> Value -> Parser (a a)
forall a. Options -> Value -> Parser (a a)
forall (f :: * -> *) a.
GFromJSON f =>
Options -> Value -> Parser (f a)
gParseJSON Options
opts Value
x Parser (b a -> (:*:) a b a) -> Parser (b a) -> Parser ((:*:) a b a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Options -> Value -> Parser (b a)
forall a. Options -> Value -> Parser (b a)
forall (f :: * -> *) a.
GFromJSON f =>
Options -> Value -> Parser (f a)
gParseJSON Options
opts Value
x
----------------------------------------------------------------------------
instance (GFromJSON a, GFromJSON b) => GFromJSON (a :+: b) where
  gParseJSON :: forall a. Options -> Value -> Parser ((:+:) a b a)
gParseJSON Options
opts Value
x = (a a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (a a -> (:+:) a b a) -> Parser (a a) -> Parser ((:+:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Options -> Value -> Parser (a a)
forall a. Options -> Value -> Parser (a a)
forall (f :: * -> *) a.
GFromJSON f =>
Options -> Value -> Parser (f a)
gParseJSON Options
opts Value
x) Parser ((:+:) a b a)
-> Parser ((:+:) a b a) -> Parser ((:+:) a b a)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (b a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (b a -> (:+:) a b a) -> Parser (b a) -> Parser ((:+:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Options -> Value -> Parser (b a)
forall a. Options -> Value -> Parser (b a)
forall (f :: * -> *) a.
GFromJSON f =>
Options -> Value -> Parser (f a)
gParseJSON Options
opts Value
x)
----------------------------------------------------------------------------
instance GFromJSON U1 where
  gParseJSON :: forall a. Options -> Value -> Parser (U1 a)
gParseJSON Options
_ Value
_ = U1 a -> Parser (U1 a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 a
forall k (p :: k). U1 p
U1
----------------------------------------------------------------------------
instance (Selector s, FromJSON a) => GFromJSON (S1 s (K1 i a)) where
  gParseJSON :: forall a. Options -> Value -> Parser (S1 s (K1 i a) a)
gParseJSON Options
opts = \case
    Object Map MisoString Value
o ->
      K1 i a a -> S1 s (K1 i a) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 i a a -> S1 s (K1 i a) a)
-> (a -> K1 i a a) -> a -> S1 s (K1 i a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> S1 s (K1 i a) a) -> Parser a -> Parser (S1 s (K1 i a) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map MisoString Value
o Map MisoString Value -> MisoString -> Parser a
forall a.
FromJSON a =>
Map MisoString Value -> MisoString -> Parser a
.: String -> MisoString
forall str. ToMisoString str => str -> MisoString
ms String
field
    Value
v ->
      K1 i a a -> S1 s (K1 i a) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 i a a -> S1 s (K1 i a) a)
-> (a -> K1 i a a) -> a -> S1 s (K1 i a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> S1 s (K1 i a) a) -> Parser a -> Parser (S1 s (K1 i a) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    where
      field :: String
field = Options -> String -> String
fieldLabelModifier Options
opts (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ M1 S s (K1 i a) () -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
selName (M1 S s (K1 i a) ()
forall a. HasCallStack => a
undefined :: S1 s (K1 i a) ())
----------------------------------------------------------------------------
instance FromJSON Value where
  parseJSON :: Value -> Parser Value
parseJSON = Value -> Parser Value
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
----------------------------------------------------------------------------
instance FromJSON Bool where
  parseJSON :: Value -> Parser Bool
parseJSON = MisoString -> (Bool -> Parser Bool) -> Value -> Parser Bool
forall a. MisoString -> (Bool -> Parser a) -> Value -> Parser a
withBool MisoString
"Bool" Bool -> Parser Bool
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
----------------------------------------------------------------------------
instance FromJSON MisoString where
  parseJSON :: Value -> Parser MisoString
parseJSON = MisoString
-> (MisoString -> Parser MisoString) -> Value -> Parser MisoString
forall a.
MisoString -> (MisoString -> Parser a) -> Value -> Parser a
withText MisoString
"MisoString" MisoString -> Parser MisoString
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
----------------------------------------------------------------------------
instance FromJSON a => FromJSON [a] where
  parseJSON :: Value -> Parser [a]
parseJSON = MisoString -> ([Value] -> Parser [a]) -> Value -> Parser [a]
forall a. MisoString -> ([Value] -> Parser a) -> Value -> Parser a
withArray MisoString
"[a]" ((Value -> Parser a) -> [Value] -> Parser [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON)
----------------------------------------------------------------------------
instance FromJSON Double where
  parseJSON :: Value -> Parser Double
parseJSON Value
Null = Double -> Parser Double
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0)
  parseJSON Value
j    = MisoString -> (Double -> Parser Double) -> Value -> Parser Double
forall a. MisoString -> (Double -> Parser a) -> Value -> Parser a
withNumber MisoString
"Double" Double -> Parser Double
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
j
----------------------------------------------------------------------------
instance FromJSON Float where
  parseJSON :: Value -> Parser Float
parseJSON Value
Null = Float -> Parser Float
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Float
0Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
0)
  parseJSON Value
j    = MisoString -> (Double -> Parser Float) -> Value -> Parser Float
forall a. MisoString -> (Double -> Parser a) -> Value -> Parser a
withNumber MisoString
"Float" (Float -> Parser Float
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Float -> Parser Float)
-> (Double -> Float) -> Double -> Parser Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac) Value
j
----------------------------------------------------------------------------
instance FromJSON Integer where
  parseJSON :: Value -> Parser Integer
parseJSON = MisoString -> (Double -> Parser Integer) -> Value -> Parser Integer
forall a. MisoString -> (Double -> Parser a) -> Value -> Parser a
withNumber MisoString
"Integer" (Integer -> Parser Integer
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Parser Integer)
-> (Double -> Integer) -> Double -> Parser Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round)
----------------------------------------------------------------------------
instance FromJSON Natural where
  parseJSON :: Value -> Parser Natural
parseJSON = MisoString -> (Double -> Parser Natural) -> Value -> Parser Natural
forall a. MisoString -> (Double -> Parser a) -> Value -> Parser a
withNumber MisoString
"Natural" Double -> Parser Natural
forall {a}. (ToMisoString a, RealFloat a) => a -> Parser Natural
parseNumber
    where parseNumber :: a -> Parser Natural
parseNumber a
d | a
d a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = MisoString -> Parser Natural
forall a. MisoString -> Parser a
pfail (MisoString
"Cannot parse negative number as Natural: " MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> a -> MisoString
forall str. ToMisoString str => str -> MisoString
ms a
d)
                        | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
d = MisoString -> Parser Natural
forall a. MisoString -> Parser a
pfail (MisoString
"Cannot parse NaN as Natural: " MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> a -> MisoString
forall str. ToMisoString str => str -> MisoString
ms a
d)
                        | Bool
otherwise  = Natural -> Parser Natural
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> Parser Natural) -> Natural -> Parser Natural
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
naturalFromInteger (Integer -> Natural) -> Integer -> Natural
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ a -> Integer
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
round a
d 
----------------------------------------------------------------------------
instance FromJSON Int where
  parseJSON :: Value -> Parser Int
parseJSON = MisoString -> (Double -> Parser Int) -> Value -> Parser Int
forall a. MisoString -> (Double -> Parser a) -> Value -> Parser a
withNumber MisoString
"Int" (Int -> Parser Int
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Parser Int) -> (Double -> Int) -> Double -> Parser Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> (Double -> Integer) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round)
----------------------------------------------------------------------------
instance FromJSON Int8 where
  parseJSON :: Value -> Parser Int8
parseJSON = MisoString -> (Double -> Parser Int8) -> Value -> Parser Int8
forall a. MisoString -> (Double -> Parser a) -> Value -> Parser a
withNumber MisoString
"Int8" (Int8 -> Parser Int8
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int8 -> Parser Int8) -> (Double -> Int8) -> Double -> Parser Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int8
forall a. Num a => Integer -> a
fromInteger (Integer -> Int8) -> (Double -> Integer) -> Double -> Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round)
----------------------------------------------------------------------------
instance FromJSON Int16 where
  parseJSON :: Value -> Parser Int16
parseJSON = MisoString -> (Double -> Parser Int16) -> Value -> Parser Int16
forall a. MisoString -> (Double -> Parser a) -> Value -> Parser a
withNumber MisoString
"Int16" (Int16 -> Parser Int16
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int16 -> Parser Int16)
-> (Double -> Int16) -> Double -> Parser Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int16
forall a. Num a => Integer -> a
fromInteger (Integer -> Int16) -> (Double -> Integer) -> Double -> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round)
----------------------------------------------------------------------------
instance FromJSON Int32 where
  parseJSON :: Value -> Parser Int32
parseJSON = MisoString -> (Double -> Parser Int32) -> Value -> Parser Int32
forall a. MisoString -> (Double -> Parser a) -> Value -> Parser a
withNumber MisoString
"Int32" (Int32 -> Parser Int32
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int32 -> Parser Int32)
-> (Double -> Int32) -> Double -> Parser Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int32
forall a. Num a => Integer -> a
fromInteger (Integer -> Int32) -> (Double -> Integer) -> Double -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round)
----------------------------------------------------------------------------
instance FromJSON Int64 where
  parseJSON :: Value -> Parser Int64
parseJSON = MisoString -> (Double -> Parser Int64) -> Value -> Parser Int64
forall a. MisoString -> (Double -> Parser a) -> Value -> Parser a
withNumber MisoString
"Int64" (Int64 -> Parser Int64
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> Parser Int64)
-> (Double -> Int64) -> Double -> Parser Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int64
forall a. Num a => Integer -> a
fromInteger (Integer -> Int64) -> (Double -> Integer) -> Double -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round)
----------------------------------------------------------------------------
instance FromJSON Word where
  parseJSON :: Value -> Parser Word
parseJSON = MisoString -> (Double -> Parser Word) -> Value -> Parser Word
forall a. MisoString -> (Double -> Parser a) -> Value -> Parser a
withNumber MisoString
"Word" (Word -> Parser Word
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word -> Parser Word) -> (Double -> Word) -> Double -> Parser Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word
forall a. Num a => Integer -> a
fromInteger (Integer -> Word) -> (Double -> Integer) -> Double -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round)
----------------------------------------------------------------------------
instance FromJSON Word8 where
  parseJSON :: Value -> Parser Word8
parseJSON = MisoString -> (Double -> Parser Word8) -> Value -> Parser Word8
forall a. MisoString -> (Double -> Parser a) -> Value -> Parser a
withNumber MisoString
"Word8" (Word8 -> Parser Word8
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Parser Word8)
-> (Double -> Word8) -> Double -> Parser Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word8
forall a. Num a => Integer -> a
fromInteger (Integer -> Word8) -> (Double -> Integer) -> Double -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round)
----------------------------------------------------------------------------
instance FromJSON Word16 where
  parseJSON :: Value -> Parser Word16
parseJSON = MisoString -> (Double -> Parser Word16) -> Value -> Parser Word16
forall a. MisoString -> (Double -> Parser a) -> Value -> Parser a
withNumber MisoString
"Word16" (Word16 -> Parser Word16
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> Parser Word16)
-> (Double -> Word16) -> Double -> Parser Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word16
forall a. Num a => Integer -> a
fromInteger (Integer -> Word16) -> (Double -> Integer) -> Double -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round)
----------------------------------------------------------------------------
instance FromJSON Word32 where
  parseJSON :: Value -> Parser Word32
parseJSON = MisoString -> (Double -> Parser Word32) -> Value -> Parser Word32
forall a. MisoString -> (Double -> Parser a) -> Value -> Parser a
withNumber MisoString
"Word32" (Word32 -> Parser Word32
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32 -> Parser Word32)
-> (Double -> Word32) -> Double -> Parser Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word32
forall a. Num a => Integer -> a
fromInteger (Integer -> Word32) -> (Double -> Integer) -> Double -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round)
----------------------------------------------------------------------------
instance FromJSON Word64 where
  parseJSON :: Value -> Parser Word64
parseJSON = MisoString -> (Double -> Parser Word64) -> Value -> Parser Word64
forall a. MisoString -> (Double -> Parser a) -> Value -> Parser a
withNumber MisoString
"Word64" (Word64 -> Parser Word64
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Parser Word64)
-> (Double -> Word64) -> Double -> Parser Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> Word64) -> (Double -> Integer) -> Double -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round)
----------------------------------------------------------------------------
instance FromJSON () where
  parseJSON :: Value -> Parser ()
parseJSON = MisoString -> ([Value] -> Parser ()) -> Value -> Parser ()
forall a. MisoString -> ([Value] -> Parser a) -> Value -> Parser a
withArray MisoString
"()" (([Value] -> Parser ()) -> Value -> Parser ())
-> ([Value] -> Parser ()) -> Value -> Parser ()
forall a b. (a -> b) -> a -> b
$ \[Value]
lst ->
    case [Value]
lst of
      [] -> () -> Parser ()
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      [Value]
_  -> MisoString -> Parser ()
forall a. MisoString -> Parser a
pfail MisoString
"expected ()"
----------------------------------------------------------------------------
instance (FromJSON a, FromJSON b) => FromJSON (a,b) where
  parseJSON :: Value -> Parser (a, b)
parseJSON = MisoString -> ([Value] -> Parser (a, b)) -> Value -> Parser (a, b)
forall a. MisoString -> ([Value] -> Parser a) -> Value -> Parser a
withArray MisoString
"(a,b)" (([Value] -> Parser (a, b)) -> Value -> Parser (a, b))
-> ([Value] -> Parser (a, b)) -> Value -> Parser (a, b)
forall a b. (a -> b) -> a -> b
$ \[Value]
lst ->
    case [Value]
lst of
      [Value
a,Value
b] -> (a -> b -> (a, b)) -> Parser a -> Parser b -> Parser (a, b)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
a) (Value -> Parser b
forall a. FromJSON a => Value -> Parser a
parseJSON Value
b)
      [Value]
_     -> MisoString -> Parser (a, b)
forall a. MisoString -> Parser a
pfail MisoString
"expected (a,b)"
----------------------------------------------------------------------------
instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (a,b,c) where
  parseJSON :: Value -> Parser (a, b, c)
parseJSON = MisoString
-> ([Value] -> Parser (a, b, c)) -> Value -> Parser (a, b, c)
forall a. MisoString -> ([Value] -> Parser a) -> Value -> Parser a
withArray MisoString
"(a,b,c)" (([Value] -> Parser (a, b, c)) -> Value -> Parser (a, b, c))
-> ([Value] -> Parser (a, b, c)) -> Value -> Parser (a, b, c)
forall a b. (a -> b) -> a -> b
$ \[Value]
lst ->
    case [Value]
lst of
      [Value
a,Value
b,Value
c] -> (a -> b -> c -> (a, b, c))
-> Parser a -> Parser b -> Parser c -> Parser (a, b, c)
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (,,) (Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
a) (Value -> Parser b
forall a. FromJSON a => Value -> Parser a
parseJSON Value
b) (Value -> Parser c
forall a. FromJSON a => Value -> Parser a
parseJSON Value
c)
      [Value]
_       -> MisoString -> Parser (a, b, c)
forall a. MisoString -> Parser a
pfail MisoString
"expected (a,b,c)"
----------------------------------------------------------------------------
instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSON (a,b,c,d) where
  parseJSON :: Value -> Parser (a, b, c, d)
parseJSON = MisoString
-> ([Value] -> Parser (a, b, c, d)) -> Value -> Parser (a, b, c, d)
forall a. MisoString -> ([Value] -> Parser a) -> Value -> Parser a
withArray MisoString
"(a,b,c,d)" (([Value] -> Parser (a, b, c, d)) -> Value -> Parser (a, b, c, d))
-> ([Value] -> Parser (a, b, c, d)) -> Value -> Parser (a, b, c, d)
forall a b. (a -> b) -> a -> b
$ \[Value]
lst ->
    case [Value]
lst of
      [Value
a,Value
b,Value
c,Value
d] -> (a -> b -> c -> d -> (a, b, c, d))
-> Parser a
-> Parser b
-> Parser c
-> Parser d
-> Parser (a, b, c, d)
forall (m :: * -> *) a1 a2 a3 a4 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
liftM4 (,,,) (Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
a) (Value -> Parser b
forall a. FromJSON a => Value -> Parser a
parseJSON Value
b) (Value -> Parser c
forall a. FromJSON a => Value -> Parser a
parseJSON Value
c) (Value -> Parser d
forall a. FromJSON a => Value -> Parser a
parseJSON Value
d)
      [Value]
_         -> MisoString -> Parser (a, b, c, d)
forall a. MisoString -> Parser a
pfail MisoString
"expected (a,b,c,d)"
----------------------------------------------------------------------------
instance FromJSON a => FromJSON (Maybe a) where
  parseJSON :: Value -> Parser (Maybe a)
parseJSON Value
Null = Maybe a -> Parser (Maybe a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
  parseJSON Value
j    = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Parser a -> Parser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
j
----------------------------------------------------------------------------
instance FromJSON Ordering where
  parseJSON :: Value -> Parser Ordering
parseJSON = MisoString
-> (MisoString -> Parser Ordering) -> Value -> Parser Ordering
forall a.
MisoString -> (MisoString -> Parser a) -> Value -> Parser a
withText MisoString
"{'LT','EQ','GT'}" ((MisoString -> Parser Ordering) -> Value -> Parser Ordering)
-> (MisoString -> Parser Ordering) -> Value -> Parser Ordering
forall a b. (a -> b) -> a -> b
$ \MisoString
s ->
    case MisoString
s of
      MisoString
"LT" -> Ordering -> Parser Ordering
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
LT
      MisoString
"EQ" -> Ordering -> Parser Ordering
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
EQ
      MisoString
"GT" -> Ordering -> Parser Ordering
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
GT
      MisoString
_    -> MisoString -> Parser Ordering
forall a. MisoString -> Parser a
pfail MisoString
"expected {'LT','EQ','GT'}"
----------------------------------------------------------------------------
instance FromJSON Char where
  parseJSON :: Value -> Parser Char
parseJSON = MisoString -> (MisoString -> Parser Char) -> Value -> Parser Char
forall a.
MisoString -> (MisoString -> Parser a) -> Value -> Parser a
withText MisoString
"Char" ((MisoString -> Parser Char) -> Value -> Parser Char)
-> (MisoString -> Parser Char) -> Value -> Parser Char
forall a b. (a -> b) -> a -> b
$ \MisoString
xs ->
    case MisoString
xs of
     MisoString
x | MisoString -> Int
MS.length MisoString
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> Char -> Parser Char
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HasCallStack => MisoString -> Char
MisoString -> Char
MS.head MisoString
x)
       | Bool
otherwise -> MisoString -> Parser Char
forall a. MisoString -> Parser a
pfail (MisoString
"expected Char, received: " MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
x)
----------------------------------------------------------------------------
instance FromJSON v => FromJSON (Map MisoString v) where
  parseJSON :: Value -> Parser (Map MisoString v)
parseJSON = MisoString
-> (Map MisoString Value -> Parser (Map MisoString v))
-> Value
-> Parser (Map MisoString v)
forall a.
MisoString
-> (Map MisoString Value -> Parser a) -> Value -> Parser a
withObject MisoString
"FromJSON v => Map MisoString v" ((Map MisoString Value -> Parser (Map MisoString v))
 -> Value -> Parser (Map MisoString v))
-> (Map MisoString Value -> Parser (Map MisoString v))
-> Value
-> Parser (Map MisoString v)
forall a b. (a -> b) -> a -> b
$ (Value -> Parser v)
-> Map MisoString Value -> Parser (Map MisoString v)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Map MisoString a -> m (Map MisoString b)
mapM Value -> Parser v
forall a. FromJSON a => Value -> Parser a
parseJSON
----------------------------------------------------------------------------
withBool :: MisoString -> (Bool -> Parser a) -> Value -> Parser a
withBool :: forall a. MisoString -> (Bool -> Parser a) -> Value -> Parser a
withBool MisoString
_        Bool -> Parser a
f (Bool Bool
arr) = Bool -> Parser a
f Bool
arr
withBool MisoString
expected Bool -> Parser a
_ Value
v          = MisoString -> Value -> Parser a
forall a. MisoString -> Value -> Parser a
typeMismatch MisoString
expected Value
v
----------------------------------------------------------------------------
withText :: MisoString -> (MisoString -> Parser a) -> Value -> Parser a
withText :: forall a.
MisoString -> (MisoString -> Parser a) -> Value -> Parser a
withText MisoString
_        MisoString -> Parser a
f (String MisoString
txt) = MisoString -> Parser a
f MisoString
txt
withText MisoString
expected MisoString -> Parser a
_ Value
v            = MisoString -> Value -> Parser a
forall a. MisoString -> Value -> Parser a
typeMismatch MisoString
expected Value
v
----------------------------------------------------------------------------
withArray :: MisoString -> ([Value] -> Parser a) -> Value -> Parser a
withArray :: forall a. MisoString -> ([Value] -> Parser a) -> Value -> Parser a
withArray MisoString
_        [Value] -> Parser a
f (Array [Value]
lst) = [Value] -> Parser a
f [Value]
lst
withArray MisoString
expected [Value] -> Parser a
_ Value
v           = MisoString -> Value -> Parser a
forall a. MisoString -> Value -> Parser a
typeMismatch MisoString
expected Value
v
----------------------------------------------------------------------------
withObject :: MisoString -> (Object -> Parser a) -> Value -> Parser a
withObject :: forall a.
MisoString
-> (Map MisoString Value -> Parser a) -> Value -> Parser a
withObject MisoString
_        Map MisoString Value -> Parser a
f (Object Map MisoString Value
obj) = Map MisoString Value -> Parser a
f Map MisoString Value
obj
withObject MisoString
expected Map MisoString Value -> Parser a
_ Value
v            = MisoString -> Value -> Parser a
forall a. MisoString -> Value -> Parser a
typeMismatch MisoString
expected Value
v
----------------------------------------------------------------------------
withNumber :: MisoString -> (Double -> Parser a) -> Value -> Parser a
withNumber :: forall a. MisoString -> (Double -> Parser a) -> Value -> Parser a
withNumber MisoString
_        Double -> Parser a
f (Number Double
n) = Double -> Parser a
f Double
n
withNumber MisoString
expected Double -> Parser a
_ Value
v          = MisoString -> Value -> Parser a
forall a. MisoString -> Value -> Parser a
typeMismatch MisoString
expected Value
v
----------------------------------------------------------------------------
typeMismatch :: MisoString -> Value -> Parser a
typeMismatch :: forall a. MisoString -> Value -> Parser a
typeMismatch MisoString
expected Value
actual =
  MisoString -> Parser a
forall a. MisoString -> Parser a
pfail
    ( MisoString
"typeMismatch: Expected " MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
expected MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
" but encountered " MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> case Value
actual of
        Object Map MisoString Value
_ -> MisoString
"Object"
        Array [Value]
_ -> MisoString
"Array"
        String MisoString
_ -> MisoString
"String"
        Number Double
_ -> MisoString
"Number"
        Bool Bool
_ -> MisoString
"Boolean"
        Value
Null -> MisoString
"Null"
    )
----------------------------------------------------------------------------
#ifdef VANILLA
encode :: ToJSON a => a -> MisoString
encode :: forall a. ToJSON a => a -> MisoString
encode = Value -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (Value -> MisoString) -> (a -> Value) -> a -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
toJSON
#else
encode :: ToJSON a => a -> MisoString
encode x = unsafePerformIO $ jsonStringify =<< toJSVal_Value (toJSON x)
#endif
----------------------------------------------------------------------------
instance FromMisoString Value where
  fromMisoStringEither :: MisoString -> Either String Value
fromMisoStringEither = MisoString -> Either String Value
Parser.decodePure
----------------------------------------------------------------------------
instance ToMisoString Value where
  toMisoString :: Value -> MisoString
toMisoString = \case
    String MisoString
s ->
      MisoString
"\"" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
s MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
"\""
    Number Double
n ->
      Double -> MisoString
forall str. ToMisoString str => str -> MisoString
ms Double
n
    Value
Null ->
      MisoString
"null"
    Array [Value]
xs ->
      MisoString
"[" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString -> [MisoString] -> MisoString
MS.intercalate MisoString
"," ((Value -> MisoString) -> [Value] -> [MisoString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> MisoString
forall str. ToMisoString str => str -> MisoString
ms [Value]
xs) MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
"]"
    Bool Bool
True ->
      MisoString
"true"
    Bool Bool
False ->
      MisoString
"false"
    Object Map MisoString Value
o ->
      MisoString
"{" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<>
        MisoString -> [MisoString] -> MisoString
MS.intercalate MisoString
"," [ MisoString
"\"" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
k MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
"\"" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
":" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> Value -> MisoString
forall str. ToMisoString str => str -> MisoString
ms Value
v | (MisoString
k,Value
v) <- Map MisoString Value -> [Pair]
forall k a. Map k a -> [(k, a)]
M.toList Map MisoString Value
o ]
      MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
"}"
----------------------------------------------------------------------------
#ifdef VANILLA
decode :: FromJSON a => MisoString -> Maybe a
decode :: forall a. FromJSON a => MisoString -> Maybe a
decode MisoString
s
  | Right Value
x <- MisoString -> Either String Value
Parser.decodePure MisoString
s
  , Success Maybe a
v <- Value -> Result (Maybe a)
forall a. FromJSON a => Value -> Result a
fromJSON Value
x = Maybe a
v
  | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
#else
decode :: FromJSON a => MisoString -> Maybe a
decode s
  | Right x <- eitherDecode s = Just x
  | otherwise = Nothing
#endif
-----------------------------------------------------------------------------
#ifdef GHCJS_OLD
foreign import javascript unsafe
  "$r = JSON.stringify($1, null, $2)"
  encodePretty_ffi :: JSVal -> Int -> IO MisoString
#endif
-----------------------------------------------------------------------------
#ifdef GHCJS_NEW
foreign import javascript unsafe
  "(($1) => { return JSON.stringify($1, null, $2); })"
  encodePretty_ffi :: JSVal -> Int -> IO MisoString
#endif
-----------------------------------------------------------------------------
#ifdef WASM
foreign import javascript unsafe
  "return JSON.stringify($1, null, $2);"
  encodePretty_ffi :: JSVal -> Int -> IO MisoString
#endif
-----------------------------------------------------------------------------
#ifdef VANILLA
encodePretty' :: ToJSON a => Config -> a -> MisoString
encodePretty' :: forall a. ToJSON a => Config -> a -> MisoString
encodePretty' = String -> Config -> a -> MisoString
forall a. HasCallStack => String -> a
error String
"encodePretty': not implemented"
-----------------------------------------------------------------------------
encodePretty :: ToJSON a => a -> MisoString
encodePretty :: forall a. ToJSON a => a -> MisoString
encodePretty a
_ = String -> MisoString
forall a. HasCallStack => String -> a
error String
"encodePretty: not implemented"
-----------------------------------------------------------------------------
#else
-----------------------------------------------------------------------------
encodePretty' :: ToJSON a => Config -> a -> MisoString
encodePretty' (Config s) x = unsafePerformIO (flip encodePretty_ffi s =<< toJSVal_Value (toJSON x))
-----------------------------------------------------------------------------
encodePretty :: ToJSON a => a -> MisoString
encodePretty = encodePretty' defConfig
#endif
-----------------------------------------------------------------------------
newtype Config
  = Config
  { Config -> Int
spaces :: Int
  } deriving (Int -> Config -> String -> String
[Config] -> String -> String
Config -> String
(Int -> Config -> String -> String)
-> (Config -> String)
-> ([Config] -> String -> String)
-> Show Config
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Config -> String -> String
showsPrec :: Int -> Config -> String -> String
$cshow :: Config -> String
show :: Config -> String
$cshowList :: [Config] -> String -> String
showList :: [Config] -> String -> String
Show, Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
/= :: Config -> Config -> Bool
Eq)
-----------------------------------------------------------------------------
defConfig :: Config
defConfig :: Config
defConfig = Int -> Config
Config Int
4
-----------------------------------------------------------------------------
#ifdef GHCJS_OLD
foreign import javascript unsafe
  "$r = JSON.stringify($1)"
  jsonStringify :: JSVal -> IO MisoString
#endif
-----------------------------------------------------------------------------
#ifdef GHCJS_NEW
foreign import javascript unsafe
  "(($1) => { return JSON.stringify($1); })"
  jsonStringify :: JSVal -> IO MisoString
#endif
-----------------------------------------------------------------------------
#ifdef WASM
foreign import javascript unsafe
  "return JSON.stringify($1);"
  jsonStringify :: JSVal -> IO MisoString
#endif
-----------------------------------------------------------------------------
#ifdef VANILLA
jsonStringify :: JSVal -> IO MisoString
jsonStringify :: JSVal -> IO MisoString
jsonStringify JSVal
_ = String -> IO MisoString
forall a. HasCallStack => String -> a
error String
"jsonStringify: not implemented"
#endif
-----------------------------------------------------------------------------
#ifdef GHCJS_OLD
foreign import javascript unsafe
  "$r = JSON.parse($1)"
  jsonParse :: MisoString -> IO JSVal
#endif
-----------------------------------------------------------------------------
#ifdef GHCJS_NEW
foreign import javascript unsafe
  "(($1) => { return JSON.parse($1); })"
  jsonParse :: MisoString -> IO JSVal
#endif
-----------------------------------------------------------------------------
#ifdef WASM
foreign import javascript unsafe
  "return JSON.parse($1);"
  jsonParse :: MisoString -> IO JSVal
#endif
-----------------------------------------------------------------------------
#ifdef VANILLA
jsonParse :: MisoString -> IO JSVal
jsonParse :: MisoString -> IO JSVal
jsonParse MisoString
_ = String -> IO JSVal
forall a. HasCallStack => String -> a
error String
"jsonParse: not implemented"
#endif
-----------------------------------------------------------------------------
eitherDecode :: FromJSON a => MisoString -> Either MisoString a
eitherDecode :: forall a. FromJSON a => MisoString -> Either MisoString a
eitherDecode MisoString
string = IO (Either MisoString a) -> Either MisoString a
forall a. IO a -> a
unsafePerformIO (IO (Either MisoString a) -> Either MisoString a)
-> IO (Either MisoString a) -> Either MisoString a
forall a b. (a -> b) -> a -> b
$ do
  (MisoString -> IO JSVal
jsonParse MisoString
string IO JSVal -> (JSVal -> IO (Maybe Value)) -> IO (Maybe Value)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> IO (Maybe Value)
fromJSVal_Value) IO (Maybe Value)
-> (Maybe Value -> IO (Either MisoString a))
-> IO (Either MisoString a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe Value
Nothing ->
      Either MisoString a -> IO (Either MisoString a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either MisoString a -> IO (Either MisoString a))
-> Either MisoString a -> IO (Either MisoString a)
forall a b. (a -> b) -> a -> b
$ MisoString -> Either MisoString a
forall a b. a -> Either a b
Left (MisoString
"eitherDecode: " MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
string)
    Just Value
result ->
      Either MisoString a -> IO (Either MisoString a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (case Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON Value
result of
        Success a
x -> a -> Either MisoString a
forall a b. b -> Either a b
Right a
x
        Error MisoString
err -> MisoString -> Either MisoString a
forall a b. a -> Either a b
Left MisoString
err)
----------------------------------------------------------------------------
fromJSON :: FromJSON a => Value -> Result a
fromJSON :: forall a. FromJSON a => Value -> Result a
fromJSON Value
value =
  case (Value -> Parser a) -> Value -> Either MisoString a
forall a b. (a -> Parser b) -> a -> Either MisoString b
parseEither Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value of
    Left MisoString
s -> MisoString -> Result a
forall a. MisoString -> Result a
Error MisoString
s
    Right a
x -> a -> Result a
forall a. a -> Result a
Success a
x
----------------------------------------------------------------------------
#ifdef GHCJS_BOTH
toJSVal_Value :: Value -> IO JSVal
toJSVal_Value = \case
  Null ->
    pure jsNull
  Bool bool_ ->
    Marshal.toJSVal bool_
  String string ->
    Marshal.toJSVal string
  Number double ->
    Marshal.toJSVal double
  Array arr ->
    toJSVal_List =<< mapM toJSVal_Value arr
  Object hms -> do
    o <- create_ffi
    forM_ (M.toList hms) $ \(k,v) -> do
      v' <- toJSVal_Value v
      setProp_ffi k v' o
    pure o
#endif
-----------------------------------------------------------------------------
#ifdef GHCJS_BOTH
fromJSVal_Value :: JSVal -> IO (Maybe Value)
fromJSVal_Value jsval_ = do
  typeof jsval_ >>= \case
    0 -> return (Just Null)
    1 -> Just . Number <$> Marshal.fromJSValUnchecked jsval_
    2 -> Just . String <$> Marshal.fromJSValUnchecked jsval_
    3 -> fromJSValUnchecked_Int jsval_ >>= \case
      0 -> pure $ Just (Bool False)
      1 -> pure $ Just (Bool True)
      _ -> pure Nothing
    4 -> do xs <- Marshal.fromJSValUnchecked jsval_
            values <- forM xs fromJSVal_Value
            pure (Array <$> sequence values)
    5 -> do keys <- Marshal.fromJSValUnchecked =<< listProps_ffi jsval_
            result <-
              runMaybeT $ forM keys $ \k -> do
                key <- MaybeT (Marshal.fromJSVal k)
                raw <- MaybeT $ Just <$> getProp_ffi key jsval_
                value <- MaybeT (fromJSVal_Value raw)
                pure (key, value)
            pure (toObject <$> result)
    _ -> error "fromJSVal_Value: Unknown JSON type"
  where
    toObject = Object . M.fromList
#endif
-----------------------------------------------------------------------------
#ifdef WASM
fromJSVal_Value :: JSVal -> IO (Maybe Value)
fromJSVal_Value jsval = do
  typeof jsval >>= \case
    0 -> return (Just Null)
    1 -> Just . Number <$> fromJSValUnchecked_Double jsval
    2 -> pure $ Just $ String $ (JSString jsval)
    3 -> fromJSValUnchecked_Int jsval >>= \case
      0 -> pure $ Just (Bool False)
      1 -> pure $ Just (Bool True)
      _ -> pure Nothing
    4 -> do xs <- fromJSValUnchecked_List jsval
            values <- forM xs fromJSVal_Value
            pure (Array <$> sequence values)
    5 -> do keys <- fromJSValUnchecked_List =<< listProps_ffi jsval
            result <-
              runMaybeT $ forM keys $ \k -> do
                let key = JSString k
                raw <- MaybeT $ Just <$> getProp_ffi key jsval
                value <- MaybeT (fromJSVal_Value raw)
                pure (key, value)
            pure (toObject <$> result)
    _ -> error "fromJSVal_Value: Unknown JSON type"
  where
    toObject = Object . M.fromList
#endif
-----------------------------------------------------------------------------
#ifdef VANILLA
-----------------------------------------------------------------------------
fromJSVal_Value :: JSVal -> IO (Maybe Value)
fromJSVal_Value :: JSVal -> IO (Maybe Value)
fromJSVal_Value = String -> JSVal -> IO (Maybe Value)
forall a. HasCallStack => String -> a
error String
"fromJSVal_Value: not implemented"
-----------------------------------------------------------------------------
toJSVal_Value :: Value -> IO JSVal
toJSVal_Value :: Value -> IO JSVal
toJSVal_Value = String -> Value -> IO JSVal
forall a. HasCallStack => String -> a
error String
"toJSVal_Value: not implemented"
-----------------------------------------------------------------------------
#endif
-----------------------------------------------------------------------------
#ifdef GHCJS_NEW
foreign import javascript unsafe
  "(($1) => { return globalThis.miso.typeOf($1); })"
  typeof :: JSVal -> IO Int
#endif
-----------------------------------------------------------------------------
#ifdef WASM
foreign import javascript unsafe
 "return globalThis.miso.typeOf($1);"
  typeof :: JSVal -> IO Int
#endif
-----------------------------------------------------------------------------
#ifdef GHCJS_OLD
foreign import javascript unsafe
  "$r = globalThis.miso.typeOf($1);"
  typeof :: JSVal -> IO Int
#endif
-----------------------------------------------------------------------------
#ifdef WASM
toJSVal_Value :: Value -> IO JSVal
toJSVal_Value = \case
  Null ->
    pure jsNull
  Bool bool_ ->
    toJSVal_Bool bool_
  String string ->
    toJSVal_JSString string
  Number double ->
    toJSVal_Double double
  Array arr ->
    toJSVal_List =<< mapM toJSVal_Value arr
  Object hms -> do
    o <- create_ffi
    forM_ (M.toList hms) $ \(k,v) -> do
      v' <- toJSVal_Value v
      setProp_ffi k v' o
    pure o
#endif
-----------------------------------------------------------------------------