Skip to content

Commit 00b18b8

Browse files
committed
Add support for accessing/projecting record type fields
1 parent 44b9f30 commit 00b18b8

File tree

2 files changed

+21
-0
lines changed

2 files changed

+21
-0
lines changed

dhall/src/Dhall/Eval.hs

+6
Original file line numberDiff line numberDiff line change
@@ -367,6 +367,9 @@ vField t0 k = go t0
367367
Just (Just _) -> VPrim $ \ ~u -> VInject m k (Just u)
368368
Just Nothing -> VInject m k Nothing
369369
_ -> error errorMsg
370+
VRecord m
371+
| Just v <- Map.lookup k m -> v
372+
| otherwise -> error errorMsg
370373
VRecordLit m
371374
| Just v <- Map.lookup k m -> v
372375
| otherwise -> error errorMsg
@@ -414,6 +417,9 @@ vProjectByFields env t ks =
414417
VRecordLit kvs ->
415418
let kvs' = Map.restrictKeys kvs (Dhall.Set.toSet ks)
416419
in VRecordLit kvs'
420+
VRecord kTs ->
421+
let kTs' = Map.restrictKeys kTs (Dhall.Set.toSet ks)
422+
in VRecord kTs'
417423
VProject t' _ ->
418424
vProjectByFields env t' ks
419425
VPrefer l (VRecordLit kvs) ->

dhall/src/Dhall/TypeCheck.hs

+15
Original file line numberDiff line numberDiff line change
@@ -1158,6 +1158,11 @@ infer typer = loop
11581158
case Dhall.Map.lookup x xTs' of
11591159
Just _T' -> return _T'
11601160
Nothing -> die (MissingField x _E'')
1161+
VConst _
1162+
| VRecord xTs' <- eval values e ->
1163+
case Dhall.Map.lookup x xTs' of
1164+
Just _T' -> return _T'
1165+
Nothing -> die (MissingField x _E'')
11611166
_ -> do
11621167
let e' = eval values e
11631168

@@ -1195,6 +1200,16 @@ infer typer = loop
11951200
let adapt = VRecord . Dhall.Map.unorderedFromList
11961201

11971202
fmap adapt (traverse process xs)
1203+
VConst c
1204+
| VRecord xTs' <- eval values e -> do
1205+
let process x =
1206+
if Dhall.Map.member x xTs'
1207+
then return ()
1208+
else die (MissingField x _E'')
1209+
1210+
Foldable.traverse_ process xs
1211+
1212+
pure (VConst c)
11981213

11991214
_ -> do
12001215
let text =

0 commit comments

Comments
 (0)