Add hashes to serial test cases

- With first test case generator transcript

unison-src/transcripts-using-base/base.u

@@ -353,8 +353,10 @@ saveTestCase name f i =
   dir = "unison-src/transcripts-using-base/serialized-cases/"
   sfile = dir ++ name ++ ".ser"
   ofile = dir ++ name ++ ".out"
+  hfile = dir ++ name ++ ".hash"
 
   output = f i
 
   saveSelfContained (f, i) sfile
   writeFile ofile (toUtf8 output)
+  writeFile hfile (crypto.hash Sha3_512 (f, i))

unison-src/transcripts-using-base/random-deserial.md

@@ -0,0 +1,55 @@
+```ucm:hide
+.> builtins.mergeio
+```
+
+```unison
+directory = "unison-src/transcripts-using-base/serialized-cases/"
+
+availableCases : '{IO,Exception} [Text]
+availableCases _ =
+  l = filter (contains ".ser") (directoryContents directory)
+  map (t -> Text.take (drop (Text.size t) 4) t) l
+
+gen : Nat -> Nat -> (Nat, Nat)
+gen seed k =
+  c = 1442695040888963407
+  a = 6364136223846793005
+  (mod seed k, a * seed + c)
+  
+shuffle : Nat -> [a] -> [a]
+shuffle =
+  pick acc seed = cases
+    l | lteq (List.size l) 1 -> acc ++ l
+      | otherwise -> match gen seed (Nat.drop (size l) 1) with
+        (k, seed) -> match (take k l, drop k l) with
+          (pre, x +: post) -> pick (acc :+ x) seed (pre ++ post)
+  
+  pick []
+
+runTestCase : Text ->{Exception,IO} Test.Result
+runTestCase name =
+  sfile = directory ++ name ++ ".ser"
+  ofile = directory ++ name ++ ".out"
+  hfile = directory ++ name ++ ".hash"
+
+  p@(f, i) = loadSelfContained sfile
+  o = fromUtf8 (readFile ofile)
+  h = readFile hfile
+
+  if f i == o
+  then if crypto.hash Sha3_512 p == h
+       then Ok name
+       else Fail (name ++ " hash mismatch")
+  else Fail (name ++ " output mismatch")
+  
+serialTests : '{IO,Exception} [Test.Result]
+serialTests = do
+  l = !availableCases
+  cs = shuffle (toRepresentation !systemTimeMicroseconds) l
+  List.map runTestCase cs
+```
+
+```ucm
+.> add
+.> io.test serialTests
+```

unison-src/transcripts-using-base/random-deserial.output.md

