From 11a8d2978c3c47d612b62ebe637aac054861ca40 Mon Sep 17 00:00:00 2001 From: Oliver Charles Date: Fri, 26 Apr 2019 14:33:22 +0100 Subject: [PATCH 1/3] dhall-nix: Fix field-based union access Fixes #906. --- dhall-nix/src/Dhall/Nix.hs | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/dhall-nix/src/Dhall/Nix.hs b/dhall-nix/src/Dhall/Nix.hs index 6b165c24b..4412c7d08 100644 --- a/dhall-nix/src/Dhall/Nix.hs +++ b/dhall-nix/src/Dhall/Nix.hs @@ -208,6 +208,13 @@ dhallToNix e = loop (Dhall.Core.normalize e) -- None needs a type to convert to an Optional loop (App None _) = do return (Fix (NConstant NNull)) + loop (App (Field (Union kts) k) v) = do + v' <- loop v + let e0 = do + k' <- Dhall.Map.keys kts + return (k', Nothing) + let e2 = Fix (NBinary NApp (Fix (NSym k)) v') + return (Fix (NAbs (ParamSet e0 False Nothing) e2)) loop (App a b) = do a' <- loop a b' <- loop b @@ -488,6 +495,12 @@ dhallToNix e = loop (Dhall.Core.normalize e) a' <- loop a b' <- loop b return (Fix (NBinary NUpdate a' b')) + loop (Field (Union kts) k) = do + let e0 = do + k' <- Dhall.Map.keys kts + return (k', Nothing) + let e2 = Fix (NSym k) + return (Fix (NAbs (ParamSet e0 False Nothing) e2)) loop (Field a b) = do a' <- loop a return (Fix (NSelect a' [StaticKey b] Nothing)) From 0a397a15c4d6af970abd7ae885c33f7da42eadc4 Mon Sep 17 00:00:00 2001 From: Oliver Charles Date: Fri, 26 Apr 2019 22:39:30 +0100 Subject: [PATCH 2/3] Correct partial application of field based union access --- dhall-nix/src/Dhall/Nix.hs | 26 ++++++++++++++++++++------ 1 file changed, 20 insertions(+), 6 deletions(-) diff --git a/dhall-nix/src/Dhall/Nix.hs b/dhall-nix/src/Dhall/Nix.hs index 4412c7d08..6ad197dd2 100644 --- a/dhall-nix/src/Dhall/Nix.hs +++ b/dhall-nix/src/Dhall/Nix.hs @@ -495,12 +495,26 @@ dhallToNix e = loop (Dhall.Core.normalize e) a' <- loop a b' <- loop b return (Fix (NBinary NUpdate a' b')) - loop (Field (Union kts) k) = do - let e0 = do - k' <- Dhall.Map.keys kts - return (k', Nothing) - let e2 = Fix (NSym k) - return (Fix (NAbs (ParamSet e0 False Nothing) e2)) + loop (Field (Union kts) k) = + case join ( Dhall.Map.lookup k kts ) of + Nothing -> do + let e0 = do + k' <- Dhall.Map.keys kts + return (k', Nothing) + let e2 = Fix (NSym k) + return (Fix (NAbs (ParamSet e0 False Nothing) e2)) + + -- If the selected alternative has an associated payload, then we + -- need introduce the partial application through an extra abstraction + -- (here "x"). + -- + -- This translates `< Foo : T >.Foo` to `x: { Foo }: Foo x` + Just _ -> do + let e0 = do + k' <- Dhall.Map.keys kts + return (k', Nothing) + let e2 = Fix (NBinary NApp (Fix (NSym k)) (Fix (NSym "x"))) + return (Fix (NAbs (Param "x") (Fix (NAbs (ParamSet e0 False Nothing) e2)))) loop (Field a b) = do a' <- loop a return (Fix (NSelect a' [StaticKey b] Nothing)) From 2495a563fe8000c6849031cea49d9bfbd0b5dd85 Mon Sep 17 00:00:00 2001 From: Oliver Charles Date: Fri, 26 Apr 2019 22:42:24 +0100 Subject: [PATCH 3/3] Fix previous commit --- dhall-nix/src/Dhall/Nix.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/dhall-nix/src/Dhall/Nix.hs b/dhall-nix/src/Dhall/Nix.hs index 6ad197dd2..501ccd346 100644 --- a/dhall-nix/src/Dhall/Nix.hs +++ b/dhall-nix/src/Dhall/Nix.hs @@ -496,25 +496,25 @@ dhallToNix e = loop (Dhall.Core.normalize e) b' <- loop b return (Fix (NBinary NUpdate a' b')) loop (Field (Union kts) k) = - case join ( Dhall.Map.lookup k kts ) of - Nothing -> do - let e0 = do - k' <- Dhall.Map.keys kts - return (k', Nothing) - let e2 = Fix (NSym k) - return (Fix (NAbs (ParamSet e0 False Nothing) e2)) - + case Dhall.Map.lookup k kts of -- If the selected alternative has an associated payload, then we -- need introduce the partial application through an extra abstraction -- (here "x"). -- -- This translates `< Foo : T >.Foo` to `x: { Foo }: Foo x` - Just _ -> do + Just ( Just _ ) -> do let e0 = do k' <- Dhall.Map.keys kts return (k', Nothing) let e2 = Fix (NBinary NApp (Fix (NSym k)) (Fix (NSym "x"))) return (Fix (NAbs (Param "x") (Fix (NAbs (ParamSet e0 False Nothing) e2)))) + + _ -> do + let e0 = do + k' <- Dhall.Map.keys kts + return (k', Nothing) + let e2 = Fix (NSym k) + return (Fix (NAbs (ParamSet e0 False Nothing) e2)) loop (Field a b) = do a' <- loop a return (Fix (NSelect a' [StaticKey b] Nothing))