{-# LANGUAGE CPP       #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE PolyKinds #-}
#endif
module Data.Binary.Instances.Tagged where

import Data.Binary         (Binary, get, put)
import Data.Binary.Orphans ()

import qualified Data.Tagged as Tagged

instance Binary b => Binary (Tagged.Tagged s b) where
    put :: Tagged s b -> Put
put = forall t. Binary t => t -> Put
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (s :: k) b. Tagged s b -> b
Tagged.unTagged
    get :: Get (Tagged s b)
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (s :: k) b. b -> Tagged s b
Tagged.Tagged forall t. Binary t => Get t
get