Skip to content
Browse files

add set, alt, get QuasiQuoters

  • Loading branch information...
1 parent acb355c commit 0afae165ebe5c55b333c319b0dd3382d0d388187 @mikeplus64 committed Dec 13, 2012
Showing with 20 additions and 8 deletions.
  1. +1 −1 record.cabal
  2. +19 −7 src/Data/Record.hs
View
2 record.cabal
@@ -1,5 +1,5 @@
name: record
-version: 0.1.0.20
+version: 0.1.0.22
synopsis: Efficient, type safe records implemented using GADTs and type level strings.
homepage: http://quasimal.com/projects/records
license: BSD3
View
26 src/Data/Record.hs
@@ -1,13 +1,27 @@
-{-# LANGUAGE GADTs, TypeFamilies, UndecidableInstances, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, ConstraintKinds, DataKinds, TypeOperators, PolyKinds, EmptyDataDecls, Rank2Types, ExistentialQuantification, FunctionalDependencies, KindSignatures, OverlappingInstances #-}
+{-# LANGUAGE GADTs, TypeFamilies, UndecidableInstances, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, ConstraintKinds, DataKinds, TypeOperators, PolyKinds, EmptyDataDecls, Rank2Types, ExistentialQuantification, FunctionalDependencies, KindSignatures, OverlappingInstances, TemplateHaskell #-}
module Data.Record where
+import Language.Haskell.TH.Syntax
+import Language.Haskell.TH.Quote
+import Language.Haskell.TH.Lib
import GHC.TypeLits
-- | A key of a record. This does not exist at runtime, and as a tradeoff,
-- you can't do field access from a string and a Typeable context, although
-- it would certainly be very nice.
data Key k
-key :: Key k
-key = undefined
+
+key :: String -> Q Exp
+key s = [| undefined :: Key $(litT . return . StrTyLit $ s) |]
+
+set :: QuasiQuoter
+set = QuasiQuoter { quoteExp = \s -> [| write $(key s) |], quoteType = undefined, quoteDec = undefined, quotePat = undefined }
+
+alt :: QuasiQuoter
+alt = QuasiQuoter { quoteExp = \s -> [| alter $(key s) |], quoteType = undefined, quoteDec = undefined, quotePat = undefined }
+
+get :: QuasiQuoter
+get = QuasiQuoter { quoteExp = \s -> [| access $(key s) |], quoteType = undefined, quoteDec = undefined, quotePat = undefined }
+
-- | A field
data F a b = F a b
@@ -17,12 +31,10 @@ infixr 4 &
data P
data family Record (t :: a) (r :: [F Symbol *])
-
-- | "Pure" records
data instance Record (w :: *) r where
Cp :: e -> Record P r -> Record P (k := e ': r)
Ep :: Record P '[]
-
-- | Record transformer
data instance Record (w :: * -> *) r where
Ct :: w e -> Record w r -> Record w (k := e ': r)
@@ -118,13 +130,13 @@ instance Access P (k := a ': xs) k a where
access _ (Cp x _) = x
instance Access P xs k a => Access P (k0 := a0 ': xs) k a where
{-# INLINE access #-}
- access k (Cp _ xs) = access k xs
+ access n (Cp _ xs) = access n xs
instance Access (w :: * -> *) (k := a ': xs) k (w a) where
{-# INLINE access #-}
access _ (Ct x _) = x
instance Access (w :: * -> *) xs k (w a) => Access (w :: * -> *) (k0 := a0 ': xs) k (w a) where
{-# INLINE access #-}
- access k (Ct _ xs) = access k xs
+ access n (Ct _ xs) = access n xs
class Update w r k a | r k -> a where
-- | Write to a record's field

0 comments on commit 0afae16

Please sign in to comment.
Something went wrong with that request. Please try again.