%sink (#6)

* %sink

* Cleaned up code

.gitignore

@@ -1,2 +1,3 @@
 elm-stuff
 elm.js
+zod

dev/elm-live.sh → dev/sink-elm-live.sh

@@ -4,4 +4,4 @@ set -e
 
 cd "$(dirname "$0")/../example"
 
-nix run nixpkgs#elmPackages.elm-live -- src/Main.elm --start-page=index.html -- --output=elm.js --debug "$@"
+nix run nixpkgs#elmPackages.elm-live -- src/Sink.elm --start-page=index.html -- --output=elm.js --debug "$@"

dev/vanilla-elm-live.sh

@@ -0,0 +1,7 @@
+#!/bin/sh
+
+set -e
+
+cd "$(dirname "$0")/../example"
+
+nix run nixpkgs#elmPackages.elm-live -- src/Vanilla.elm --start-page=index.html -- --output=elm.js --debug "$@"

example/script.js

@@ -2,7 +2,22 @@ import { fetchEventSource } from "/fetch-event-source.js"
 
 const uid = `${Math.floor(Date.now() / 1000)}-${Math.random()}`;
 
-let app = Elm.Main.init({ node: document.getElementById("elm"), flags: { uid } });
+function searchForInit(obj) {
+  if (obj.init) {
+    return obj.init;
+  } else {
+    for (let key in obj) {
+      if (obj.hasOwnProperty(key)) {
+        const result = searchForInit(obj[key]);
+        if (result) {
+          return result;
+        }
+      }
+    }
+  }
+}
+
+let app = searchForInit(Elm)({ node: document.getElementById("elm"), flags: { uid } });
 
 app.ports.createEventSource.subscribe((url) => {
   fetchEventSource(url, {

example/src/Sink.elm

@@ -0,0 +1,204 @@
+port module Sink exposing (main)
+
+import BigInt exposing (BigInt)
+import Browser exposing (Document)
+import Element exposing (..)
+import Element.Border as Border
+import Heroicons.Outline
+import Json.Decode as JD
+import Task
+import Time
+import Ur
+import Ur.Cmd
+import Ur.Constructor as C
+import Ur.Deconstructor as D
+import Ur.Run
+import Ur.Sub
+import Ur.Types exposing (Noun)
+import Widget
+import Widget.Icon as Icon
+import Widget.Material as Material
+
+
+url : String
+url =
+    "http://localhost:8080"
+
+
+main : Ur.Run.Program Model Msg
+main =
+    Ur.Run.application
+        { init =
+            \_ _ ->
+                ( { error = ""
+                  , entries = Nothing
+                  , newEntry = ""
+                  , shipName = Nothing
+                  }
+                , Cmd.batch
+                    [ Ur.logIn url "lidlut-tabwed-pillex-ridrup"
+                        |> Cmd.map (result (Debug.toString >> Error) (always Noop))
+                    , Ur.getShipName url |> Cmd.map (result (always Noop) GotShipName)
+                    ]
+                    |> Ur.Cmd.cmd
+                )
+        , update = update
+        , view = view
+        , subscriptions = always Sub.none
+        , createEventSource = createEventSource
+        , urbitSubscriptions =
+            \{ shipName } ->
+                case shipName of
+                    Just ship ->
+                        Ur.Sub.batch
+                            [ Ur.Sub.sink
+                                { ship = ship
+                                , app = "journal"
+                                , path = [ "sync" ]
+                                , deconstructor =
+                                    D.list (D.cell D.bigint D.cord |> D.map (\a b -> ( a, b )))
+                                        |> D.map GotListings
+                                }
+                            ]
+
+                    _ ->
+                        Ur.Sub.none
+        , onEventSourceMsg = onEventSourceMessage
+        , onUrlChange = \_ -> Noop
+        , onUrlRequest = \_ -> Noop
+        , urbitUrl = \_ -> url
+        }
+
+
+type alias Model =
+    { error : String
+    , entries : Maybe (List ( BigInt, String ))
+    , newEntry : String
+    , shipName : Maybe String
+    }
+
+
+type Msg
+    = Noop
+    | GotSink Noun
+    | Error String
+    | GotListings (List ( BigInt, String ))
+    | UpdateNewEntry String
+    | DeleteEntry BigInt
+    | AddEntry String
+    | RunCmd (Ur.Cmd.Cmd Msg)
+    | GotShipName String
+
+
+update : Msg -> Model -> ( Model, Ur.Cmd.Cmd Msg )
+update msg model =
+    case msg of
+        Noop ->
+            ( model, Ur.Cmd.none )
+
+        GotSink _ ->
+            ( model, Ur.Cmd.none )
+
+        Error err ->
+            ( { model | error = err }, Ur.Cmd.none )
+
+        GotListings entries ->
+            ( { model | entries = Just entries }, Ur.Cmd.none )
+
+        UpdateNewEntry txt ->
+            ( { model | newEntry = txt }, Ur.Cmd.none )
+
+        DeleteEntry id ->
+            ( model
+            , Ur.Cmd.poke
+                { ship = "~zod"
+                , agent = "journal"
+                , mark = "journal-action"
+                , noun = C.cell (C.cord "del") (C.bigint id)
+                }
+            )
+
+        AddEntry txt ->
+            ( { model | newEntry = "" }
+            , Time.now
+                |> Task.perform
+                    (\time ->
+                        Ur.Cmd.poke
+                            { ship = "~zod"
+                            , agent = "journal"
+                            , mark = "journal-action"
+                            , noun = C.cell (C.cord "add") (C.cell (time |> Time.posixToMillis |> BigInt.fromInt |> C.bigint) (C.cord txt))
+                            }
+                            |> RunCmd
+                    )
+                |> Ur.Cmd.cmd
+            )
+
+        RunCmd cmd ->
+            ( model, cmd )
+
+        GotShipName name ->
+            ( { model | shipName = Just name }, Ur.Cmd.none )
+
+
+view : Model -> Document Msg
+view model =
+    { body =
+        [ layout []
+            ([ el [ alignTop ] (text model.error)
+             , row [ spacing 8 ]
+                [ Widget.textInput (Material.textInput Material.defaultPalette)
+                    { chips = []
+                    , text = model.newEntry
+                    , placeholder = Nothing
+                    , label = "New entry"
+                    , onChange = UpdateNewEntry
+                    }
+                , Widget.iconButton (Material.containedButton Material.defaultPalette)
+                    { text = "submit"
+                    , icon = Icon.elmHeroicons Heroicons.Outline.check
+                    , onPress = AddEntry model.newEntry |> Just
+                    }
+                ]
+             , model.entries
+                |> Maybe.withDefault []
+                |> List.map
+                    (\( id, txt ) ->
+                        row
+                            [ Border.rounded 10
+                            , Border.shadow { offset = ( 0, 5 ), size = 1, blur = 10, color = rgba 0 0 0 0.3 }
+                            , centerX
+                            , padding 10
+                            , spacing 12
+                            ]
+                            [ paragraph [] [ text txt ]
+                            , Widget.iconButton (Material.containedButton Material.defaultPalette)
+                                { text = "delete"
+                                , icon = Icon.elmHeroicons Heroicons.Outline.trash
+                                , onPress = DeleteEntry id |> Just
+                                }
+                            ]
+                    )
+                |> column [ spacing 10, centerX ]
+             ]
+                |> column [ spacing 18, centerX ]
+            )
+        ]
+    , title = "Airlock"
+    }
+
+
+result : (a -> c) -> (b -> c) -> Result a b -> c
+result f g res =
+    case res of
+        Ok b ->
+            g b
+
+        Err a ->
+            f a
+
+
+port createEventSource : String -> Cmd msg
+
+
+port onEventSourceMessage : (JD.Value -> msg) -> Sub msg

example/src/Main.elm → example/src/Vanilla.elm

@@ -1,4 +1,4 @@
-port module Main exposing (main)
+port module Vanilla exposing (main)
 
 import BigInt exposing (BigInt)
 import Browser exposing (Document)
@@ -12,14 +12,18 @@ import Ur
 import Ur.Cmd
 import Ur.Constructor as C
 import Ur.Deconstructor as D
-import Ur.Requests
 import Ur.Run
 import Ur.Sub
 import Widget
 import Widget.Icon as Icon
 import Widget.Material as Material
 
 
+url : String
+url =
+    "http://localhost:8080"
+
+
 main : Ur.Run.Program Model Msg
 main =
     Ur.Run.application
@@ -31,11 +35,11 @@ main =
                   , shipName = Nothing
                   }
                 , Cmd.batch
-                    [ Ur.logIn "http://localhost:8080" "lidlut-tabwed-pillex-ridrup"
+                    [ Ur.logIn url "lidlut-tabwed-pillex-ridrup"
                         |> Cmd.map (result (Debug.toString >> Error) (always Noop))
-                    , Ur.getShipName "http://localhost:8080" |> Cmd.map (result (always Noop) GotShipName)
-                    , Ur.Requests.scry
-                        { url = "http://localhost:8080"
+                    , Ur.getShipName url |> Cmd.map (result (always Noop) GotShipName)
+                    , Ur.scry
+                        { url = url
                         , agent = "journal"
                         , path = [ "entries", "all" ]
                         , error = Noop
@@ -69,7 +73,7 @@ main =
         , onEventSourceMsg = onEventSourceMessage
         , onUrlChange = \_ -> Noop
         , onUrlRequest = \_ -> Noop
-        , urbitUrl = \_ -> "http://localhost:8080"
+        , urbitUrl = \_ -> url
         }