-- Record Access interface
-- Dylan Simon
{-|
This provides a more generic interface to record fields in Haskell.
It is based on and uses
Template Haskell to create accessors. To use it, just do:
@
import "RecordAccess"
data MyRecordType = MyRecord { myField :: FieldType, ... } ...
$('genRecordAccessors' \'\'MyRecordType (++\"\'\"))
@
The @++\"\'\"@ specifies to append a @\'@ to your field names to generate the
accessors (but you can use any String -> String modification you want).
Now you have:
> myField' :: RecordAccessor MyRecordType FieldType
which you can use however you like:
> set myField' value record
> get myField' record
> modify myField' (\v -> ...) record
Remember to compile with @-fth@.
-}
module RecordAccess
( RecordAccessor
, set, (~=), (~/), (~//)
, get, (~!)
, modify
, (~.)
-- ** Template Haskell functions
, recordAccessor
, genRecordAccessors
, listRecordAccessors
) where
import Control.Monad
import Language.Haskell.TH
-- |The generic type of a record field accessor for a field of type a in a record of type r.
type RecordAccessor r a = a -> r -> (a, r)
-- |The record with a field set to a value.
set :: RecordAccessor r a -> a -> r -> r
set f x = snd . f x
infixl 8 ~=
-- |Modification accessor infix operator: @(record~=field) value@
(~=) :: r -> RecordAccessor r a -> a -> r
(~=) r f v = set f v r
infixl 9 ~/
-- |Modification infix operator: @record ~\/ (field,value)@
(~/) :: r -> (RecordAccessor r a, a) -> r
(~/) r (f,v) = set f v r
infixl 9 ~//
-- |Multiple modification infix operator, like arrays: @record ~\/\/ [(field,value)]@
(~//) :: r -> [(RecordAccessor r a, a)] -> r
(~//) = foldr (uncurry set)
-- |The value of a field in a record.
get :: RecordAccessor r a -> r -> a
get f = fst . f undefined
infixl 8 ~!
-- |Get accessor infix operator: @record~!field~!subfield@
(~!) :: r -> RecordAccessor r a -> a
(~!) r f = get f r
-- |The record with a field's value transformed by a function.
modify :: RecordAccessor r a -> (a -> a) -> (r -> r)
modify f g rOld = rNew where (a,rNew) = f (g a) rOld
infixr 9 ~.
-- |Accessor composition: @field ~. subfield@
(~.) :: RecordAccessor r1 r2 -> RecordAccessor r2 a -> RecordAccessor r1 a
(~.) ra1 ra2 v' r1 = (v, r1') where
(r2, r1') = ra1 r2' r1
(v, r2') = ra2 v' r2
-- ((get ra1 . get ra2) r1, (modify ra1 . modify ra2) r1)
-- |The TH RecordAccessor for a given field name.
recordAccessor :: Name -> Q Exp
recordAccessor f = do
r <- newName "r"
a <- newName "a"
lamE [varP a, varP r] $
tupE [
appE (varE f) (varE r),
recUpdE (varE r) [liftM ((,) f) (varE a)]
]
forRec :: Name -> (Name -> Q a) -> Q [a]
forRec ty fun = forr (const True) ty where
forr sel ty = reify ty >>= sett sel
sett sel (TyConI (DataD _ _ _ cl _)) = liftM concat $ mapM (setc sel) cl
sett sel (TyConI (NewtypeD _ _ _ c _)) = setc sel c
sett sel (DataConI n _ ty _)
| sel n = forRec ty fun
| otherwise = return []
sett _ _ = report True (show ty ++ " is not a record type constructor") >> return []
setc sel (RecC n r)
| sel n = mapM setr r
| otherwise = return []
setc _ _ = return []
setr (f, _, _) = fun f
-- |All the TH RecordAccessor declarations for a given record type or constructor, which will be named by their field names transformed by the given function.
genRecordAccessors :: Name -> (String -> String) -> Q [Dec]
genRecordAccessors ty fn = forRec ty accf where
accf f = valD (varP (mkName (fn (nameBase f)))) (normalB (recordAccessor f)) []
-- |If all the fields in a record type or constructor are of the same type, the TH list of all their RecordAccessors
listRecordAccessors :: Name -> Q Exp
listRecordAccessors ty = liftM ListE $ forRec ty recordAccessor