superrecord.hs

{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Data.Monoid
import SuperRecord
import Data.Aeson
import qualified Data.HashMap.Strict as HM
import qualified Data.Text.Lazy.IO as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.Text as T
import Data.Text (Text)
import Data.Proxy

----------------------------------------------------------------------------
-- Properly encoding superrecords to JSON
----------------------------------------------------------------------------

recToObject :: forall lts. (RecApply lts lts ToJSON) => Rec lts -> Object
recToObject r =
  HM.fromList $ reflectRec @ToJSON Proxy (\k v -> (T.pack k, toJSON v)) r

-- TODO: 'recToEncoding' for speed

----------------------------------------------------------------------------
-- The 'Augmented' type
----------------------------------------------------------------------------

data Augmented x r = Augmented {
  value :: x,
  extra :: Rec r }

instance (ToJSON x, RecApply r r ToJSON) => ToJSON (Augmented x r) where
  toJSON (Augmented x r) =
    case toJSON x of
      Object obj -> Object (obj <> recObj)
      other      -> Object (HM.insert "value" other recObj)
    where
      recObj = recToObject r

-- TODO: FromJSON
-- TODO: figure out how to work with 'Record's (sorted)

----------------------------------------------------------------------------
-- Usage example
----------------------------------------------------------------------------

-- | A greeting is a string with some metadata.
type Greeting = Augmented Text
  '[ "author"   := Text
   , "language" := Text
   ]

-- | Here's a sample greeting.
greeting :: Greeting
greeting = Augmented "hello" $
    #language := "English" &
    #author   := "Artyom"  &
    rnil

main :: IO ()
main = do
  TL.putStrLn $ TL.decodeUtf8 $ encode greeting