{-# LANGUAGE DeriveDataTypeable  #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving  #-}
{-# LANGUAGE TypeOperators       #-}
-- |
-- Module      :  Pinch.Internal.Value
-- Copyright   :  (c) Abhinav Gupta 2015
-- License     :  BSD3
--
-- Maintainer  :  Abhinav Gupta <mail@abhinavg.net>
-- Stability   :  experimental
--
-- This module defines an intermediate representation for Thrift values and
-- functions to work with the intermediate representation.
module Pinch.Internal.Value
    ( Value(..)
    , MapItem(..)
    , SomeValue(..)
    , castValue
    , valueTType
    ) where

import Control.DeepSeq     (NFData (..))
import Data.ByteString     (ByteString)
import Data.Hashable       (Hashable (..))
import Data.HashMap.Strict (HashMap)
import Data.Int            (Int16, Int32, Int64, Int8)
import Data.List           (intercalate)
import Data.Typeable       ((:~:) (..), Typeable)

import qualified Data.Foldable       as F
import qualified Data.HashMap.Strict as M
import qualified Data.HashSet        as S

import Pinch.Internal.FoldList (FoldList)
import Pinch.Internal.TType

-- | A single item in a map
data MapItem k v = MapItem !(Value k) !(Value v)
  deriving (MapItem k v -> MapItem k v -> Bool
(MapItem k v -> MapItem k v -> Bool)
-> (MapItem k v -> MapItem k v -> Bool) -> Eq (MapItem k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. MapItem k v -> MapItem k v -> Bool
/= :: MapItem k v -> MapItem k v -> Bool
$c/= :: forall k v. MapItem k v -> MapItem k v -> Bool
== :: MapItem k v -> MapItem k v -> Bool
$c== :: forall k v. MapItem k v -> MapItem k v -> Bool
Eq, Typeable)

instance NFData (MapItem k v) where
    rnf :: MapItem k v -> ()
rnf (MapItem Value k
k Value v
v) = Value k -> ()
forall a. NFData a => a -> ()
rnf Value k
k () -> () -> ()
`seq` Value v -> ()
forall a. NFData a => a -> ()
rnf Value v
v () -> () -> ()
`seq` ()

instance Hashable (MapItem k v) where
    hashWithSalt :: Int -> MapItem k v -> Int
hashWithSalt Int
s (MapItem Value k
k Value v
v) = Int
s Int -> Value k -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Value k
k Int -> Value v -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Value v
v

instance Show (MapItem k v) where
    show :: MapItem k v -> String
show (MapItem Value k
k Value v
v) = Value k -> String
forall a. Show a => a -> String
show Value k
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value v -> String
forall a. Show a => a -> String
show Value v
v

-- | @Value@ maps directly to serialized representation of Thrift types. It
-- contains about as much information as what gets sent over the wire.
-- @Value@ objects are tagged with different 'TType' values to indicate the
-- type of the value.
--
-- Typical usage will not involve accessing the constructors for this type.
-- 'Pinch.Pinchable.Pinchable' must be used to construct 'Value' objects or
-- convert them back to original types.
data Value a where
    VBool   :: !Bool                      -> Value TBool
    VByte   :: !Int8                      -> Value TByte
    VDouble :: !Double                    -> Value TDouble
    VInt16  :: !Int16                     -> Value TInt16
    VInt32  :: !Int32                     -> Value TInt32
    VInt64  :: !Int64                     -> Value TInt64
    VBinary :: !ByteString                -> Value TBinary
    VStruct :: !(HashMap Int16 SomeValue) -> Value TStruct

    VMap  :: forall k v. (IsTType k, IsTType v)
          => !(FoldList (MapItem k v)) -> Value TMap
    VNullMap :: Value TMap
    VSet  :: forall a. IsTType a => !(FoldList (Value a)) -> Value TSet
    VList :: forall a. IsTType a => !(FoldList (Value a)) -> Value TList
  deriving Typeable

instance Show (Value a) where
    show :: Value a -> String
show (VBool   Bool
x) = Bool -> String
forall a. Show a => a -> String
show Bool
x
    show (VByte   Int8
x) = Int8 -> String
forall a. Show a => a -> String
show Int8
x
    show (VDouble Double
x) = Double -> String
forall a. Show a => a -> String
show Double
x
    show (VInt16  Int16
x) = String
"i16(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int16 -> String
forall a. Show a => a -> String
show Int16
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    show (VInt32  Int32
x) = String
"i32(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int32 -> String
forall a. Show a => a -> String
show Int32
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    show (VInt64  Int64
x) = String
"i64(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int64 -> String
forall a. Show a => a -> String
show Int64
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    show (VBinary ByteString
x) = ByteString -> String
forall a. Show a => a -> String
show ByteString
x

    show (VStruct HashMap Int16 SomeValue
x) = String
"{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
      where
        s :: String
s = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (([String] -> Int16 -> SomeValue -> [String])
-> [String] -> HashMap Int16 SomeValue -> [String]
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
M.foldlWithKey' [String] -> Int16 -> SomeValue -> [String]
forall p. Show p => [String] -> p -> SomeValue -> [String]
go [] HashMap Int16 SomeValue
x)
        go :: [String] -> p -> SomeValue -> [String]
go [String]
xs p
i (SomeValue Value a
val) = (p -> String
forall a. Show a => a -> String
show p
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value a -> String
forall a. Show a => a -> String
show Value a
val)String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
xs

    show (VMap FoldList (MapItem k v)
x) = FoldList (MapItem k v) -> String
forall a. Show a => a -> String
show FoldList (MapItem k v)
x
    show Value a
VNullMap = String
"[]"
    show (VSet  FoldList (Value a)
x) = FoldList (Value a) -> String
forall a. Show a => a -> String
show FoldList (Value a)
x
    show (VList FoldList (Value a)
x) = FoldList (Value a) -> String
forall a. Show a => a -> String
show FoldList (Value a)
x

instance Eq (Value a) where
    VBool   Bool
a == :: Value a -> Value a -> Bool
== VBool   Bool
b = Bool
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
b
    VByte   Int8
a == VByte   Int8
b = Int8
a Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
b
    VDouble Double
a == VDouble Double
b = Double
a Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
b
    VInt16  Int16
a == VInt16  Int16
b = Int16
a Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== Int16
b
    VInt32  Int32
a == VInt32  Int32
b = Int32
a Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
b
    VInt64  Int64
a == VInt64  Int64
b = Int64
a Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
b
    VBinary ByteString
a == VBinary ByteString
b = ByteString
a ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
b
    VStruct HashMap Int16 SomeValue
a == VStruct HashMap Int16 SomeValue
b = HashMap Int16 SomeValue
a HashMap Int16 SomeValue -> HashMap Int16 SomeValue -> Bool
forall a. Eq a => a -> a -> Bool
== HashMap Int16 SomeValue
b

    VList FoldList (Value a)
as == VList FoldList (Value a)
bs = FoldList (Value a) -> FoldList (Value a) -> Bool
forall a b (f :: * -> *).
(IsTType a, IsTType b, Foldable f, Eq (f (Value a))) =>
f (Value a) -> f (Value b) -> Bool
areEqual1 FoldList (Value a)
as FoldList (Value a)
bs
    VMap FoldList (MapItem k v)
as == VMap  FoldList (MapItem k v)
bs = [(Value k, Value v)] -> [(Value k, Value v)] -> Bool
forall k1 v1 k2 v2.
(IsTType k1, IsTType v1, IsTType k2, IsTType v2) =>
[(Value k1, Value v1)] -> [(Value k2, Value v2)] -> Bool
areEqual2 (FoldList (MapItem k v) -> [(Value k, Value v)]
forall k v. FoldList (MapItem k v) -> [(Value k, Value v)]
toMap FoldList (MapItem k v)
as) (FoldList (MapItem k v) -> [(Value k, Value v)]
forall k v. FoldList (MapItem k v) -> [(Value k, Value v)]
toMap FoldList (MapItem k v)
bs)
      where
        toMap :: FoldList (MapItem k v) -> [(Value k, Value v)]
toMap = HashMap (Value k) (Value v) -> [(Value k, Value v)]
forall k v. HashMap k v -> [(k, v)]
M.toList (HashMap (Value k) (Value v) -> [(Value k, Value v)])
-> (FoldList (MapItem k v) -> HashMap (Value k) (Value v))
-> FoldList (MapItem k v)
-> [(Value k, Value v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap (Value k) (Value v)
 -> MapItem k v -> HashMap (Value k) (Value v))
-> HashMap (Value k) (Value v)
-> FoldList (MapItem k v)
-> HashMap (Value k) (Value v)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' (\HashMap (Value k) (Value v)
m (MapItem Value k
k Value v
v) -> Value k
-> Value v
-> HashMap (Value k) (Value v)
-> HashMap (Value k) (Value v)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert Value k
k Value v
v HashMap (Value k) (Value v)
m) HashMap (Value k) (Value v)
forall k v. HashMap k v
M.empty
    Value a
VNullMap == VMap FoldList (MapItem k v)
xs  = FoldList (MapItem k v)
forall a. Monoid a => a
mempty FoldList (MapItem k v) -> FoldList (MapItem k v) -> Bool
forall a. Eq a => a -> a -> Bool
== FoldList (MapItem k v)
xs
    VMap FoldList (MapItem k v)
xs  == Value a
VNullMap = FoldList (MapItem k v)
xs FoldList (MapItem k v) -> FoldList (MapItem k v) -> Bool
forall a. Eq a => a -> a -> Bool
== FoldList (MapItem k v)
forall a. Monoid a => a
mempty
    VSet FoldList (Value a)
as  == VSet FoldList (Value a)
bs  = HashSet (Value a) -> HashSet (Value a) -> Bool
forall a b (f :: * -> *).
(IsTType a, IsTType b, Foldable f, Eq (f (Value a))) =>
f (Value a) -> f (Value b) -> Bool
areEqual1 (FoldList (Value a) -> HashSet (Value a)
forall (f :: * -> *) x.
(Foldable f, Hashable x, Eq x) =>
f x -> HashSet x
toSet FoldList (Value a)
as) (FoldList (Value a) -> HashSet (Value a)
forall (f :: * -> *) x.
(Foldable f, Hashable x, Eq x) =>
f x -> HashSet x
toSet FoldList (Value a)
bs)
    Value a
_ == Value a
_ = Bool
False

toSet :: forall f x. (F.Foldable f, Hashable x, Eq x) => f x -> S.HashSet x
toSet :: f x -> HashSet x
toSet = (HashSet x -> x -> HashSet x) -> HashSet x -> f x -> HashSet x
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' ((x -> HashSet x -> HashSet x) -> HashSet x -> x -> HashSet x
forall a b c. (a -> b -> c) -> b -> a -> c
flip x -> HashSet x -> HashSet x
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
S.insert) HashSet x
forall a. HashSet a
S.empty

instance NFData (Value a) where
    rnf :: Value a -> ()
rnf (VBool   Bool
a) = Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
a
    rnf (VByte   Int8
a) = Int8 -> ()
forall a. NFData a => a -> ()
rnf Int8
a
    rnf (VDouble Double
a) = Double -> ()
forall a. NFData a => a -> ()
rnf Double
a
    rnf (VInt16  Int16
a) = Int16 -> ()
forall a. NFData a => a -> ()
rnf Int16
a
    rnf (VInt32  Int32
a) = Int32 -> ()
forall a. NFData a => a -> ()
rnf Int32
a
    rnf (VInt64  Int64
a) = Int64 -> ()
forall a. NFData a => a -> ()
rnf Int64
a
    rnf (VBinary ByteString
a) = ByteString -> ()
forall a. NFData a => a -> ()
rnf ByteString
a
    rnf (VStruct HashMap Int16 SomeValue
a) = HashMap Int16 SomeValue -> ()
forall a. NFData a => a -> ()
rnf HashMap Int16 SomeValue
a
    rnf (VMap   FoldList (MapItem k v)
as) = FoldList (MapItem k v) -> ()
forall a. NFData a => a -> ()
rnf FoldList (MapItem k v)
as
    rnf Value a
VNullMap    = ()
    rnf (VSet   FoldList (Value a)
as) = FoldList (Value a) -> ()
forall a. NFData a => a -> ()
rnf FoldList (Value a)
as
    rnf (VList  FoldList (Value a)
as) = FoldList (Value a) -> ()
forall a. NFData a => a -> ()
rnf FoldList (Value a)
as

-- | 'SomeValue' holds any value, regardless of type. This may be used when
-- the type of the value is not necessarily known at compile time. Typically,
-- this will be pattern matched on and code that depends on the value's
-- 'TType' will go inside the scope of the match.
data SomeValue where
    SomeValue :: (IsTType a) => !(Value a) -> SomeValue
  deriving Typeable

deriving instance Show SomeValue

instance Eq SomeValue where
    SomeValue Value a
a == :: SomeValue -> SomeValue -> Bool
== SomeValue Value a
b = Value a -> Value a -> Bool
forall a b. (IsTType a, IsTType b) => Value a -> Value b -> Bool
areEqual Value a
a Value a
b

instance NFData SomeValue where
    rnf :: SomeValue -> ()
rnf (SomeValue Value a
a) = Value a -> ()
forall a. NFData a => a -> ()
rnf Value a
a

-- | Safely attempt to cast a Value into another.
castValue :: forall a b. (IsTType a, IsTType b) => Value a -> Maybe (Value b)
castValue :: Value a -> Maybe (Value b)
castValue Value a
v = case Maybe (a :~: b)
forall a b. (IsTType a, IsTType b) => Maybe (a :~: b)
ttypeEqT :: Maybe (a :~: b) of
    Just a :~: b
Refl -> Value a -> Maybe (Value a)
forall a. a -> Maybe a
Just Value a
v
    Maybe (a :~: b)
Nothing -> Maybe (Value b)
forall a. Maybe a
Nothing
{-# INLINE castValue #-}

-- | Get the 'TType' of a 'Value'.
valueTType :: IsTType a => Value a -> TType a
valueTType :: Value a -> TType a
valueTType Value a
_ = TType a
forall a. IsTType a => TType a
ttype
{-# INLINE valueTType #-}

areEqual
    :: forall a b. (IsTType a, IsTType b) => Value a -> Value b -> Bool
areEqual :: Value a -> Value b -> Bool
areEqual Value a
l Value b
r = case Maybe (a :~: b)
forall a b. (IsTType a, IsTType b) => Maybe (a :~: b)
ttypeEqT :: Maybe (a :~: b) of
    Just a :~: b
Refl -> Value a
l Value a -> Value a -> Bool
forall a. Eq a => a -> a -> Bool
== Value a
Value b
r
    Maybe (a :~: b)
Nothing -> Bool
False
{-# INLINE areEqual #-}

areEqual1
    :: forall a b f. (IsTType a, IsTType b, F.Foldable f, Eq (f (Value a)))
    => f (Value a) -> f (Value b) -> Bool
areEqual1 :: f (Value a) -> f (Value b) -> Bool
areEqual1 f (Value a)
l f (Value b)
r = case Maybe (a :~: b)
forall a b. (IsTType a, IsTType b) => Maybe (a :~: b)
ttypeEqT of
    Just (a :~: b
Refl :: a :~: b) -> f (Value a)
l f (Value a) -> f (Value a) -> Bool
forall a. Eq a => a -> a -> Bool
== f (Value a)
f (Value b)
r
    Maybe (a :~: b)
Nothing -> Bool
False
{-# INLINE areEqual1 #-}

areEqual2
    :: forall k1 v1 k2 v2.
    ( IsTType k1, IsTType v1, IsTType k2, IsTType v2
    ) => [(Value k1, Value v1)] -> [(Value k2, Value v2)] -> Bool
areEqual2 :: [(Value k1, Value v1)] -> [(Value k2, Value v2)] -> Bool
areEqual2 [(Value k1, Value v1)]
l [(Value k2, Value v2)]
r = case Maybe (k1 :~: k2)
forall a b. (IsTType a, IsTType b) => Maybe (a :~: b)
ttypeEqT of
    Just (k1 :~: k2
Refl :: k1 :~: k2) -> case Maybe (v1 :~: v2)
forall a b. (IsTType a, IsTType b) => Maybe (a :~: b)
ttypeEqT of
        Just (v1 :~: v2
Refl :: v1 :~: v2) -> [(Value k1, Value v1)]
l [(Value k1, Value v1)] -> [(Value k1, Value v1)] -> Bool
forall a. Eq a => a -> a -> Bool
== [(Value k1, Value v1)]
[(Value k2, Value v2)]
r
        Maybe (v1 :~: v2)
Nothing -> Bool
False
    Maybe (k1 :~: k2)
Nothing -> Bool
False
{-# INLINE areEqual2 #-}

instance Hashable (Value a) where
    hashWithSalt :: Int -> Value a -> Int
hashWithSalt Int
s Value a
a = case Value a
a of
      VBinary ByteString
x -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
0 :: Int) Int -> ByteString -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` ByteString
x
      VBool   Bool
x -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
1 :: Int) Int -> Bool -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Bool
x
      VByte   Int8
x -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
2 :: Int) Int -> Int8 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int8
x
      VDouble Double
x -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
3 :: Int) Int -> Double -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Double
x
      VInt16  Int16
x -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
4 :: Int) Int -> Int16 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int16
x
      VInt32  Int32
x -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
5 :: Int) Int -> Int32 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int32
x
      VInt64  Int64
x -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
6 :: Int) Int -> Int64 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int64
x
      VList   FoldList (Value a)
x -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
7 :: Int) Int -> FoldList (Value a) -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` FoldList (Value a)
x
      VMap    FoldList (MapItem k v)
x -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
8 :: Int) Int -> FoldList (MapItem k v) -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` FoldList (MapItem k v)
x
      Value a
VNullMap  -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
8 :: Int)
      VSet    FoldList (Value a)
x -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
9 :: Int) Int -> FoldList (Value a) -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` FoldList (Value a)
x

      VStruct HashMap Int16 SomeValue
fields ->
        (Int -> Int16 -> SomeValue -> Int)
-> Int -> HashMap Int16 SomeValue -> Int
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
M.foldlWithKey' (\Int
s' Int16
k SomeValue
v -> Int
s' Int -> Int16 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int16
k Int -> SomeValue -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` SomeValue
v)
                        (Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
10 :: Int))
                        HashMap Int16 SomeValue
fields


instance Hashable SomeValue where
    hashWithSalt :: Int -> SomeValue -> Int
hashWithSalt Int
s (SomeValue Value a
v) = Int -> Value a -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s Value a
v