{-# LANGUAGE FlexibleInstances #-}

module Argo.Class.ToValue where

import qualified Argo.Json.Member as Member
import qualified Argo.Json.Number as Number
import qualified Argo.Json.Value as Value
import qualified Argo.Pattern as Pattern
import qualified Argo.Pointer.Pointer as Pointer
import qualified Argo.Type.Config as Config
import qualified Argo.Type.Decimal as Decimal
import qualified Argo.Type.Encoder as Encoder
import qualified Argo.Vendor.Builder as Builder
import qualified Argo.Vendor.ByteString as ByteString
import qualified Argo.Vendor.Text as Text
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.Word as Word
import qualified Numeric

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

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

instance ToValue Bool where
    toValue :: Bool -> Value
toValue = Bool -> Value
Pattern.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 Integer
x = Decimal -> Value
Pattern.Number (Decimal -> Value) -> Decimal -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Decimal
Decimal.decimal Integer
x 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 = Text -> Value
Pattern.String

instance ToValue Text.LazyText where
    toValue :: LazyText -> Value
toValue = Text -> Value
forall a. ToValue a => a -> Value
toValue (Text -> Value) -> (LazyText -> Text) -> LazyText -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyText -> Text
Text.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 Value
Pattern.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 ([] :: [Value.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 [a] where
    toValue :: [a] -> Value
toValue = [Value] -> Value
Pattern.Array ([Value] -> Value) -> ([a] -> [Value]) -> [a] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> [a] -> [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 (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 =
        [MemberOf Value] -> Value
Pattern.Object
            ([MemberOf Value] -> Value)
-> ([(Text, a)] -> [MemberOf Value]) -> [(Text, a)] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, a) -> MemberOf Value) -> [(Text, a)] -> [MemberOf Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Text
k, a
v) -> Name -> Value -> MemberOf Value
forall value. Name -> value -> MemberOf value
Member.Member (Text -> Name
Pattern.Name 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

instance ToValue Pointer.Pointer where
    toValue :: Pointer -> Value
toValue =
        (UnicodeException -> Value)
-> (Text -> Value) -> Either UnicodeException Text -> Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Value
forall a. HasCallStack => String -> a
error (String -> Value)
-> (UnicodeException -> String) -> UnicodeException -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall a. Monoid a => a -> a -> a
mappend String
"Pointer.toValue: " (String -> String)
-> (UnicodeException -> String) -> UnicodeException -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnicodeException -> String
forall a. Show a => a -> String
show) Text -> Value
forall a. ToValue a => a -> Value
toValue
            (Either UnicodeException Text -> Value)
-> (Pointer -> Either UnicodeException Text) -> Pointer -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
Text.decodeUtf8'
            (ByteString -> Either UnicodeException Text)
-> (Pointer -> ByteString)
-> Pointer
-> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
ByteString.toStrict
            (ByteString -> ByteString)
-> (Pointer -> ByteString) -> Pointer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString
            (Builder -> ByteString)
-> (Pointer -> Builder) -> Pointer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Encoder () -> Builder
forall a. Config -> Encoder a -> Builder
Encoder.run Config
Config.initial
            (Encoder () -> Builder)
-> (Pointer -> Encoder ()) -> Pointer -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pointer -> Encoder ()
Pointer.encode

realFloatToValue :: RealFloat a => a -> Value.Value
realFloatToValue :: a -> Value
realFloatToValue a
x
    | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x
    = Value
Pattern.Null
    | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x
    = Value
Pattern.Null
    | Bool
otherwise
    = let isNegative :: Bool
isNegative = a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0
      in
          Number -> Value
Value.Number
          (Number -> Value) -> (a -> Number) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decimal -> Number
Number.fromDecimal
          (Decimal -> Number) -> (a -> Decimal) -> a -> Number
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
isNegative then Decimal -> Decimal
Decimal.negate else Decimal -> Decimal
forall a. a -> a
id)
          (Decimal -> Decimal) -> (a -> Decimal) -> a -> Decimal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int] -> Int -> Decimal) -> ([Int], Int) -> Decimal
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Int] -> Int -> Decimal
digitsToDecimal
          (([Int], Int) -> Decimal) -> (a -> ([Int], Int)) -> a -> Decimal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a -> ([Int], Int)
forall a. RealFloat a => Integer -> a -> ([Int], Int)
Numeric.floatToDigits Integer
10
          (a -> Value) -> a -> Value
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Num a => a -> a
abs a
x

digitsToDecimal :: [Int] -> Int -> Decimal.Decimal
digitsToDecimal :: [Int] -> Int -> Decimal
digitsToDecimal [Int]
ds Int
e = (Integer -> Integer -> Decimal) -> (Integer, Integer) -> Decimal
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Integer -> Integer -> Decimal
Decimal.decimal ((Integer, Integer) -> Decimal) -> (Integer, Integer) -> Decimal
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