use the Monoid instance for Data.Set

meadow-client/src/Semantics.purs

@@ -3,8 +3,10 @@ module Semantics where
 import Prelude
 import Data.BigInteger (BigInteger, fromInt)
 import Data.FoldableWithIndex (foldrWithIndexDefault)
+import Data.Foldable (foldMap)
 import Data.List (List(Nil, Cons), concat, foldl, foldr)
 import Data.Maybe (Maybe(..), fromMaybe)
+import Data.Monoid (mempty)
 import Data.Newtype (unwrap)
 import Data.Tuple (Tuple(..))
 import Marlowe.Types (BlockNumber, Choice, ValueF(..), ObservationF(..), ContractF(..), Contract(Use, Let, Scale, While, When, Choice, Both, Pay, Commit, Null), IdAction, IdChoice, IdCommit, IdOracle, LetLabel, Observation(FalseObs, TrueObs, ValueEQ, ValueLE, ValueLT, ValueGT, ValueGE, ChoseSomething, ChoseThis, NotObs, OrObs, AndObs, BelowTimeout), Person, Timeout, Value(ValueFromOracle, ValueFromChoice, ModValue, DivValue, MulValue, SubValue, AddValue, NegValue, Constant, Committed, CurrentBlock), WIdChoice(WIdChoice))
@@ -1159,7 +1161,7 @@ class PeopleFrom a where
 
 instance peopleFromCommitInfo :: PeopleFrom CommitInfo where
   peopleFrom (CommitInfo { redeemedPerPerson: rpp, currentCommitsById: ccbi })
-    = S.union (S.fromFoldable (M.keys rpp)) (S.fromFoldable (map (\x -> x.person) (M.values ccbi)))
+    = S.fromFoldable (M.keys rpp) <> S.fromFoldable (map _.person (M.values ccbi))
 
 instance peopleFromState :: PeopleFrom State where
   peopleFrom (State { commits: comm }) = peopleFrom comm
@@ -1168,53 +1170,50 @@ instance peopleFromValue :: PeopleFrom Value where
   peopleFrom = cata algebra
     where
       algebra :: Algebra ValueF (S.Set Person)
-      algebra CurrentBlockF = S.empty
-      algebra (CommittedF _) = S.empty
-      algebra (ConstantF _) = S.empty
+      algebra CurrentBlockF = mempty
+      algebra (CommittedF _) = mempty
+      algebra (ConstantF _) = mempty
       algebra (NegValueF value) = value
-      algebra (AddValueF value1 value2) = S.union value1 value2
-      algebra (SubValueF value1 value2) = S.union value1 value2
-      algebra (MulValueF value1 value2) = S.union value1 value2
-      algebra (DivValueF value1 value2 value3) = S.unions [value1, value2, value3]
-      algebra (ModValueF value1 value2 value3) = S.unions [value1, value2, value3]
+      algebra (AddValueF value1 value2) = value1 <> value2
+      algebra (SubValueF value1 value2) = value1 <> value2
+      algebra (MulValueF value1 value2) = value1 <> value2
+      algebra (DivValueF value1 value2 value3) = value1 <> value2 <> value3
+      algebra (ModValueF value1 value2 value3) = value1 <> value2 <> value3
       algebra (ValueFromChoiceF v value) = S.insert (unwrap v).person value
       algebra (ValueFromOracleF _ value) = value
 
 instance peopleFromObservation :: PeopleFrom Observation where
   peopleFrom = cata algebra
     where
       algebra :: Algebra ObservationF (S.Set Person)
-      algebra (BelowTimeoutF _) = S.empty
-      algebra (AndObsF observation1 observation2) = S.union observation1 observation2
-      algebra (OrObsF observation1 observation2) = S.union observation1 observation2
+      algebra (BelowTimeoutF _) = mempty
+      algebra (AndObsF observation1 observation2) = observation1 <> observation2
+      algebra (OrObsF observation1 observation2) = observation1 <> observation2
       algebra (NotObsF observation) = observation
