{-# LANGUAGE FlexibleInstances #-}

module Argo.Class.FromValue where

import qualified Argo.Json.Member as Member
import qualified Argo.Json.Value as Value
import qualified Argo.Pattern as Pattern
import qualified Argo.Pointer.Pointer as Pointer
import qualified Argo.Type.Decimal as Decimal
import qualified Argo.Type.Decoder as Decoder
import qualified Argo.Vendor.Text as Text
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.Word as Word

class FromValue a where
    fromValue :: Value.Value -> Either String a

instance FromValue Value.Value where
    fromValue :: Value -> Either String Value
fromValue = Value -> Either String Value
forall a b. b -> Either a b
Right

instance FromValue Bool where
    fromValue :: Value -> Either String Bool
fromValue = String
-> (Bool -> Either String Bool) -> Value -> Either String Bool
forall a.
String -> (Bool -> Either String a) -> Value -> Either String a
withBoolean String
"Bool" Bool -> Either String Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance FromValue Char where
    fromValue :: Value -> Either String Char
fromValue = String
-> (Text -> Either String Char) -> Value -> Either String Char
forall a.
String -> (Text -> Either String a) -> Value -> Either String a
withString String
"Char" ((Text -> Either String Char) -> Value -> Either String Char)
-> (Text -> Either String Char) -> Value -> Either String 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 -> Either String Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
y
        Maybe (Char, Text)
_ -> String -> Either String Char
forall a b. a -> Either a b
Left (String -> Either String Char) -> String -> Either String 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 -> Either String Int
fromValue = Value -> Either String Int
forall a. (Integral a, Bits a) => Value -> Either String a
viaInteger

instance FromValue Int.Int8 where
    fromValue :: Value -> Either String Int8
fromValue = Value -> Either String Int8
forall a. (Integral a, Bits a) => Value -> Either String a
viaInteger

instance FromValue Int.Int16 where
    fromValue :: Value -> Either String Int16
fromValue = Value -> Either String Int16
forall a. (Integral a, Bits a) => Value -> Either String a
viaInteger

instance FromValue Int.Int32 where
    fromValue :: Value -> Either String Int32
fromValue = Value -> Either String Int32
forall a. (Integral a, Bits a) => Value -> Either String a
viaInteger

instance FromValue Int.Int64 where
    fromValue :: Value -> Either String Int64
fromValue = Value -> Either String Int64
forall a. (Integral a, Bits a) => Value -> Either String a
viaInteger

instance FromValue Word where
    fromValue :: Value -> Either String Word
fromValue = Value -> Either String Word
forall a. (Integral a, Bits a) => Value -> Either String a
viaInteger

instance FromValue Word.Word8 where
    fromValue :: Value -> Either String Word8
fromValue = Value -> Either String Word8
forall a. (Integral a, Bits a) => Value -> Either String a
viaInteger

instance FromValue Word.Word16 where
    fromValue :: Value -> Either String Word16
fromValue = Value -> Either String Word16
forall a. (Integral a, Bits a) => Value -> Either String a
viaInteger

instance FromValue Word.Word32 where
    fromValue :: Value -> Either String Word32
fromValue = Value -> Either String Word32
forall a. (Integral a, Bits a) => Value -> Either String a
viaInteger

instance FromValue Word.Word64 where
    fromValue :: Value -> Either String Word64
fromValue = Value -> Either String Word64
forall a. (Integral a, Bits a) => Value -> Either String a
viaInteger

instance FromValue Integer where
    fromValue :: Value -> Either String Integer
fromValue = String
-> (Decimal -> Either String Integer)
-> Value
-> Either String Integer
forall a.
String -> (Decimal -> Either String a) -> Value -> Either String a
withNumber String
"Integer" ((Decimal -> Either String Integer)
 -> Value -> Either String Integer)
-> (Decimal -> Either String Integer)
-> Value
-> Either String Integer
forall a b. (a -> b) -> a -> b
$ \x :: Decimal
x@(Decimal.Decimal Integer
s Integer
e) -> if Integer
e Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
        then String -> Either String Integer
forall a b. a -> Either a b
Left (String -> Either String Integer)
-> String -> Either String Integer
forall a b. (a -> b) -> a -> b
$ String
"expected integer but got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Decimal -> String
forall a. Show a => a -> String
show Decimal
x
        else Integer -> Either String Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Either String Integer)
-> Integer -> Either String Integer
forall a b. (a -> b) -> a -> b
$ Integer
s 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
e

instance FromValue Float where
    fromValue :: Value -> Either String Float
