diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Main.hs | 58 | 
1 files changed, 57 insertions, 1 deletions
| 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 () |