{-# 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

-- | Traditional JSON type.
--
-- This type has the a constructor per JSON data type as is typical for JSON in most libraries.
--
-- See 'jsonValueAt' on how to parse JSON text into this datatype.
--
-- Although Haskell data types are lazy by default, you will not get a fully lazy data structure
-- when parsing to this type because there is no way to express parsing errors in this datatype.
--
-- For a data type that gives you lazier behaviour, see other alternatives such as
-- 'HaskellWorks.Data.Json.PartialValue.JsonPartialValue' or 'HaskellWorks.Data.Json.LightJson.LightJson'.
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
  -- | Get a JSON value from another type
  --
  -- The @hw-json@ library does not do full JSON validation for efficiency reasons, but parsing can
  -- fail if the JSON is malformed.  When parsing fails, then 'Left' will be returned.
  --
  -- If 'Right' is returned then that means there are no parsing failures, which implies "knowing"
  -- that there parsing failures in the entire document, which implies that pattern matching on
  -- 'Right' evaluates the entire document.
  --
  -- This limits the laziness of the JSON parsing.  For lazier alternatives, see
  -- 'HaskellWorks.Data.Json.PartialValue.jsonPartialJsonValueAt' or 'HaskellWorks.Data.Json.LightJson.lightJsonAt'.
  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)) -- TODO optimise
    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 -- TODO optimise
          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