-      algebra (ChoseThisF v _) = S.insert (unwrap v).person S.empty
-      algebra (ChoseSomethingF v) = S.insert (unwrap v).person S.empty
-      algebra (ValueGEF value1 value2) = S.union (peopleFrom value1) (peopleFrom value2)
-      algebra (ValueGTF value1 value2) = S.union (peopleFrom value1) (peopleFrom value2)
-      algebra (ValueLTF value1 value2) = S.union (peopleFrom value1) (peopleFrom value2)
-      algebra (ValueLEF value1 value2) = S.union (peopleFrom value1) (peopleFrom value2)
-      algebra (ValueEQF value1 value2) = S.union (peopleFrom value1) (peopleFrom value2)
-      algebra TrueObsF = S.empty
-      algebra FalseObsF = S.empty
+      algebra (ChoseThisF v _) = S.insert (unwrap v).person mempty
+      algebra (ChoseSomethingF v) = S.insert (unwrap v).person mempty
+      algebra (ValueGEF value1 value2) = peopleFrom value1 <> peopleFrom value2
+      algebra (ValueGTF value1 value2) = peopleFrom value1 <> peopleFrom value2
+      algebra (ValueLTF value1 value2) = peopleFrom value1 <> peopleFrom value2
+      algebra (ValueLEF value1 value2) = peopleFrom value1 <> peopleFrom value2
+      algebra (ValueEQF value1 value2) = peopleFrom value1 <> peopleFrom value2
+      algebra TrueObsF = mempty
+      algebra FalseObsF = mempty
 
 instance peopleFromContract :: PeopleFrom Contract where
   peopleFrom = cata algebra
     where
       algebra :: Algebra ContractF (S.Set Person)
-      algebra NullF = S.empty
-      algebra (CommitF _ _ person value _ _ c1 c2) = S.insert person (S.unions [peopleFrom value, c1, c2])
-      algebra (PayF _ _ person value _  c1 c2) = S.insert person (S.unions [peopleFrom value, c1, c2])
-      algebra (BothF c1 c2) = S.union c1 c2
-      algebra (ChoiceF observation c1 c2) = S.unions [peopleFrom observation, c1, c2]
-      algebra (WhenF observation _ c1 c2) = S.unions [peopleFrom observation, c1, c2]
-      algebra (WhileF observation _ c1 c2) = S.unions [peopleFrom observation, c1, c2]
-      algebra (ScaleF v1 v2 v3 c) = S.unions $ map peopleFrom [v1, v2, v3] <> [c]
-      algebra (LetF _ c1 c2) = S.union c1 c2
-      algebra (UseF _) = S.empty
+      algebra NullF = mempty
+      algebra (CommitF _ _ person value _ _ c1 c2) = S.insert person (peopleFrom value <> c1 <> c2)
+      algebra (PayF _ _ person value _  c1 c2) = S.insert person (peopleFrom value <> c1 <> c2)
+      algebra (BothF c1 c2) = c1 <> c2
+      algebra (ChoiceF observation c1 c2) = peopleFrom observation <> c1 <> c2
+      algebra (WhenF observation _ c1 c2) = peopleFrom observation <> c1 <> c2
+      algebra (WhileF observation _ c1 c2) = peopleFrom observation <> c1 <> c2
+      algebra (ScaleF v1 v2 v3 c) = foldMap peopleFrom [v1, v2, v3] <> c
+      algebra (LetF _ c1 c2) = c1 <> c2
+      algebra (UseF _) = mempty
 
 peopleFromStateAndContract :: State -> Contract -> List Person
-peopleFromStateAndContract sta con = S.toUnfoldable (S.union psta pcon)
-  where
-  psta = peopleFrom sta
-  pcon = peopleFrom con
+peopleFromStateAndContract sta con = S.toUnfoldable (peopleFrom sta <> peopleFrom con)