Messing around.

pkg/hs/stack.yaml

@@ -3,6 +3,7 @@ resolver: lts-13.10
 packages:
   - hoon
   - uterm
+  - vere
 
 extra-deps:
   - para-1.1@sha256:a90eebb063ad70271e6e2a7f00a93e8e8f8b77273f100f39852fbf8301926f81

pkg/hs/vere/Main.hs

@@ -0,0 +1,65 @@
+module Main where
+
+import ClassyPrelude hiding (atomically, newTVarIO)
+import Control.Lens
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Concurrent.STM.TBMQueue
+
+--------------------------------------------------------------------------------
+
+newtype Cpu st ev fx = Cpu { runCpu :: st -> ev -> (st, fx) }
+
+data CpuApi ev st fx = CpuApi
+    { caHalt   :: IO ()
+    , caInput  :: TBMQueue ev
+    , caOutput :: TBMQueue (st, fx)
+    }
+
+--------------------------------------------------------------------------------
+
+dummyCpu :: Cpu () () ()
+dummyCpu = Cpu $ (\() () -> ((), ()))
+
+runCpuIO :: Cpu st ev fx
+         -> TVar st
+         -> TBMQueue ev
+         -> TBMQueue (st, fx)
+         -> IO ()
+runCpuIO cpu vSt inp out =
+    forever $ atomically $ do
+        ev <- readTBMQueue inp >>= maybe (error "No more input") pure
+        st <- readTVar vSt
+        runCpu cpu st ev & \(st', fx) -> do
+            writeTVar vSt st'
+            writeTBMQueue out (st', fx)
+
+runCpuThread :: Cpu st ev fx
+             -> st
+             -> IO (CpuApi ev st fx)
+runCpuThread cpu init = do
+    inp  <- newTBMQueueIO 1
+    out  <- newTBMQueueIO 16
+    vSt  <- newTVarIO init
+    tid  <- forkIO (runCpuIO cpu vSt inp out)
+
+    let kill = do atomically (closeTBMQueue inp >> closeTBMQueue out)
+                  killThread tid
+
+    pure (CpuApi kill inp out)
+
+--------------------------------------------------------------------------------
+
+{-
+  - When an event comes in:
+    - process the event
+    - persist the event
+    - run the effects
+
+  - Take a snapshot at any time.
+-}
+
+main :: IO ()
+main = do
+    cpuProc <- runCpuThread dummyCpu ()
+    caHalt cpuProc

pkg/hs/vere/package.yaml

@@ -0,0 +1,27 @@
+name: vere
+version: 0.1.0
+license: AGPL-3.0-only
+
+default-extensions:
+ - OverloadedStrings
+ - TypeApplications
+ - UnicodeSyntax
+ - FlexibleContexts
+ - TemplateHaskell
+ - QuasiQuotes
+ - LambdaCase
+ - NoImplicitPrelude
+ - ScopedTypeVariables
+ - DeriveAnyClass
+ - DeriveGeneric
+
+dependencies:
+ - base
+ - classy-prelude
+ - stm
+ - stm-chans
+ - lens
+
+executables:
+  vere:
+    main: Main.hs