Last active
August 7, 2017 14:59
-
-
Save freckletonj/b1fafa06230c672850ca2248e8b2a625 to your computer and use it in GitHub Desktop.
Attempting to get values out of constrained Vinyl/Composite Extensible Records
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE DataKinds #-} | |
{-# LANGUAGE FlexibleContexts #-} | |
{-# LANGUAGE FlexibleInstances #-} | |
{-# LANGUAGE GADTs #-} | |
{-# LANGUAGE RankNTypes #-} | |
{-# LANGUAGE ScopedTypeVariables #-} | |
{-# LANGUAGE TypeFamilies #-} | |
{-# LANGUAGE TypeOperators #-} | |
module ConstrainedVinylRecords where | |
import Composite.Aeson | |
import Composite.Aeson.TH | |
import Composite.Record | |
import Composite.TH | |
import Data.Functor.Identity | |
import Data.Proxy | |
import Data.String.Conversions (cs) | |
import Data.Vinyl | |
import qualified Data.Vinyl.Functor as Vinyl | |
import Data.Vinyl.Lens | |
import GHC.TypeLits | |
import Data.Vinyl.TypeLevel | |
import Composite | |
type FA = "a" :-> String | |
type FB = "b" :-> Int | |
type AB = '[FA, FB] | |
ab :: Rec Identity AB | |
ab = "A" :*: 1 :*: RNil | |
-------------------------------------------------- | |
-- Solution #1 | |
-- both solutions are thanks to Alec | |
-- https://stackoverflow.com/a/45476085/3884713 | |
class Tuplify a where | |
tuplify :: a -> [(String, String)] | |
instance Tuplify (Rec Identity '[]) where | |
tuplify RNil = [] | |
instance (Show t, KnownSymbol s, Tuplify (Rec Identity rs)) => | |
Tuplify (Rec Identity (s :-> t ': rs)) where | |
tuplify (v :*: rs) = (symbolVal (Proxy :: Proxy s), show v) : tuplify rs | |
-------------------------------------------------- | |
-- Solution #2 | |
class ShowField a where | |
showField :: a -> (String, String) | |
instance (KnownSymbol s, Show a) => ShowField (Identity (s :-> a)) where | |
showField (Identity (Val v)) = (symbolVal (Proxy :: Proxy s), show v) | |
tuplify' :: RecAll Identity rs ShowField => Rec Identity rs -> [(String, String)] | |
tuplify' xs = recordToList | |
. rmap (\(Vinyl.Compose (Dict x)) -> Vinyl.Const $ showField x) | |
$ reifyConstraint (Proxy :: Proxy ShowField) xs |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment