{-# 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
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
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
  -- | 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 forall a. Parser a -> ByteString -> Result a
ABC.parse forall t u. (Parser t u, IsString t) => Parser t String
parseJsonString ByteString
s of
      ABC.Fail    {}  -> forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError (String
"Invalid string: '" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int -> ByteString -> ByteString
BS.take Int
20 ByteString
s) forall a. [a] -> [a] -> [a]
++ String
"...'"))
      ABC.Partial ByteString -> IResult ByteString String
_   -> forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError String
"Unexpected end of string")
      ABC.Done    ByteString
_ String
r -> forall a b. b -> Either a b
Right (Text -> JsonValue
JsonString (String -> Text
T.pack String
r)) -- TODO optimise
    JsonIndexNumber  ByteString
s  -> case forall a. Parser a -> ByteString -> Result a
ABC.parse forall a. Fractional a => Parser a
ABC.rational ByteString
s of
      ABC.Fail    {}    -> forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError (String
"Invalid number: '" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int -> ByteString -> ByteString
BS.take Int
20 ByteString
s) forall a. [a] -> [a] -> [a]
++ String
"...'"))
      ABC.Partial ByteString -> IResult ByteString Double
f     -> case ByteString -> IResult ByteString Double
f ByteString
" " of
        ABC.Fail    {}  -> forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError (String
"Invalid number: '" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int -> ByteString -> ByteString
BS.take Int
20 ByteString
s) forall a. [a] -> [a] -> [a]
++ String
"...'"))
        ABC.Partial ByteString -> IResult ByteString Double
_   -> forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError String
"Unexpected end of number")
        ABC.Done    ByteString
_ Double
r -> forall a b. b -> Either a b
Right (Double -> JsonValue
JsonNumber Double
r)
      ABC.Done    ByteString
_ Double
r   -> forall a b. b -> Either a b
Right (Double -> JsonValue
JsonNumber Double
r)
    JsonIndexObject  [(ByteString, JsonIndex)]
fs -> [(Text, JsonValue)] -> JsonValue
JsonObject forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(ByteString, JsonIndex)
f -> (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either DecodeError Text
parseText (forall a b. (a, b) -> a
fst (ByteString, JsonIndex)
f) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. JsonValueAt a => a -> Either DecodeError JsonValue
jsonValueAt (forall a b. (a, b) -> b
snd (ByteString, JsonIndex)
f)) [(ByteString, JsonIndex)]
fs
    JsonIndexArray   [JsonIndex]
es -> [JsonValue] -> JsonValue
JsonArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. JsonValueAt a => a -> Either DecodeError JsonValue
jsonValueAt [JsonIndex]
es
    JsonIndexBool    Bool
v  -> forall a b. b -> Either a b
Right (Bool -> JsonValue
JsonBool Bool
v)
    JsonIndex
JsonIndexNull       -> forall a b. b -> Either a b
Right JsonValue
JsonNull
    where parseText :: ByteString -> Either DecodeError Text
parseText ByteString
bs = String -> Text
T.pack 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 forall a. Parser a -> ByteString -> Result a
ABC.parse forall t u. (Parser t u, IsString t) => Parser t String
parseJsonString ByteString
bs of
            ABC.Fail    {}  -> forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError (String
"Invalid field: '" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int -> ByteString -> ByteString
BS.take Int
20 ByteString
bs) forall a. [a] -> [a] -> [a]
++ String
"...'"))
            ABC.Partial ByteString -> IResult ByteString String
_   -> forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError String
"Unexpected end of field")
            ABC.Done    ByteString
_ String
s -> forall a b. b -> Either a b
Right String
s