Skip to content

Instantly share code, notes, and snippets.

@PkmX
Forked from chrisdone/NamedTuple.hs
Last active October 21, 2021 10:20
Show Gist options
  • Save PkmX/bfb2c5af4317c96282795f8c588fda1c to your computer and use it in GitHub Desktop.
Save PkmX/bfb2c5af4317c96282795f8c588fda1c to your computer and use it in GitHub Desktop.
Using type-level symbols and overloaded labels to make named tuples
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
-- | This module provides a way to name the fields in a regular
-- Haskell tuple and then look them up later, statically.
module Main where
import Data.String
import Language.Haskell.TH
import Data.Proxy
import GHC.TypeLits
import GHC.OverloadedLabels
-- | The syntax and the type of a field assignment.
data l := t = KnownSymbol l => Proxy l := 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 :: r -> a
-- Instances which we could easily generate with TH.
instance Has l (l := a) a where get (_ := a) = a
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)))|]
instance l ~ l' => IsLabel (l :: Symbol) (Proxy l') where
fromLabel _ = Proxy
instance Has l r a => IsLabel (l :: Symbol) (r -> a) where
fromLabel _ = get @l
----------------------------------------------------------------------------------------------------
type User = ( "login" := String, "id" := Integer )
user :: User
user = ( #login := "themoritz", #id := 3522732 )
mentioned :: ( "url" := String, "title" := String, "user" := User )
mentioned = ( #url := "https://api.github.com/repos/commercialhaskell/intero/issues/64"
, #title := "Support GHCJS"
, #user := user
)
main :: IO ()
main = do
print $ #url mentioned -- "https://api.github.com/repos/commercialhaskell/intero/issues/64"
print $ #login (#user mentioned) -- "themoritz"
print $ (#id . #user) mentioned -- 3522732
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment