{-# LANGUAGE FlexibleInstances #-}

module Argo.Class.FromValue where

import Control.Monad ((<=<))

import qualified Argo.Type as Type
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 :: Type.Value -> Maybe a

instance FromValue Type.Value where
    fromValue :: Value -> Maybe Value
fromValue = Value -> Maybe Value
forall a. a -> Maybe a
Just

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

instance FromValue Char where
    fromValue :: Value -> Maybe Char
fromValue = String -> (Text -> Maybe Char) -> Value -> Maybe Char
forall a. String -> (Text -> Maybe a) -> Value -> Maybe a
withString String
"Char" ((Text -> Maybe Char) -> Value -> Maybe Char)
-> (Text -> Maybe Char) -> Value -> Maybe 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 -> Maybe Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
y
        Maybe (Char, Text)
_ -> String -> Maybe Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not singleton"

instance FromValue Int where
    fromValue :: Value -> Maybe Int
fromValue =
        let
            integerToInt :: Integer -> Maybe Int
            integerToInt :: Integer -> Maybe Int
integerToInt = Integer -> Maybe Int
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized
        in Integer -> Maybe Int
integerToInt (Integer -> Maybe Int)
-> (Value -> Maybe Integer) -> Value -> Maybe Int
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Maybe Integer
forall a. FromValue a => Value -> Maybe a
fromValue

instance FromValue Int.Int8 where
    fromValue :: Value -> Maybe Int8
fromValue =
        let
            integerToInt8 :: Integer -> Maybe Int.Int8
            integerToInt8 :: Integer -> Maybe Int8
integerToInt8 = Integer -> Maybe Int8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized
        in Integer -> Maybe Int8
integerToInt8 (Integer -> Maybe Int8)
-> (Value -> Maybe Integer) -> Value -> Maybe Int8
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Maybe Integer
forall a. FromValue a => Value -> Maybe a
fromValue

instance FromValue Int.Int16 where
    fromValue :: Value -> Maybe Int16
fromValue =
        let
            integerToInt16 :: Integer -> Maybe Int.Int16
            integerToInt16 :: Integer -> Maybe Int16
integerToInt16 = Integer -> Maybe Int16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized
        in Integer -> Maybe Int16
integerToInt16 (Integer -> Maybe Int16)
-> (Value -> Maybe Integer) -> Value -> Maybe Int16
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Maybe Integer
forall a. FromValue a => Value -> Maybe a
fromValue

instance FromValue Int.Int32 where
    fromValue :: Value -> Maybe Int32
fromValue =
        let
            integerToInt32 :: Integer -> Maybe Int.Int32
            integerToInt32 :: Integer -> Maybe Int32
integerToInt32 = Integer -> Maybe Int32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized
        in Integer -> Maybe Int32
integerToInt32 (Integer -> Maybe Int32)
-> (Value -> Maybe Integer) -> Value -> Maybe Int32
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Maybe Integer
forall a. FromValue a => Value -> Maybe a
fromValue

instance FromValue Int.Int64 where
    fromValue :: Value -> Maybe Int64
fromValue =
        let
            integerToInt64 :: Integer -> Maybe Int.Int64
            integerToInt64 :: Integer -> Maybe Int64
integerToInt64 = Integer -> Maybe Int64
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized
        in Integer -> Maybe Int64
integerToInt64 (Integer -> Maybe Int64)
-> (Value -> Maybe Integer) -> Value -> Maybe Int64
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Maybe Integer
forall a. FromValue a => Value -> Maybe a
fromValue

instance FromValue Word where
    fromValue :: Value -> Maybe Word
fromValue =
        let
            integerToWord :: Integer -> Maybe Word
            integerToWord :: Integer -> Maybe Word
integerToWord = Integer -> Maybe Word
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized
        in Integer -> Maybe Word
integerToWord (Integer -> Maybe Word)
-> (Value -> Maybe Integer) -> Value -> Maybe Word
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Maybe Integer
forall a. FromValue a => Value -> Maybe a
fromValue

instance FromValue Word.Word8 where
    fromValue :: Value -> Maybe Word8
fromValue =
        let
            integerToWord8 :: Integer -> Maybe Word.Word8
            integerToWord8 :: Integer -> Maybe Word8
integerToWord8 = Integer -> Maybe Word8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized
        in Integer -> Maybe Word8
integerToWord8 (Integer -> Maybe Word8)
-> (Value -> Maybe Integer) -> Value -> Maybe Word8
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Maybe Integer
forall a. FromValue a => Value -> Maybe a
fromValue

instance FromValue Word.Word16 where
    fromValue :: Value -> Maybe Word16
fromValue =
        let
            integerToWord16 :: Integer -> Maybe Word.Word16
            integerToWord16 :: Integer -> Maybe Word16
integerToWord16 = Integer -> Maybe Word16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized
        in Integer -> Maybe Word16
integerToWord16 (Integer -> Maybe Word16)
-> (Value -> Maybe Integer) -> Value -> Maybe Word16
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Maybe Integer
forall a. FromValue a => Value -> Maybe a
fromValue

instance FromValue Word.Word32 where
    fromValue :: Value -> Maybe Word32
fromValue =
        let
            integerToWord32 :: Integer -> Maybe Word.Word32
            integerToWord32 :: Integer -> Maybe Word32
integerToWord32 = Integer -> Maybe Word32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized
        in Integer -> Maybe Word32
integerToWord32 (Integer -> Maybe Word32)
-> (Value -> Maybe Integer) -> Value -> Maybe Word32
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Maybe Integer
forall a. FromValue a => Value -> Maybe a
fromValue

instance FromValue Word.Word64 where
    fromValue :: Value -> Maybe Word64
fromValue =
        let
            integerToWord64 :: Integer -> Maybe Word.Word64
            integerToWord64 :: Integer -> Maybe Word64
integerToWord64 = Integer -> Maybe Word64
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized
        in Integer -> Maybe Word64
integerToWord64 (Integer -> Maybe Word64)
-> (Value -> Maybe Integer) -> Value -> Maybe Word64
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Maybe Integer
forall a. FromValue a => Value -> Maybe a
fromValue

instance FromValue Integer where
    fromValue :: Value -> Maybe Integer
fromValue = String
-> (Integer -> Integer -> Maybe Integer) -> Value -> Maybe Integer
forall a.
String -> (Integer -> Integer -> Maybe a) -> Value -> Maybe a
withNumber String
"Integer" ((Integer -> Integer -> Maybe Integer) -> Value -> Maybe Integer)
-> (Integer -> Integer -> Maybe Integer) -> Value -> Maybe 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 -> Maybe Integer
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"fractional" else Integer -> Maybe Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Maybe Integer) -> Integer -> Maybe 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 -> Maybe Float
fromValue = String
-> (Integer -> Integer -> Maybe Float) -> Value -> Maybe Float
forall a.
String -> (Integer -> Integer -> Maybe a) -> Value -> Maybe a
withNumber String
"Float" ((Integer -> Integer -> Maybe Float) -> Value -> Maybe Float)
-> (Integer -> Integer -> Maybe Float) -> Value -> Maybe Float
forall a b. (a -> b) -> a -> b
$ \ Integer
x Integer
y ->
        Float -> Maybe Float
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Float -> Maybe Float)
-> (Number -> Float) -> Number -> Maybe 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 -> Maybe Float) -> Number -> Maybe Float
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Number
Number.Number Integer
x Integer
y

