A music player that connects to your cloud/distributed storage.
Processing Pt. 2
+573
-135
+2
-1
elm.json
+2
-1
elm.json
···
9
9
"direct": {
10
10
"Chadtech/return": "1.0.2",
11
11
"avh4/elm-color": "1.0.0",
12
+
"danfishgold/base64-bytes": "1.0.1",
12
13
"danmarcab/material-icons": "1.0.0",
13
14
"elm/browser": "1.0.1",
15
+
"elm/bytes": "1.0.7",
14
16
"elm/core": "1.0.2",
15
17
"elm/html": "1.0.0",
16
18
"elm/http": "2.0.0",
···
33
35
},
34
36
"indirect": {
35
37
"Skinney/murmur3": "2.0.8",
36
-
"elm/bytes": "1.0.7",
37
38
"elm/file": "1.0.1",
38
39
"elm/parser": "1.1.0",
39
40
"elm/random": "1.0.0",
+29
-36
src/Applications/Brain.elm
+29
-36
src/Applications/Brain.elm
···
1
1
module Brain exposing (main)
2
2
3
3
import Alien
4
-
import Brain.Authentication
4
+
import Brain.Authentication as Authentication
5
5
import Brain.Core exposing (..)
6
6
import Brain.Ports
7
7
import Brain.Reply as Reply exposing (Reply(..))
8
-
import Brain.Sources.Processing
8
+
import Brain.Sources.Processing as Processing
9
+
import Brain.Sources.Processing.Common as Processing
9
10
import Json.Decode
10
11
import Replying exposing (return)
11
-
import Sources.Processing.Encoding
12
+
import Sources.Processing.Encoding as Processing
12
13
13
14
14
15
···
33
34
( -----------------------------------------
34
35
-- Initial model
35
36
-----------------------------------------
36
-
{ authentication = Brain.Authentication.initialModel
37
-
, sourceProcessing = Brain.Sources.Processing.initialModel
37
+
{ authentication = Authentication.initialModel
38
+
, processing = Processing.initialModel
38
39
}
39
40
-----------------------------------------
40
41
-- Initial command
41
42
-----------------------------------------
42
43
, Cmd.batch
43
-
[ Cmd.map AuthenticationMsg Brain.Authentication.initialCommand
44
-
, Cmd.map SourceProcessingMsg Brain.Sources.Processing.initialCommand
44
+
[ Cmd.map AuthenticationMsg Authentication.initialCommand
45
+
, Cmd.map ProcessingMsg Processing.initialCommand
45
46
]
46
47
)
47
48
···
70
71
updateChild
71
72
{ mapCmd = AuthenticationMsg
72
73
, mapModel = \child -> { model | authentication = child }
73
-
, update = Brain.Authentication.update
74
+
, update = Authentication.update
74
75
}
75
76
{ model = model.authentication
76
77
, msg = sub
77
78
}
78
79
79
-
SourceProcessingMsg sub ->
80
+
ProcessingMsg sub ->
80
81
updateChild
81
-
{ mapCmd = SourceProcessingMsg
82
-
, mapModel = \child -> { model | sourceProcessing = child }
83
-
, update = Brain.Sources.Processing.update
82
+
{ mapCmd = ProcessingMsg
83
+
, mapModel = \child -> { model | processing = child }
84
+
, update = Processing.update
84
85
}
85
-
{ model = model.sourceProcessing
86
+
{ model = model.processing
86
87
, msg = sub
87
88
}
88
89
···
100
101
-----------------------------------------
101
102
-- To UI
102
103
-----------------------------------------
103
-
HideLoadingScreen ->
104
-
Alien.HideLoadingScreen
105
-
|> Alien.trigger
106
-
|> NotifyUI
104
+
GiveUI tag data ->
105
+
NotifyUI (Alien.broadcast tag data)
107
106
108
-
LoadEnclosedUserData data ->
109
-
NotifyUI (Alien.broadcast Alien.LoadEnclosedUserData data)
110
-
111
-
LoadHypaethralUserData data ->
112
-
NotifyUI (Alien.broadcast Alien.LoadHypaethralUserData data)
113
-
114
-
ReportSourceProcessingError data ->
115
-
NotifyUI (Alien.broadcast Alien.ReportSourceProcessingError data)
107
+
NudgeUI tag ->
108
+
NotifyUI (Alien.trigger tag)
116
109
117
110
118
111
updateChild =
···
132
125
-----------------------------------------
133
126
-- Children
134
127
-----------------------------------------
135
-
, Sub.map
136
-
SourceProcessingMsg
137
-
(Brain.Sources.Processing.subscriptions model.sourceProcessing)
128
+
, Sub.map ProcessingMsg (Processing.subscriptions model.processing)
138
129
]
139
130
140
131
···
142
133
translateAlienEvent event =
143
134
case Alien.tagFromString event.tag of
144
135
Just Alien.AuthAnonymous ->
145
-
AuthenticationMsg (Brain.Authentication.HypaethralDataRetrieved event.data)
136
+
AuthenticationMsg (Authentication.HypaethralDataRetrieved event.data)
146
137
147
138
Just Alien.AuthMethod ->
148
-
AuthenticationMsg (Brain.Authentication.MethodRetrieved event.data)
139
+
AuthenticationMsg (Authentication.MethodRetrieved event.data)
149
140
150
141
Just Alien.ProcessSources ->
151
142
-- Only proceed to the processing if we got all the necessary data,
152
143
-- otherwise report an error in the UI.
153
-
case Json.Decode.decodeValue Sources.Processing.Encoding.argumentsDecoder event.data of
144
+
case Json.Decode.decodeValue Processing.argumentsDecoder event.data of
154
145
Ok arguments ->
155
-
SourceProcessingMsg (Brain.Sources.Processing.Process arguments)
146
+
arguments
147
+
|> Processing.Process
148
+
|> ProcessingMsg
156
149
157
150
Err error ->
158
151
error
···
161
154
|> NotifyUI
162
155
163
156
Just Alien.SaveEnclosedUserData ->
164
-
AuthenticationMsg (Brain.Authentication.SaveEnclosedData event.data)
157
+
AuthenticationMsg (Authentication.SaveEnclosedData event.data)
165
158
166
159
Just Alien.SaveHypaethralUserData ->
167
-
AuthenticationMsg (Brain.Authentication.SaveHypaethralData event.data)
160
+
AuthenticationMsg (Authentication.SaveHypaethralData event.data)
168
161
169
162
Just Alien.SignIn ->
170
-
AuthenticationMsg (Brain.Authentication.PerformSignIn event.data)
163
+
AuthenticationMsg (Authentication.PerformSignIn event.data)
171
164
172
165
Just Alien.SignOut ->
173
-
AuthenticationMsg Brain.Authentication.PerformSignOut
166
+
AuthenticationMsg Authentication.PerformSignOut
174
167
175
168
_ ->
176
169
Bypass
+3
-3
src/Applications/Brain/Authentication.elm
+3
-3
src/Applications/Brain/Authentication.elm
···
168
168
EnclosedDataRetrieved json ->
169
169
( model
170
170
, noCmd
171
-
, Just [ LoadEnclosedUserData json ]
171
+
, Just [ GiveUI Alien.LoadEnclosedUserData json ]
172
172
)
173
173
174
174
SaveEnclosedData json ->
···
223
223
terminate t =
224
224
case t of
225
225
Authenticated json ->
226
-
Just [ LoadHypaethralUserData json ]
226
+
Just [ GiveUI Alien.LoadHypaethralUserData json ]
227
227
228
228
NotAuthenticated ->
229
-
Just [ HideLoadingScreen ]
229
+
Just [ NudgeUI Alien.HideLoadingScreen ]
+6
-6
src/Applications/Brain/Core.elm
+6
-6
src/Applications/Brain/Core.elm
···
1
1
module Brain.Core exposing (Flags, Model, Msg(..))
2
2
3
3
import Alien
4
-
import Brain.Authentication
5
-
import Brain.Sources.Processing
4
+
import Brain.Authentication as Authentication
5
+
import Brain.Sources.Processing.Common as Processing
6
6
7
7
8
8
···
18
18
19
19
20
20
type alias Model =
21
-
{ authentication : Brain.Authentication.Model
22
-
, sourceProcessing : Brain.Sources.Processing.Model
21
+
{ authentication : Authentication.Model
22
+
, processing : Processing.Model
23
23
}
24
24
25
25
···
33
33
-----------------------------------------
34
34
-- Children
35
35
-----------------------------------------
36
-
| AuthenticationMsg Brain.Authentication.Msg
37
-
| SourceProcessingMsg Brain.Sources.Processing.Msg
36
+
| AuthenticationMsg Authentication.Msg
37
+
| ProcessingMsg Processing.Msg
+8
-1
src/Applications/Brain/Ports.elm
+8
-1
src/Applications/Brain/Ports.elm
···
1
-
port module Brain.Ports exposing (fromCache, fromUI, removeCache, requestCache, toCache, toUI)
1
+
port module Brain.Ports exposing (fromCache, fromUI, receiveTags, removeCache, requestCache, requestTags, toCache, toUI)
2
2
3
3
import Alien
4
+
import Sources.Processing exposing (ContextForTags)
4
5
5
6
6
7
···
13
14
port requestCache : Alien.Event -> Cmd msg
14
15
15
16
17
+
port requestTags : ContextForTags -> Cmd msg
18
+
19
+
16
20
port toCache : Alien.Event -> Cmd msg
17
21
18
22
···
27
31
28
32
29
33
port fromUI : (Alien.Event -> msg) -> Sub msg
34
+
35
+
36
+
port receiveTags : (ContextForTags -> msg) -> Sub msg
+3
-4
src/Applications/Brain/Reply.elm
+3
-4
src/Applications/Brain/Reply.elm
···
1
1
module Brain.Reply exposing (Reply(..))
2
2
3
+
import Alien
3
4
import Json.Encode as Json
4
5
5
6
···
10
11
type Reply
11
12
= Chill
12
13
-- UI
13
-
| HideLoadingScreen
14
-
| LoadEnclosedUserData Json.Value
15
-
| LoadHypaethralUserData Json.Value
16
-
| ReportSourceProcessingError Json.Value
14
+
| GiveUI Alien.Tag Json.Value
15
+
| NudgeUI Alien.Tag
+34
-72
src/Applications/Brain/Sources/Processing.elm
+34
-72
src/Applications/Brain/Sources/Processing.elm
···
1
-
module Brain.Sources.Processing exposing (Model, Msg(..), initialCommand, initialModel, subscriptions, update)
1
+
module Brain.Sources.Processing exposing (initialCommand, initialModel, subscriptions, update)
2
2
3
3
import Brain.Reply exposing (Reply(..))
4
-
import Http exposing (Error(..))
5
-
import Json.Encode as Encode
4
+
import Brain.Sources.Processing.Common exposing (..)
5
+
import Brain.Sources.Processing.Steps as Steps
6
+
import Http
6
7
import Replying exposing (R3D3)
7
-
import Sources exposing (Service, Source)
8
+
import Return3
8
9
import Sources.Processing exposing (..)
9
-
import Sources.Services as Services
10
10
import Time
11
-
import Tracks exposing (Track)
12
11
13
12
14
13
15
14
-- 🌳
16
15
17
16
18
-
type alias Model =
19
-
{ currentTime : Time.Posix
20
-
, origin : String
21
-
, status : Status
22
-
}
23
-
24
-
25
17
initialModel : Model
26
18
initialModel =
27
19
{ currentTime = Time.millisToPosix 0
···
39
31
-- 📣
40
32
41
33
42
-
type Msg
43
-
= Process Arguments
44
-
| NextInLine
45
-
-----------------------------------------
46
-
-- Steps
47
-
-----------------------------------------
48
-
| PrepareStep Context (Result Http.Error String)
49
-
| TreeStep Context (Result Http.Error String)
50
-
| TagsStep ContextForTags
51
-
-----------------------------------------
52
-
-- Bits & Pieces
53
-
-----------------------------------------
54
-
| SetCurrentTime Time.Posix
55
-
56
-
57
34
update : Msg -> Model -> R3D3 Model Msg Reply
58
35
update msg model =
59
36
case msg of
···
62
39
If there are sources, start processing the first source.
63
40
-}
64
41
Process { origin, sources, tracks } ->
65
-
( model
66
-
, Cmd.none
67
-
, Nothing
68
-
)
42
+
if isProcessing model.status then
43
+
Return3.withNothing model
44
+
45
+
else
46
+
case List.head sources of
47
+
Just source ->
48
+
let
49
+
filter s =
50
+
List.filter (.sourceId >> (==) s.id) tracks
51
+
52
+
status =
53
+
sources
54
+
|> List.map (\s -> ( s, filter s ))
55
+
|> Processing
56
+
in
57
+
( { model | status = status }
58
+
, Steps.takeFirstStep origin model.currentTime source
59
+
, Nothing
60
+
)
61
+
62
+
Nothing ->
63
+
Return3.withNothing model
69
64
70
65
{- If not processing, do nothing.
71
66
If there are no sources left, do nothing.
···
109
104
, Just [ reportHttpError context.source err ]
110
105
)
111
106
107
+
TreeStepRemoveTracks sourceId filePaths ->
108
+
-- TODO
109
+
( model
110
+
, Cmd.none
111
+
, Nothing
112
+
)
113
+
112
114
-----------------------------------------
113
115
-- Phase 3
114
116
-- Get the tags for each file in the file list.
···
127
129
, Cmd.none
128
130
, Nothing
129
131
)
130
-
131
-
132
-
133
-
-- 📣 ▒▒▒ COMMON
134
-
135
-
136
-
reportHttpError : Source -> Http.Error -> Reply
137
-
reportHttpError source err =
138
-
reportError
139
-
{ sourceId = source.id
140
-
, error = translateHttpError source.service err
141
-
}
142
-
143
-
144
-
reportError : { sourceId : String, error : String } -> Reply
145
-
reportError { sourceId, error } =
146
-
[ ( "sourceId", Encode.string sourceId )
147
-
, ( "error", Encode.string error )
148
-
]
149
-
|> Encode.object
150
-
|> ReportSourceProcessingError
151
-
152
-
153
-
translateHttpError : Service -> Http.Error -> String
154
-
translateHttpError service err =
155
-
case err of
156
-
NetworkError ->
157
-
"Cannot connect to this source"
158
-
159
-
Timeout ->
160
-
"Source did not respond (timeout)"
161
-
162
-
BadUrl _ ->
163
-
"Diffuse error, invalid url was used"
164
-
165
-
BadStatus _ ->
166
-
"Got a faulty response from this source"
167
-
168
-
BadBody response ->
169
-
Services.parseErrorResponse service response
170
132
171
133
172
134
+118
src/Applications/Brain/Sources/Processing/Common.elm
+118
src/Applications/Brain/Sources/Processing/Common.elm
···
1
+
module Brain.Sources.Processing.Common exposing (Model, Msg(..), contextToTagsContext, findTagsContextSource, isProcessing, reportError, reportHttpError, tracksFromTagsContext, translateHttpError)
2
+
3
+
import Alien
4
+
import Brain.Reply exposing (Reply(..))
5
+
import Http exposing (Error(..))
6
+
import Json.Encode as Encode
7
+
import List.Extra as List
8
+
import Maybe.Extra as Maybe
9
+
import Sources exposing (Service, Source)
10
+
import Sources.Processing exposing (..)
11
+
import Sources.Services as Services
12
+
import Time
13
+
import Tracks exposing (Track)
14
+
15
+
16
+
17
+
-- 🌳
18
+
19
+
20
+
type alias Model =
21
+
{ currentTime : Time.Posix
22
+
, origin : String
23
+
, status : Status
24
+
}
25
+
26
+
27
+
28
+
-- 📣
29
+
30
+
31
+
type Msg
32
+
= Process Arguments
33
+
| NextInLine
34
+
-----------------------------------------
35
+
-- Steps
36
+
-----------------------------------------
37
+
| PrepareStep Context (Result Http.Error String)
38
+
| TreeStep Context (Result Http.Error String)
39
+
| TreeStepRemoveTracks String (List String)
40
+
| TagsStep ContextForTags
41
+
-----------------------------------------
42
+
-- Bits & Pieces
43
+
-----------------------------------------
44
+
| SetCurrentTime Time.Posix
45
+
46
+
47
+
48
+
-- 🔱
49
+
50
+
51
+
contextToTagsContext : Context -> ContextForTags
52
+
contextToTagsContext context =
53
+
{ nextFilePaths = context.filePaths
54
+
, receivedFilePaths = []
55
+
, receivedTags = []
56
+
, sourceId = context.source.id
57
+
, urlsForTags = []
58
+
}
59
+
60
+
61
+
findTagsContextSource : ContextForTags -> List Source -> Maybe Source
62
+
findTagsContextSource tagsContext =
63
+
List.find (.id >> (==) tagsContext.sourceId)
64
+
65
+
66
+
isProcessing : Status -> Bool
67
+
isProcessing status =
68
+
case status of
69
+
Processing _ ->
70
+
True
71
+
72
+
NotProcessing ->
73
+
False
74
+
75
+
76
+
reportHttpError : Source -> Http.Error -> Reply
77
+
reportHttpError source err =
78
+
reportError
79
+
{ sourceId = source.id
80
+
, error = translateHttpError source.service err
81
+
}
82
+
83
+
84
+
reportError : { sourceId : String, error : String } -> Reply
85
+
reportError { sourceId, error } =
86
+
[ ( "sourceId", Encode.string sourceId )
87
+
, ( "error", Encode.string error )
88
+
]
89
+
|> Encode.object
90
+
|> GiveUI Alien.ReportProcessingError
91
+
92
+
93
+
tracksFromTagsContext : ContextForTags -> List Track
94
+
tracksFromTagsContext context =
95
+
context.receivedTags
96
+
|> List.zip context.receivedFilePaths
97
+
|> List.filter (Tuple.second >> Maybe.isJust)
98
+
|> List.map (Tuple.mapSecond (Maybe.withDefault Tracks.emptyTags))
99
+
|> List.map (Tracks.makeTrack context.sourceId)
100
+
101
+
102
+
translateHttpError : Service -> Http.Error -> String
103
+
translateHttpError service err =
104
+
case err of
105
+
NetworkError ->
106
+
"Cannot connect to this source"
107
+
108
+
Timeout ->
109
+
"Source did not respond (timeout)"
110
+
111
+
BadUrl _ ->
112
+
"Diffuse error, invalid url was used"
113
+
114
+
BadStatus _ ->
115
+
"Got a faulty response from this source"
116
+
117
+
BadBody response ->
118
+
Services.parseErrorResponse service response
+320
src/Applications/Brain/Sources/Processing/Steps.elm
+320
src/Applications/Brain/Sources/Processing/Steps.elm
···
1
+
module Brain.Sources.Processing.Steps exposing
2
+
( takeFirstStep
3
+
, takePrepareStep
4
+
, takeTagsStep
5
+
, takeTreeStep
6
+
)
7
+
8
+
{-| Processing.
9
+
10
+
## How it works
11
+
12
+
This describes the process for a single source.
13
+
14
+
1. Get a file tree/list from the source
15
+
-> This can happen in multiple steps as with Amazon S3.
16
+
A command is issued for each step of this process.
17
+
2. Get the tags (ie. metadata) for each file that we found.
18
+
-> This also happens in multiple steps, so that we can flush
19
+
every x tracks while processing.
20
+
A command is issued for each step of this process.
21
+
22
+
-}
23
+
24
+
import Alien
25
+
import Brain.Ports as Ports
26
+
import Brain.Reply exposing (Reply(..))
27
+
import Brain.Sources.Processing.Common exposing (..)
28
+
import List.Extra as List
29
+
import Replying exposing (do)
30
+
import Set
31
+
import Sources exposing (Source)
32
+
import Sources.Encoding
33
+
import Sources.Processing exposing (..)
34
+
import Sources.Services as Services
35
+
import Time
36
+
import Tracks exposing (Track)
37
+
38
+
39
+
40
+
-- SETTINGS
41
+
42
+
43
+
{-| How much tags do we want to process
44
+
before we send them back to Elm.
45
+
46
+
eg. After we got the tags for 50 tracks,
47
+
we store these and continue with the rest.
48
+
49
+
-}
50
+
tagsBatchSize : Int
51
+
tagsBatchSize =
52
+
50
53
+
54
+
55
+
56
+
-- 1st STEP
57
+
58
+
59
+
takeFirstStep : String -> Time.Posix -> Source -> Cmd Msg
60
+
takeFirstStep origin currentTime source =
61
+
let
62
+
initialContext =
63
+
{ filePaths = []
64
+
, origin = origin
65
+
, preparationMarker = TheBeginning
66
+
, source = source
67
+
, treeMarker = TheBeginning
68
+
}
69
+
in
70
+
prepare initialContext currentTime
71
+
72
+
73
+
74
+
-- 2nd STEP
75
+
76
+
77
+
takePrepareStep : Context -> String -> Time.Posix -> ( Cmd Msg, Maybe Reply )
78
+
takePrepareStep context response currentTime =
79
+
context
80
+
|> handlePreparationResponse response
81
+
|> intoPreparationCommands currentTime
82
+
83
+
84
+
85
+
-- 3rd STEP
86
+
87
+
88
+
takeTreeStep : Context -> String -> List Track -> Time.Posix -> Cmd Msg
89
+
takeTreeStep context response associatedTracks currentTime =
90
+
context
91
+
|> handleTreeResponse response
92
+
|> intoTreeCommand associatedTracks currentTime
93
+
94
+
95
+
96
+
-- 4th STEP
97
+
98
+
99
+
takeTagsStep : Time.Posix -> ContextForTags -> Source -> Maybe (Cmd Msg)
100
+
takeTagsStep currentTime tagsCtx source =
101
+
let
102
+
( filesToProcess, nextFiles ) =
103
+
List.splitAt tagsBatchSize tagsCtx.nextFilePaths
104
+
105
+
newTagsCtx =
106
+
{ nextFilePaths = nextFiles
107
+
, receivedFilePaths = filesToProcess
108
+
, receivedTags = []
109
+
, sourceId = source.id
110
+
, urlsForTags = makeTrackUrls currentTime source filesToProcess
111
+
}
112
+
in
113
+
filesToProcess
114
+
|> List.head
115
+
|> Maybe.map (always (getTags newTagsCtx))
116
+
117
+
118
+
119
+
-----------------------------------------
120
+
-- ㊙️
121
+
-----------------------------------------
122
+
-- PREPARE
123
+
124
+
125
+
prepare : Context -> Time.Posix -> Cmd Msg
126
+
prepare context currentTime =
127
+
let
128
+
maybePreparationCommand =
129
+
Services.prepare
130
+
context.source.service
131
+
context.origin
132
+
context.source.data
133
+
context.preparationMarker
134
+
(PrepareStep context)
135
+
in
136
+
case maybePreparationCommand of
137
+
Just cmd ->
138
+
cmd
139
+
140
+
Nothing ->
141
+
-- Some services don't need to prepare for processing.
142
+
-- 🚀
143
+
makeTree context currentTime
144
+
145
+
146
+
handlePreparationResponse : String -> Context -> Context
147
+
handlePreparationResponse response context =
148
+
let
149
+
answer =
150
+
Services.parsePreparationResponse
151
+
context.source.service
152
+
response
153
+
context.source.data
154
+
context.preparationMarker
155
+
156
+
source =
157
+
context.source
158
+
in
159
+
{ context
160
+
| preparationMarker = answer.marker
161
+
, source = { source | data = answer.sourceData }
162
+
}
163
+
164
+
165
+
intoPreparationCommands : Time.Posix -> Context -> ( Cmd Msg, Maybe Reply )
166
+
intoPreparationCommands currentTime context =
167
+
case context.preparationMarker of
168
+
TheBeginning ->
169
+
( Cmd.none
170
+
, Nothing
171
+
)
172
+
173
+
-- Still preparing,
174
+
-- carry on.
175
+
--
176
+
InProgress _ ->
177
+
( prepare context currentTime
178
+
, Nothing
179
+
)
180
+
181
+
-- The preparation is completed,
182
+
-- continue to the next step.
183
+
--
184
+
TheEnd ->
185
+
let
186
+
updatedSource =
187
+
context.source
188
+
in
189
+
( -- Make a file tree, the next step.
190
+
-- 🚀
191
+
makeTree context currentTime
192
+
-- Update source data.
193
+
, updatedSource
194
+
|> Sources.Encoding.encode
195
+
|> GiveUI Alien.UpdateSourceData
196
+
|> Just
197
+
)
198
+
199
+
200
+
201
+
-- TREE
202
+
203
+
204
+
makeTree : Context -> Time.Posix -> Cmd Msg
205
+
makeTree context currentTime =
206
+
Services.makeTree
207
+
context.source.service
208
+
context.source.data
209
+
context.treeMarker
210
+
currentTime
211
+
(TreeStep context)
212
+
213
+
214
+
handleTreeResponse : String -> Context -> Context
215
+
handleTreeResponse response context =
216
+
let
217
+
parsingFunc =
218
+
Services.parseTreeResponse context.source.service
219
+
220
+
parsedResponse =
221
+
parsingFunc response context.treeMarker
222
+
in
223
+
{ context
224
+
| filePaths = context.filePaths ++ parsedResponse.filePaths
225
+
, treeMarker = parsedResponse.marker
226
+
}
227
+
228
+
229
+
intoTreeCommand : List Track -> Time.Posix -> Context -> Cmd Msg
230
+
intoTreeCommand associatedTracks currentTime context =
231
+
case context.treeMarker of
232
+
TheBeginning ->
233
+
Cmd.none
234
+
235
+
-- Still building the tree,
236
+
-- carry on.
237
+
--
238
+
InProgress _ ->
239
+
makeTree context currentTime
240
+
241
+
-- The tree's been build,
242
+
-- continue to the next step.
243
+
--
244
+
TheEnd ->
245
+
let
246
+
filteredFiles =
247
+
Services.postProcessTree context.source.service context.filePaths
248
+
249
+
postContext =
250
+
{ context | filePaths = filteredFiles }
251
+
252
+
pathsSourceOfTruth =
253
+
postContext.filePaths
254
+
255
+
pathsCurrent =
256
+
List.map .path associatedTracks
257
+
258
+
( pathsAdded, pathsRemoved ) =
259
+
separate pathsCurrent pathsSourceOfTruth
260
+
in
261
+
Cmd.batch
262
+
[ -- Get tags from tracks, the next step.
263
+
-- 🚀
264
+
postContext
265
+
|> (\ctx -> { ctx | filePaths = pathsAdded })
266
+
|> contextToTagsContext
267
+
|> TagsStep
268
+
|> do
269
+
270
+
-- Remove tracks
271
+
, if not (List.isEmpty pathsRemoved) then
272
+
pathsRemoved
273
+
|> TreeStepRemoveTracks context.source.id
274
+
|> do
275
+
276
+
else
277
+
Cmd.none
278
+
]
279
+
280
+
281
+
separate : List String -> List String -> ( List String, List String )
282
+
separate current srcOfTruth =
283
+
let
284
+
setCurrent =
285
+
Set.fromList current
286
+
287
+
setSrcOfTruth =
288
+
Set.fromList srcOfTruth
289
+
in
290
+
( -- Added
291
+
--------
292
+
Set.diff setSrcOfTruth setCurrent |> Set.toList
293
+
, -- Removed
294
+
----------
295
+
Set.diff setCurrent setSrcOfTruth |> Set.toList
296
+
)
297
+
298
+
299
+
300
+
-- TAGS
301
+
302
+
303
+
getTags : ContextForTags -> Cmd Msg
304
+
getTags context =
305
+
Ports.requestTags context
306
+
307
+
308
+
makeTrackUrls : Time.Posix -> Source -> List String -> List TagUrls
309
+
makeTrackUrls currentTime source filePaths =
310
+
let
311
+
maker =
312
+
Services.makeTrackUrl source.service
313
+
314
+
mapFn =
315
+
\path ->
316
+
{ getUrl = maker currentTime source.data Get path
317
+
, headUrl = maker currentTime source.data Head path
318
+
}
319
+
in
320
+
List.map mapFn filePaths
+2
-2
src/Applications/UI/Backdrop.elm
+2
-2
src/Applications/UI/Backdrop.elm
···
8
8
import Html.Styled.Lazy as Lazy
9
9
import Json.Decode
10
10
import Replying exposing (R3D3)
11
-
import Return3 as Return
11
+
import Return3
12
12
import Tachyons.Classes as T
13
13
import UI.Animations
14
14
import UI.Reply as Reply exposing (Reply)
···
57
57
[ backdrop ]
58
58
|> List.append model.loaded
59
59
|> (\list -> { model | loaded = list })
60
-
|> Return.withNothing
60
+
|> Return3.withNothing
61
61
62
62
63
63
+12
-5
src/Library/Alien.elm
+12
-5
src/Library/Alien.elm
···
33
33
| LoadEnclosedUserData
34
34
| LoadHypaethralUserData
35
35
| ReportGenericError
36
-
| ReportSourceProcessingError
36
+
| ReportProcessingError
37
+
| UpdateSourceData
37
38
38
39
39
40
···
109
110
ReportGenericError ->
110
111
"REPORT_GENERIC_ERROR"
111
112
112
-
ReportSourceProcessingError ->
113
-
"REPORT_SOURCE_PROCESSING_ERROR"
113
+
ReportProcessingError ->
114
+
"REPORT_PROCESSING_ERROR"
115
+
116
+
UpdateSourceData ->
117
+
"UPDATE_SOURCE_DATA"
114
118
115
119
116
120
tagFromString : String -> Maybe Tag
···
158
162
"REPORT_GENERIC_ERROR" ->
159
163
Just ReportGenericError
160
164
161
-
"REPORT_SOURCE_PROCESSING_ERROR" ->
162
-
Just ReportSourceProcessingError
165
+
"REPORT_PROCESSING_ERROR" ->
166
+
Just ReportProcessingError
167
+
168
+
"UPDATE_SOURCE_DATA" ->
169
+
Just UpdateSourceData
163
170
164
171
_ ->
165
172
Nothing
+8
-2
src/Library/Sources/Processing.elm
+8
-2
src/Library/Sources/Processing.elm
···
1
-
module Sources.Processing exposing (Arguments, Context, ContextForTags, HttpMethod(..), Marker(..), PrepationAnswer, Status(..), TreeAnswer, httpMethod)
1
+
module Sources.Processing exposing (Arguments, Context, ContextForTags, HttpMethod(..), Marker(..), PrepationAnswer, Status(..), TagUrls, TreeAnswer, httpMethod)
2
2
3
3
import Http
4
4
import Sources exposing (Source, SourceData)
···
61
61
, receivedFilePaths : List String
62
62
, receivedTags : List (Maybe Tags)
63
63
, sourceId : String
64
-
, urlsForTags : List String
64
+
, urlsForTags : List TagUrls
65
+
}
66
+
67
+
68
+
type alias TagUrls =
69
+
{ getUrl : String
70
+
, headUrl : String
65
71
}
66
72
67
73
+6
-2
src/Library/String/Ext.elm
+6
-2
src/Library/String/Ext.elm
···
4
4
chopEnd : String -> String -> String
5
5
chopEnd needle str =
6
6
if String.endsWith needle str then
7
-
String.dropRight (String.length str) str
7
+
str
8
+
|> String.dropRight (String.length str)
9
+
|> chopEnd needle
8
10
9
11
else
10
12
str
···
13
15
chopStart : String -> String -> String
14
16
chopStart needle str =
15
17
if String.startsWith needle str then
16
-
String.dropLeft (String.length str) str
18
+
str
19
+
|> String.dropLeft (String.length str)
20
+
|> chopStart needle
17
21
18
22
else
19
23
str
+22
-1
src/Library/Tracks.elm
+22
-1
src/Library/Tracks.elm
···
1
-
module Tracks exposing (Collection, Favourite, IdentifiedTrack, Identifiers, Tags, Track, emptyCollection, emptyIdentifiedTrack, emptyTags, emptyTrack, missingId)
1
+
module Tracks exposing (Collection, Favourite, IdentifiedTrack, Identifiers, Tags, Track, emptyCollection, emptyIdentifiedTrack, emptyTags, emptyTrack, makeTrack, missingId)
2
+
3
+
import Base64
4
+
import Bytes.Encode
5
+
import String.Ext as String
6
+
7
+
2
8
3
9
-- 🌳
4
10
···
120
126
, identified = []
121
127
, arranged = []
122
128
, harvested = []
129
+
}
130
+
131
+
132
+
makeTrack : String -> ( String, Tags ) -> Track
133
+
makeTrack sourceId ( path, tags ) =
134
+
{ id =
135
+
(sourceId ++ "//" ++ path)
136
+
|> Bytes.Encode.string
137
+
|> Bytes.Encode.encode
138
+
|> Base64.fromBytes
139
+
|> Maybe.map (String.chopEnd "=")
140
+
|> Maybe.withDefault missingId
141
+
, path = path
142
+
, sourceId = sourceId
143
+
, tags = tags
123
144
}
124
145
125
146