{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} module HaskellWorks.Data.Json.FromValue where import HaskellWorks.Data.Decode import HaskellWorks.Data.Json.Value class FromJsonValue a where fromJsonValue :: JsonValue -> Either DecodeError a instance FromJsonValue JsonValue where fromJsonValue :: JsonValue -> Either DecodeError JsonValue fromJsonValue = JsonValue -> Either DecodeError JsonValue 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 String r -> String -> Either DecodeError String forall a b. b -> Either a b Right String r JsonValue _ -> DecodeError -> Either DecodeError String 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 -> Int -> Either DecodeError Int forall a b. b -> Either a b Right (Double -> Int forall a b. (RealFrac a, Integral b) => a -> b floor Double r) JsonValue _ -> DecodeError -> Either DecodeError Int 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 -> Double -> Either DecodeError Double forall a b. b -> Either a b Right Double r JsonValue _ -> DecodeError -> Either DecodeError Double 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 -> Bool -> Either DecodeError Bool forall a b. b -> Either a b Right Bool r JsonValue _ -> DecodeError -> Either DecodeError Bool 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 -> (JsonValue -> Either DecodeError a) -> [JsonValue] -> Either DecodeError [a] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM JsonValue -> Either DecodeError a forall a. FromJsonValue a => JsonValue -> Either DecodeError a fromJsonValue [JsonValue] xs JsonValue _ -> DecodeError -> Either DecodeError [a] 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] _) -> (,) (a -> b -> (a, b)) -> Either DecodeError a -> Either DecodeError (b -> (a, b)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> JsonValue -> Either DecodeError a forall a. FromJsonValue a => JsonValue -> Either DecodeError a fromJsonValue JsonValue a Either DecodeError (b -> (a, b)) -> Either DecodeError b -> Either DecodeError (a, b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> JsonValue -> Either DecodeError b forall a. FromJsonValue a => JsonValue -> Either DecodeError a fromJsonValue JsonValue b JsonValue _ -> DecodeError -> Either DecodeError (a, b) 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] _) -> (,,) (a -> b -> c -> (a, b, c)) -> Either DecodeError a -> Either DecodeError (b -> c -> (a, b, c)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> JsonValue -> Either DecodeError a forall a. FromJsonValue a => JsonValue -> Either DecodeError a fromJsonValue JsonValue a Either DecodeError (b -> c -> (a, b, c)) -> Either DecodeError b -> Either DecodeError (c -> (a, b, c)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> JsonValue -> Either DecodeError b forall a. FromJsonValue a => JsonValue -> Either DecodeError a fromJsonValue JsonValue b Either DecodeError (c -> (a, b, c)) -> Either DecodeError c -> Either DecodeError (a, b, c) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> JsonValue -> Either DecodeError c forall a. FromJsonValue a => JsonValue -> Either DecodeError a fromJsonValue JsonValue c JsonValue _ -> DecodeError -> Either DecodeError (a, b, c) 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] _) -> (,,,) (a -> b -> c -> d -> (a, b, c, d)) -> Either DecodeError a -> Either DecodeError (b -> c -> d -> (a, b, c, d)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> JsonValue -> Either DecodeError a forall a. FromJsonValue a => JsonValue -> Either DecodeError a fromJsonValue JsonValue a Either DecodeError (b -> c -> d -> (a, b, c, d)) -> Either DecodeError b -> Either DecodeError (c -> d -> (a, b, c, d)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> JsonValue -> Either DecodeError b forall a. FromJsonValue a => JsonValue -> Either DecodeError a fromJsonValue JsonValue b Either DecodeError (c -> d -> (a, b, c, d)) -> Either DecodeError c -> Either DecodeError (d -> (a, b, c, d)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> JsonValue -> Either DecodeError c forall a. FromJsonValue a => JsonValue -> Either DecodeError a fromJsonValue JsonValue c Either DecodeError (d -> (a, b, c, d)) -> Either DecodeError d -> Either DecodeError (a, b, c, d) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> JsonValue -> Either DecodeError d forall a. FromJsonValue a => JsonValue -> Either DecodeError a fromJsonValue JsonValue d JsonValue _ -> DecodeError -> Either DecodeError (a, b, c, d) forall a b. a -> Either a b Left (String -> DecodeError DecodeError String "Not a 4-tuple")