Remove Optional/fold and Optional/build (#1802)

…as standardized in dhall-lang/dhall-lang#1014.

Author: sjakobi

dhall-bash/src/Dhall/Bash.hs

@@ -321,8 +321,6 @@ dhallToStatement expr0 var0 = go (Dhall.Core.normalize expr0)
     go e@(ListReverse        ) = Left (UnsupportedStatement e)
     go e@(Optional           ) = Left (UnsupportedStatement e)
     go e@(None               ) = Left (UnsupportedStatement e)
-    go e@(OptionalFold       ) = Left (UnsupportedStatement e)
-    go e@(OptionalBuild      ) = Left (UnsupportedStatement e)
     go e@(Record           {}) = Left (UnsupportedStatement e)
     go e@(Union            {}) = Left (UnsupportedStatement e)
     go e@(Combine          {}) = Left (UnsupportedStatement e)

dhall-json/src/Dhall/JSON.hs

@@ -963,12 +963,6 @@ convertToHomogeneousMaps (Conversion {..}) e0 = loop (Core.normalize e0)
         Core.None ->
             Core.None
 
-        Core.OptionalFold ->
-            Core.OptionalFold
-
-        Core.OptionalBuild ->
-            Core.OptionalBuild
-
         Core.Record a ->
             Core.Record a'
           where

dhall-nix/release.nix

@@ -81,22 +81,6 @@ in
             then (Some 0)
             else (None Natural)
         '';
-        testOptionalFold = dhallToNix ''
-          Optional/fold
-          Natural
-          (Some 1)
-          Natural
-        '';
-        testOptionalBuild = dhallToNix ''
-            λ(b : Bool)
-          → Optional/build
-            Natural
-            ( λ(optional : Type)
-            → λ(just : Natural → optional)
-            → λ(nothing : optional)
-            → if b then just 1 else nothing
-            )
-        '';
         testNone = dhallToNix "None Natural";
         testSome = dhallToNix "Some 4";
         testRecord = dhallToNix "{}";
@@ -182,9 +166,6 @@ in
         assert (testOptional {} == {});
         assert (testOptionalLit true == 0);
         assert (testOptionalLit false == null);
-        assert (testOptionalFold (n : n) 0 == 1);
-        assert (testOptionalBuild true == 1);
-        assert (testOptionalBuild false == null);
         assert (testRecord == {});
         assert (testRecordLit == { foo = 1; bar = true; });
         assert (testUnion == {});

dhall-nix/src/Dhall/Nix.hs

@@ -101,7 +101,6 @@ import Data.Void (Void, absurd)
 import Dhall.Core
     ( Binding(..)
     , Chunks(..)
-    , Const(..)
     , DhallDouble(..)
     , Expr(..)
     , MultiLet(..)
@@ -524,19 +523,6 @@ dhallToNix e =
     loop Optional = return (Fix (NAbs "t" untranslatable))
     loop (Some a) = loop a
     loop None = return (Fix (NConstant NNull))
-    loop OptionalFold = do
-        let e0 = Fix (NBinary NEq "x" (Fix (NConstant NNull)))
-        let e1 = Fix (NIf e0 "nothing" (Fix (NBinary NApp "just" "x")))
-        let e2 = Fix (NAbs "t" (Fix (NAbs "just" (Fix (NAbs "nothing" e1)))))
-        return (Fix (NAbs "t" (Fix (NAbs "x" e2))))
-    loop OptionalBuild = do
-        let e0 = Pi "nothing" "optional" "optional"
-        let e1 = Pi "just" (Pi "_" "a" "optional") e0
-        let e2 = Pi "optional" (Const Type) e1
-        let e3 = App None "a"
-        let e4 = Lam "x" "a" (Some "x")
-        let e5 = App (App (App "f" (App Optional "a")) e4) e3
-        loop (Lam "a" (Const Type) (Lam "f" e2 e5))
     loop (Record _) = return untranslatable
     loop (RecordLit a) = do
         a' <- traverse loop a

dhall/benchmark/examples/issue108.dhall

@@ -15,8 +15,9 @@ Text , user : Optional Text } xs Text ( λ ( x : { cores : Natural , host : Text
 {} | MIPS64el_Linux : {} | PowerPC_Linux : {} | X86_64_Cygwin : {} |
 X86_64_Darwin : {} | X86_64_FreeBSD : {} | X86_64_Linux : {} | X86_64_Solaris :
 {} > , speedFactor : Natural , supportedFeatures : List Text , user : Optional
-Text } ) → λ(y : Text) → Optional/fold Text x.user Text (λ(user : Text) → user
-++ "@" ++ x.host ++ "") x.host ++ " " ++ ( merge { Empty = λ(_ : {}) → "",
+Text } ) → λ(y : Text) →
+merge { None = x.host, Some = λ(user : Text) → "${user}@${x.host}" } x.user
+++ " " ++ ( merge { Empty = λ(_ : {}) → "",
 NonEmpty = λ(result : Text) → result } ( List/fold < AArch64_Linux : {} |
 ARMv5tel_Linux : {} | ARMv7l_Linux : {} | I686_Cygwin : {} | I686_Linux : {} |
 MIPS64el_Linux : {} | PowerPC_Linux : {} | X86_64_Cygwin : {} | X86_64_Darwin :

dhall/benchmark/examples/issue108.dhall.bin

@@ -189,7 +189,8 @@ Extra-Source-Files:
     dhall-lang/tests/binary-decode/success/unit/*.dhallb
     dhall-lang/tests/binary-decode/success/unit/imports/*.dhall
     dhall-lang/tests/binary-decode/success/unit/imports/*.dhallb
-    dhall-lang/tests/import/cache/dhall/1220efc43103e49b56c5bf089db8e0365bbfc455b8a2f0dc6ee5727a3586f85969fd
+    dhall-lang/tests/import/cache/dhall/12203871180b87ecaba8b53fffb2a8b52d3fce98098fab09a6f759358b9e8042eedc
+    dhall-lang/tests/import/cache/dhall/1220618f785ce8f3930a9144398f576f0a992544b51212bc9108c31b4e670dc6ed21
     dhall-lang/tests/import/data/*.dhall
     dhall-lang/tests/import/data/*.txt
     dhall-lang/tests/import/failure/*.dhall

dhall/benchmark/examples/kubernetes.dhall.bin

@@ -190,10 +190,8 @@ decodeExpressionInternal decodeEmbed = go
                        | sb == "Natural/show"      -> return NaturalShow
                     13 | sb == "Integer/clamp"     -> return IntegerClamp
                        | sb == "Natural/build"     -> return NaturalBuild
-                       | sb == "Optional/fold"     -> return OptionalFold
                     14 | sb == "Integer/negate"    -> return IntegerNegate
                        | sb == "Natural/isZero"    -> return NaturalIsZero
-                       | sb == "Optional/build"    -> return OptionalBuild
                     16 | sb == "Integer/toDouble"  -> return IntegerToDouble
                        | sb == "Natural/subtract"  -> return NaturalSubtract
                     17 | sb == "Natural/toInteger" -> return NaturalToInteger
@@ -662,12 +660,6 @@ encodeExpressionInternal encodeEmbed = go
         ListReverse ->
             Encoding.encodeUtf8ByteArray "List/reverse"
 
-        OptionalFold ->
-            Encoding.encodeUtf8ByteArray "Optional/fold"
-
-        OptionalBuild ->
-            Encoding.encodeUtf8ByteArray "Optional/build"
-
         Bool ->
             Encoding.encodeUtf8ByteArray "Bool"
 

dhall/dhall-lang

@@ -1272,18 +1272,6 @@ diffPrimitiveExpression l@None r =
     mismatch l r
 diffPrimitiveExpression l r@None =
     mismatch l r
-diffPrimitiveExpression OptionalFold OptionalFold =
-    "…"
-diffPrimitiveExpression l@OptionalFold r =
-    mismatch l r
-diffPrimitiveExpression l r@OptionalFold =
-    mismatch l r
-diffPrimitiveExpression OptionalBuild OptionalBuild =
-    "…"
-diffPrimitiveExpression l@OptionalBuild r =
-    mismatch l r
-diffPrimitiveExpression l r@OptionalBuild =
-    mismatch l r
 diffPrimitiveExpression (BoolLit aL) (BoolLit aR) =
     diffBool aL aR
 diffPrimitiveExpression l@(BoolLit {}) r =

dhall/dhall.cabal

@@ -211,8 +211,6 @@ data Val a
     | VOptional (Val a)
     | VSome (Val a)
     | VNone (Val a)
-    | VOptionalFold (Val a) !(Val a) (Val a) !(Val a) !(Val a)
-    | VOptionalBuild (Val a) !(Val a)
     | VRecord !(Map Text (Val a))
     | VRecordLit !(Map Text (Val a))
     | VUnion !(Map Text (Maybe (Val a)))
@@ -671,32 +669,6 @@ eval !env t0 =
             VSome (eval env t)
         None ->
             VPrim $ \ ~a -> VNone a
-        OptionalFold ->
-            VPrim $ \ ~a ->
-            VPrim $ \case
-                VNone _ ->
-                    VHLam (Typed "optional" (VConst Type)) $ \optional ->
-                    VHLam (Typed "some" (a ~> optional)) $ \_some ->
-                    VHLam (Typed "none" optional) $ \none ->
-                    none
-                VSome t ->
-                    VHLam (Typed "optional" (VConst Type)) $ \optional ->
-                    VHLam (Typed "some" (a ~> optional)) $ \some ->
-                    VHLam (Typed "none" optional) $ \_none ->
-                    some `vApp` t
-                opt ->
-                    VPrim $ \o ->
-                    VPrim $ \s ->
-                    VPrim $ \n ->
-                    VOptionalFold a opt o s n
-        OptionalBuild ->
-            VPrim $ \ ~a ->
-            VPrim $ \case
-                VPrimVar -> VOptionalBuild a VPrimVar
-                t ->       t
-                    `vApp` VOptional a
-                    `vApp` VHLam (Typed "a" a) VSome
-                    `vApp` VNone a
         Record kts ->
             VRecord (Map.sort (fmap (eval env) kts))
         RecordLit kts ->
@@ -937,8 +909,6 @@ conv !env t0 t0' =
             conv env t t'
         (VNone _, VNone _) ->
             True
-        (VOptionalBuild _ t, VOptionalBuild _ t') ->
-            conv env t t'
         (VRecord m, VRecord m') ->
             eqMapsBy (conv env) m m'
         (VRecordLit m, VRecordLit m') ->
@@ -969,8 +939,6 @@ conv !env t0 t0' =
             eqMapsBy (eqMaybeBy (conv env)) m m' && k == k' && eqMaybeBy (conv env) mt mt'
         (VEmbed a, VEmbed a') ->
             a == a'
-        (VOptionalFold a t _ u v, VOptionalFold a' t' _ u' v') ->
-            conv env a a' && conv env t t' && conv env u u' && conv env v v'
         (_, _) ->
             False
   where
@@ -1123,10 +1091,6 @@ quote !env !t0 =
             Some (quote env t)
         VNone t ->
             None `qApp` t
-        VOptionalFold a o t u v ->
-            OptionalFold `qApp` a `qApp` o `qApp` t `qApp` u `qApp` v
-        VOptionalBuild a t ->
-            OptionalBuild `qApp` a `qApp` t
         VRecord m ->
             Record (fmap (quote env) m)
         VRecordLit m ->
@@ -1303,10 +1267,6 @@ alphaNormalize = goEnv EmptyNames
                 Some (go t)
             None ->
                 None
-            OptionalFold ->
-                OptionalFold
-            OptionalBuild ->
-                OptionalBuild
             Record kts ->
                 Record (fmap go kts)
             RecordLit kts ->

dhall/src/Dhall/Binary.hs

@@ -14,8 +14,6 @@ module Dhall.Lint
     , fixAssert
     , fixParentPath
     , removeLetInLet
-    , replaceOptionalBuildFold
-    , replaceSaturatedOptionalFold
     , useToMap
     ) where
 
@@ -24,7 +22,6 @@ import Control.Applicative ((<|>))
 import Dhall.Syntax
     ( Binding(..)
     , Chunks(..)
-    , Const(..)
     , Directory(..)
     , Expr(..)
     , File(..)
@@ -51,20 +48,15 @@ import qualified Lens.Family
     * fixes @let a = x ≡ y@ to be @let a = assert : x ≡ y@
     * consolidates nested @let@ bindings to use a multiple-@let@ binding with 'removeLetInLet'
     * fixes paths of the form @.\/..\/foo@ to @..\/foo@
-    * Replaces deprecated @Optional\/fold@ and @Optional\/build@ built-ins
 -}
 lint :: Expr s Import -> Expr s Import
-lint =  Dhall.Optics.rewriteOf subExpressions lowerPriorityRewrite
-    .   Dhall.Optics.rewriteOf subExpressions higherPriorityRewrite
+lint =  Dhall.Optics.rewriteOf subExpressions rewrite
   where
-    lowerPriorityRewrite e =
+    rewrite e =
             fixAssert                e
         <|> removeUnusedBindings     e
         <|> fixParentPath            e
         <|> removeLetInLet           e
-        <|> replaceOptionalBuildFold e
-
-    higherPriorityRewrite = replaceSaturatedOptionalFold
 
 -- | Remove unused `Let` bindings.
 removeUnusedBindings :: Eq a => Expr s a -> Maybe (Expr s a)
@@ -132,68 +124,6 @@ removeLetInLet :: Expr s a -> Maybe (Expr s a)
 removeLetInLet (Let binding (Note _ l@Let{})) = Just (Let binding l)
 removeLetInLet _ = Nothing
 
--- | This replaces @Optional/fold@ and @Optional/build@, both of which can be
--- implemented within the language
-replaceOptionalBuildFold :: Expr s a -> Maybe (Expr s a)
-replaceOptionalBuildFold OptionalBuild =
-    Just
-        (Lam "a" (Const Type)
-            (Lam "build"
-                (Pi "optional" (Const Type)
-                    (Pi "some" (Pi "_" "a" "optional")
-                        (Pi "none" "optional" "optional")
-                    )
-                )
-                (App (App (App "build" (App Optional "a")) (Lam "x" "a" (Some "x"))) (App None "a"))
-            )
-        )
-replaceOptionalBuildFold OptionalFold =
-    Just
-        (Lam "a" (Const Type)
-            (Lam "o" (App Optional "a")
-                (Lam "optional" (Const Type)
-                    (Lam "some" (Pi "_" "a" "optional")
-                        (Lam "none" "optional"
-                            (Merge
-                                (RecordLit
-                                    [ ("Some", "some")
-                                    , ("None", "none")
-                                    ]
-                                )
-                                "o"
-                                Nothing
-                            )
-                        )
-                    )
-                )
-            )
-        )
-replaceOptionalBuildFold _ =
-    Nothing
-
--- | This replaces a saturated @Optional/fold@ with the equivalent @merge@
--- expression
-replaceSaturatedOptionalFold :: Expr s a -> Maybe (Expr s a)
-replaceSaturatedOptionalFold
-    (App
-        (Core.shallowDenote -> App
-            (Core.shallowDenote -> App
-                (Core.shallowDenote -> App
-                    (Core.shallowDenote -> App
-                        (Core.shallowDenote -> OptionalFold)
-                        _
-                    )
-                    o
-                )
-                _
-            )
-            some
-        )
-        none
-    ) = Just (Merge (RecordLit [ ("Some", some), ("None", none) ]) o Nothing)
-replaceSaturatedOptionalFold _ =
-    Nothing
-
 -- | This replaces a record of key-value pairs with the equivalent use of
 --   @toMap@
 --