{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Miso.JSON
(
Value(..)
, Object
, Pair
, Result (..)
, (.=)
, object
, emptyArray
, emptyObject
, (.:)
, (.:?)
, (.:!)
, (.!=)
, encode
, decode
, withObject
, withText
, withArray
, withNumber
, withBool
, FromJSON(parseJSON)
, Parser, parseMaybe
, ToJSON(toJSON)
, fromJSON
, parseEither
, eitherDecode
, typeMismatch
, encodePretty
, encodePretty'
, defConfig
, Config (..)
, fromJSVal_Value
, toJSVal_Value
, jsonStringify
, jsonParse
, Options (..)
, defaultOptions
, GToJSON (..)
, genericToJSON
, GFromJSON (..)
, genericParseJSON
, camelTo2
) where
#ifdef GHCJS_BOTH
import qualified GHCJS.Marshal as Marshal
#endif
import Control.Applicative
import Control.Monad
import Data.Char
import qualified Data.Map.Strict as M
import Data.Map.Strict (Map)
import Data.Int
import Data.Kind
import Data.Word
import Data.String
import GHC.Generics
import System.IO.Unsafe (unsafePerformIO)
import Miso.DSL.FFI
import Miso.String (MisoString, ms, singleton)
#ifndef VANILLA
import Control.Monad.Trans.Maybe
#endif
(.=) :: 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)
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
emptyObject :: Value
emptyObject :: Value
emptyObject = Map MisoString Value -> Value
Object Map MisoString Value
forall a. Monoid a => a
mempty
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") 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 (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
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
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
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
newtype Parser a = P { forall a. Parser a -> Either MisoString a
unP :: 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 Alternative Parser where
empty :: forall a. Parser a
empty = Either MisoString a -> Parser a
forall a. Either MisoString a -> Parser a
P (MisoString -> Either MisoString a
forall a b. a -> Either a b
Left MisoString
forall a. Monoid a => a
mempty)
P (Left MisoString
_) <|> :: forall a. Parser a -> Parser a -> Parser a
<|> Parser a
r = Parser a
r
Parser a
l <|> Parser a
_ = Parser a
l
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
unP (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
P (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 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 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
"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
_ = MisoString -> Parser a
forall a. MisoString -> Parser a
pfail (MisoString
"expected " MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
expected)
encode :: ToJSON a => a -> MisoString
encode :: forall a. ToJSON a => a -> MisoString
encode a
x = IO MisoString -> MisoString
forall a. IO a -> a
unsafePerformIO (IO MisoString -> MisoString) -> IO MisoString -> MisoString
forall a b. (a -> b) -> a -> b
$ JSVal -> IO MisoString
jsonStringify (JSVal -> IO MisoString) -> IO JSVal -> IO MisoString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> IO JSVal
toJSVal_Value (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
x)
decode :: FromJSON a => MisoString -> Maybe a
decode :: forall a. FromJSON a => MisoString -> Maybe a
decode MisoString
s
| Right a
x <- MisoString -> Either MisoString a
forall a. FromJSON a => MisoString -> Either MisoString a
eitherDecode MisoString
s = a -> Maybe a
forall a. a -> Maybe a
Just a
x
| Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
#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' = Config -> a -> MisoString
forall a. HasCallStack => a
undefined
encodePretty :: ToJSON a => a -> MisoString
encodePretty :: forall a. ToJSON a => a -> MisoString
encodePretty a
_ = MisoString
forall a. HasCallStack => a
undefined
#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
_ = IO MisoString
forall a. HasCallStack => a
undefined
#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
_ = IO JSVal
forall a. HasCallStack => a
undefined
#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)
data Value
= Number Double
| Bool Bool
| String MisoString
| Array [Value]
| Object (Map MisoString Value)
| Null
deriving (Int -> Value -> String -> String
[Value] -> String -> String
Value -> String
(Int -> Value -> String -> String)
-> (Value -> String) -> ([Value] -> String -> String) -> Show Value
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Value -> String -> String
showsPrec :: Int -> Value -> String -> String
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> String -> String
showList :: [Value] -> String -> String
Show, Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq)
instance IsString Value where
fromString :: String -> Value
fromString = MisoString -> Value
String (MisoString -> Value) -> (String -> MisoString) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> MisoString
forall a. IsString a => String -> a
fromString
type Pair = (MisoString, Value)
type Object = Map MisoString Value
data Result a
= Success a
| Error MisoString
deriving (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
$cshowsPrec :: forall a. Show a => Int -> Result a -> String -> String
showsPrec :: Int -> Result a -> String -> String
$cshow :: forall a. Show a => Result a -> String
show :: Result a -> String
$cshowList :: forall a. Show a => [Result a] -> String -> String
showList :: [Result a] -> String -> String
Show, 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
$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
/= :: Result a -> Result a -> Bool
Eq)
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 = JSVal -> IO (Maybe Value)
forall a. HasCallStack => a
undefined
toJSVal_Value :: Value -> IO JSVal
toJSVal_Value :: Value -> IO JSVal
toJSVal_Value = Value -> IO JSVal
forall a. HasCallStack => a
undefined
#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