-----------------------------------------------------------------------------

-- |

-- Copyright   :  (C) 2013-2015 Edward Kmett and Anthony Cowley

-- License     :  BSD-style (see the file LICENSE)

--

-- Maintainer  :  Edward Kmett <ekmett@gmail.com>

-- Stability   :  experimental

-- Portability :  non-portable

--

-- Serialization of statically-sized types with the "Data.Binary"

-- library.

------------------------------------------------------------------------------

module Linear.Binary
  ( putLinear
  , getLinear
  ) where

import Data.Binary
import Data.Foldable (traverse_)

-- | Serialize a linear type.

putLinear :: (Binary a, Foldable t) => t a -> Put
putLinear :: forall a (t :: * -> *). (Binary a, Foldable t) => t a -> Put
putLinear = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall t. Binary t => t -> Put
put

-- | Deserialize a linear type.

getLinear :: (Binary a, Applicative t, Traversable t) => Get (t a)
getLinear :: forall a (t :: * -> *).
(Binary a, Applicative t, Traversable t) =>
Get (t a)
getLinear = forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall t. Binary t => Get t
get