Add archiveCmd to DAML Script (#7268)

Factored out from #7264 and added a test. Just makes the migration a tiny bit easier. changelog_begin - [DAML Script] Add `archiveCmd cid` as a convenience wrapper around `exerciseCmd cid Archive`. changelog_end
digital-asset · Aug 31, 2020 · 6743bf5 · 6743bf5
1 parent 4c7b07f
commit 6743bf5
Show file tree

Hide file tree

Showing 2 changed files with 15 additions and 2 deletions.
diff --git a/compiler/damlc/tests/src/DA/Test/ScriptService.hs b/compiler/damlc/tests/src/DA/Test/ScriptService.hs
@@ -104,7 +104,11 @@ main =
                       "testMulti = do",
                       "  p <- allocateParty \"p\"",
                       "  (cid1, cid2) <- submit p $ (,) <$> createCmd (T p 23) <*> createCmd (T p 42)",
-                      "  submit p $ (,) <$> exerciseCmd cid1 C <*> exerciseCmd cid2 C"
+                      "  submit p $ (,) <$> exerciseCmd cid1 C <*> exerciseCmd cid2 C",
+                      "testArchive = do",
+                      "  p <- allocateParty \"p\"",
+                      "  cid <- submit p (createCmd (T p 42))",
+                      "  submit p (archiveCmd cid)"
                     ]
                 expectScriptSuccess rs (vr "testCreate") $ \r ->
                   matchRegex r "Active contracts:  #0:0\n\nReturn value: #0:0\n\n$"
@@ -121,7 +125,9 @@ main =
                         "  DA\\.Types:Tuple2@[a-z0-9]+ with",
                         "    _1 = 23; _2 = 42",
                         ""
-                      ],
+                      ]
+                expectScriptSuccess rs (vr "testArchive") $ \r ->
+                  matchRegex r "'p' exercises Archive on #0:0",
               testCase "exerciseByKeyCmd" $ do
                 rs <-
                   runScripts

diff --git a/daml-script/daml/Daml/Script.daml b/daml-script/daml/Daml/Script.daml
@@ -21,6 +21,7 @@ module Daml.Script
   , exerciseCmd
   , exerciseByKeyCmd
   , createAndExerciseCmd
+  , archiveCmd
   , getTime
   , setTime
   , sleep
@@ -287,6 +288,12 @@ exerciseByKeyCmd key arg = Commands $ Ap (\f -> f (ExerciseByKey (templateTypeRe
 createAndExerciseCmd : forall t c r. Choice t c r => t -> c -> Commands r
 createAndExerciseCmd tplArg choiceArg = Commands $ Ap (\f -> f (CreateAndExercise (toAnyTemplate tplArg) (toAnyChoice @t choiceArg) identity) (pure fromLedgerValue))
 
+-- | Archive the given contract.
+--
+-- `archiveCmd cid` is equivalent to `exerciseCmd cid Archive`.
+archiveCmd : Choice t Archive () => ContractId t -> Commands ()
+archiveCmd cid = exerciseCmd cid Archive
+
 instance Applicative Script where
     pure a = Script $ \ s -> return (a, s)