{-# LANGUAGE FlexibleInstances #-}

module HaskellWorks.Data.Json.FromValue where

import Data.Text                          (Text)
import HaskellWorks.Data.Json.DecodeError
import HaskellWorks.Data.Json.Value

import qualified Data.Text as T

class FromJsonValue a where
  fromJsonValue :: JsonValue -> Either DecodeError a

instance FromJsonValue JsonValue where
  fromJsonValue :: JsonValue -> Either DecodeError JsonValue
fromJsonValue = forall a b. b -> Either a b
Right

instance FromJsonValue String where
  fromJsonValue :: JsonValue -> Either DecodeError String
fromJsonValue JsonValue
v = case JsonValue
v of
    JsonString Text
r -> forall a b. b -> Either a b
Right (Text -> String
T.unpack Text
r)
    JsonValue
_            -> forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError String
"Not a string")

instance FromJsonValue Text where
  fromJsonValue :: JsonValue -> Either DecodeError Text
fromJsonValue JsonValue
v = case JsonValue
v of
    JsonString Text
r -> forall a b. b -> Either a b
Right Text
r
    JsonValue
_            -> forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError String
"Not a string")

instance FromJsonValue Int where
  fromJsonValue :: JsonValue -> Either DecodeError Int
fromJsonValue JsonValue
v = case JsonValue
v of
    JsonNumber Double
r -> forall a b. b -> Either a b
Right (forall a b. (RealFrac a, Integral b) => a -> b
floor Double
r)
    JsonValue
_            -> forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError String
"Not an integer")

instance FromJsonValue Double where
  fromJsonValue :: JsonValue -> Either DecodeError Double
fromJsonValue JsonValue
v = case JsonValue
v of
    JsonNumber Double
r -> forall a b. b -> Either a b
Right Double
r
    JsonValue
_            -> forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError String
"Not a double")

instance FromJsonValue Bool where
  fromJsonValue :: JsonValue -> Either DecodeError Bool
fromJsonValue JsonValue
v = case JsonValue
v of
    JsonBool Bool
r -> forall a b. b -> Either a b
Right Bool
r
    JsonValue
_          -> forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError String
"Not a boolean")

instance FromJsonValue a => FromJsonValue [a] where
  fromJsonValue :: JsonValue -> Either DecodeError [a]
fromJsonValue JsonValue
v = case JsonValue
v of
    JsonArray [JsonValue]
xs -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. FromJsonValue a => JsonValue -> Either DecodeError a
fromJsonValue [JsonValue]
xs
    JsonValue
_            -> forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError String
"Not an array")

instance (FromJsonValue a, FromJsonValue b) => FromJsonValue (a, b) where
  fromJsonValue :: JsonValue -> Either DecodeError (a, b)
fromJsonValue JsonValue
v = case JsonValue
v of
    JsonArray (JsonValue
a:JsonValue
b:[JsonValue]
_) -> (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJsonValue a => JsonValue -> Either DecodeError a
fromJsonValue JsonValue
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJsonValue a => JsonValue -> Either DecodeError a
fromJsonValue JsonValue
b
    JsonValue
_                 -> forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError String
"Not a 2-tuple")

instance (FromJsonValue a, FromJsonValue b, FromJsonValue c) => FromJsonValue (a, b, c) where
  fromJsonValue :: JsonValue -> Either DecodeError (a, b, c)
fromJsonValue JsonValue
v = case JsonValue
v of
    JsonArray (JsonValue
a:JsonValue
b:JsonValue
c:[JsonValue]
_) -> (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJsonValue a => JsonValue -> Either DecodeError a
fromJsonValue JsonValue
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJsonValue a => JsonValue -> Either DecodeError a
fromJsonValue JsonValue
b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJsonValue a => JsonValue -> Either DecodeError a
fromJsonValue JsonValue
c
    JsonValue
_                   -> forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError String
"Not a 3-tuple")

instance (FromJsonValue a, FromJsonValue b, FromJsonValue c, FromJsonValue d) => FromJsonValue (a, b, c, d) where
  fromJsonValue :: JsonValue -> Either DecodeError (a, b, c, d)
fromJsonValue JsonValue
v = case JsonValue
v of
    JsonArray (JsonValue
a:JsonValue
b:JsonValue
c:JsonValue
d:[JsonValue]
_) -> (,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJsonValue a => JsonValue -> Either DecodeError a
fromJsonValue JsonValue
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJsonValue a => JsonValue -> Either DecodeError a
fromJsonValue JsonValue
b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJsonValue a => JsonValue -> Either DecodeError a
fromJsonValue JsonValue
c forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJsonValue a => JsonValue -> Either DecodeError a
fromJsonValue JsonValue
d
    JsonValue
_                     -> forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError String
"Not a 4-tuple")