Erebos local state in memory storage

2 files changed, 82 insertions, 1 deletions

diff --git a/erebos-webapp.cabal b/erebos-webapp.cabal
index 4fc3ca6..a040a0a 100644
--- a/erebos-webapp.cabal
+++ b/erebos-webapp.cabal
@@ -25,12 +25,37 @@ executable erebos-webapp
         -optl-mexec-model=reactor
         -optl-Wl,--export=hs_init,--export=setup
 
+    extra-libraries: blake2b-ref
+
     -- other-modules:
 
+    default-extensions:
+        DefaultSignatures
+        ExistentialQuantification
+        FlexibleContexts
+        FlexibleInstances
+        FunctionalDependencies
+        GeneralizedNewtypeDeriving
+        ImportQualifiedPost
+        LambdaCase
+        MultiWayIf
+        RankNTypes
+        RecordWildCards
+        ScopedTypeVariables
+        StandaloneDeriving
+        TypeOperators
+        TupleSections
+        TypeApplications
+        TypeFamilies
+        TypeFamilyDependencies
+
     -- other-extensions:
     build-depends:
         base ^>= { 4.21 },
+        erebos ^>= { 0.1.8 },
         ghc-experimental ^>= { 9.1201 },
+        mtl ^>= { 2.3 },
+        text ^>= { 2.1 },
 
     hs-source-dirs:   src
     default-language: GHC2021
diff --git a/src/Main.hs b/src/Main.hs
index 69276ac..d201708 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,21 +1,74 @@
 module Main (main, setup) where
 
+import Control.Monad.Reader
+
+import Data.Maybe
+import Data.Proxy
+import Data.Text qualified as T
+
 import GHC.Wasm.Prim
 
+import Erebos.Identity
+import Erebos.State
+import Erebos.Storable
+import Erebos.Storage
+
+import System.IO.Unsafe
+
 main :: IO ()
 main = error "unused"
 
+{-# NOINLINE globalStorage #-}
+globalStorage :: Storage
+globalStorage = unsafePerformIO $ memoryStorage
+
+{-# NOINLINE globalHead #-}
+globalHead :: Head LocalState
+globalHead = unsafePerformIO $ do
+    identity <- createIdentity globalStorage (Just $ T.pack "<init>") Nothing
+    storeHead globalStorage $ LocalState { lsPrev = Nothing, lsIdentity = idExtData identity, lsShared = [], lsOther = [] }
+
 foreign export javascript setup :: IO ()
 setup :: IO ()
 setup = do
     body <- js_document_getElementById (toJSString "body")
-    js_set_innerHTML body (toJSString "<input id=\"some_input\" type=\"text\" value=\"xyz\" /><button id=\"some_button\">add</button></div><div><ul id=\"some_list\"></ul></div>")
+    js_set_innerHTML body (toJSString "<div>Name: <span id=\"name_text\"></span></div><hr><input id=\"some_input\" type=\"text\" value=\"xyz\" /><button id=\"some_button\">add</button></div><div><ul id=\"some_list\"></ul></div>")
+
+    nameElem <- js_document_getElementById (toJSString "name_text")
+    _ <- watchHead globalHead $ \ls -> do
+        js_set_textContent nameElem $ toJSString $ T.unpack $ displayIdentity $ headLocalIdentity ls
 
     buttonElem <- js_document_getElementById (toJSString "some_button")
     buttonCallback <- asEventListener onButtonClick
 
     js_addEventListener buttonElem (toJSString "click") buttonCallback
 
+    let name = T.pack "My Name"
+        devName = T.pack "WebApp"
+
+    let st = globalStorage
+    owner <- if
+        | T.null name -> return Nothing
+        | otherwise -> Just <$> createIdentity st (Just name) Nothing
+
+    identity <- createIdentity st (if T.null devName then Nothing else Just devName) owner
+
+    shared <- wrappedStore st $ SharedState
+        { ssPrev = []
+        , ssType = Just $ sharedTypeID @(Maybe ComposedIdentity) Proxy
+        , ssValue = [ storedRef $ idExtData $ fromMaybe identity owner ]
+        }
+    flip runReaderT globalHead $ do
+        updateLocalState_ $ \_ -> do
+            mstore $ LocalState
+                { lsPrev = Nothing
+                , lsIdentity = idExtData identity
+                , lsShared = [ shared ]
+                , lsOther = []
+                }
+    return ()
+
+
 onButtonClick :: JSVal -> IO ()
 onButtonClick _event = do
     inputElem <- js_document_getElementById (toJSString "some_input")
@@ -32,6 +85,9 @@ foreign import javascript unsafe "document.getElementById($1)"
 foreign import javascript unsafe "$1.innerHTML = $2"
     js_set_innerHTML :: JSVal -> JSString -> IO ()
 
+foreign import javascript unsafe "$1.textContent = $2"
+    js_set_textContent :: JSVal -> JSString -> IO ()
+
 foreign import javascript unsafe "$1.appendChild($2)"
     js_appendChild :: JSVal -> JSVal -> IO ()