BothSides.hs

{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
-- | Use Applicative style to define "both sides" of a serializer.
module Jordan.BothSides
    where

import Data.Functor.Contravariant
import Data.Functor.Contravariant.Divisible (Divisible(..))
import Data.Text (Text)
import Jordan.FromJSON.Class
import Jordan.ToJSON.Class

-- | Run both sides of JSON serialization at once.
data BothSides serialized a
  = BothSides
  { serialize :: forall s. JSONObjectSerializer s => s serialized
  , parse :: forall s. JSONObjectParser s => s a
  }

instance Functor (BothSides s) where
  fmap f (BothSides s p) = BothSides s $ fmap f p

instance Applicative (BothSides s) where
  pure a = BothSides conquer (pure a)
  (BothSides fs fp) <*> (BothSides as ap) =
    BothSides (divide (\a -> (a, a)) fs as) (fp <*> ap)

objectKey
  :: (FromJSON f, ToJSON f)
  => Text
  -> (serialized -> f)
  -> BothSides serialized f
objectKey t f = BothSides (contramap f $ writeField t toJSON) (parseField t)