diff --git a/.hlint.yaml b/.hlint.yaml index 3f9d7b9c..0eaeced6 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -28,8 +28,11 @@ - modules: # Ensure that MonadDelay is imported from TimeCompat - name: + - "Data.Time.**" - "Control.Monad.Class.MonadTime" - "Control.Monad.Class.MonadTime.SI" + - "Control.Monad.Class.MonadTimer" + - "Control.Monad.Class.MonadTimer.SI" within: "TimeCompat" message: "Use TimeCompat instead" # Ensure that MonadSTM is imported from STMCompat diff --git a/simulation/src/LeiosProtocol/Short/SimP2P.hs b/simulation/src/LeiosProtocol/Short/SimP2P.hs index 9a843f31..c8ae41fc 100644 --- a/simulation/src/LeiosProtocol/Short/SimP2P.hs +++ b/simulation/src/LeiosProtocol/Short/SimP2P.hs @@ -6,6 +6,10 @@ module LeiosProtocol.Short.SimP2P where +import ChanMux (newConnectionBundleTCP) +import ChanTCP +import Control.Monad (forever) +import Control.Monad.Class.MonadFork (MonadFork (forkIO)) import Control.Monad.IOSim as IOSim (IOSim, runSimTrace) import Control.Tracer as Tracer ( Contravariant (contramap), @@ -13,14 +17,8 @@ import Control.Tracer as Tracer ( traceWith, ) import Data.List (unfoldr) -import qualified Data.Map.Strict as Map -import System.Random (StdGen, split) - -import ChanMux (newConnectionBundleTCP) -import ChanTCP -import Control.Monad (forever) -import Control.Monad.Class.MonadFork (MonadFork (forkIO)) import qualified Data.Map.Strict as M +import qualified Data.Map.Strict as Map import LeiosProtocol.Common import LeiosProtocol.Short import LeiosProtocol.Short.Node @@ -28,6 +26,7 @@ import LeiosProtocol.Short.Sim import P2P (P2PTopography (..)) import SimTCPLinks (labelDirToLabelLink, mkTcpConnProps, selectTimedEvents, simTracer) import SimTypes +import System.Random (StdGen, split) traceLeiosP2P :: StdGen -> diff --git a/simulation/src/PraosProtocol/Common/ConcreteBlock.hs b/simulation/src/PraosProtocol/Common/ConcreteBlock.hs index 717ff23a..fbd7dc29 100644 --- a/simulation/src/PraosProtocol/Common/ConcreteBlock.hs +++ b/simulation/src/PraosProtocol/Common/ConcreteBlock.hs @@ -31,9 +31,6 @@ module PraosProtocol.Common.ConcreteBlock ( hashBody, IsBody, - -- * Converting slots to times - convertSlotToTimeForTestsAssumingNoHardFork, - -- * Creating sample chains mkChain, mkChainSimple, @@ -62,8 +59,6 @@ import Data.ByteString (ByteString) import Data.Function (fix) import Data.Hashable (Hashable (hash)) import Data.String (IsString) -import Data.Time.Calendar (fromGregorian) -import Data.Time.Clock (UTCTime (..), addUTCTime, secondsToNominalDiffTime) import Data.Typeable (Typeable) import GHC.Generics (Generic) import NoThunks.Class (NoThunks) @@ -373,28 +368,3 @@ instance Serialise BlockBody where encode (BlockBody b) = encodeBytes b decode = BlockBody <$> decodeBytes - -{------------------------------------------------------------------------------- - Simple static time conversions, since no HardFork --------------------------------------------------------------------------------} - --- | Arbitrarily but consistently converts slots UTCTimes. --- --- It is only intended for use in tests. Notably it assumes a fixed system --- start time, slot length, and the absence of a hard fork (ie no --- HardForkCombinator). This is how it's available as a pure function. -convertSlotToTimeForTestsAssumingNoHardFork :: SlotNo -> UTCTime -convertSlotToTimeForTestsAssumingNoHardFork sl = - flip addUTCTime startTime $ - -- ^^^ arbitrary start time for testing - secondsToNominalDiffTime $ - fromIntegral $ - unSlotNo sl * 10 - where - -- ^^^ arbitrary slot length for testing - - startTime = - UTCTime - { utctDay = fromGregorian 2000 1 1 - , utctDayTime = 0 - } diff --git a/simulation/src/TimeCompat.hs b/simulation/src/TimeCompat.hs index a9663554..90784f09 100644 --- a/simulation/src/TimeCompat.hs +++ b/simulation/src/TimeCompat.hs @@ -1,31 +1,41 @@ -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE NumericUnderscores #-} - module TimeCompat ( - -- Legacy interfact - module Control.Monad.Class.MonadTime.SI, - threadDelayNDT, + DiffTime, + MonadTime (getCurrentTime), + MonadDelay (threadDelay), + MonadMonotonicTime (getMonotonicTime), + Time (Time), + UTCTime, + NominalDiffTime, + diffTimeToSeconds, + addTime, + addUTCTime, + diffTime, + diffUTCTime, threadDelaySI, - MonadDelay, - -- Int-as-Micros API - Microseconds (..), - threadDelayMS, -) where + threadDelayNDT, +) +where -import Control.Monad.Class.MonadTime.SI -import Control.Monad.Class.MonadTimer (MonadDelay (..)) +import Control.Monad.Class.MonadTime.SI ( + DiffTime, + MonadMonotonicTime (getMonotonicTime), + MonadTime (getCurrentTime), + NominalDiffTime, + Time (..), + UTCTime, + addTime, + addUTCTime, + diffTime, + diffUTCTime, + ) +import Control.Monad.Class.MonadTimer (MonadDelay (threadDelay)) +import Data.Time.Clock (diffTimeToPicoseconds) -newtype Microseconds = Microseconds {getMicroseconds :: Int} - deriving newtype (Eq, Ord, Show, Enum, Num, Real, Integral) +diffTimeToSeconds :: DiffTime -> Double +diffTimeToSeconds = (* 1e-12) . fromIntegral . diffTimeToPicoseconds -threadDelayMS :: MonadDelay m => Microseconds -> m () -threadDelayMS micros = threadDelay (getMicroseconds micros) +threadDelaySI :: MonadDelay m => DiffTime -> m () +threadDelaySI = threadDelay . round . (* 1e6) --- | Suspends the current thread for a given amount of time. threadDelayNDT :: MonadDelay m => NominalDiffTime -> m () -threadDelayNDT = threadDelay . round . (1_000_000 *) - --- | Suspends the current thread for a given amount of time. -threadDelaySI :: MonadDelay m => DiffTime -> m () -threadDelaySI = threadDelay . round . (1_000_000 *) +threadDelayNDT = threadDelay . round . (* 1e6) diff --git a/simulation/src/Viz.hs b/simulation/src/Viz.hs index fe6aa75e..b39b48d6 100644 --- a/simulation/src/Viz.hs +++ b/simulation/src/Viz.hs @@ -14,7 +14,6 @@ import Data.Functor.Contravariant (Contravariant (contramap)) import Data.IORef (newIORef, readIORef, writeIORef) import Data.List (foldl1', mapAccumL, zip4) import Data.Ratio ((%)) -import qualified Data.Time as Time import Data.Tree as Tree (Tree (..)) import qualified Graphics.Rendering.Cairo as Cairo import qualified Graphics.Rendering.Pango.Cairo as Pango @@ -22,6 +21,7 @@ import qualified Graphics.Rendering.Pango.Font as Pango import qualified Graphics.Rendering.Pango.Layout as Pango import Graphics.UI.Gtk (AttrOp ((:=))) import qualified Graphics.UI.Gtk as Gtk +import Text.Printf (printf) import TimeCompat ------------------------------------------------------------------------------ @@ -710,8 +710,7 @@ layoutLabelTime = Cairo.moveTo 5 20 Cairo.setFontSize 20 Cairo.setSourceRGB 0 0 0 - Cairo.showText $ - Time.formatTime Time.defaultTimeLocale "Time (sec): %-2Es" t + Cairo.showText (printf "Time (sec): %.4fs" (diffTimeToSeconds t) :: String) layoutLabel :: Int -> String -> Layout (VizRender model) layoutLabel size label =