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