{-# LANGUAGE FlexibleInstances #-} module Argo.Class.FromValue where import qualified Argo.Result as Result import qualified Argo.Type.Array as Array import qualified Argo.Type.Boolean as Boolean import qualified Argo.Type.Number as Number import qualified Argo.Type.Object as Object import qualified Argo.Type.Pair as Pair import qualified Argo.Type.String as String import qualified Argo.Type.Value as Value import qualified Data.Array import qualified Data.Bits as Bits import qualified Data.Int as Int import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Map as Map import qualified Data.Text as Text import qualified Data.Text.Lazy as LazyText import qualified Data.Word as Word class FromValue a where fromValue :: Value.Value -> Result.Result a instance FromValue Value.Value where fromValue :: Value -> Result Value fromValue = Value -> Result Value forall a. a -> Result a Result.Success instance FromValue Bool where fromValue :: Value -> Result Bool fromValue = String -> (Bool -> Result Bool) -> Value -> Result Bool forall a. String -> (Bool -> Result a) -> Value -> Result a withBoolean String "Bool" Bool -> Result Bool forall (f :: * -> *) a. Applicative f => a -> f a pure instance FromValue Char where fromValue :: Value -> Result Char fromValue = String -> (Text -> Result Char) -> Value -> Result Char forall a. String -> (Text -> Result a) -> Value -> Result a withString String "Char" ((Text -> Result Char) -> Value -> Result Char) -> (Text -> Result Char) -> Value -> Result Char forall a b. (a -> b) -> a -> b $ \ Text x -> case Text -> Maybe (Char, Text) Text.uncons Text x of Just (Char y, Text z) | Text -> Bool Text.null Text z -> Char -> Result Char forall (f :: * -> *) a. Applicative f => a -> f a pure Char y Maybe (Char, Text) _ -> String -> Result Char forall (m :: * -> *) a. MonadFail m => String -> m a fail (String -> Result Char) -> String -> Result Char forall a b. (a -> b) -> a -> b $ String "expected single character but got " String -> String -> String forall a. Semigroup a => a -> a -> a <> Text -> String forall a. Show a => a -> String show Text x instance FromValue Int where fromValue :: Value -> Result Int fromValue = Value -> Result Int forall a. (Integral a, Bits a) => Value -> Result a viaInteger instance FromValue Int.Int8 where fromValue :: Value -> Result Int8 fromValue = Value -> Result Int8 forall a. (Integral a, Bits a) => Value -> Result a viaInteger instance FromValue Int.Int16 where fromValue :: Value -> Result Int16 fromValue = Value -> Result Int16 forall a. (Integral a, Bits a) => Value -> Result a viaInteger instance FromValue Int.Int32 where fromValue :: Value -> Result Int32 fromValue = Value -> Result Int32 forall a. (Integral a, Bits a) => Value -> Result a viaInteger instance FromValue Int.Int64 where fromValue :: Value -> Result Int64 fromValue = Value -> Result Int64 forall a. (Integral a, Bits a) => Value -> Result a viaInteger instance FromValue Word where fromValue :: Value -> Result Word fromValue = Value -> Result Word forall a. (Integral a, Bits a) => Value -> Result a viaInteger instance FromValue Word.Word8 where fromValue :: Value -> Result Word8 fromValue = Value -> Result Word8 forall a. (Integral a, Bits a) => Value -> Result a viaInteger instance FromValue Word.Word16 where fromValue :: Value -> Result Word16 fromValue = Value -> Result Word16 forall a. (Integral a, Bits a) => Value -> Result a viaInteger instance FromValue Word.Word32 where fromValue :: Value -> Result Word32 fromValue = Value -> Result Word32 forall a. (Integral a, Bits a) => Value -> Result a viaInteger instance FromValue Word.Word64 where fromValue :: Value -> Result Word64 fromValue = Value -> Result Word64 forall a. (Integral a, Bits a) => Value -> Result a viaInteger instance FromValue Integer where fromValue :: Value -> Result Integer fromValue = String -> (Integer -> Integer -> Result Integer) -> Value -> Result Integer forall a. String -> (Integer -> Integer -> Result a) -> Value -> Result a withNumber String "Integer" ((Integer -> Integer -> Result Integer) -> Value -> Result Integer) -> (Integer -> Integer -> Result Integer) -> Value -> Result Integer forall a b. (a -> b) -> a -> b $ \ Integer x Integer y -> if Integer y Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool < Integer 0 then String -> Result Integer forall (m :: * -> *) a. MonadFail m => String -> m a fail (String -> Result Integer) -> String -> Result Integer forall a b. (a -> b) -> a -> b $ String "expected integer but got " String -> String -> String forall a. Semigroup a => a -> a -> a <> Number -> String forall a. Show a => a -> String show (Integer -> Integer -> Number Number.number Integer x Integer y) else Integer -> Result Integer forall (f :: * -> *) a. Applicative f => a -> f a pure (Integer -> Result Integer) -> Integer -> Result Integer forall a b. (a -> b) -> a -> b $ Integer x Integer -> Integer -> Integer forall a. Num a => a -> a -> a * Integer 10 Integer -> Integer -> Integer forall a b. (Num a, Integral b) => a -> b -> a ^ Integer y instance FromValue Float where fromValue :: Value -> Result Float fromValue = String -> (Integer -> Integer -> Result Float) -> Value -> Result Float forall a. String -> (Integer -> Integer -> Result a) -> Value -> Result a withNumber String "Float" ((Integer -> Integer -> Result Float) -> Value -> Result Float) -> (Integer -> Integer -> Result Float) -> Value -> Result Float forall a b. (a -> b) -> a -> b $ \ Integer x Integer y -> Float -> Result Float forall (f :: * -> *) a. Applicative f => a -> f a pure (Float -> Result Float) -> (Number -> Float) -> Number -> Result Float forall b c a. (b -> c) -> (a -> b) -> a -> c . Rational -> Float forall a. Fractional a => Rational -> a fromRational (Rational -> Float) -> (Number -> Rational) -> Number -> Float forall b c a. (b -> c) -> (a -> b) -> a -> c . Number -> Rational Number.toRational (Number -> Result Float) -> Number -> Result Float forall a b. (a -> b) -> a -> b $ Integer -> Integer -> Number Number.Number Integer x Integer y instance FromValue Double where fromValue :: Value -> Result Double fromValue = String -> (Integer -> Integer -> Result Double) -> Value -> Result Double forall a. String -> (Integer -> Integer -> Result a) -> Value -> Result a withNumber String "Double" ((Integer -> Integer -> Result Double) -> Value -> Result Double) -> (Integer -> Integer -> Result Double) -> Value -> Result Double forall a b. (a -> b) -> a -> b $ \ Integer x Integer y -> Double -> Result Double forall (f :: * -> *) a. Applicative f => a -> f a pure (Double -> Result Double) -> (Number -> Double) -> Number -> Result Double forall b c a. (b -> c) -> (a -> b) -> a -> c . Rational -> Double forall a. Fractional a => Rational -> a fromRational (Rational -> Double) -> (Number -> Rational) -> Number -> Double forall b c a. (b -> c) -> (a -> b) -> a -> c . Number -> Rational Number.toRational (Number -> Result Double) -> Number -> Result Double forall a b. (a -> b) -> a -> b $ Integer -> Integer -> Number Number.Number Integer x Integer y instance {-# OVERLAPPING #-} FromValue String where fromValue :: Value -> Result String fromValue = (Text -> String) -> Result Text -> Result String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Text -> String Text.unpack (Result Text -> Result String) -> (Value -> Result Text) -> Value -> Result String forall b c a. (b -> c) -> (a -> b) -> a -> c . Value -> Result Text forall a. FromValue a => Value -> Result a fromValue instance FromValue Text.Text where fromValue :: Value -> Result Text fromValue = String -> (Text -> Result Text) -> Value -> Result Text forall a. String -> (Text -> Result a) -> Value -> Result a withString String "Text" Text -> Result Text forall (f :: * -> *) a. Applicative f => a -> f a pure instance FromValue LazyText.Text where fromValue :: Value -> Result Text fromValue = (Text -> Text) -> Result Text -> Result Text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Text -> Text LazyText.fromStrict (Result Text -> Result Text) -> (Value -> Result Text) -> Value -> Result Text forall b c a. (b -> c) -> (a -> b) -> a -> c . Value -> Result Text forall a. FromValue a => Value -> Result a fromValue instance FromValue a => FromValue (Maybe a) where fromValue :: Value -> Result (Maybe a) fromValue Value x = case Value x of Value.Null Null _ -> Maybe a -> Result (Maybe a) forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe a forall a. Maybe a Nothing Value _ -> a -> Maybe a forall a. a -> Maybe a Just (a -> Maybe a) -> Result a -> Result (Maybe a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Value -> Result a forall a. FromValue a => Value -> Result a fromValue Value x instance FromValue () where fromValue :: Value -> Result () fromValue Value x = do [] <- Value -> Result [Value] forall a. FromValue a => Value -> Result a fromValue Value x :: Result.Result [Value.Value] () -> Result () forall (f :: * -> *) a. Applicative f => a -> f a pure () instance (FromValue a, FromValue b) => FromValue (a, b) where fromValue :: Value -> Result (a, b) fromValue Value x = do [Value y, Value z] <- Value -> Result [Value] forall a. FromValue a => Value -> Result a fromValue Value x (,) (a -> b -> (a, b)) -> Result a -> Result (b -> (a, b)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Value -> Result a forall a. FromValue a => Value -> Result a fromValue Value y Result (b -> (a, b)) -> Result b -> Result (a, b) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Value -> Result b forall a. FromValue a => Value -> Result a fromValue Value z instance FromValue a => FromValue (Data.Array.Array Int a) where fromValue :: Value -> Result (Array Int a) fromValue = String -> (Array Int Value -> Result (Array Int a)) -> Value -> Result (Array Int a) forall a. String -> (Array Int Value -> Result a) -> Value -> Result a withArray String "Array" ((Array Int Value -> Result (Array Int a)) -> Value -> Result (Array Int a)) -> (Array Int Value -> Result (Array Int a)) -> Value -> Result (Array Int a) forall a b. (a -> b) -> a -> b $ (Value -> Result a) -> Array Int Value -> Result (Array Int a) forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse Value -> Result a forall a. FromValue a => Value -> Result a fromValue instance FromValue a => FromValue [a] where fromValue :: Value -> Result [a] fromValue = let arrayToList :: Data.Array.Array Int b -> [b] arrayToList :: Array Int b -> [b] arrayToList = Array Int b -> [b] forall i e. Array i e -> [e] Data.Array.elems in (Array Int a -> [a]) -> Result (Array Int a) -> Result [a] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Array Int a -> [a] forall b. Array Int b -> [b] arrayToList (Result (Array Int a) -> Result [a]) -> (Value -> Result (Array Int a)) -> Value -> Result [a] forall b c a. (b -> c) -> (a -> b) -> a -> c . Value -> Result (Array Int a) forall a. FromValue a => Value -> Result a fromValue instance (FromValue a, Show a) => FromValue (NonEmpty.NonEmpty a) where fromValue :: Value -> Result (NonEmpty a) fromValue Value value = do [a] list <- Value -> Result [a] forall a. FromValue a => Value -> Result a fromValue Value value case [a] -> Maybe (NonEmpty a) forall a. [a] -> Maybe (NonEmpty a) NonEmpty.nonEmpty [a] list of Maybe (NonEmpty a) Nothing -> String -> Result (NonEmpty a) forall (m :: * -> *) a. MonadFail m => String -> m a fail (String -> Result (NonEmpty a)) -> String -> Result (NonEmpty a) forall a b. (a -> b) -> a -> b $ String "expected non-empty list but got " String -> String -> String forall a. Semigroup a => a -> a -> a <> [a] -> String forall a. Show a => a -> String show [a] list Just NonEmpty a nonEmpty -> NonEmpty a -> Result (NonEmpty a) forall (f :: * -> *) a. Applicative f => a -> f a pure NonEmpty a nonEmpty instance FromValue a => FromValue (Map.Map Text.Text a) where fromValue :: Value -> Result (Map Text a) fromValue = String -> (Array Int (Pair String Value) -> Result (Map Text a)) -> Value -> Result (Map Text a) forall a. String -> (Array Int (Pair String Value) -> Result a) -> Value -> Result a withObject String "Map" ((Array Int (Pair String Value) -> Result (Map Text a)) -> Value -> Result (Map Text a)) -> (Array Int (Pair String Value) -> Result (Map Text a)) -> Value -> Result (Map Text a) forall a b. (a -> b) -> a -> b $ ([(Text, a)] -> Map Text a) -> Result [(Text, a)] -> Result (Map Text a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap [(Text, a)] -> Map Text a forall k a. Ord k => [(k, a)] -> Map k a Map.fromList (Result [(Text, a)] -> Result (Map Text a)) -> (Array Int (Pair String Value) -> Result [(Text, a)]) -> Array Int (Pair String Value) -> Result (Map Text a) forall b c a. (b -> c) -> (a -> b) -> a -> c . (Pair String Value -> Result (Text, a)) -> [Pair String Value] -> Result [(Text, a)] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse (\ (Pair.Pair (String.String Text k, Value v)) -> (,) Text k (a -> (Text, a)) -> Result a -> Result (Text, a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Value -> Result a forall a. FromValue a => Value -> Result a fromValue Value v) ([Pair String Value] -> Result [(Text, a)]) -> (Array Int (Pair String Value) -> [Pair String Value]) -> Array Int (Pair String Value) -> Result [(Text, a)] forall b c a. (b -> c) -> (a -> b) -> a -> c . Array Int (Pair String Value) -> [Pair String Value] forall i e. Array i e -> [e] Data.Array.elems withBoolean :: String -> (Bool -> Result.Result a) -> Value.Value -> Result.Result a withBoolean :: String -> (Bool -> Result a) -> Value -> Result a withBoolean String s Bool -> Result a f Value x = case Value x of Value.Boolean (Boolean.Boolean Bool y) -> Bool -> Result a f Bool y Value _ -> String -> Result a forall (m :: * -> *) a. MonadFail m => String -> m a fail (String -> Result a) -> String -> Result a forall a b. (a -> b) -> a -> b $ String "expected " String -> String -> String forall a. Semigroup a => a -> a -> a <> String s String -> String -> String forall a. Semigroup a => a -> a -> a <> String " but got " String -> String -> String forall a. Semigroup a => a -> a -> a <> Value -> String forall a. Show a => a -> String show Value x withNumber :: String -> (Integer -> Integer -> Result.Result a) -> Value.Value -> Result.Result a withNumber :: String -> (Integer -> Integer -> Result a) -> Value -> Result a withNumber String s Integer -> Integer -> Result a f Value x = case Value x of Value.Number (Number.Number Integer y Integer z) -> Integer -> Integer -> Result a f Integer y Integer z Value _ -> String -> Result a forall (m :: * -> *) a. MonadFail m => String -> m a fail (String -> Result a) -> String -> Result a forall a b. (a -> b) -> a -> b $ String "expected " String -> String -> String forall a. Semigroup a => a -> a -> a <> String s String -> String -> String forall a. Semigroup a => a -> a -> a <> String " but got " String -> String -> String forall a. Semigroup a => a -> a -> a <> Value -> String forall a. Show a => a -> String show Value x withString :: String -> (Text.Text -> Result.Result a) -> Value.Value -> Result.Result a withString :: String -> (Text -> Result a) -> Value -> Result a withString String s Text -> Result a f Value x = case Value x of Value.String (String.String Text y) -> Text -> Result a f Text y Value _ -> String -> Result a forall (m :: * -> *) a. MonadFail m => String -> m a fail (String -> Result a) -> String -> Result a forall a b. (a -> b) -> a -> b $ String "expected " String -> String -> String forall a. Semigroup a => a -> a -> a <> String s String -> String -> String forall a. Semigroup a => a -> a -> a <> String " but got " String -> String -> String forall a. Semigroup a => a -> a -> a <> Value -> String forall a. Show a => a -> String show Value x withArray :: String -> (Data.Array.Array Int Value.Value -> Result.Result a) -> Value.Value -> Result.Result a withArray :: String -> (Array Int Value -> Result a) -> Value -> Result a withArray String s Array Int Value -> Result a f Value x = case Value x of Value.Array (Array.Array Array Int Value y) -> Array Int Value -> Result a f Array Int Value y Value _ -> String -> Result a forall (m :: * -> *) a. MonadFail m => String -> m a fail (String -> Result a) -> String -> Result a forall a b. (a -> b) -> a -> b $ String "expected " String -> String -> String forall a. Semigroup a => a -> a -> a <> String s String -> String -> String forall a. Semigroup a => a -> a -> a <> String " but got " String -> String -> String forall a. Semigroup a => a -> a -> a <> Value -> String forall a. Show a => a -> String show Value x withObject :: String -> (Data.Array.Array Int (Pair.Pair String.String Value.Value) -> Result.Result a) -> Value.Value -> Result.Result a withObject :: String -> (Array Int (Pair String Value) -> Result a) -> Value -> Result a withObject String s Array Int (Pair String Value) -> Result a f Value x = case Value x of Value.Object (Object.Object Array Int (Pair String Value) y) -> Array Int (Pair String Value) -> Result a f Array Int (Pair String Value) y Value _ -> String -> Result a forall (m :: * -> *) a. MonadFail m => String -> m a fail (String -> Result a) -> String -> Result a forall a b. (a -> b) -> a -> b $ String "expected " String -> String -> String forall a. Semigroup a => a -> a -> a <> String s String -> String -> String forall a. Semigroup a => a -> a -> a <> String " but got " String -> String -> String forall a. Semigroup a => a -> a -> a <> Value -> String forall a. Show a => a -> String show Value x viaInteger :: (Integral a, Bits.Bits a) => Value.Value -> Result.Result a viaInteger :: Value -> Result a viaInteger Value value = do Integer integer <- Value -> Result Integer forall a. FromValue a => Value -> Result a fromValue Value value case Integer -> Maybe a forall a b. (Integral a, Integral b, Bits a, Bits b) => a -> Maybe b Bits.toIntegralSized (Integer integer :: Integer) of Maybe a Nothing -> String -> Result a forall (m :: * -> *) a. MonadFail m => String -> m a fail (String -> Result a) -> String -> Result a forall a b. (a -> b) -> a -> b $ String "integer out of bounds " String -> String -> String forall a. Semigroup a => a -> a -> a <> Integer -> String forall a. Show a => a -> String show Integer integer Just a x -> a -> Result a forall (f :: * -> *) a. Applicative f => a -> f a pure a x