git.iko.soy/airlock
on master help sign in
airlock/example/src/Vanilla.elm
251 lines 7.9 kB history raw
1port module Vanilla exposing (main)
3import BigInt exposing (BigInt)
4import Browser exposing (Document)
5import Element exposing (..)
6import Element.Border as Border
7import Heroicons.Outline
8import Json.Decode as JD
9import Task
10import Time
11import Ur
12import Ur.Cmd
13import Ur.Constructor as C
14import Ur.Deconstructor as D
15import Ur.Run
16import Ur.Sub
17import Widget
18import Widget.Icon as Icon
19import Widget.Material as Material
22url : String
23url =
24 "http://localhost:8080"
27main : Ur.Run.Program Model Msg
28main =
29 Ur.Run.application
30 { init =
31 \_ _ ->
32 ( { error = ""
33 , entries = Nothing
34 , newEntry = ""
35 , shipName = Nothing
36 }
37 , Cmd.batch
38 [ Ur.logIn url "lidlut-tabwed-pillex-ridrup"
39 |> Cmd.map (result (Debug.toString >> Error) (always Noop))
40 , Ur.getShipName url |> Cmd.map (result (always Noop) GotShipName)
41 , Ur.scry
42 { url = url
43 , agent = "journal"
44 , path = [ "entries", "all" ]
45 , error = Noop
46 , success =
47 D.cell D.ignore
48 (D.cell (D.const D.cord "jrnl")
49 (D.list (D.cell D.bigint D.cord))
50 )
51 |> D.map (\( (), ( (), listings ) ) -> GotListings listings)
52 }
53 ]
54 |> Ur.Cmd.cmd
55 )
56 , update = update
57 , view = view
58 , subscriptions = always Sub.none
59 , createEventSource = createEventSource
60 , urbitSubscriptions =
61 \{ entries, shipName } ->
62 case ( entries, shipName ) of
63 ( Just _, Just ship ) ->
64 Ur.Sub.subscribe
65 { ship = ship
66 , app = "journal"
67 , path = [ "updates" ]
68 , deconstructor = decodeJournalUpdate |> D.map GotUpdate
69 }
71 _ ->
72 Ur.Sub.none
73 , onEventSourceMsg = onEventSourceMessage
74 , onUrlChange = \_ -> Noop
75 , onUrlRequest = \_ -> Noop
76 , urbitUrl = \_ -> url
77 }
80type alias Model =
81 { error : String
82 , entries : Maybe (List ( BigInt, String ))
83 , newEntry : String
84 , shipName : Maybe String
85 }
88type Msg
89 = Noop
90 | Error String
91 | GotListings (List ( BigInt, String ))
92 | GotUpdate JournalUpdate
93 | UpdateNewEntry String
94 | DeleteEntry BigInt
95 | AddEntry String
96 | RunCmd (Ur.Cmd.Cmd Msg)
97 | GotShipName String
100update : Msg -> Model -> ( Model, Ur.Cmd.Cmd Msg )
101update msg model =
102 case msg of
103 Noop ->
104 ( model, Ur.Cmd.none )
106 Error err ->
107 ( { model | error = err }, Ur.Cmd.none )
109 GotListings entries ->
110 ( { model | entries = Just entries }, Ur.Cmd.none )
112 GotUpdate action ->
113 let
114 applyAction oldEntries =
115 case action of
116 Add id txt ->
117 ( id, txt ) :: oldEntries
119 Edit id txt ->
120 oldEntries
121 |> List.map
122 (\(( key, _ ) as value) ->
123 if key == id then
124 ( key, txt )
126 else
127 value
128 )
130 Delete id ->
131 oldEntries |> List.filter (\( key, _ ) -> key /= id)
133 newEntries =
134 model.entries |> Maybe.map applyAction
135 in
136 ( { model | entries = newEntries }, Ur.Cmd.none )
138 UpdateNewEntry txt ->
139 ( { model | newEntry = txt }, Ur.Cmd.none )
141 DeleteEntry id ->
142 ( model
143 , Ur.Cmd.poke
144 { ship = "~zod"
145 , agent = "journal"
146 , mark = "journal-action"
147 , noun = C.cell (C.cord "del") (C.bigint id)
148 }
149 )
151 AddEntry txt ->
152 ( { model | newEntry = "" }
153 , Time.now
154 |> Task.perform
155 (\time ->
156 Ur.Cmd.poke
157 { ship = "~zod"
158 , agent = "journal"
159 , mark = "journal-action"
160 , noun = C.cell (C.cord "add") (C.cell (time |> Time.posixToMillis |> BigInt.fromInt |> C.bigint) (C.cord txt))
161 }
162 |> RunCmd
163 )
164 |> Ur.Cmd.cmd
165 )
167 RunCmd cmd ->
168 ( model, cmd )
170 GotShipName name ->
171 ( { model | shipName = Just name }, Ur.Cmd.none )
174type JournalUpdate
175 = Add BigInt String
176 | Edit BigInt String
177 | Delete BigInt
180decodeJournalUpdate : D.Deconstructor JournalUpdate
181decodeJournalUpdate =
182 D.oneOf
183 [ (D.cell (D.const D.cord "add") <| D.cell D.bigint D.cord) |> D.map (\( (), ( id, txt ) ) -> Add id txt)
184 , D.cell (D.const D.cord "edit") (D.cell D.bigint D.cord) |> D.map (\( (), ( id, txt ) ) -> Edit id txt)
185 , D.cell (D.const D.cord "del") D.bigint |> D.map (\( (), id ) -> Delete id)
186 ]
187 |> D.cell D.ignore
188 |> D.map (\( (), upd ) -> upd)
191view : Model -> Document Msg
192view model =
193 { body =
194 [ layout []
195 ([ el [ alignTop ] (text model.error)
196 , row [ spacing 8 ]
197 [ Widget.textInput (Material.textInput Material.defaultPalette)
198 { chips = []
199 , text = model.newEntry
200 , placeholder = Nothing
201 , label = "New entry"
202 , onChange = UpdateNewEntry
203 }
204 , Widget.iconButton (Material.containedButton Material.defaultPalette)
205 { text = "submit"
206 , icon = Icon.elmHeroicons Heroicons.Outline.check
207 , onPress = AddEntry model.newEntry |> Just
208 }
209 ]
210 , model.entries
211 |> Maybe.withDefault []
212 |> List.map
213 (\( id, txt ) ->
214 row
215 [ Border.rounded 10
216 , Border.shadow { offset = ( 0, 5 ), size = 1, blur = 10, color = rgba 0 0 0 0.3 }
217 , centerX
218 , padding 10
219 , spacing 12
220 ]
221 [ paragraph [] [ text txt ]
222 , Widget.iconButton (Material.containedButton Material.defaultPalette)
223 { text = "delete"
224 , icon = Icon.elmHeroicons Heroicons.Outline.trash
225 , onPress = DeleteEntry id |> Just
226 }
227 ]
228 )
229 |> column [ spacing 10, centerX ]
230 ]
231 |> column [ spacing 18, centerX ]
232 )
233 ]
234 , title = "Airlock"
235 }
238result : (a -> c) -> (b -> c) -> Result a b -> c
239result f g res =
240 case res of
241 Ok b ->
242 g b
244 Err a ->
245 f a
248port createEventSource : String -> Cmd msg
251port onEventSourceMessage : (JD.Value -> msg) -> Sub msg