FromJSON, ToJSON instances for Bookkeeper's extensible record.

FromJSON.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Bookkeeper.FromJSON where

import Bookkeeper.Internal (Book'(..))
import Data.Aeson (FromJSON(..), Object, withObject, (.:))
import Data.Aeson.Types (Parser(..))
import qualified Data.Text as Text
import Data.Type.Map (Map(..), Mapping(..), Var(..))
import GHC.TypeLits (Symbol, KnownSymbol, symbolVal)
import Data.Kind (Type)
import Data.Proxy (Proxy(..))

instance Obj2Map m => FromJSON (Book' m) where
  parseJSON = withObject "Object" (fmap Book . obj2Map @m)

class Obj2Map (m :: [Mapping Symbol Type]) where
  obj2Map :: Object -> Parser (Map m)

instance Obj2Map '[] where
  obj2Map obj = pure Empty

instance (KnownSymbol k, FromJSON v, Obj2Map m) => Obj2Map ((k :-> v) ': m) where
  obj2Map obj = do
    v <- obj .: Text.pack (symbolVal (Proxy @k))
    rest <- obj2Map @m obj
    pure $ Ext (Var @k) v rest

ToJSON.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}

module Bookkeeper.ToJSON where

import Bookkeeper.Internal (Book'(..))
import Data.Aeson (ToJSON(..), object, (.=))
import Data.Aeson.Types (Pair)
import qualified Data.Text as Text
import Data.Type.Map (Map(..), Mapping(..))
import GHC.TypeLits (KnownSymbol, Symbol)
import Data.Kind (Type)

instance ToPairs m => ToJSON (Book' m) where
  toJSON (Book m) = object $ toPairs m

class ToPairs (m :: [Mapping Symbol Type]) where
  toPairs :: Map m -> [Pair]

instance ToPairs '[] where
  toPairs _ = []

instance (KnownSymbol k, ToJSON v, ToPairs m) => ToPairs ((k :-> v) ': m) where
  toPairs (Ext k v m) = (Text.pack (show k) .= toJSON v) : toPairs m

> type Person = Book '["name" :=> String, "age" :=> Int]

> decode "{\"name\": \"john\", \"age\": 25}" :: Maybe Person
Just Book {age = 25, name = "john"}

> p = emptyBook & #name =: "john" & #age =: 25
> encode p
"{\"age\":25,\"name\":\"john\"}"