fromValue = String
-> (Decimal -> Either String Float) -> Value -> Either String Float
forall a.
String -> (Decimal -> Either String a) -> Value -> Either String a
withNumber String
"Float" ((Decimal -> Either String Float) -> Value -> Either String Float)
-> (Decimal -> Either String Float) -> Value -> Either String Float
forall a b. (a -> b) -> a -> b
$ Float -> Either String Float
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Float -> Either String Float)
-> (Decimal -> Float) -> Decimal -> Either String Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Float
forall a. Fractional a => Rational -> a
fromRational (Rational -> Float) -> (Decimal -> Rational) -> Decimal -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decimal -> Rational
Decimal.toRational

instance FromValue Double where
    fromValue :: Value -> Either String Double
fromValue = String
-> (Decimal -> Either String Double)
-> Value
-> Either String Double
forall a.
String -> (Decimal -> Either String a) -> Value -> Either String a
withNumber String
"Double" ((Decimal -> Either String Double)
 -> Value -> Either String Double)
-> (Decimal -> Either String Double)
-> Value
-> Either String Double
forall a b. (a -> b) -> a -> b
$ Double -> Either String Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Either String Double)
-> (Decimal -> Double) -> Decimal -> Either String Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> (Decimal -> Rational) -> Decimal -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decimal -> Rational
Decimal.toRational

