{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Composite.Record.Binary where

import Composite.Record((:->), Record, Rec((:&)), val, getVal)
import Control.Applicative(liftA2)
import Data.Binary(Binary(put, get))
import Data.Functor.Identity(runIdentity)

instance Binary a => Binary (s :-> a) where
  put :: (s :-> a) -> Put
put = a -> Put
forall t. Binary t => t -> Put
put (a -> Put) -> ((s :-> a) -> a) -> (s :-> a) -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s :-> a) -> a
forall (s :: Symbol) a. (s :-> a) -> a
getVal
  get :: Get (s :-> a)
get = (a -> s :-> a) -> Get a -> Get (s :-> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Identity (s :-> a) -> s :-> a
forall a. Identity a -> a
runIdentity (Identity (s :-> a) -> s :-> a)
-> (a -> Identity (s :-> a)) -> a -> s :-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity (s :-> a)
forall (s :: Symbol) a. a -> Identity (s :-> a)
val) Get a
forall t. Binary t => Get t
get

instance Binary (Record '[])

instance (Binary x, Binary (Record xs)) => Binary (Record (x : xs)) where
  put :: Record (x : xs) -> Put
put (Identity r
x :& Rec Identity rs
xs) = Identity r -> Put
forall t. Binary t => t -> Put
put Identity r
x Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Rec Identity rs -> Put
forall t. Binary t => t -> Put
put Rec Identity rs
xs
  get :: Get (Record (x : xs))
get = (Identity x -> Record xs -> Record (x : xs))
-> Get (Identity x) -> Get (Record xs) -> Get (Record (x : xs))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Identity x -> Record xs -> Record (x : xs)
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
(:&) Get (Identity x)
forall t. Binary t => Get t
get Get (Record xs)
forall t. Binary t => Get t
get