{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module HaskellWorks.Data.Json.Value where
import Data.Text (Text)
import HaskellWorks.Data.Json.DecodeError
import HaskellWorks.Data.Json.Internal.Index
import HaskellWorks.Data.Json.Internal.Value
import qualified Data.Attoparsec.ByteString.Char8 as ABC
import qualified Data.ByteString as BS
import qualified Data.Text as T
data JsonValue
= JsonString Text
| JsonNumber Double
| JsonObject [(Text, JsonValue)]
| JsonArray [JsonValue]
| JsonBool Bool
| JsonNull
deriving (JsonValue -> JsonValue -> Bool
(JsonValue -> JsonValue -> Bool)
-> (JsonValue -> JsonValue -> Bool) -> Eq JsonValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JsonValue -> JsonValue -> Bool
== :: JsonValue -> JsonValue -> Bool
$c/= :: JsonValue -> JsonValue -> Bool
/= :: JsonValue -> JsonValue -> Bool
Eq, Int -> JsonValue -> ShowS
[JsonValue] -> ShowS
JsonValue -> String
(Int -> JsonValue -> ShowS)
-> (JsonValue -> String)
-> ([JsonValue] -> ShowS)
-> Show JsonValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JsonValue -> ShowS
showsPrec :: Int -> JsonValue -> ShowS
$cshow :: JsonValue -> String
show :: JsonValue -> String
$cshowList :: [JsonValue] -> ShowS
showList :: [JsonValue] -> ShowS
Show)
class JsonValueAt a where
jsonValueAt :: a -> Either DecodeError JsonValue
instance JsonValueAt JsonIndex where
jsonValueAt :: JsonIndex -> Either DecodeError JsonValue
jsonValueAt JsonIndex
i = case JsonIndex
i of
JsonIndexString ByteString
s -> case Parser String -> ByteString -> Result String
forall a. Parser a -> ByteString -> Result a
ABC.parse Parser String
forall t u. (Parser t u, IsString t) => Parser t String
parseJsonString ByteString
s of
ABC.Fail {} -> DecodeError -> Either DecodeError JsonValue
forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError (String
"Invalid string: '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Int -> ByteString -> ByteString
BS.take Int
20 ByteString
s) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"...'"))
ABC.Partial ByteString -> Result String
_ -> DecodeError -> Either DecodeError JsonValue
forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError String
"Unexpected end of string")
ABC.Done ByteString
_ String
r -> JsonValue -> Either DecodeError JsonValue
forall a b. b -> Either a b
Right (Text -> JsonValue
JsonString (String -> Text
T.pack String
r))
JsonIndexNumber ByteString
s -> case Parser Double -> ByteString -> Result Double
forall a. Parser a -> ByteString -> Result a
ABC.parse Parser Double
forall a. Fractional a => Parser a
ABC.rational ByteString
s of
ABC.Fail {} -> DecodeError -> Either DecodeError JsonValue
forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError (String
"Invalid number: '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Int -> ByteString -> ByteString
BS.take Int
20 ByteString
s) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"...'"))
ABC.Partial ByteString -> Result Double
f -> case ByteString -> Result Double
f ByteString
" " of
ABC.Fail {} -> DecodeError -> Either DecodeError JsonValue
forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError (String
"Invalid number: '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Int -> ByteString -> ByteString
BS.take Int
20 ByteString
s) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"...'"))
ABC.Partial ByteString -> Result Double
_ -> DecodeError -> Either DecodeError JsonValue
forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError String
"Unexpected end of number")
ABC.Done ByteString
_ Double
r -> JsonValue -> Either DecodeError JsonValue
forall a b. b -> Either a b
Right (Double -> JsonValue
JsonNumber Double
r)
ABC.Done ByteString
_ Double
r -> JsonValue -> Either DecodeError JsonValue
forall a b. b -> Either a b
Right (Double -> JsonValue
JsonNumber Double
r)
JsonIndexObject [(ByteString, JsonIndex)]
fs -> [(Text, JsonValue)] -> JsonValue
JsonObject ([(Text, JsonValue)] -> JsonValue)
-> Either DecodeError [(Text, JsonValue)]
-> Either DecodeError JsonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ByteString, JsonIndex) -> Either DecodeError (Text, JsonValue))
-> [(ByteString, JsonIndex)]
-> Either DecodeError [(Text, JsonValue)]
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 (\(ByteString, JsonIndex)
f -> (,) (Text -> JsonValue -> (Text, JsonValue))
-> Either DecodeError Text
-> Either DecodeError (JsonValue -> (Text, JsonValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either DecodeError Text
parseText ((ByteString, JsonIndex) -> ByteString
forall a b. (a, b) -> a
fst (ByteString, JsonIndex)
f) Either DecodeError (JsonValue -> (Text, JsonValue))
-> Either DecodeError JsonValue
-> Either DecodeError (Text, JsonValue)
forall a b.
Either DecodeError (a -> b)
-> Either DecodeError a -> Either DecodeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JsonIndex -> Either DecodeError JsonValue
forall a. JsonValueAt a => a -> Either DecodeError JsonValue
jsonValueAt ((ByteString, JsonIndex) -> JsonIndex
forall a b. (a, b) -> b
snd (ByteString, JsonIndex)
f)) [(ByteString, JsonIndex)]
fs
JsonIndexArray [JsonIndex]
es -> [JsonValue] -> JsonValue
JsonArray ([JsonValue] -> JsonValue)
-> Either DecodeError [JsonValue] -> Either DecodeError JsonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JsonIndex -> Either DecodeError JsonValue)
-> [JsonIndex] -> Either DecodeError [JsonValue]
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 JsonIndex -> Either DecodeError JsonValue
forall a. JsonValueAt a => a -> Either DecodeError JsonValue
jsonValueAt [JsonIndex]
es
JsonIndexBool Bool
v -> JsonValue -> Either DecodeError JsonValue
forall a b. b -> Either a b
Right (Bool -> JsonValue
JsonBool Bool
v)
JsonIndex
JsonIndexNull -> JsonValue -> Either DecodeError JsonValue
forall a b. b -> Either a b
Right JsonValue
JsonNull
where parseText :: ByteString -> Either DecodeError Text
parseText ByteString
bs = String -> Text
T.pack (String -> Text)
-> Either DecodeError String -> Either DecodeError Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either DecodeError String
parseString ByteString
bs
parseString :: ByteString -> Either DecodeError String
parseString ByteString
bs = case Parser String -> ByteString -> Result String
forall a. Parser a -> ByteString -> Result a
ABC.parse Parser String
forall t u. (Parser t u, IsString t) => Parser t String
parseJsonString ByteString
bs of
ABC.Fail {} -> DecodeError -> Either DecodeError String
forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError (String
"Invalid field: '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Int -> ByteString -> ByteString
BS.take Int
20 ByteString
bs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"...'"))
ABC.Partial ByteString -> Result String
_ -> DecodeError -> Either DecodeError String
forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError String
"Unexpected end of field")
ABC.Done ByteString
_ String
s -> String -> Either DecodeError String
forall a b. b -> Either a b
Right String
s