@@ -0,0 +1,86 @@
+```unison
+directory = "unison-src/transcripts-using-base/serialized-cases/"
+
+availableCases : '{IO,Exception} [Text]
+availableCases _ =
+  l = filter (contains ".ser") (directoryContents directory)
+  map (t -> Text.take (drop (Text.size t) 4) t) l
+
+gen : Nat -> Nat -> (Nat, Nat)
+gen seed k =
+  c = 1442695040888963407
+  a = 6364136223846793005
+  (mod seed k, a * seed + c)
+  
+shuffle : Nat -> [a] -> [a]
+shuffle =
+  pick acc seed = cases
+    l | lteq (List.size l) 1 -> acc ++ l
+      | otherwise -> match gen seed (Nat.drop (size l) 1) with
+        (k, seed) -> match (take k l, drop k l) with
+          (pre, x +: post) -> pick (acc :+ x) seed (pre ++ post)
+  
+  pick []
+
+runTestCase : Text ->{Exception,IO} Test.Result
+runTestCase name =
+  sfile = directory ++ name ++ ".ser"
+  ofile = directory ++ name ++ ".out"
+  hfile = directory ++ name ++ ".hash"
+
+  p@(f, i) = loadSelfContained sfile
+  o = fromUtf8 (readFile ofile)
+  h = readFile hfile
+
+  if f i == o
+  then if crypto.hash Sha3_512 p == h
+       then Ok name
+       else Fail (name ++ " hash mismatch")
+  else Fail (name ++ " output mismatch")
+  
+serialTests : '{IO,Exception} [Test.Result]
+serialTests = do
+  l = !availableCases
+  cs = shuffle (toRepresentation !systemTimeMicroseconds) l
+  List.map runTestCase cs
+```
+
+```ucm
+
+  I found and typechecked these definitions in scratch.u. If you
+  do an `add` or `update`, here's how your codebase would
+  change:
+  
+    ⍟ These new definitions are ok to `add`:
+    
+      availableCases : '{IO, Exception} [Text]
+      directory      : Text
+      gen            : Nat -> Nat -> (Nat, Nat)
+      runTestCase    : Text ->{IO, Exception} Result
+      serialTests    : '{IO, Exception} [Result]
+      shuffle        : Nat -> [a] -> [a]
+
+```
+```ucm
+.> add
+
+  ⍟ I've added these definitions:
+  
+    availableCases : '{IO, Exception} [Text]
+    directory      : Text
+    gen            : Nat -> Nat -> (Nat, Nat)
+    runTestCase    : Text ->{IO, Exception} Result
+    serialTests    : '{IO, Exception} [Result]
+    shuffle        : Nat -> [a] -> [a]
+
+.> io.test serialTests
+
+    New test results:
+  
+  ◉ serialTests   case-00
+  
+  ✅ 1 test(s) passing
+  
+  Tip: Use view serialTests to view the source of a test.
+
+```

unison-src/transcripts-using-base/serial-test-00.md

@@ -0,0 +1,77 @@
+```ucm:hide
+.> builtins.mergeio
+```
+
+```unison
+structural type Tree a = Leaf | Node (Tree a) a (Tree a)
+
+foldMap  : r -> (r -> r -> r) -> (a -> r) -> Tree a -> r
+foldMap z m f =
+  walk = cases
+    Leaf -> z
+    Node l x r -> m (walk l) (m (f x) (walk r)) 
+
+  walk 
+
+tree0 : Tree Nat
+tree0 =
+  (Node
+     (Node Leaf 2 Leaf)
+     1
+     (Node Leaf 3 (Node Leaf 4 Leaf)))
+
+tree1 : Tree Nat
+tree1 =
+  Node
+    tree0
+    0
+    (Node
+       (Node
+          (Node Leaf 7 Leaf)
+          6
+          (Node
+             Leaf
+             8
+             (Node Leaf 9 Leaf)))
+       5
+       Leaf)
+
+tree2 : Tree Nat
+tree2 = Node tree0 10 tree1
+
+tree3 : Tree Text
+tree3 =
+  Node
+    (Node Leaf "hello" Leaf)
+    " "
+    (Node (Node Leaf "good" Leaf)
+          "bye"
+          Leaf)
+
+evaluate
+  : (Tree Nat ->{} Nat)
+  -> (Tree Text ->{} Text)
+  -> (Tree Nat, Tree Nat, Tree Nat, Tree Text)
+  -> Text
+evaluate f g = cases
+  (w, x, y, z) ->
+    ow = f w
+    ox = f x
+    oy = f y
+    oz = g z
+    "(" ++ toText ow ++ ", " ++ toText ox ++ ", " ++ toText oy ++ ", " ++ oz ++ ")"
+
+mkTestCase : '{IO,Exception} ()
+mkTestCase = do
+  balancedSum = foldMap 0 (Nat.+) (x -> x)
+  catenate = foldMap "" (Text.++) (x -> x)
+  f = evaluate balancedSum catenate
+  tup = (tree0, tree1, tree2, tree3)
+
+  saveTestCase "case-00" f tup
+```
+
+```ucm
+.> add
+.> run mkTestCase
+```

unison-src/transcripts-using-base/serial-test-00.output.md

