From a452968263c7c596f9fe06ec86e89a10edf5a775 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Tue, 14 Nov 2023 20:17:26 +0100 Subject: [PATCH 1/6] Updated command for generating purescript in README.md --- marlowe-playground-client/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/marlowe-playground-client/README.md b/marlowe-playground-client/README.md index 454c53a76..ff13e904e 100644 --- a/marlowe-playground-client/README.md +++ b/marlowe-playground-client/README.md @@ -15,7 +15,7 @@ Now we will build and run the front end: ```bash [nix-shell] $ cd marlowe-playground-client # Generate the purescript bridge files -[nix-shell] $ generate-purs +[nix-shell] $ generate-purescript # Download javascript dependencies (we use ci to use the package-lock.json) [nix-shell] $ npm ci # Install purescript depdendencies From 0ef584fa8534d84463ba3bd55b8b6f061f2aa06b Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Thu, 16 Nov 2023 02:23:21 +0100 Subject: [PATCH 2/6] Show initial time for counterexamples in a human readable way --- .../Marlowe/Symbolic/Types/Response.purs | 36 ++++++++++++++++--- .../src/StaticAnalysis/BottomPanel.purs | 20 ++++++++--- marlowe-playground-server/app/PSGenerator.hs | 1 + .../src/Marlowe/Symbolic/Server.hs | 6 ++-- .../src/Marlowe/Symbolic/Types/Response.hs | 10 ++++-- web-common-marlowe/src/Humanize.purs | 8 +++++ 6 files changed, 66 insertions(+), 15 deletions(-) diff --git a/marlowe-playground-client/generated/Marlowe/Symbolic/Types/Response.purs b/marlowe-playground-client/generated/Marlowe/Symbolic/Types/Response.purs index fb47b2b7a..afd9e254a 100644 --- a/marlowe-playground-client/generated/Marlowe/Symbolic/Types/Response.purs +++ b/marlowe-playground-client/generated/Marlowe/Symbolic/Types/Response.purs @@ -27,6 +27,32 @@ import Language.Marlowe.Core.V1.Semantics.Types ) import Type.Proxy (Proxy(Proxy)) +newtype POSIXTimeWrapper = POSIXTimeWrapper BigInt + +derive instance Eq POSIXTimeWrapper + +derive instance Ord POSIXTimeWrapper + +instance Show POSIXTimeWrapper where + show a = genericShow a + +instance EncodeJson POSIXTimeWrapper where + encodeJson = defer \_ -> E.encode $ unwrap >$< E.value + +instance DecodeJson POSIXTimeWrapper where + decodeJson = defer \_ -> D.decode $ (POSIXTimeWrapper <$> D.value) + +derive instance Generic POSIXTimeWrapper _ + +derive instance Newtype POSIXTimeWrapper _ + +-------------------------------------------------------------------------------- + +_POSIXTimeWrapper :: Iso' POSIXTimeWrapper BigInt +_POSIXTimeWrapper = _Newtype + +-------------------------------------------------------------------------------- + newtype Response = Response { result :: Result , durationMs :: BigInt @@ -65,7 +91,7 @@ _Response = _Newtype data Result = Valid | CounterExample - { initialSlot :: BigInt + { initialTime :: POSIXTimeWrapper , transactionList :: Array TransactionInput , transactionWarning :: Array TransactionWarning } @@ -77,10 +103,10 @@ instance Show Result where instance EncodeJson Result where encodeJson = defer \_ -> case _ of Valid -> encodeJson { tag: "Valid", contents: jsonNull } - CounterExample { initialSlot, transactionList, transactionWarning } -> + CounterExample { initialTime, transactionList, transactionWarning } -> encodeJson { tag: "CounterExample" - , initialSlot: flip E.encode initialSlot E.value + , initialTime: flip E.encode initialTime E.value , transactionList: flip E.encode transactionList E.value , transactionWarning: flip E.encode transactionWarning E.value } @@ -93,7 +119,7 @@ instance DecodeJson Result where [ "Valid" /\ pure Valid , "CounterExample" /\ ( CounterExample <$> D.object "CounterExample" - { initialSlot: D.value :: _ BigInt + { initialTime: D.value :: _ POSIXTimeWrapper , transactionList: D.value :: _ (Array TransactionInput) , transactionWarning: D.value :: _ (Array TransactionWarning) } @@ -112,7 +138,7 @@ _Valid = prism' (const Valid) case _ of _CounterExample :: Prism' Result - { initialSlot :: BigInt + { initialTime :: POSIXTimeWrapper , transactionList :: Array TransactionInput , transactionWarning :: Array TransactionWarning } diff --git a/marlowe-playground-client/src/StaticAnalysis/BottomPanel.purs b/marlowe-playground-client/src/StaticAnalysis/BottomPanel.purs index 858738eba..cf12e4907 100644 --- a/marlowe-playground-client/src/StaticAnalysis/BottomPanel.purs +++ b/marlowe-playground-client/src/StaticAnalysis/BottomPanel.purs @@ -5,12 +5,15 @@ module StaticAnalysis.BottomPanel import Prologue hiding (div) import Data.Array as Array +import Data.BigInt.Argonaut (toNumber) import Data.BigInt.Argonaut as BigInt +import Data.DateTime.Instant (instant) import Data.Lens (to, (^.)) import Data.List (List(..), null, toUnfoldable, (:)) import Data.List as List import Data.List.NonEmpty (toList) -import Data.Time.Duration (Minutes) +import Data.Newtype (unwrap) +import Data.Time.Duration (Milliseconds(..), Minutes) import Effect.Aff.Class (class MonadAff) import Halogen (ComponentHTML) import Halogen.Classes (btn, spaceBottom, spaceRight, spaceTop, spanText) @@ -32,7 +35,7 @@ import Halogen.HTML ) import Halogen.HTML.Events (onClick) import Halogen.HTML.Properties (classes, enabled) -import Humanize (humanizeInterval, humanizeValue) +import Humanize (humanizeInstant, humanizeInterval, humanizeValue) import Icons (Icon(..), icon) import Language.Marlowe.Core.V1.Semantics.Types ( ChoiceId(..) @@ -185,7 +188,7 @@ warningAnalysisResult tzOffset staticSubResult = div ] Success ( R.CounterExample - { initialSlot, transactionList, transactionWarning } + { initialTime, transactionList, transactionWarning } ) -> [ h3 [ classes [ ClassName "analysis-result-title" ] ] [ text "Warning Analysis Result: Warnings Found" ] @@ -196,8 +199,15 @@ warningAnalysisResult tzOffset staticSubResult = div , displayWarningList transactionWarning ] , li_ - [ spanText "Initial slot: " - , b_ [ spanText (BigInt.toString initialSlot) ] + [ spanText "Initial time: " + , b_ + [ spanText $ + case + instant $ Milliseconds $ toNumber $ unwrap initialTime + of + Just inst -> humanizeInstant tzOffset inst + Nothing -> "Error parsing time" + ] ] , li_ [ spanText "Offending sequence: " diff --git a/marlowe-playground-server/app/PSGenerator.hs b/marlowe-playground-server/app/PSGenerator.hs index de74d84c1..b27d77a07 100644 --- a/marlowe-playground-server/app/PSGenerator.hs +++ b/marlowe-playground-server/app/PSGenerator.hs @@ -222,6 +222,7 @@ myTypes = , equal . genericShow . argonaut $ mkSumType @Owner , equal . genericShow . argonaut $ mkSumType @Auth.AuthStatus , order . equal . genericShow . argonaut $ mkSumType @Auth.AuthRole + , order . equal . genericShow . argonaut $ mkSumType @MSRes.POSIXTimeWrapper , argonaut $ mkSumType @CompilationError , argonaut $ mkSumType @InterpreterError , argonaut $ mkSumType @Warning diff --git a/marlowe-symbolic/src/Marlowe/Symbolic/Server.hs b/marlowe-symbolic/src/Marlowe/Symbolic/Server.hs index 18a03fe34..3880cdb7e 100644 --- a/marlowe-symbolic/src/Marlowe/Symbolic/Server.hs +++ b/marlowe-symbolic/src/Marlowe/Symbolic/Server.hs @@ -22,7 +22,7 @@ import Formatting.Clock (timeSpecs) import Language.Marlowe (POSIXTime (..), TransactionInput, TransactionWarning) import Language.Marlowe.Analysis.FSSemantics (warningsTraceCustom) import Marlowe.Symbolic.Types.Request (Request (..)) -import Marlowe.Symbolic.Types.Response (Response (..), Result (..)) +import Marlowe.Symbolic.Types.Response (POSIXTimeWrapper (..), Response (..), Result (..)) import Servant (Application, JSON, Post, ReqBody, Server, serve, (:>)) import System.Clock (Clock (Monotonic), diffTimeSpec, getTime, toNanoSecs) @@ -35,9 +35,9 @@ makeResult (Left err) = Error (show err) makeResult (Right res) = case res of Nothing -> Valid - Just (POSIXTime sn, ti, tw) -> + Just (POSIXTime iti, ti, tw) -> CounterExample - { initialSlot = sn + { initialTime = POSIXTimeWrapper iti , transactionList = ti , transactionWarning = tw } diff --git a/marlowe-symbolic/src/Marlowe/Symbolic/Types/Response.hs b/marlowe-symbolic/src/Marlowe/Symbolic/Types/Response.hs index d2bdbb287..29cfd8678 100644 --- a/marlowe-symbolic/src/Marlowe/Symbolic/Types/Response.hs +++ b/marlowe-symbolic/src/Marlowe/Symbolic/Types/Response.hs @@ -1,13 +1,19 @@ {-# LANGUAGE DeriveGeneric #-} module Marlowe.Symbolic.Types.Response where -import Data.Aeson (FromJSON, ToJSON) import GHC.Generics +import Data.Aeson (FromJSON, ToJSON) import Language.Marlowe.Core.V1.Semantics (TransactionInput, TransactionWarning) +newtype POSIXTimeWrapper = POSIXTimeWrapper Integer + deriving (Generic) + +instance ToJSON POSIXTimeWrapper +instance FromJSON POSIXTimeWrapper + data Result = Valid | CounterExample - { initialSlot :: Integer + { initialTime :: POSIXTimeWrapper , transactionList :: [TransactionInput] , transactionWarning :: [TransactionWarning] } diff --git a/web-common-marlowe/src/Humanize.purs b/web-common-marlowe/src/Humanize.purs index 247b8eef8..ad689fe1c 100644 --- a/web-common-marlowe/src/Humanize.purs +++ b/web-common-marlowe/src/Humanize.purs @@ -4,6 +4,7 @@ module Humanize , humanizeDuration , formatDate , formatDate' + , humanizeInstant , formatInstant , formatDateTime' , formatDateTime @@ -76,6 +77,13 @@ toLocalDateTime :: Minutes -> Instant -> Maybe DateTime toLocalDateTime tzOffset = adjust (over Minutes negate tzOffset :: Minutes) <<< toDateTime +humanizeInstant :: Minutes -> Instant -> String +humanizeInstant tzOffset time = + let + date /\ time = formatInstant tzOffset time + in + date <> " at " <> time + formatInstant :: Minutes -> Instant -> (Tuple String String) formatInstant tzOffset time = let From e0b1e70f93b3ef1366ccd5655bbdc909397609e4 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Thu, 16 Nov 2023 02:29:56 +0100 Subject: [PATCH 3/6] Add scriv to nix shell --- nix/shell.nix | 1 + 1 file changed, 1 insertion(+) diff --git a/nix/shell.nix b/nix/shell.nix index b120809a9..520796d41 100644 --- a/nix/shell.nix +++ b/nix/shell.nix @@ -49,6 +49,7 @@ _cabalProject: pkgs.act pkgs.gawk pkgs.nil + pkgs.scriv pkgs.z3 pkgs.which pkgs.prefetch-npm-deps From a185c55de8844a3d8f0dc076225b58b695a057f0 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Thu, 16 Nov 2023 02:31:24 +0100 Subject: [PATCH 4/6] Add changelog entry --- .../20231116_023007_pablo.lamela_PLT_3985.md | 42 +++++++++++++++++++ 1 file changed, 42 insertions(+) create mode 100644 changelog.d/20231116_023007_pablo.lamela_PLT_3985.md diff --git a/changelog.d/20231116_023007_pablo.lamela_PLT_3985.md b/changelog.d/20231116_023007_pablo.lamela_PLT_3985.md new file mode 100644 index 000000000..4f35f33af --- /dev/null +++ b/changelog.d/20231116_023007_pablo.lamela_PLT_3985.md @@ -0,0 +1,42 @@ + + + + + + + +### Fixed + +- Fix a legacy vestige that caused the initial time of counterexamples sroduced by the static analysis to be shown as a slot number. + + + From 6510788ab0ccf4c507aae2ed376344cd6cee2b2c Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Thu, 16 Nov 2023 02:33:18 +0100 Subject: [PATCH 5/6] Remove trailing space --- marlowe-playground-client/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/marlowe-playground-client/README.md b/marlowe-playground-client/README.md index ff13e904e..5abf8dd58 100644 --- a/marlowe-playground-client/README.md +++ b/marlowe-playground-client/README.md @@ -15,7 +15,7 @@ Now we will build and run the front end: ```bash [nix-shell] $ cd marlowe-playground-client # Generate the purescript bridge files -[nix-shell] $ generate-purescript +[nix-shell] $ generate-purescript # Download javascript dependencies (we use ci to use the package-lock.json) [nix-shell] $ npm ci # Install purescript depdendencies From 10d8e8a759c694e86a1908382bf672b15778e2bc Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Thu, 16 Nov 2023 02:36:23 +0100 Subject: [PATCH 6/6] Fixed typo in changelog --- changelog.d/20231116_023007_pablo.lamela_PLT_3985.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/changelog.d/20231116_023007_pablo.lamela_PLT_3985.md b/changelog.d/20231116_023007_pablo.lamela_PLT_3985.md index 4f35f33af..ed6471865 100644 --- a/changelog.d/20231116_023007_pablo.lamela_PLT_3985.md +++ b/changelog.d/20231116_023007_pablo.lamela_PLT_3985.md @@ -31,7 +31,7 @@ Uncomment the section that is right (remove the HTML comment wrapper). ### Fixed -- Fix a legacy vestige that caused the initial time of counterexamples sroduced by the static analysis to be shown as a slot number. +- Fix a legacy vestige that caused the initial time of counterexamples produced by the static analysis to be shown as a slot number.