Extend merge to work on Optionals

11 files changed, 64 insertions, 12 deletions

diff --git a/dhall-lang b/dhall-lang
-Subproject c7dd51ec433e07433243cf1a1134655dbab6cc9
+Subproject 0c99dc6f53919fc2df6b965877c355b62cf6ba0
diff --git a/dhall/build.rs b/dhall/build.rs
index 981e558..3d4a2eb 100644
--- a/dhall/build.rs
+++ b/dhall/build.rs
@@ -128,7 +128,7 @@ fn generate_tests() -> std::io::Result<()> {
                     || path == "unit/import/urls/emptyPath0"
                     || path == "unit/import/urls/emptyPath1"
                     || path == "unit/import/urls/emptyPathSegment"
-                    // TODO: https://github.com/dhall-lang/dhall-lang/pull/788#issuecomment-568298973
+                    // TODO: waiting for https://github.com/dhall-lang/dhall-lang/pull/871
                     || path == "preferMissingNoSpaces"
             }),
             input_type: FileType::Text,
@@ -154,7 +154,7 @@ fn generate_tests() -> std::io::Result<()> {
                     || path == "unit/import/urls/emptyPath0"
                     || path == "unit/import/urls/emptyPath1"
                     || path == "unit/import/urls/emptyPathSegment"
-                    // TODO: https://github.com/dhall-lang/dhall-lang/pull/788#issuecomment-568298973
+                    // TODO: waiting for https://github.com/dhall-lang/dhall-lang/pull/871
                     || path == "preferMissingNoSpaces"
             }),
             input_type: FileType::Text,
@@ -178,7 +178,7 @@ fn generate_tests() -> std::io::Result<()> {
                     || path == "unit/import/urls/emptyPath0"
                     || path == "unit/import/urls/emptyPath1"
                     || path == "unit/import/urls/emptyPathSegment"
-                    // TODO: https://github.com/dhall-lang/dhall-lang/pull/788#issuecomment-568298973
+                    // TODO: waiting for https://github.com/dhall-lang/dhall-lang/pull/871
                     || path == "preferMissingNoSpaces"
             }),
             input_type: FileType::Text,
@@ -282,6 +282,9 @@ fn generate_tests() -> std::io::Result<()> {
                     // TODO: record completion
                     || path == "simple/completion"
                     || path == "unit/Completion"
+                    // TODO: waiting for https://github.com/dhall-lang/dhall-lang/pull/871
+                    || path == "unit/MergeNone"
+                    || path == "unit/MergeSome"
             }),
             input_type: FileType::Text,
             output_type: Some(FileType::Text),
@@ -317,6 +320,9 @@ fn generate_tests() -> std::io::Result<()> {
                     // TODO: record completion
                     || path == "simple/completion"
                     || path == "unit/Completion"
+                    // TODO: waiting for https://github.com/dhall-lang/dhall-lang/pull/871
+                    || path == "unit/MergeNone"
+                    || path == "unit/MergeSome"
             }),
             input_type: FileType::Text,
             output_type: Some(FileType::Text),
