Fix marshaling new-style union literals (#918)

Fixes https://github.com/dhall-lang/dhall-haskell/issues/915

dhall/src/Dhall.hs

@@ -1535,7 +1535,15 @@ union (UnionType (Data.Functor.Compose.Compose mp)) = Type
   where
     expect = (possible . Dhall.expected) <$> mp
     extractF e0 = do
-      UnionLit fld e1 rest <- Just e0
+      (fld, e1, rest) <- do
+        case e0 of
+          UnionLit fld e1 rest ->
+            return (fld, e1, rest)
+          App (Field (Union kts) fld) e1 ->
+            return (fld, e1, Dhall.Map.delete fld kts)
+          _ ->
+            empty
+
       t <- Dhall.Map.lookup fld mp
       guard $ Dhall.Core.Union rest `Dhall.Core.judgmentallyEqual`
                 Dhall.Core.Union (Dhall.Map.delete fld expect)

dhall/tests/Dhall/Test/Dhall.hs

@@ -15,7 +15,9 @@ import qualified Dhall.Map
 tests :: TestTree
 tests =
     testGroup "Input"
-     [ shouldShowDetailedTypeError ]
+     [ shouldShowDetailedTypeError
+     , shouldHandleBothUnionLiterals
+     ]
 
 data MyType = MyType { foo :: String , bar :: Natural }
 
@@ -55,5 +57,13 @@ shouldShowDetailedTypeError = testCase "detailed TypeError" $ do
   case inputEx of
     Left ex -> assertEqual assertMsg expectedMsg (show ex)
     Right _ -> fail "The extraction using a wrong type succeded"
- 
-        
+
+license :: Dhall.Type ()
+license = Dhall.union (Dhall.constructor "AllRightsReserved" Dhall.unit)
+
+-- https://github.com/dhall-lang/dhall-haskell/issues/915
+shouldHandleBothUnionLiterals :: TestTree
+shouldHandleBothUnionLiterals = testCase "Marshal union literals" $ do
+    _ <- Dhall.input license "< AllRightsReserved : {} >.AllRightsReserved {=}"
+    _ <- Dhall.input license "< AllRightsReserved = {=} >"
+    return ()