From 05cb68e8927dfff29addcb3c6a80a35728653885 Mon Sep 17 00:00:00 2001
From: Karl Ostmo <kostmo@gmail.com>
Date: Wed, 6 Sep 2023 12:43:09 -0700
Subject: [PATCH] use UnitInterval type for safer guarantees

---
 src/Swarm/TUI/View.hs             | 10 +++-------
 src/Swarm/Util/UnitInterval.hs    | 24 ++++++++++++++++++++++++
 src/Swarm/Util/WindowedCounter.hs | 10 ++++++----
 swarm.cabal                       |  1 +
 4 files changed, 34 insertions(+), 11 deletions(-)
 create mode 100644 src/Swarm/Util/UnitInterval.hs

diff --git a/src/Swarm/TUI/View.hs b/src/Swarm/TUI/View.hs
index 20eca4f53c..0dba43a99e 100644
--- a/src/Swarm/TUI/View.hs
+++ b/src/Swarm/TUI/View.hs
@@ -113,6 +113,7 @@ import Swarm.TUI.View.CellDisplay
 import Swarm.TUI.View.Objective qualified as GR
 import Swarm.TUI.View.Util as VU
 import Swarm.Util
+import Swarm.Util.UnitInterval
 import Swarm.Util.WindowedCounter qualified as WC
 import Swarm.Version (NewReleaseFailure (..))
 import System.Clock (TimeSpec (..))
@@ -647,12 +648,7 @@ robotsListWidget s = hCenter table
       , txt rLog
       ]
 
-    dutyCycleAttrIdx = floor $ dutyCycleRatio * fromIntegral (length meterAttributeNames - 1)
-    -- Since (!!) is partial, here is "proof" that it is safe:
-    -- \* 'dutyCycleRatio' lies within the unit interval
-    -- \* If 'dutyCycleRatio' is 1, then the maximum value of 'dutyCycleAttrIdx' is
-    --   one less than the length of 'meterAttributeNames' (i.e., a valid index).
-    dutyCycleAttr = meterAttributeNames !! dutyCycleAttrIdx
+    dutyCycleAttr = safeIndex dutyCycleRatio meterAttributeNames
     dutyCycleDisplay = withAttr dutyCycleAttr . str . flip (showFFloat (Just 1)) "%" $ dutyCyclePercentage
 
     dutyCycleRatio =
@@ -660,7 +656,7 @@ robotsListWidget s = hCenter table
         robot ^. activityCounts . activityWindow
 
     dutyCyclePercentage :: Double
-    dutyCyclePercentage = 100 * dutyCycleRatio
+    dutyCyclePercentage = 100 * getValue dutyCycleRatio
 
     idWidget = str $ show $ robot ^. robotID
     nameWidget =
diff --git a/src/Swarm/Util/UnitInterval.hs b/src/Swarm/Util/UnitInterval.hs
new file mode 100644
index 0000000000..bf64dbf6bf
--- /dev/null
+++ b/src/Swarm/Util/UnitInterval.hs
@@ -0,0 +1,24 @@
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+--
+-- Creation and utilities for tge unit interval
+module Swarm.Util.UnitInterval (
+  UnitInterval,
+  getValue,
+  mkInterval,
+  safeIndex,
+) where
+
+newtype UnitInterval a = UnitInterval
+  { getValue :: a
+  }
+
+-- | Guarantees that the stored interval falls on the range
+--   @[0, 1]@. It is up to clients to ensure that the promotion
+--   to this type is lossless.
+mkInterval :: (Ord a, Num a) => a -> UnitInterval a
+mkInterval = UnitInterval . max 0 . min 1
+
+safeIndex :: (RealFrac a, Num a) => UnitInterval a -> [b] -> b
+safeIndex (UnitInterval alpha) xs =
+  xs !! floor (alpha * fromIntegral (length xs - 1))
diff --git a/src/Swarm/Util/WindowedCounter.hs b/src/Swarm/Util/WindowedCounter.hs
index 696c0c664b..9a09726242 100644
--- a/src/Swarm/Util/WindowedCounter.hs
+++ b/src/Swarm/Util/WindowedCounter.hs
@@ -22,6 +22,7 @@ module Swarm.Util.WindowedCounter (
 import Data.Aeson
 import Data.Set (Set)
 import Data.Set qualified as Set
+import Swarm.Util.UnitInterval
 import Prelude hiding (length)
 
 -- | Values that can be offset by an integral amount
@@ -128,11 +129,12 @@ getOccupancy ::
   -- | current time
   a ->
   WindowedCounter a ->
-  Double
+  UnitInterval Double
 getOccupancy currentTime wc@(WindowedCounter s lastLargest nominalSpan) =
-  if Set.null s || maybe False (< referenceTick) lastLargest
-    then 0
-    else fromIntegral (Set.size culledSet) / fromIntegral nominalSpan
+  mkInterval $
+    if Set.null s || maybe False (< referenceTick) lastLargest
+      then 0
+      else fromIntegral (Set.size culledSet) / fromIntegral nominalSpan
  where
   referenceTick = offsetBy (negate nominalSpan) currentTime
   -- Cull the window according to the current time
diff --git a/swarm.cabal b/swarm.cabal
index bfecddfbbe..afd8de2a7d 100644
--- a/swarm.cabal
+++ b/swarm.cabal
@@ -202,6 +202,7 @@ library
                       Swarm.Util.Erasable
                       Swarm.Util.Lens
                       Swarm.Util.Parse
+                      Swarm.Util.UnitInterval
                       Swarm.Util.WindowedCounter
                       Swarm.Util.Yaml
                       Swarm.Version