{-# LANGUAGE FlexibleInstances #-}

module Argo.Class.ToValue where

import qualified Argo.Type as Type
import qualified Argo.Type.Array as Array
import qualified Argo.Type.Boolean as Boolean
import qualified Argo.Type.Null as Null
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.Int as Int
import qualified Data.List as List
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
import qualified Numeric

class ToValue a where
    toValue :: a -> Type.Value

instance ToValue Type.Value where
    toValue :: Value -> Value
toValue = Value -> Value
forall a. a -> a
id

instance ToValue Bool where
    toValue :: Bool -> Value
toValue = Boolean -> Value
Value.Boolean (Boolean -> Value) -> (Bool -> Boolean) -> Bool -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Boolean
Boolean.Boolean

instance ToValue Char where
    toValue :: Char -> Value
toValue = Text -> Value
forall a. ToValue a => a -> Value
toValue (Text -> Value) -> (Char -> Text) -> Char -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
Text.singleton

instance ToValue Int where
    toValue :: Int -> Value
toValue = Integer -> Value
forall a. ToValue a => a -> Value
toValue (Integer -> Value) -> (Int -> Integer) -> Int -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger

instance ToValue Int.Int8 where
    toValue :: Int8 -> Value
toValue = Integer -> Value
forall a. ToValue a => a -> Value
toValue (Integer -> Value) -> (Int8 -> Integer) -> Int8 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Integer
forall a. Integral a => a -> Integer
toInteger

instance ToValue Int.Int16 where
    toValue :: Int16 -> Value
toValue = Integer -> Value
forall a. ToValue a => a -> Value
toValue (Integer -> Value) -> (Int16 -> Integer) -> Int16 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Integer
forall a. Integral a => a -> Integer
toInteger

instance ToValue Int.Int32 where
    toValue :: Int32 -> Value
toValue = Integer -> Value
forall a. ToValue a => a -> Value
toValue (Integer -> Value) -> (Int32 -> Integer) -> Int32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger

instance ToValue Int.Int64 where
    toValue :: Int64 -> Value
toValue = Integer -> Value
forall a. ToValue a => a -> Value
toValue (Integer -> Value) -> (Int64 -> Integer) -> Int64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger

instance ToValue Word where
    toValue :: Word -> Value
toValue = Integer -> Value
forall a. ToValue a => a -> Value
toValue (Integer -> Value) -> (Word -> Integer) -> Word -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger

instance ToValue Word.Word8 where
    toValue :: Word8 -> Value
toValue = Integer -> Value
forall a. ToValue a => a -> Value
toValue (Integer -> Value) -> (Word8 -> Integer) -> Word8 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger

instance ToValue Word.Word16 where
    toValue :: Word16 -> Value
toValue = Integer -> Value
forall a. ToValue a => a -> Value
toValue (Integer -> Value) -> (Word16 -> Integer) -> Word16 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Integer
forall a. Integral a => a -> Integer
toInteger

instance ToValue Word.Word32 where
    toValue :: Word32 -> Value
toValue = Integer -> Value
forall a. ToValue a => a -> Value
toValue (Integer -> Value) -> (Word32 -> Integer) -> Word32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger

instance ToValue Word.Word64 where
    toValue :: Word64 -> Value
toValue = Integer -> Value
forall a. ToValue a => a -> Value
toValue (Integer -> Value) -> (Word64 -> Integer) -> Word64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger

instance ToValue Integer where
    toValue :: Integer -> Value
toValue = Number -> Value
Value.Number (Number -> Value) -> (Integer -> Number) -> Integer -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Number) -> Integer -> Integer -> Number
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Integer -> Number
Number.number Integer
0

instance ToValue Float where
    toValue :: Float -> Value
toValue = Float -> Value
forall a. RealFloat a => a -> Value
realFloatToValue

instance ToValue Double where
    toValue :: Double -> Value
toValue = Double -> Value
forall a. RealFloat a => a -> Value
realFloatToValue