instance {-# OVERLAPPING #-} FromValue String where
    fromValue :: Value -> Either String String
fromValue = (Text -> String) -> Either String Text -> Either String String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
Text.unpack (Either String Text -> Either String String)
-> (Value -> Either String Text) -> Value -> Either String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either String Text
forall a. FromValue a => Value -> Either String a
fromValue

instance FromValue Text.Text where
    fromValue :: Value -> Either String Text
fromValue = String
-> (Text -> Either String Text) -> Value -> Either String Text
forall a.
String -> (Text -> Either String a) -> Value -> Either String a
withString String
"Text" Text -> Either String Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance FromValue Text.LazyText where
    fromValue :: Value -> Either String LazyText
fromValue = (Text -> LazyText) -> Either String Text -> Either String LazyText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> LazyText
Text.fromStrict (Either String Text -> Either String LazyText)
-> (Value -> Either String Text) -> Value -> Either String LazyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either String Text
forall a. FromValue a => Value -> Either String a
fromValue

instance FromValue a => FromValue (Maybe a) where
    fromValue :: Value -> Either String (Maybe a)
fromValue Value
x = case Value
x of
        Value
Pattern.Null -> Maybe a -> Either String (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) -> Either String a -> Either String (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either String a
forall a. FromValue a => Value -> Either String a
fromValue Value
x

instance FromValue () where
    fromValue :: Value -> Either String ()
fromValue = String
-> ([Value] -> Either String ()) -> Value -> Either String ()
forall a.
String -> ([Value] -> Either String a) -> Value -> Either String a
withArray String
"()" (([Value] -> Either String ()) -> Value -> Either String ())
-> ([Value] -> Either String ()) -> Value -> Either String ()
forall a b. (a -> b) -> a -> b
$ \[Value]
xs -> case [Value]
xs of
        [] -> () -> Either String ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        [Value]
_ -> String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
"expected empty list but got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Value] -> String
forall a. Show a => a -> String
show [Value]
xs

instance (FromValue a, FromValue b) => FromValue (a, b) where
    fromValue :: Value -> Either String (a, b)
fromValue = String
-> ([Value] -> Either String (a, b))
-> Value
-> Either String (a, b)
forall a.
String -> ([Value] -> Either String a) -> Value -> Either String a
withArray String
"(a, b)" (([Value] -> Either String (a, b))
 -> Value -> Either String (a, b))
-> ([Value] -> Either String (a, b))
-> Value
-> Either String (a, b)
forall a b. (a -> b) -> a -> b
$ \[Value]
xs -> case [Value]
xs of
        [Value
x, Value
y] -> (,) (a -> b -> (a, b))
-> Either String a -> Either String (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either String a
forall a. FromValue a => Value -> Either String a
fromValue Value
x Either String (b -> (a, b))
-> Either String b -> Either String (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Either String b
forall a. FromValue a => Value -> Either String a
fromValue Value
y
        [Value]
_ -> String -> Either String (a, b)
forall a b. a -> Either a b
Left (String -> Either String (a, b)) -> String -> Either String (a, b)
forall a b. (a -> b) -> a -> b
$ String
"expected tuple but got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Value] -> String
forall a. Show a => a -> String
show [Value]
xs

instance FromValue a => FromValue [a] where
    fromValue :: Value -> Either String [a]
fromValue = String
-> ([Value] -> Either String [a]) -> Value -> Either String [a]
forall a.
String -> ([Value] -> Either String a) -> Value -> Either String a
withArray String
"[a]" (([Value] -> Either String [a]) -> Value -> Either String [a])
-> ([Value] -> Either String [a]) -> Value -> Either String [a]
forall a b. (a -> b) -> a -> b
$ (Value -> Either String a) -> [Value] -> Either String [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Either String a
forall a. FromValue a => Value -> Either String a
fromValue

instance FromValue a => FromValue (NonEmpty.NonEmpty a) where
    fromValue :: Value -> Either String (NonEmpty a)
fromValue Value
value = do
        [a]
list <- Value -> Either String [a]
forall a. FromValue a => Value -> Either String 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 -> Either String (NonEmpty a)
forall a b. a -> Either a b
Left String
"unexpected empty list"
            Just NonEmpty a
nonEmpty -> NonEmpty a -> Either String (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 -> Either String (Map Text a)
fromValue = String
-> ([MemberOf Value] -> Either String (Map Text a))
-> Value
-> Either String (Map Text a)
forall a.
String
-> ([MemberOf Value] -> Either String a)
-> Value
-> Either String a
withObject String
"Map" (([MemberOf Value] -> Either String (Map Text a))
 -> Value -> Either String (Map Text a))
-> ([MemberOf Value] -> Either String (Map Text a))
-> Value
-> Either String (Map Text a)
forall a b. (a -> b) -> a -> b
$ ([(Text, a)] -> Map Text a)
-> Either String [(Text, a)] -> Either String (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 (Either String [(Text, a)] -> Either String (Map Text a))
-> ([MemberOf Value] -> Either String [(Text, a)])
-> [MemberOf Value]
-> Either String (Map Text a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MemberOf Value -> Either String (Text, a))
-> [MemberOf Value] -> Either String [(Text, a)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
        (\(Member.Member (Pattern.Name Text
k) Value
v) -> (,) Text
k (a -> (Text, a)) -> Either String a -> Either String (Text, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either String a
forall a. FromValue a => Value -> Either String a
fromValue Value
v)

instance FromValue Pointer.Pointer where
    fromValue :: Value -> Either String Pointer
fromValue =
        String
-> (Text -> Either String Pointer)
-> Value
-> Either String Pointer
forall a.
String -> (Text -> Either String a) -> Value -> Either String a
withString String
"Pointer" ((Text -> Either String Pointer) -> Value -> Either String Pointer)
-> (Text -> Either String Pointer)
-> Value
-> Either String Pointer
forall a b. (a -> b) -> a -> b
$ Decoder Pointer -> ByteString -> Either String Pointer
forall a. Decoder a -> ByteString -> Either String a
Decoder.run Decoder Pointer
Pointer.decode (ByteString -> Either String Pointer)
-> (Text -> ByteString) -> Text -> Either String Pointer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8

withBoolean
    :: String -> (Bool -> Either String a) -> Value.Value -> Either String a
withBoolean :: String -> (Bool -> Either String a) -> Value -> Either String a
withBoolean String
s Bool -> Either String a
f Value
x = case Value
x of
    Pattern.Boolean Bool
y -> Bool -> Either String a
f Bool
y
    Value
_ -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String 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
    -> (Decimal.Decimal -> Either String a)
    -> Value.Value
    -> Either String a
withNumber :: String -> (Decimal -> Either String a) -> Value -> Either String a
withNumber String
s Decimal -> Either String a
f Value
x = case Value
x of
    Pattern.Number Decimal
y -> Decimal -> Either String a
f Decimal
y
    Value
_ -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String 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 -> Either String a)
    -> Value.Value
    -> Either String a
withString :: String -> (Text -> Either String a) -> Value -> Either String a
withString String
s Text -> Either String a
f Value
x = case Value
x of
    Pattern.String Text
y -> Text -> Either String a
f Text
y
    Value
_ -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String 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
    -> ([Value.Value] -> Either String a)
    -> Value.Value
    -> Either String a
withArray :: String -> ([Value] -> Either String a) -> Value -> Either String a
withArray String
s [Value] -> Either String a
f Value
x = case Value
x of
    Pattern.Array [Value]
y -> [Value] -> Either String a
f [Value]
y
    Value
_ -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String 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
    -> ([Member.MemberOf Value.Value] -> Either String a)
    -> Value.Value
    -> Either String a
withObject :: String
-> ([MemberOf Value] -> Either String a)
-> Value
-> Either String a
withObject String
s [MemberOf Value] -> Either String a
f Value
x = case Value
x of
    Pattern.Object [MemberOf Value]
y -> [MemberOf Value] -> Either String a
f [MemberOf Value]
y
    Value
_ -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String 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 -> Either String a
viaInteger :: Value -> Either String a
viaInteger Value
value = do
    Integer
integer <- Value -> Either String Integer
forall a. FromValue a => Value -> Either String 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 -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String 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 -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x