@@ -423,6 +429,10 @@ fn convert_abnf_to_pest() -> std::io::Result<()> {
 
     // Prefer my nice error message to illegible parse errors.
     rules.remove("unicode_escape");
+    rules.remove("unbraced_escape");
+    rules.remove("braced_escape");
+    rules.remove("braced_codepoint");
+    rules.remove("unicode_suffix");
     writeln!(
         &mut file,
         r#"unicode_escape = _{{ HEXDIG{{4}} | "{{" ~ HEXDIG+ ~ "}}" }}"#
diff --git a/dhall/src/dhall.pest.visibility b/dhall/src/dhall.pest.visibility
index 5d3b4c8..03a000b 100644
--- a/dhall/src/dhall.pest.visibility
+++ b/dhall/src/dhall.pest.visibility
@@ -21,6 +21,7 @@ quoted_label
 # label
 # nonreserved_label
 # any_label
+any_label_or_some
 double_quote_chunk
 double_quote_escaped
 # unicode_escape
diff --git a/dhall/src/error/mod.rs b/dhall/src/error/mod.rs
index 8976478..6e7be64 100644
--- a/dhall/src/error/mod.rs
+++ b/dhall/src/error/mod.rs
@@ -67,7 +67,7 @@ pub(crate) enum TypeMessage {
     BinOpTypeMismatch(BinOp, Value),
     InvalidTextInterpolation(Value),
     Merge1ArgMustBeRecord(Value),
-    Merge2ArgMustBeUnion(Value),
+    Merge2ArgMustBeUnionOrOptional(Value),
     MergeEmptyNeedsAnnotation,
     MergeHandlerMissingVariant(Label),
     MergeVariantMissingHandler(Label),
diff --git a/dhall/src/semantics/phase/normalize.rs b/dhall/src/semantics/phase/normalize.rs
index 5a0f566..459eaf1 100644
--- a/dhall/src/semantics/phase/normalize.rs
+++ b/dhall/src/semantics/phase/normalize.rs
@@ -590,8 +590,8 @@ pub(crate) fn normalize_one_layer(
     ty: &Value,
 ) -> ValueKind {
     use ValueKind::{
-        AppliedBuiltin, BoolLit, DoubleLit, EmptyListLit, IntegerLit,
-        NEListLit, NEOptionalLit, NaturalLit, RecordLit, TextLit,
+        AppliedBuiltin, BoolLit, DoubleLit, EmptyListLit, EmptyOptionalLit,
+        IntegerLit, NEListLit, NEOptionalLit, NaturalLit, RecordLit, TextLit,
         UnionConstructor, UnionLit, UnionType,
     };
 
@@ -739,6 +739,26 @@ pub(crate) fn normalize_one_layer(
                         Ret::Expr(expr)
                     }
                 },
+                (RecordLit(kvs), EmptyOptionalLit(_)) => {
+                    match kvs.get(&"None".into()) {
+                        Some(h) => Ret::Value(h.clone()),
+                        None => {
+                            drop(handlers_borrow);
+                            drop(variant_borrow);
+                            Ret::Expr(expr)
+                        }
+                    }
+                }
+                (RecordLit(kvs), NEOptionalLit(v)) => {
+                    match kvs.get(&"Some".into()) {
+                        Some(h) => Ret::Value(h.app(v.clone())),
+                        None => {
+                            drop(handlers_borrow);
+                            drop(variant_borrow);
+                            Ret::Expr(expr)
+                        }
+                    }
+                }
                 _ => {
                     drop(handlers_borrow);
                     drop(variant_borrow);
diff --git a/dhall/src/semantics/phase/typecheck.rs b/dhall/src/semantics/phase/typecheck.rs
index 7ea4951..97502d4 100644
--- a/dhall/src/semantics/phase/typecheck.rs
+++ b/dhall/src/semantics/phase/typecheck.rs
@@ -1,3 +1,4 @@
+use std::borrow::Cow;
 use std::cmp::max;
 use std::collections::HashMap;
 
@@ -695,8 +696,19 @@ fn type_last_layer(
             let union_type = union.get_type()?;
             let union_borrow = union_type.as_whnf();
             let variants = match &*union_borrow {
-                ValueKind::UnionType(kts) => kts,
-                _ => return mkerr(Merge2ArgMustBeUnion(union.clone())),
+                ValueKind::UnionType(kts) => Cow::Borrowed(kts),
+                ValueKind::AppliedBuiltin(syntax::Builtin::Optional, args)
+                    if args.len() == 1 =>
+                {
+                    let ty = &args[0];
+                    let mut kts = HashMap::new();
+                    kts.insert("None".into(), None);
+                    kts.insert("Some".into(), Some(ty.clone()));
+                    Cow::Owned(kts)
+                }
+                _ => {
+                    return mkerr(Merge2ArgMustBeUnionOrOptional(union.clone()))
+                }
             };
 
             let mut inferred_type = None;
diff --git a/dhall/src/syntax/text/parser.rs b/dhall/src/syntax/text/parser.rs
index 0e3e97a..feaa2a5 100644
--- a/dhall/src/syntax/text/parser.rs
+++ b/dhall/src/syntax/text/parser.rs
@@ -183,6 +183,15 @@ impl DhallParser {
         Ok(Label::from(input.as_str()))
     }
 
+    // TODO: waiting for https://github.com/dhall-lang/dhall-lang/pull/871
+    // #[alias(label)]
+    // fn any_label_or_some(input: ParseInput) -> ParseResult<Label> {
+    //     Ok(match_nodes!(input.into_children();
+    //         [label(l)] => l,
+    //         [Some_(_)] => Label::from("Some"),
+    //     ))
+    // }
+
     fn double_quote_literal(input: ParseInput) -> ParseResult<ParsedText> {
         Ok(match_nodes!(input.into_children();
             [double_quote_chunk(chunks)..] => {
diff --git a/dhall/tests/type-errors/unit/MergeAnnotationNotType.txt b/dhall/tests/type-errors/unit/MergeAnnotationNotType.txt
index 852634a..7da5cb9 100644
--- a/dhall/tests/type-errors/unit/MergeAnnotationNotType.txt
+++ b/dhall/tests/type-errors/unit/MergeAnnotationNotType.txt
@@ -1 +1 @@
-Type error: Unhandled error: Merge2ArgMustBeUnion(Value@Unevaled { value: UnionType({}), type: Type })
+Type error: Unhandled error: Merge2ArgMustBeUnionOrOptional(Value@Unevaled { value: UnionType({}), type: Type })
diff --git a/dhall/tests/type-errors/unit/MergeEmptyWithoutAnnotation.txt b/dhall/tests/type-errors/unit/MergeEmptyWithoutAnnotation.txt
index 852634a..7da5cb9 100644
--- a/dhall/tests/type-errors/unit/MergeEmptyWithoutAnnotation.txt
+++ b/dhall/tests/type-errors/unit/MergeEmptyWithoutAnnotation.txt
@@ -1 +1 @@
-Type error: Unhandled error: Merge2ArgMustBeUnion(Value@Unevaled { value: UnionType({}), type: Type })
+Type error: Unhandled error: Merge2ArgMustBeUnionOrOptional(Value@Unevaled { value: UnionType({}), type: Type })
diff --git a/dhall/tests/type-errors/unit/MergeHandlerNotInUnion.txt b/dhall/tests/type-errors/unit/MergeHandlerNotInUnion.txt
index 852634a..7da5cb9 100644
--- a/dhall/tests/type-errors/unit/MergeHandlerNotInUnion.txt
+++ b/dhall/tests/type-errors/unit/MergeHandlerNotInUnion.txt
@@ -1 +1 @@
-Type error: Unhandled error: Merge2ArgMustBeUnion(Value@Unevaled { value: UnionType({}), type: Type })
+Type error: Unhandled error: Merge2ArgMustBeUnionOrOptional(Value@Unevaled { value: UnionType({}), type: Type })
diff --git a/dhall/tests/type-errors/unit/MergeRhsNotUnion.txt b/dhall/tests/type-errors/unit/MergeRhsNotUnion.txt
index 0872642..db93650 100644
--- a/dhall/tests/type-errors/unit/MergeRhsNotUnion.txt
+++ b/dhall/tests/type-errors/unit/MergeRhsNotUnion.txt
@@ -1 +1 @@
-Type error: Unhandled error: Merge2ArgMustBeUnion(Value@Unevaled { value: PartialExpr(BoolLit(true)), type: Value@WHNF { value: AppliedBuiltin(Bool, []), type: Type } })
+Type error: Unhandled error: Merge2ArgMustBeUnionOrOptional(Value@Unevaled { value: PartialExpr(BoolLit(true)), type: Value@WHNF { value: AppliedBuiltin(Bool, []), type: Type } })