instance {-# OVERLAPPING #-} ToValue String where
    toValue :: String -> Value
toValue = Text -> Value
forall a. ToValue a => a -> Value
toValue (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

instance ToValue Text.Text where
    toValue :: Text -> Value
toValue = String -> Value
Value.String (String -> Value) -> (Text -> String) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
String.String

instance ToValue LazyText.Text where
    toValue :: Text -> Value
toValue = Text -> Value
forall a. ToValue a => a -> Value
toValue (Text -> Value) -> (Text -> Text) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LazyText.toStrict

instance ToValue a => ToValue (Maybe a) where
    toValue :: Maybe a -> Value
toValue = Value -> (a -> Value) -> Maybe a -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Null -> Value
Value.Null (Null -> Value) -> Null -> Value
forall a b. (a -> b) -> a -> b
$ () -> Null
Null.Null ()) a -> Value
forall a. ToValue a => a -> Value
toValue

instance ToValue () where
    toValue :: () -> Value
toValue = Value -> () -> Value
forall a b. a -> b -> a
const (Value -> () -> Value) -> Value -> () -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Value
forall a. ToValue a => a -> Value
toValue ([] :: [Type.Value])

instance (ToValue a, ToValue b) => ToValue (a, b) where
    toValue :: (a, b) -> Value
toValue (a
x, b
y) = [Value] -> Value
forall a. ToValue a => a -> Value
toValue [a -> Value
forall a. ToValue a => a -> Value
toValue a
x, b -> Value
forall a. ToValue a => a -> Value
toValue b
y]

instance ToValue a => ToValue (Data.Array.Array Int a) where
    toValue :: Array Int a -> Value
toValue = Array Value -> Value
Value.Array (Array Value -> Value)
-> (Array Int a -> Array Value) -> Array Int a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int Value -> Array Value
forall a. Array Int a -> Array a
Array.Array (Array Int Value -> Array Value)
-> (Array Int a -> Array Int Value) -> Array Int a -> Array Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> Array Int a -> Array Int Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Value
forall a. ToValue a => a -> Value
toValue

instance ToValue a => ToValue [a] where
    toValue :: [a] -> Value
toValue =
        let
            listToArray :: [b] -> Data.Array.Array Int b
            listToArray :: [b] -> Array Int b
listToArray [b]
xs = (Int, Int) -> [b] -> Array Int b
forall i e. Ix i => (i, i) -> [e] -> Array i e
Data.Array.listArray (Int
0, [b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [b]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [b]
xs
        in Array Int a -> Value
forall a. ToValue a => a -> Value
toValue (Array Int a -> Value) -> ([a] -> Array Int a) -> [a] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Array Int a
forall b. [b] -> Array Int b
listToArray

instance ToValue a => ToValue (NonEmpty.NonEmpty a) where
    toValue :: NonEmpty a -> Value
toValue = [a] -> Value
forall a. ToValue a => a -> Value
toValue ([a] -> Value) -> (NonEmpty a -> [a]) -> NonEmpty a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NonEmpty.toList

instance ToValue a => ToValue (Map.Map Text.Text a) where
    toValue :: Map Text a -> Value
toValue Map Text a
x = Object Value -> Value
Value.Object
        (Object Value -> Value)
-> ([(Text, a)] -> Object Value) -> [(Text, a)] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int (Pair String Value) -> Object Value
forall a. Array Int (Pair String a) -> Object a
Object.Object
        (Array Int (Pair String Value) -> Object Value)
-> ([(Text, a)] -> Array Int (Pair String Value))
-> [(Text, a)]
-> Object Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> [Pair String Value] -> Array Int (Pair String Value)
forall i e. Ix i => (i, i) -> [e] -> Array i e
Data.Array.listArray (Int
0, Map Text a -> Int
forall k a. Map k a -> Int
Map.size Map Text a
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        ([Pair String Value] -> Array Int (Pair String Value))
-> ([(Text, a)] -> [Pair String Value])
-> [(Text, a)]
-> Array Int (Pair String Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, a) -> Pair String Value)
-> [(Text, a)] -> [Pair String Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (Text
k, a
v) -> (String, Value) -> Pair String Value
forall k v. (k, v) -> Pair k v
Pair.Pair (Text -> String
String.String Text
k, a -> Value
forall a. ToValue a => a -> Value
toValue a
v))
        ([(Text, a)] -> Value) -> [(Text, a)] -> Value
forall a b. (a -> b) -> a -> b
$ Map Text a -> [(Text, a)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map Text a
x

realFloatToValue :: RealFloat a => a -> Value.Value
realFloatToValue :: a -> Value
realFloatToValue a
x
    | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x = Null -> Value
Value.Null (Null -> Value) -> Null -> Value
forall a b. (a -> b) -> a -> b
$ () -> Null
Null.Null ()
    | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x = Null -> Value
Value.Null (Null -> Value) -> Null -> Value
forall a b. (a -> b) -> a -> b
$ () -> Null
Null.Null ()
    | Bool
otherwise = Number -> Value
Value.Number (Number -> Value)
-> (([Int], Int) -> Number) -> ([Int], Int) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int] -> Int -> Number) -> ([Int], Int) -> Number
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Int] -> Int -> Number
digitsToNumber (([Int], Int) -> Value) -> ([Int], Int) -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> a -> ([Int], Int)
forall a. RealFloat a => Integer -> a -> ([Int], Int)
Numeric.floatToDigits Integer
10 a
x

digitsToNumber :: [Int] -> Int -> Number.Number
digitsToNumber :: [Int] -> Int -> Number
digitsToNumber [Int]
ds Int
e = (Integer -> Integer -> Number) -> (Integer, Integer) -> Number
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Integer -> Integer -> Number
Number.number ((Integer, Integer) -> Number) -> (Integer, Integer) -> Number
forall a b. (a -> b) -> a -> b
$ ((Integer, Integer) -> Int -> (Integer, Integer))
-> (Integer, Integer) -> [Int] -> (Integer, Integer)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
    (\ (Integer
a, Integer
n) Int
d -> (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
d, Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1))
    (Integer
0, Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
e)
    [Int]
ds