Using type-level lits, overloaded strings, and splices to make named tuples

NamedTuple.hs

{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}

-- | This module provides a way to name the fields in a regular
-- Haskell tuple and then look them up later, statically.

module NamedTuple
  (module NamedTuple
  ,module Data.Proxy)
  where

import Data.String
import Language.Haskell.TH
import Data.Proxy
import GHC.TypeLits

-- | The syntax and the type of a field assignment.
data l := t = KnownSymbol l => Proxy (l :: Symbol) := t

-- Simple show instance for a field.
instance Show t => Show (l := t) where
  show (l := t) = symbolVal l ++ " := " ++ show t

-- | Means to search for a field within a tuple.
-- We could add `set` to this, or just have a `lens` method
-- which generates a lens for that field.
class Has (l :: Symbol) r a | l r -> a where
  get :: f l -> r -> a

-- Instances which we could easily generate with TH.
instance Has l ((l := a), u0) a where get _ ((_ := a),_) = a
instance Has l (u0, (l := a)) a where get _ (_,(_ := a)) = a
instance Has l ((l := a), u0, u1) a where get _ ((_ := a),_,_) = a
instance Has l (u0, (l := a), u1) a where get _ (_,(_ := a),_) = a
instance Has l (u0, u1, (l := a)) a where get _ (_,_,(_ := a)) = a

-- Provide convenient syntax: $("foo") for Proxy :: Proxy "foo".
instance IsString (Q Exp) where
  fromString str = [|Proxy :: Proxy $(litT (return (StrTyLit str)))|]

X_example.hs

{-# LANGUAGE DataKinds, OverloadedStrings, TemplateHaskell #-}
-- Taken from JSON from the GitHub API.
import NamedTuple
mentioned =
  (
    $("url") := "https://api.github.com/repos/commercialhaskell/intero/issues/64",
    $("title") := "Support GHCJS",
    $("user") := (
       $("login") := "themoritz",
       $("id") := 3522732
      )
  )

X_repl.hs

> mentioned
(url := "https://api.github.com/repos/commercialhaskell/intero/issues/64",title := "Support GHCJS",user := (login := "themoritz",id := 3522732))
> get $("login") (get $("user") mentioned)
"themoritz"
> get $("id") (get $("user") mentioned)
3522732
> :t get $("id") (get $("user") ($("url") := "https://api.github.com/repos/commercialhaskell/intero/issues/64", $("title") := "Support GHCJS", $("user") := ($("login") := "themoritz", $("id") := 3522732)))
Num a => a
> get $("id") (get $("user") ($("url") := "https://api.github.com/repos/commercialhaskell/intero/issues/64", $("title") := "Support GHCJS", $("user") := ($("login") := "themoritz", $("id") := 3522732)))
3522732