cleanup a bit

IntersectMBO · Jul 29, 2021 · bdb788b · bdb788b
1 parent 85d0b49
commit bdb788b
Show file tree

Hide file tree

Showing 4 changed files with 9 additions and 17 deletions.
diff --git a/marlowe-actus/src/Language/Marlowe/ACTUS/Generator.hs b/marlowe-actus/src/Language/Marlowe/ACTUS/Generator.hs
@@ -16,7 +16,6 @@ import           Data.Time                                                (Day)
 import           Data.Validation                                          (Validation (..))
 import           Language.Marlowe                                         (Action (Choice, Deposit), Bound (Bound),
                                                                            Case (Case), ChoiceId (ChoiceId),
-                                                                           ChoiceName (..),
                                                                            Contract (Close, Let, Pay, When),
                                                                            Observation, Party (Role), Payee (Party),
                                                                            Slot (..),
@@ -97,12 +96,12 @@ inquiryFs ev ct timePosfix date oracle context continue =
         letTemplate inputChoiceId inputOwner cont =
             Let
                 (ValueId inputChoiceId)
-                (ChoiceValue (ChoiceId (ChoiceName inputChoiceId) inputOwner))
+                (ChoiceValue (ChoiceId inputChoiceId inputOwner))
                 cont
 
         inputTemplate inputChoiceId inputOwner inputBound cont =
             When
-                [ Case (Choice (ChoiceId (ChoiceName inputChoiceId) inputOwner) inputBound) $
+                [ Case (Choice (ChoiceId inputChoiceId inputOwner) inputBound) $
                     letTemplate inputChoiceId inputOwner cont
                 ]
                 date

diff --git a/marlowe-playground-server/app/PSGenerator.hs b/marlowe-playground-server/app/PSGenerator.hs
@@ -239,8 +239,8 @@ writePangramJson outputDir = do
             S.Assert S.TrueObs
                 (S.When
                     [ S.Case (S.Deposit alicePk alicePk ada valueExpr)
-                        ( S.Let "x" valueExpr
-                            (S.Pay alicePk (S.Party bobRole) ada (S.Cond S.TrueObs (S.UseValue "x") (S.UseValue "y")) S.Close)
+                        ( S.Let (S.ValueId "x") valueExpr
+                            (S.Pay alicePk (S.Party bobRole) ada (S.Cond S.TrueObs (S.UseValue (S.ValueId "x")) (S.UseValue (S.ValueId "y"))) S.Close)
                         )
                     , S.Case (S.Choice choiceId [ S.Bound 0 1 ])
                         ( S.If (S.ChoseSomething choiceId `S.OrObs` (S.ChoiceValue choiceId `S.ValueEQ` S.Scale (1 S.% 10) const100))
@@ -257,7 +257,7 @@ writePangramJson outputDir = do
             State
             { accounts = Map.singleton (alicePk, token) 12
             , choices = Map.singleton choiceId 42
-            , boundValues = Map.fromList [ ("x", 1), ("y", 2) ]
+            , boundValues = Map.fromList [ (ValueId "x", 1), (ValueId "y", 2) ]
             , minSlot = S.Slot 123
             }
         encodedState = BS8.pack . Char8.unpack $ encode state

diff --git a/marlowe/src/Language/Marlowe/Semantics.hs b/marlowe/src/Language/Marlowe/Semantics.hs
@@ -108,20 +108,16 @@ instance Haskell.Show Party where
 type AccountId = Party
 type Timeout = Slot
 type Money = Val.Value
+type ChoiceName = BuiltinByteString
 type ChosenNum = Integer
 type SlotInterval = (Slot, Slot)
 type Accounts = Map (AccountId, Token) Integer
 
-newtype ChoiceName = ChoiceName { unChoiceName :: BuiltinByteString }
-  deriving (IsString, Haskell.Show, Pretty) via TokenName
-  deriving stock (Generic)
-  deriving newtype (Haskell.Eq, Haskell.Ord, Eq)
-
 -- * Data Types
 {-| Choices – of integers – are identified by ChoiceId
     which combines a name for the choice with the Party who had made the choice.
 -}
-data ChoiceId = ChoiceId ChoiceName Party
+data ChoiceId = ChoiceId BuiltinByteString Party
   deriving stock (Haskell.Show,Generic,Haskell.Eq,Haskell.Ord)
   deriving anyclass (Pretty)
 
@@ -833,12 +829,12 @@ instance ToJSON Party where
 
 instance FromJSON ChoiceId where
   parseJSON = withObject "ChoiceId" (\v ->
-       ChoiceId <$> (ChoiceName . fromHaskellByteString . Text.encodeUtf8 <$> (v .: "choice_name"))
+       ChoiceId <$> (fromHaskellByteString . Text.encodeUtf8 <$> (v .: "choice_name"))
                 <*> (v .: "choice_owner")
                                     )
 
 instance ToJSON ChoiceId where
-  toJSON (ChoiceId name party) = object [ "choice_name" .= (JSON.String $ Text.decodeUtf8 $ toHaskellByteString $ unChoiceName name)
+  toJSON (ChoiceId name party) = object [ "choice_name" .= (JSON.String $ Text.decodeUtf8 $ toHaskellByteString name)
                                         , "choice_owner" .= party
                                         ]
 
@@ -1301,8 +1297,6 @@ instance Eq State where
 
 
 -- Lifting data types to Plutus Core
-makeLift ''ChoiceName
-makeIsDataIndexed ''ChoiceName [('ChoiceName,0)]
 makeLift ''Party
 makeIsDataIndexed ''Party [('PK,0),('Role,1)]
 makeLift ''ChoiceId

diff --git a/plutus-tx/src/PlutusTx/Builtins/Internal.hs b/plutus-tx/src/PlutusTx/Builtins/Internal.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE DerivingVia        #-}
 {-# LANGUAGE TypeApplications   #-}
 -- This ensures that we don't put *anything* about these functions into the interface
 -- file, otherwise GHC can be clever about the ones that are always error, even though