{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE InstanceSigs          #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TupleSections         #-}

module HaskellWorks.Data.Json.Value where

import qualified Data.Attoparsec.ByteString.Char8       as ABC
import qualified Data.ByteString                        as BS
import           HaskellWorks.Data.Decode
import           HaskellWorks.Data.Json.Succinct.Index
import           HaskellWorks.Data.Json.Value.Internal

data JsonValue
  = JsonString String
  | JsonNumber Double
  | JsonObject [(String, 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
/= :: JsonValue -> JsonValue -> Bool
$c/= :: JsonValue -> JsonValue -> Bool
== :: JsonValue -> JsonValue -> Bool
$c== :: 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
showList :: [JsonValue] -> ShowS
$cshowList :: [JsonValue] -> ShowS
show :: JsonValue -> String
$cshow :: JsonValue -> String
showsPrec :: Int -> JsonValue -> ShowS
$cshowsPrec :: Int -> 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. (Parser t, 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 (String -> JsonValue
JsonString 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 -> [(String, JsonValue)] -> JsonValue
JsonObject ([(String, JsonValue)] -> JsonValue)
-> Either DecodeError [(String, JsonValue)]
-> Either DecodeError JsonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ByteString, JsonIndex) -> Either DecodeError (String, JsonValue))
-> [(ByteString, JsonIndex)]
-> Either DecodeError [(String, JsonValue)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(ByteString, JsonIndex)
f -> (,) (String -> JsonValue -> (String, JsonValue))
-> Either DecodeError String
-> Either DecodeError (JsonValue -> (String, JsonValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either DecodeError String
parseString ((ByteString, JsonIndex) -> ByteString
forall a b. (a, b) -> a
fst (ByteString, JsonIndex)
f) Either DecodeError (JsonValue -> (String, JsonValue))
-> Either DecodeError JsonValue
-> Either DecodeError (String, JsonValue)
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)
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 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. (Parser t, 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