module Haddock.Utils.Json.Types
( Value (..)
, typeOf
, Pair
, Object
, object
) where
import Data.String
data Value
= Object !Object
| Array [Value]
| String String
| Number !Double
| Bool !Bool
| Null
deriving (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, ReadPrec [Value]
ReadPrec Value
Int -> ReadS Value
ReadS [Value]
(Int -> ReadS Value)
-> ReadS [Value]
-> ReadPrec Value
-> ReadPrec [Value]
-> Read Value
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Value
readsPrec :: Int -> ReadS Value
$creadList :: ReadS [Value]
readList :: ReadS [Value]
$creadPrec :: ReadPrec Value
readPrec :: ReadPrec Value
$creadListPrec :: ReadPrec [Value]
readListPrec :: ReadPrec [Value]
Read, Int -> Value -> ShowS
[Value] -> ShowS
Value -> [Char]
(Int -> Value -> ShowS)
-> (Value -> [Char]) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> [Char]
show :: Value -> [Char]
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show)
typeOf :: Value -> String
typeOf :: Value -> [Char]
typeOf Value
v = case Value
v of
Object [Pair]
_ -> [Char]
"Object"
Array [Value]
_ -> [Char]
"Array"
String [Char]
_ -> [Char]
"String"
Number Double
_ -> [Char]
"Number"
Bool Bool
_ -> [Char]
"Boolean"
Value
Null -> [Char]
"Null"
type Pair = (String, Value)
type Object = [Pair]
object :: [Pair] -> Value
object :: [Pair] -> Value
object = [Pair] -> Value
Object
instance IsString Value where
fromString :: [Char] -> Value
fromString = [Char] -> Value
String