-- |
-- Module:      Data.ProtoBuf.WireType
-- Copyright:   (c) 2015-2016 Martijn Rijkeboer <mrr@sru-systems.com>
-- License:     MIT
-- Maintainer:  Martijn Rijkeboer <mrr@sru-systems.com>
--
-- WireType type and functions.

module Data.ProtoBuf.WireType
    ( WireType(..)
    , fromWireType
    , toWireType
    ) where


import Data.Bits ((.&.))
import Data.Word (Word32)


-- | Type to represent the Protocol Buffers wire type.
data WireType
    -- | The varint type: int32, int64, uint32, sint32, sint64, bool enum
    = VarInt
    -- | The 64-bit type: fixed64, sfixed64, double
    | Bit64
    -- | The length-delimited: string, bytes, embedded messages, packed repeated fields
    | LenDelim
    -- | The 32-bit type: fixed32, sfixed32, float
    | Bit32
    deriving (Int -> WireType -> ShowS
[WireType] -> ShowS
WireType -> String
(Int -> WireType -> ShowS)
-> (WireType -> String) -> ([WireType] -> ShowS) -> Show WireType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WireType] -> ShowS
$cshowList :: [WireType] -> ShowS
show :: WireType -> String
$cshow :: WireType -> String
showsPrec :: Int -> WireType -> ShowS
$cshowsPrec :: Int -> WireType -> ShowS
Show, WireType -> WireType -> Bool
(WireType -> WireType -> Bool)
-> (WireType -> WireType -> Bool) -> Eq WireType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WireType -> WireType -> Bool
$c/= :: WireType -> WireType -> Bool
== :: WireType -> WireType -> Bool
$c== :: WireType -> WireType -> Bool
Eq, Eq WireType
Eq WireType
-> (WireType -> WireType -> Ordering)
-> (WireType -> WireType -> Bool)
-> (WireType -> WireType -> Bool)
-> (WireType -> WireType -> Bool)
-> (WireType -> WireType -> Bool)
-> (WireType -> WireType -> WireType)
-> (WireType -> WireType -> WireType)
-> Ord WireType
WireType -> WireType -> Bool
WireType -> WireType -> Ordering
WireType -> WireType -> WireType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WireType -> WireType -> WireType
$cmin :: WireType -> WireType -> WireType
max :: WireType -> WireType -> WireType
$cmax :: WireType -> WireType -> WireType
>= :: WireType -> WireType -> Bool
$c>= :: WireType -> WireType -> Bool
> :: WireType -> WireType -> Bool
$c> :: WireType -> WireType -> Bool
<= :: WireType -> WireType -> Bool
$c<= :: WireType -> WireType -> Bool
< :: WireType -> WireType -> Bool
$c< :: WireType -> WireType -> Bool
compare :: WireType -> WireType -> Ordering
$ccompare :: WireType -> WireType -> Ordering
$cp1Ord :: Eq WireType
Ord)


-- | Convert a WireType into a Word32.
fromWireType :: WireType -> Word32
fromWireType :: WireType -> Word32
fromWireType WireType
VarInt   = Word32
0
fromWireType WireType
Bit64    = Word32
1
fromWireType WireType
LenDelim = Word32
2
fromWireType WireType
Bit32    = Word32
5


-- | Convert a Word32 into a WireType or an error.
toWireType :: Word32 -> Either String WireType
toWireType :: Word32 -> Either String WireType
toWireType Word32
i
    | Word32
wType Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 = WireType -> Either String WireType
forall a b. b -> Either a b
Right WireType
VarInt
    | Word32
wType Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
1 = WireType -> Either String WireType
forall a b. b -> Either a b
Right WireType
Bit64
    | Word32
wType Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
2 = WireType -> Either String WireType
forall a b. b -> Either a b
Right WireType
LenDelim
    | Word32
wType Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
3 = String -> Either String WireType
forall a b. a -> Either a b
Left String
"Deprecated WireType: 3 (Start Group)"
    | Word32
wType Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
4 = String -> Either String WireType
forall a b. a -> Either a b
Left String
"Deprecated WireType: 4 (End Group)"
    | Word32
wType Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
5 = WireType -> Either String WireType
forall a b. b -> Either a b
Right WireType
Bit32
    | Bool
otherwise  = String -> Either String WireType
forall a b. a -> Either a b
Left (String -> Either String WireType)
-> String -> Either String WireType
forall a b. (a -> b) -> a -> b
$ String
"Invalid WireType: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
wType
  where wType :: Word32
wType = Word32
i Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
7