@@ -0,0 +1,122 @@
+```unison
+structural type Tree a = Leaf | Node (Tree a) a (Tree a)
+
+foldMap  : r -> (r -> r -> r) -> (a -> r) -> Tree a -> r
+foldMap z m f =
+  walk = cases
+    Leaf -> z
+    Node l x r -> m (walk l) (m (f x) (walk r)) 
+
+  walk 
+
+tree0 : Tree Nat
+tree0 =
+  (Node
+     (Node Leaf 2 Leaf)
+     1
+     (Node Leaf 3 (Node Leaf 4 Leaf)))
+
+tree1 : Tree Nat
+tree1 =
+  Node
+    tree0
+    0
+    (Node
+       (Node
+          (Node Leaf 7 Leaf)
+          6
+          (Node
+             Leaf
+             8
+             (Node Leaf 9 Leaf)))
+       5
+       Leaf)
+
+tree2 : Tree Nat
+tree2 = Node tree0 10 tree1
+
+tree3 : Tree Text
+tree3 =
+  Node
+    (Node Leaf "hello" Leaf)
+    " "
+    (Node (Node Leaf "good" Leaf)
+          "bye"
+          Leaf)
+
+evaluate
+  : (Tree Nat ->{} Nat)
+  -> (Tree Text ->{} Text)
+  -> (Tree Nat, Tree Nat, Tree Nat, Tree Text)
+  -> Text
+evaluate f g = cases
+  (w, x, y, z) ->
+    ow = f w
+    ox = f x
+    oy = f y
+    oz = g z
+    "(" ++ toText ow ++ ", " ++ toText ox ++ ", " ++ toText oy ++ ", " ++ oz ++ ")"
+
+mkTestCase : '{IO,Exception} ()
+mkTestCase = do
+  balancedSum = foldMap 0 (Nat.+) (x -> x)
+  catenate = foldMap "" (Text.++) (x -> x)
+  f = evaluate balancedSum catenate
+  tup = (tree0, tree1, tree2, tree3)
+
+  saveTestCase "case-00" f tup
+```
+
+```ucm
+
+  I found and typechecked these definitions in scratch.u. If you
+  do an `add` or `update`, here's how your codebase would
+  change:
+  
+    ⍟ These new definitions are ok to `add`:
+    
+      structural type Tree a
+      evaluate   : (Tree Nat -> Nat)
+                   -> (Tree Text -> Text)
+                   -> (Tree Nat, Tree Nat, Tree Nat, Tree Text)
+                   -> Text
+      foldMap    : ∀ a r g2 g1 g.
+                     r
+                     -> (r ->{g2} r ->{g1} r)
+                     -> (a ->{g} r)
+                     -> Tree a
+                     ->{g2, g1, g} r
+      mkTestCase : '{IO, Exception} ()
+      tree0      : Tree Nat
+      tree1      : Tree Nat
+      tree2      : Tree Nat
+      tree3      : Tree Text
+
+```
+```ucm
+.> add
+
+  ⍟ I've added these definitions:
+  
+    structural type Tree a
+    evaluate   : (Tree Nat -> Nat)
+                 -> (Tree Text -> Text)
+                 -> (Tree Nat, Tree Nat, Tree Nat, Tree Text)
+                 -> Text
+    foldMap    : ∀ a r g2 g1 g.
+                   r
+                   -> (r ->{g2} r ->{g1} r)
+                   -> (a ->{g} r)
+                   -> Tree a
+                   ->{g2, g1, g} r
+    mkTestCase : '{IO, Exception} ()
+    tree0      : Tree Nat
+    tree1      : Tree Nat
+    tree2      : Tree Nat
+    tree3      : Tree Text
+
+.> run mkTestCase
+
+  ()
+
+```

unison-src/transcripts-using-base/serialized-cases/case-00.hash

@@ -0,0 +1 @@
+rAŠęúž;ŚUŔ+vŰLÔ«Qěî€Gh;Z54ŠîŠm®Ş´ăŔ=Z;<3B>Ü:3vóó”˙6źŁ™w{™=RĽ

unison-src/transcripts-using-base/serialized-cases/case-00.out

@@ -0,0 +1 @@
+(10, 45, 65, hello goodbye)