From ebcb538a3264ebfe941b7ddf3948094facd29313 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Sat, 23 Dec 2023 12:13:30 +0100
Subject: [PATCH] Fix RandomWalk, small fixes, Util

---
 rhine-examples/src/RandomWalk.hs | 39 ++++++++++++++++++++------------
 rhine/src/FRP/Rhine/SN/Free.hs   |  9 ++++----
 2 files changed, 29 insertions(+), 19 deletions(-)

diff --git a/rhine-examples/src/RandomWalk.hs b/rhine-examples/src/RandomWalk.hs
index d658d9e6..157fbe14 100644
--- a/rhine-examples/src/RandomWalk.hs
+++ b/rhine-examples/src/RandomWalk.hs
@@ -18,15 +18,15 @@ import System.Random
 import Data.Vector2
 
 -- rhine
-import FRP.Rhine hiding (flow, sn, Rhine)
-import FRP.Rhine.SN.Free
+import FRP.Rhine hiding (Rhine, flow, sn)
 import FRP.Rhine.Rhine.Free
+import FRP.Rhine.SN.Free
 
 type Point = Vector2 Float
 
 type SimulationClock = Millisecond 1
 type DisplayClock = Millisecond 1000
-type AppClock = '[StdinClock, SimulationClock, DisplayClock]
+type AppClock = '[SimulationClock, StdinClock, DisplayClock]
 
 {- | On every newline, show the current point and the local time.
    Also, forward the current point so it can be saved.
@@ -37,8 +37,7 @@ keyboard = proc currentPoint -> do
   debugLocalTime -< ()
   returnA -< currentPoint
 
-{- | Every millisecond, go one step up, down, right or left.
--}
+-- | Every millisecond, go one step up, down, right or left.
 simulation :: ClSF IO SimulationClock () Point
 simulation = feedback zeroVector $ proc ((), lastPoint) -> do
   direction <- constMCl $ randomRIO (0, 3 :: Int) -< ()
@@ -77,18 +76,28 @@ debugLocalTime = proc a -> do
   arrMCl putStrLn -< "since init: " ++ show sinceInit_ ++ "\nsince start: " ++ show sinceStart_
   returnA -< a
 
+-- | In this example, we will always zero-order resample, that is, by keeping the last value
+resample ::
+  ( HasClocksOrdered clA clB cls
+  , Monad m
+  ) =>
+  FreeSN m cls (At clA Point) (At clB Point)
+resample = resampling $ keepLast zeroVector
+
 -- | Wire together all components
 mainRhine :: Rhine IO UTCTime AppClock () ()
-mainRhine = Rhine
-  { clocks = StdinClock .:. waitClock .:. waitClock .:. cnil
-  , sn = feedbackSN (debugLocalTime ^->> keepLast zeroVector) $ proc (lastPoint, ()) -> do
-      savedPoint <- resampling (keepLast zeroVector) <<< synchronous keyboard -< lastPoint
-      currentPoint <- resampling (keepLast zeroVector) <<< synchronous simulation -< pure ()
-      synchronous display -< (,) <$> savedPoint <*> currentPoint
-      returnA -< (currentPoint, ())
-  }
-  -- feedbackRhine (debugLocalTime ^->> keepLast zeroVector) $
-  --   keyboard @@ StdinClock >-- keepLast zeroVector --> simulation @@ waitClock >-- keepLast (zeroVector, zeroVector) --> display @@ waitClock
+mainRhine =
+  Rhine
+    -- The order of the clocks matters!
+    -- Since we are using the `simulation` first, we need to list its clock first.
+    { clocks = waitClock .:. StdinClock .:. waitClock .:. cnil
+    , sn = proc () -> do
+        currentPoint <- synchronous simulation -< pure ()
+        savedPoint <- resample <<< synchronous keyboard <<< resample -< currentPoint
+        currentPointDisplay <- resample -< currentPoint
+        synchronous display -< (,) <$> savedPoint <*> currentPointDisplay
+        returnA -< ()
+    }
 
 -- | Execute the main Rhine
 main :: IO ()
diff --git a/rhine/src/FRP/Rhine/SN/Free.hs b/rhine/src/FRP/Rhine/SN/Free.hs
index a25d4904..9de1817a 100644
--- a/rhine/src/FRP/Rhine/SN/Free.hs
+++ b/rhine/src/FRP/Rhine/SN/Free.hs
@@ -35,6 +35,7 @@ module FRP.Rhine.SN.Free (
   Append,
   Position, -- FIXME this should be internal
   HasClock (..),
+  HasClocksOrdered (..),
   runClocks,
   -- FIXME the followong are probably internal
   appendClocks,
@@ -175,10 +176,7 @@ synchronous :: (HasClock cl cls, Clock m cl) => ClSF m cl a b -> FreeSN m cls (A
 synchronous = FreeSN . liftFree2 . Synchronous position
 
 resampling ::
-  ( HasClock clA cls
-  , Clock m clA
-  , HasClocksOrdered clA clB cls
-  , HasClock clB cls
+  ( HasClocksOrdered clA clB cls
   ) =>
   ResamplingBuffer m clA clB a b ->
   FreeSN m cls (At clA a) (At clB b)
@@ -269,6 +267,9 @@ infixr 9 .:.
 (.:.) :: (GetClockProxy cl, Clock m cl) => cl -> Clocks m (Time cl) cls -> Clocks m (Time cl) (cl ': cls)
 getClassyClock .:. Clocks {getClocks} = Clocks $ ClassyClock {getClassyClock} :* getClocks
 
+clocks :: (GetClockProxy cl, Clock m cl) => cl -> Clocks m (Time cl) '[cl]
+clocks cl = cl .:. cnil
+
 cnil :: Clocks m td '[]
 cnil = Clocks Nil