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