module Data.ProtocolBuffers.Types
( Field(..)
, HasField(..)
, Required
, RequiredField(..)
, Optional
, OptionalField(..)
, Repeated
, RepeatedField(..)
, Packed
, Value(..)
, Enumeration(..)
, Fixed(..)
, Signed(..)
, Always(..)
, PackedList(..)
, PackedField(..)
) where
import Control.DeepSeq (NFData)
import Data.Bits
import Data.Foldable as Fold
import Data.Monoid
import Data.Traversable
import Data.Typeable
newtype Value a = Value {runValue :: a}
deriving (Bounded, Eq, Enum, Foldable, Functor, Monoid, Ord, NFData, Show, Traversable, Typeable)
newtype RequiredField a = Required {runRequired :: a}
deriving (Bounded, Eq, Enum, Foldable, Functor, Monoid, Ord, NFData, Show, Traversable, Typeable)
newtype OptionalField a = Optional {runOptional :: a}
deriving (Bounded, Eq, Enum, Foldable, Functor, Monoid, Ord, NFData, Show, Traversable, Typeable)
newtype RepeatedField a = Repeated {runRepeated :: a}
deriving (Bounded, Eq, Enum, Foldable, Functor, Monoid, Ord, NFData, Show, Traversable, Typeable)
newtype Field (n :: *) a = Field {runField :: a}
deriving (Bounded, Eq, Enum, Foldable, Functor, Monoid, Ord, NFData, Show, Traversable, Typeable)
newtype Always a = Always {runAlways :: a}
deriving (Bounded, Eq, Enum, Foldable, Functor, Ord, NFData, Show, Traversable, Typeable)
instance Monoid (Always a) where
mempty = error "Always is not a Monoid"
mappend _ y = y
class HasField a where
type FieldType a :: *
getField :: a -> FieldType a
putField :: FieldType a -> a
field :: Functor f => (FieldType a -> f (FieldType a)) -> a -> f a
field f = fmap putField . f . getField
instance HasField (Field n (RequiredField (Always (Value a)))) where
type FieldType (Field n (RequiredField (Always (Value a)))) = a
getField = runValue . runAlways . runRequired . runField
putField = Field . Required . Always . Value
instance HasField (Field n (RequiredField (Always (Enumeration a)))) where
type FieldType (Field n (RequiredField (Always (Enumeration a)))) = a
getField = runEnumeration . runAlways . runRequired . runField
putField = Field . Required . Always . Enumeration
instance HasField (Field n (OptionalField (Last (Value a)))) where
type FieldType (Field n (OptionalField (Last (Value a)))) = Maybe a
getField = fmap runValue . getLast . runOptional . runField
putField = Field . Optional . Last . fmap Value
instance HasField (Field n (OptionalField (Last (Enumeration a)))) where
type FieldType (Field n (OptionalField (Last (Enumeration a)))) = Maybe a
getField = fmap runEnumeration . getLast . runOptional . runField
putField = Field . Optional . Last . fmap Enumeration
instance HasField (Field n (RepeatedField [Value a])) where
type FieldType (Field n (RepeatedField [Value a])) = [a]
getField = fmap runValue . runRepeated . runField
putField = Field . Repeated . fmap Value
instance HasField (Field n (RepeatedField [Enumeration a])) where
type FieldType (Field n (RepeatedField [Enumeration a])) = [a]
getField = fmap runEnumeration . runRepeated . runField
putField = Field . Repeated . fmap Enumeration
instance HasField (Field n (PackedField (PackedList (Value a)))) where
type FieldType (Field n (PackedField (PackedList (Value a)))) = [a]
getField = fmap runValue . unPackedList . runPackedField . runField
putField = Field . PackedField . PackedList . fmap Value
instance HasField (Field n (PackedField (PackedList (Enumeration a)))) where
type FieldType (Field n (PackedField (PackedList (Enumeration a)))) = [a]
getField = fmap runEnumeration . unPackedList . runPackedField . runField
putField = Field . PackedField . PackedList . fmap Enumeration
type family Optional (n :: *) (a :: *) :: *
type instance Optional n (Value a) = Field n (OptionalField (Last (Value a)))
type instance Optional n (Enumeration a) = Field n (OptionalField (Last (Enumeration a)))
type family Required (n :: *) (a :: *) :: *
type instance Required n (Value a) = Field n (RequiredField (Always (Value a)))
type instance Required n (Enumeration a) = Field n (RequiredField (Always (Enumeration a)))
type Repeated n a = Field n (RepeatedField [a])
type Packed n a = Field n (PackedField (PackedList a))
newtype Enumeration a = Enumeration {runEnumeration :: a}
deriving (Bounded, Eq, Enum, Foldable, Functor, Ord, Monoid, NFData, Show, Traversable, Typeable)
newtype PackedField a = PackedField {runPackedField :: a}
deriving (Eq, Foldable, Functor, Monoid, NFData, Ord, Show, Traversable, Typeable)
newtype PackedList a = PackedList {unPackedList :: [a]}
deriving (Eq, Foldable, Functor, Monoid, NFData, Ord, Show, Traversable, Typeable)
newtype Signed a = Signed a
deriving (Bits, Bounded, Enum, Eq, Floating, Foldable, Fractional, Functor, Integral, Monoid, NFData, Num, Ord, Real, RealFloat, RealFrac, Show, Traversable, Typeable)
newtype Fixed a = Fixed a
deriving (Bits, Bounded, Enum, Eq, Floating, Foldable, Fractional, Functor, Integral, Monoid, NFData, Num, Ord, Real, RealFloat, RealFrac, Show, Traversable, Typeable)