instance FromValue Double where
    fromValue :: Value -> Maybe Double
fromValue = String
-> (Integer -> Integer -> Maybe Double) -> Value -> Maybe Double
forall a.
String -> (Integer -> Integer -> Maybe a) -> Value -> Maybe a
withNumber String
"Double" ((Integer -> Integer -> Maybe Double) -> Value -> Maybe Double)
-> (Integer -> Integer -> Maybe Double) -> Value -> Maybe Double
forall a b. (a -> b) -> a -> b
$ \ Integer
x Integer
y ->
        Double -> Maybe Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Maybe Double)
-> (Number -> Double) -> Number -> Maybe 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 -> Maybe Double) -> Number -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Number
Number.Number Integer
x Integer
y

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

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

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

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

instance FromValue () where
    fromValue :: Value -> Maybe ()
fromValue Value
x = do
        [] <- Value -> Maybe [Value]
forall a. FromValue a => Value -> Maybe a
fromValue Value
x :: Maybe [Type.Value]
        () -> Maybe ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance (FromValue a, FromValue b) => FromValue (a, b) where
    fromValue :: Value -> Maybe (a, b)
fromValue Value
x = do
        [Value
y, Value
z] <- Value -> Maybe [Value]
forall a. FromValue a => Value -> Maybe a
fromValue Value
x
        (,) (a -> b -> (a, b)) -> Maybe a -> Maybe (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Maybe a
forall a. FromValue a => Value -> Maybe a
fromValue Value
y Maybe (b -> (a, b)) -> Maybe b -> Maybe (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Maybe b
forall a. FromValue a => Value -> Maybe a
fromValue Value
z

instance FromValue a => FromValue (Data.Array.Array Int a) where
    fromValue :: Value -> Maybe (Array Int a)
fromValue = String
-> (Array Int Value -> Maybe (Array Int a))
-> Value
-> Maybe (Array Int a)
forall a.
String -> (Array Int Value -> Maybe a) -> Value -> Maybe a
withArray String
"Array" ((Array Int Value -> Maybe (Array Int a))
 -> Value -> Maybe (Array Int a))
-> (Array Int Value -> Maybe (Array Int a))
-> Value
-> Maybe (Array Int a)
forall a b. (a -> b) -> a -> b
$ (Value -> Maybe a) -> Array Int Value -> Maybe (Array Int a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Maybe a
forall a. FromValue a => Value -> Maybe a
fromValue

instance FromValue a => FromValue [a] where
    fromValue :: Value -> Maybe [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]) -> Maybe (Array Int a) -> Maybe [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 (Maybe (Array Int a) -> Maybe [a])
-> (Value -> Maybe (Array Int a)) -> Value -> Maybe [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Maybe (Array Int a)
forall a. FromValue a => Value -> Maybe a
fromValue

instance FromValue a => FromValue (NonEmpty.NonEmpty a) where
    fromValue :: Value -> Maybe (NonEmpty a)
fromValue = [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty ([a] -> Maybe (NonEmpty a))
-> (Value -> Maybe [a]) -> Value -> Maybe (NonEmpty a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Maybe [a]
forall a. FromValue a => Value -> Maybe a
fromValue

instance FromValue a => FromValue (Map.Map Text.Text a) where
    fromValue :: Value -> Maybe (Map Text a)
fromValue = String
-> (Array Int (Pair String Value) -> Maybe (Map Text a))
-> Value
-> Maybe (Map Text a)
forall a.
String
-> (Array Int (Pair String Value) -> Maybe a) -> Value -> Maybe a
withObject String
"Map"
        ((Array Int (Pair String Value) -> Maybe (Map Text a))
 -> Value -> Maybe (Map Text a))
-> (Array Int (Pair String Value) -> Maybe (Map Text a))
-> Value
-> Maybe (Map Text a)
forall a b. (a -> b) -> a -> b
$ ([(Text, a)] -> Map Text a)
-> Maybe [(Text, a)] -> Maybe (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
        (Maybe [(Text, a)] -> Maybe (Map Text a))
-> (Array Int (Pair String Value) -> Maybe [(Text, a)])
-> Array Int (Pair String Value)
-> Maybe (Map Text a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pair String Value -> Maybe (Text, a))
-> [Pair String Value] -> Maybe [(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)) -> Maybe a -> Maybe (Text, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Maybe a
forall a. FromValue a => Value -> Maybe a
fromValue Value
v)
        ([Pair String Value] -> Maybe [(Text, a)])
-> (Array Int (Pair String Value) -> [Pair String Value])
-> Array Int (Pair String Value)
-> Maybe [(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 -> Maybe a) -> Type.Value -> Maybe a
withBoolean :: String -> (Bool -> Maybe a) -> Value -> Maybe a
withBoolean String
s Bool -> Maybe a
f Value
x = case Value
x of
    Value.Boolean (Boolean.Boolean Bool
y) -> Bool -> Maybe a
f Bool
y
    Value
_ -> String -> Maybe a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
s

withNumber :: String -> (Integer -> Integer -> Maybe a) -> Type.Value -> Maybe a
withNumber :: String -> (Integer -> Integer -> Maybe a) -> Value -> Maybe a
withNumber String
s Integer -> Integer -> Maybe a
f Value
x = case Value
x of
    Value.Number (Number.Number Integer
y Integer
z) -> Integer -> Integer -> Maybe a
f Integer
y Integer
z
    Value
_ -> String -> Maybe a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
s

withString :: String -> (Text.Text -> Maybe a) -> Type.Value -> Maybe a
withString :: String -> (Text -> Maybe a) -> Value -> Maybe a
withString String
s Text -> Maybe a
f Value
x = case Value
x of
    Value.String (String.String Text
y) -> Text -> Maybe a
f Text
y
    Value
_ -> String -> Maybe a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
s

withArray :: String -> (Data.Array.Array Int Type.Value -> Maybe a) -> Type.Value -> Maybe a
withArray :: String -> (Array Int Value -> Maybe a) -> Value -> Maybe a
withArray String
s Array Int Value -> Maybe a
f Value
x = case Value
x of
    Value.Array (Array.Array Array Int Value
y) -> Array Int Value -> Maybe a
f Array Int Value
y
    Value
_ -> String -> Maybe a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
s

withObject :: String -> (Data.Array.Array Int (Pair.Pair String.String Type.Value) -> Maybe a) -> Type.Value -> Maybe a
withObject :: String
-> (Array Int (Pair String Value) -> Maybe a) -> Value -> Maybe a
withObject String
s Array Int (Pair String Value) -> Maybe a
f Value
x = case Value
x of
    Value.Object (Object.Object Array Int (Pair String Value)
y) -> Array Int (Pair String Value) -> Maybe a
f Array Int (Pair String Value)
y
    Value
_ -> String -> Maybe a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
s