TaggedPut.hs

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DefaultSignatures #-}
module TaggedPut where

import           Data.Binary (Binary)
import qualified Data.Binary as Binary
import Data.ByteString.Lazy

data Binary'

newtype Protocol a = Protocol { getByteString :: ByteString }

getBinaryByteString :: Protocol Binary' -> ByteString
getBinaryByteString = getByteString

class TaggedPut p a where
    put :: a -> Protocol p
    default put :: TaggedPut Binary' a => a -> Protocol p
    put = Protocol . getBinaryByteString . put

instance Binary a => TaggedPut Binary' a where
    put = Protocol . Binary.encode

data Compact
instance TaggedPut Compact String
instance TaggedPut Compact Int where
   put _ = Protocol (singleton 0)