A music player that connects to your cloud/distributed storage.
1module UI.DnD exposing (Environment, Model, Msg, hasDropped, initialModel, isBeingDraggedOver, isDragging, isDraggingOver, listenToEnterLeave, listenToStart, modelSubject, modelTarget, startDragging, stoppedDragging, update)
2
3import Html exposing (Attribute)
4import Html.Events.Extra.Mouse as Mouse
5import Html.Events.Extra.Pointer as Pointer
6
7
8
9-- 🌳
10
11
12type Model context
13 = NotDragging
14 | Dragging { subject : context }
15 | DraggingOver { subject : context, target : context }
16 | Dropped { subject : context, target : context }
17
18
19type Msg context
20 = Start context
21 | Enter context
22 | Leave context
23 | Stop
24
25
26type alias Environment context msg =
27 { model : Model context
28 , toMsg : Msg context -> msg
29 }
30
31
32type alias Response =
33 { initiated : Bool }
34
35
36initialModel : Model context
37initialModel =
38 NotDragging
39
40
41
42-- 📣
43
44
45update : Msg context -> Model context -> ( Model context, Response )
46update msg model =
47 ( ------------------------------------
48 -- Model
49 ------------------------------------
50 case msg of
51 Start context ->
52 Dragging { subject = context }
53
54 Enter context ->
55 case model of
56 NotDragging ->
57 NotDragging
58
59 Dragging { subject } ->
60 DraggingOver { subject = subject, target = context }
61
62 DraggingOver { subject } ->
63 DraggingOver { subject = subject, target = context }
64
65 Dropped _ ->
66 NotDragging
67
68 Leave context ->
69 case model of
70 NotDragging ->
71 NotDragging
72
73 Dragging env ->
74 Dragging env
75
76 DraggingOver { subject, target } ->
77 if context == target then
78 Dragging { subject = subject }
79
80 else
81 model
82
83 Dropped _ ->
84 NotDragging
85
86 Stop ->
87 case model of
88 DraggingOver { subject, target } ->
89 if subject /= target then
90 Dropped { subject = subject, target = target }
91
92 else
93 NotDragging
94
95 _ ->
96 NotDragging
97 ------------------------------------
98 -- Response
99 ------------------------------------
100 , case msg of
101 Start _ ->
102 { initiated = True }
103
104 _ ->
105 { initiated = False }
106 )
107
108
109
110-- 🔱 ░░ EVENTS & MESSAGES
111
112
113listenToStart : Environment context msg -> context -> Attribute msg
114listenToStart { toMsg } context =
115 Pointer.onWithOptions
116 "pointerdown"
117 { stopPropagation = True
118 , preventDefault = False
119 }
120 (\event ->
121 case ( event.pointer.button, event.isPrimary ) of
122 ( Mouse.MainButton, True ) ->
123 toMsg (Start context)
124
125 _ ->
126 toMsg Stop
127 )
128
129
130listenToEnterLeave : Environment context msg -> context -> List (Attribute msg)
131listenToEnterLeave { model, toMsg } context =
132 case model of
133 NotDragging ->
134 []
135
136 _ ->
137 [ context
138 |> Enter
139 |> toMsg
140 |> always
141 |> Pointer.onEnter
142 , context
143 |> Leave
144 |> toMsg
145 |> always
146 |> Pointer.onLeave
147 ]
148
149
150startDragging : context -> Msg context
151startDragging =
152 Start
153
154
155stoppedDragging : Msg context
156stoppedDragging =
157 Stop
158
159
160
161-- 🔱 ░░ MODEL
162
163
164isBeingDraggedOver : context -> Model context -> Bool
165isBeingDraggedOver context model =
166 case model of
167 DraggingOver { target } ->
168 context == target
169
170 _ ->
171 False
172
173
174isDragging : Model context -> Bool
175isDragging model =
176 case model of
177 NotDragging ->
178 False
179
180 Dragging _ ->
181 True
182
183 DraggingOver _ ->
184 True
185
186 Dropped _ ->
187 False
188
189
190isDraggingOver : context -> Model context -> Bool
191isDraggingOver context model =
192 case model of
193 NotDragging ->
194 False
195
196 Dragging _ ->
197 False
198
199 DraggingOver { target } ->
200 target == context
201
202 Dropped _ ->
203 False
204
205
206hasDropped : Model context -> Bool
207hasDropped model =
208 case model of
209 Dropped _ ->
210 True
211
212 _ ->
213 False
214
215
216modelSubject : Model context -> Maybe context
217modelSubject model =
218 case model of
219 NotDragging ->
220 Nothing
221
222 Dragging { subject } ->
223 Just subject
224
225 DraggingOver { subject } ->
226 Just subject
227
228 Dropped { subject } ->
229 Just subject
230
231
232modelTarget : Model context -> Maybe context
233modelTarget model =
234 case model of
235 NotDragging ->
236 Nothing
237
238 Dragging _ ->
239 Nothing
240
241 DraggingOver { target } ->
242 Just target
243
244 Dropped { target } ->
245 Just target