A music player that connects to your cloud/distributed storage.
Add processed tracks to the collection
+327
-111
+1
-1
src/Applications/Brain/Authentication.elm
+1
-1
src/Applications/Brain/Authentication.elm
+34
-26
src/Applications/UI.elm
+34
-26
src/Applications/UI.elm
···
7
7
import Chunky exposing (..)
8
8
import Color
9
9
import Color.Ext as Color
10
+
import Common
10
11
import Css exposing (url)
11
12
import Css.Global
12
13
import Html.Styled as Html exposing (Html, div, section, text, toUnstyled)
13
14
import Html.Styled.Attributes exposing (id, style)
14
15
import Html.Styled.Lazy as Lazy
15
16
import Json.Encode as Encode
16
-
import Replying exposing (return)
17
+
import Replying exposing (do, return)
17
18
import Return2
18
19
import Return3
19
20
import Sources
···
97
98
)
98
99
99
100
LoadHypaethralUserData json ->
100
-
( { model | isAuthenticated = True, isLoading = False }
101
+
{ model | isAuthenticated = True, isLoading = False }
101
102
|> UI.UserData.importHypaethral json
102
-
, Cmd.none
103
-
)
103
+
|> Replying.reducto update translateReply
104
104
105
105
ToggleLoadingScreen On ->
106
106
( { model | isLoading = True }
···
155
155
156
156
Core.ProcessSources ->
157
157
( model
158
-
, [ ( "origin", Encode.string "TODO" )
159
-
, ( "sources", Encode.list Sources.Encoding.encode model.sources.collection )
160
-
, ( "tracks", Encode.list Tracks.Encoding.encodeTrack [] )
158
+
, [ ( "origin"
159
+
, Encode.string (Common.urlOrigin model.url)
160
+
)
161
+
, ( "sources"
162
+
, Encode.list Sources.Encoding.encode model.sources.collection
163
+
)
164
+
, ( "tracks"
165
+
, Encode.list Tracks.Encoding.encodeTrack model.tracks.collection.untouched
166
+
)
161
167
]
162
168
|> Encode.object
163
169
|> Alien.broadcast Alien.ProcessSources
···
187
193
)
188
194
189
195
SignOut ->
196
+
-- TODO: Reset user data
190
197
( { model | isAuthenticated = False }
191
198
, Alien.SignOut
192
199
|> Alien.trigger
···
265
272
translateAlienEvent event =
266
273
case Alien.tagFromString event.tag of
267
274
Just Alien.AddTracks ->
268
-
let
269
-
dbg =
270
-
-- TODO
271
-
Debug.log "addTracks" event
272
-
in
273
-
Bypass
275
+
TracksMsg (UI.Tracks.Add event.data)
274
276
275
277
Just Alien.FinishedProcessingSources ->
276
278
SourcesMsg UI.Sources.FinishedProcessing
···
362
364
-----------------------------------------
363
365
-- Main
364
366
-----------------------------------------
365
-
, case model.page of
366
-
Page.Index ->
367
-
model.tracks
368
-
|> Lazy.lazy UI.Tracks.view
369
-
|> Html.map TracksMsg
367
+
, UI.Kit.vessel
368
+
[ model.tracks
369
+
|> Lazy.lazy UI.Tracks.view
370
+
|> Html.map TracksMsg
370
371
371
-
Page.NotFound ->
372
-
text "Page not found."
372
+
-- Pages
373
+
--------
374
+
, case model.page of
375
+
Page.Index ->
376
+
empty
373
377
374
-
Page.Settings ->
375
-
UI.Settings.view model
378
+
Page.NotFound ->
379
+
UI.Kit.receptacle [ text "Page not found." ]
376
380
377
-
Page.Sources subPage ->
378
-
model.sources
379
-
|> Lazy.lazy2 UI.Sources.view subPage
380
-
|> Html.map SourcesMsg
381
+
Page.Settings ->
382
+
UI.Settings.view model
383
+
384
+
Page.Sources subPage ->
385
+
model.sources
386
+
|> Lazy.lazy2 UI.Sources.view subPage
387
+
|> Html.map SourcesMsg
388
+
]
381
389
382
390
-----------------------------------------
383
391
-- Controls
+13
-1
src/Applications/UI/Kit.elm
+13
-1
src/Applications/UI/Kit.elm
···
1
-
module UI.Kit exposing (ButtonType(..), button, buttonFocus, canister, centeredContent, colorKit, colors, defaultFontFamilies, h1, h2, h3, headerFontFamilies, inputFocus, insulationWidth, intro, label, link, logoBackdrop, navFocus, select, textField, textFocus, vessel)
1
+
module UI.Kit exposing (ButtonType(..), button, buttonFocus, canister, centeredContent, colorKit, colors, defaultFontFamilies, h1, h2, h3, headerFontFamilies, inputFocus, insulationWidth, intro, label, link, logoBackdrop, navFocus, receptacle, select, textField, textFocus, vessel)
2
2
3
3
import Chunky exposing (..)
4
4
import Color
···
315
315
[]
316
316
317
317
318
+
receptacle : List (Html msg) -> Html msg
319
+
receptacle =
320
+
chunk
321
+
[ T.absolute
322
+
, T.absolute__fill
323
+
, T.bg_white
324
+
, T.flex
325
+
, T.flex_column
326
+
]
327
+
328
+
318
329
select : (String -> msg) -> List (Html msg) -> Html msg
319
330
select inputHandler options =
320
331
brick
···
375
386
, T.flex_column
376
387
, T.flex_grow_1
377
388
, T.overflow_hidden
389
+
, T.relative
378
390
, T.w_100
379
391
]
380
392
+1
-1
src/Applications/UI/Settings.elm
+1
-1
src/Applications/UI/Settings.elm
+1
-1
src/Applications/UI/Sources.elm
+1
-1
src/Applications/UI/Sources.elm
+88
-3
src/Applications/UI/Tracks.elm
+88
-3
src/Applications/UI/Tracks.elm
···
1
-
module UI.Tracks exposing (Model, Msg(..), initialModel, update, view)
1
+
module UI.Tracks exposing (Model, Msg(..), initialModel, makeParcel, resolveParcel, update, view)
2
2
3
3
import Chunky exposing (..)
4
4
import Html.Styled as Html exposing (Html, text)
5
+
import Json.Decode
5
6
import Replying exposing (R3D3)
6
7
import Return3
7
8
import Tracks exposing (..)
9
+
import Tracks.Collection exposing (..)
10
+
import Tracks.Encoding as Encoding
8
11
import UI.Kit
9
-
import UI.Reply exposing (Reply)
12
+
import UI.Reply exposing (Reply(..))
10
13
11
14
12
15
···
15
18
16
19
type alias Model =
17
20
{ collection : Collection
21
+
, enabledSourceIds : List String
22
+
, favourites : List Favourite
23
+
, favouritesOnly : Bool
24
+
, nowPlaying : Maybe IdentifiedTrack
25
+
, searchResults : Maybe (List String)
26
+
, searchTerm : Maybe String
27
+
, sortBy : SortBy
28
+
, sortDirection : SortDirection
18
29
}
19
30
20
31
21
32
initialModel : Model
22
33
initialModel =
23
34
{ collection = emptyCollection
35
+
, enabledSourceIds = []
36
+
, favourites = []
37
+
, favouritesOnly = False
38
+
, nowPlaying = Nothing
39
+
, searchResults = Nothing
40
+
, searchTerm = Nothing
41
+
, sortBy = Artist
42
+
, sortDirection = Asc
24
43
}
25
44
26
45
···
30
49
31
50
type Msg
32
51
= Bypass
52
+
-----------------------------------------
53
+
-- Collection, Pt. 1
54
+
-----------------------------------------
55
+
-----------------------------------------
56
+
-- Collection, Pt. 2
57
+
-----------------------------------------
58
+
| Add Json.Decode.Value
33
59
34
60
35
61
update : Msg -> Model -> R3D3 Model Msg Reply
···
38
64
Bypass ->
39
65
Return3.withNothing model
40
66
67
+
-----------------------------------------
68
+
-- Collection, Pt. 1
69
+
-----------------------------------------
70
+
-----------------------------------------
71
+
-- Collection, Pt. 2
72
+
-----------------------------------------
73
+
-- # Add
74
+
-- > Add tracks to the collection.
75
+
--
76
+
Add json ->
77
+
let
78
+
tracks =
79
+
json
80
+
|> Json.Decode.decodeValue (Json.Decode.list Encoding.trackDecoder)
81
+
|> Result.withDefault []
82
+
in
83
+
model
84
+
|> makeParcel
85
+
|> add tracks
86
+
|> resolveParcel model
87
+
88
+
89
+
90
+
-- 📣 ░░ PARCEL
91
+
92
+
93
+
makeParcel : Model -> Parcel
94
+
makeParcel model =
95
+
( { enabledSourceIds = model.enabledSourceIds
96
+
, favourites = model.favourites
97
+
, favouritesOnly = model.favouritesOnly
98
+
, nowPlaying = model.nowPlaying
99
+
, searchResults = model.searchResults
100
+
, sortBy = model.sortBy
101
+
, sortDirection = model.sortDirection
102
+
}
103
+
, model.collection
104
+
)
105
+
106
+
107
+
resolveParcel : Model -> Parcel -> R3D3 Model Msg Reply
108
+
resolveParcel model ( _, newCollection ) =
109
+
let
110
+
modelWithNewCollection =
111
+
{ model | collection = newCollection }
112
+
in
113
+
if model.collection.untouched /= newCollection.untouched then
114
+
( modelWithNewCollection
115
+
, Cmd.none
116
+
, Just [ SaveHypaethralUserData ]
117
+
)
118
+
119
+
else
120
+
Return3.withNothing modelWithNewCollection
121
+
41
122
42
123
43
124
-- 🗺
···
45
126
46
127
view : Model -> Html Msg
47
128
view model =
48
-
UI.Kit.vessel []
129
+
raw
130
+
(List.map
131
+
(\t -> text t.tags.title)
132
+
model.collection.untouched
133
+
)
+84
-22
src/Applications/UI/UserData.elm
+84
-22
src/Applications/UI/UserData.elm
···
1
-
module UI.UserData exposing (HypaethralBundle, exportHypaethral, importHypaethral)
1
+
module UI.UserData exposing (exportHypaethral, importHypaethral)
2
2
3
3
{-| Import user data into or export user data from the UI.Core.Model
4
4
-}
···
6
6
import Authentication exposing (..)
7
7
import Json.Decode as Decode
8
8
import Json.Encode as Encode
9
+
import Replying exposing (R3D3)
9
10
import Sources.Encoding as Sources
11
+
import Tracks exposing (emptyCollection)
12
+
import Tracks.Collection as Tracks
13
+
import Tracks.Encoding as Tracks
10
14
import UI.Core
11
-
import UI.Sources
15
+
import UI.Reply as UI
16
+
import UI.Sources as Sources
17
+
import UI.Tracks as Tracks
12
18
13
19
14
20
···
17
23
-----------------------------------------
18
24
19
25
20
-
type alias HypaethralBundle =
21
-
( HypaethralUserData, Decode.Value )
22
-
23
-
24
-
importHypaethral : Decode.Value -> UI.Core.Model -> UI.Core.Model
26
+
importHypaethral : Decode.Value -> UI.Core.Model -> R3D3 UI.Core.Model UI.Core.Msg UI.Reply
25
27
importHypaethral value model =
26
28
let
27
29
data =
28
30
Result.withDefault emptyHypaethralUserData (decode value)
29
31
30
-
bundle =
31
-
( data
32
-
, Encode.null
33
-
)
32
+
( sourcesModel, sourcesCmd, sourcesReply ) =
33
+
importSources model.sources data
34
+
35
+
( tracksModel, tracksCmd, tracksReply ) =
36
+
importTracks model.tracks data
34
37
in
35
-
{ model | sources = importSources model.sources bundle }
38
+
( { model
39
+
| sources = sourcesModel
40
+
, tracks = tracksModel
41
+
}
42
+
, Cmd.batch
43
+
[ Cmd.map UI.Core.SourcesMsg sourcesCmd
44
+
, Cmd.map UI.Core.TracksMsg tracksCmd
45
+
]
46
+
, mergeReplies
47
+
[ sourcesReply
48
+
, tracksReply
49
+
]
50
+
)
36
51
37
52
53
+
mergeReplies : List (Maybe (List UI.Reply)) -> Maybe (List UI.Reply)
54
+
mergeReplies list =
55
+
list
56
+
|> List.foldl
57
+
(\maybeReply replies ->
58
+
case maybeReply of
59
+
Just r ->
60
+
replies ++ r
38
61
39
-
-- 📭 ░░ IMPORTING HYPAETHRAL
62
+
Nothing ->
63
+
replies
64
+
)
65
+
[]
66
+
|> Just
40
67
41
68
42
-
importSources : UI.Sources.Model -> HypaethralBundle -> UI.Sources.Model
43
-
importSources model ( data, _ ) =
44
-
{ model | collection = Maybe.withDefault [] data.sources }
69
+
70
+
-- ░░ IMPORTING HYPAETHRAL
71
+
72
+
73
+
importSources : Sources.Model -> HypaethralUserData -> R3D3 Sources.Model Sources.Msg UI.Reply
74
+
importSources model data =
75
+
( { model
76
+
| collection = Maybe.withDefault [] data.sources
77
+
}
78
+
, Cmd.none
79
+
, Nothing
80
+
)
81
+
82
+
83
+
importTracks : Tracks.Model -> HypaethralUserData -> R3D3 Tracks.Model Tracks.Msg UI.Reply
84
+
importTracks model data =
85
+
let
86
+
tracks =
87
+
Maybe.withDefault [] data.tracks
88
+
89
+
adjustedModel =
90
+
{ model
91
+
| collection = { emptyCollection | untouched = tracks }
92
+
, favourites = Maybe.withDefault [] data.favourites
93
+
}
94
+
in
95
+
adjustedModel
96
+
|> Tracks.makeParcel
97
+
|> Tracks.identify
98
+
|> Tracks.resolveParcel adjustedModel
45
99
46
100
47
101
48
-
-- 📭 ░░ DECODING
102
+
-- ░░ DECODING
49
103
50
104
51
105
decode : Decode.Value -> Result Decode.Error HypaethralUserData
···
55
109
56
110
decoder : Decode.Decoder HypaethralUserData
57
111
decoder =
58
-
Decode.map
112
+
Decode.map3
59
113
HypaethralUserData
114
+
(Decode.maybe <| Decode.field "favourites" <| Decode.list Tracks.favouriteDecoder)
60
115
(Decode.maybe <| Decode.field "sources" <| Decode.list Sources.decoder)
116
+
(Decode.maybe <| Decode.field "tracks" <| Decode.list Tracks.trackDecoder)
61
117
62
118
63
119
64
-
-- 📭 ░░ FALLBACKS
120
+
-- ░░ FALLBACKS
65
121
66
122
67
123
emptyHypaethralUserData : HypaethralUserData
68
124
emptyHypaethralUserData =
69
-
{ sources = Nothing }
125
+
{ favourites = Nothing
126
+
, sources = Nothing
127
+
, tracks = Nothing
128
+
}
70
129
71
130
72
131
···
81
140
82
141
83
142
84
-
-- 📮 ░░ ENCODING
143
+
-- ░░ ENCODING
85
144
86
145
87
146
encode : UI.Core.Model -> Encode.Value
88
147
encode model =
89
148
Encode.object
90
-
[ ( "sources", Encode.list Sources.encode model.sources.collection ) ]
149
+
[ ( "favourites", Encode.list Tracks.encodeFavourite model.tracks.favourites )
150
+
, ( "sources", Encode.list Sources.encode model.sources.collection )
151
+
, ( "tracks", Encode.list Tracks.encodeTrack model.tracks.collection.untouched )
152
+
]
+4
-1
src/Library/Authentication.elm
+4
-1
src/Library/Authentication.elm
···
1
1
module Authentication exposing (EnclosedUserData, HypaethralUserData, Method(..), methodFromString, methodToString)
2
2
3
3
import Sources
4
+
import Tracks
4
5
5
6
6
7
···
16
17
17
18
18
19
type alias HypaethralUserData =
19
-
{ sources : Maybe (List Sources.Source)
20
+
{ favourites : Maybe (List Tracks.Favourite)
21
+
, sources : Maybe (List Sources.Source)
22
+
, tracks : Maybe (List Tracks.Track)
20
23
}
21
24
22
25
+26
src/Library/Common.elm
+26
src/Library/Common.elm
···
1
+
module Common exposing (urlOrigin)
2
+
3
+
import Url exposing (Protocol(..), Url)
4
+
5
+
6
+
7
+
-- 🔱
8
+
9
+
10
+
urlOrigin : Url -> String
11
+
urlOrigin { host, port_, protocol } =
12
+
let
13
+
scheme =
14
+
case protocol of
15
+
Http ->
16
+
"http://"
17
+
18
+
Https ->
19
+
"https://"
20
+
21
+
thePort =
22
+
port_
23
+
|> Maybe.map (String.fromInt >> (++) ":")
24
+
|> Maybe.withDefault ""
25
+
in
26
+
scheme ++ host ++ thePort
+15
-13
src/Library/Replying.elm
+15
-13
src/Library/Replying.elm
···
1
-
module Replying exposing (R3D3, do, return, updateChild)
1
+
module Replying exposing (R3D3, Updator, do, reducto, return, updateChild)
2
2
3
3
import Return3
4
4
import Task
···
10
10
11
11
type alias R3D3 model msg reply =
12
12
( model, Cmd msg, Maybe (List reply) )
13
+
14
+
15
+
type alias Updator msg model =
16
+
msg -> model -> ( model, Cmd msg )
13
17
14
18
15
19
···
46
50
( model, msg )
47
51
48
52
53
+
{-| Reduce a `R3D3` to a `R2D2`.
54
+
-}
55
+
reducto : Updator msg model -> (reply -> msg) -> R3D3 model msg reply -> ( model, Cmd msg )
56
+
reducto updator translator ( model, cmd, maybeReplies ) =
57
+
maybeReplies
58
+
|> Maybe.withDefault []
59
+
|> List.map translator
60
+
|> List.foldl (andThenUpdate updator) ( model, cmd )
61
+
62
+
49
63
50
64
-- 🔱 ░░ TASKS
51
65
···
61
75
-----------------------------------------
62
76
63
77
64
-
type alias Updator msg model =
65
-
msg -> model -> ( model, Cmd msg )
66
-
67
-
68
78
andThenUpdate : Updator msg model -> msg -> ( model, Cmd msg ) -> ( model, Cmd msg )
69
79
andThenUpdate updator msg ( model, cmd ) =
70
80
model
71
81
|> updator msg
72
82
|> Tuple.mapSecond (\c -> Cmd.batch [ cmd, c ])
73
-
74
-
75
-
reducto : Updator msg model -> (reply -> msg) -> R3D3 model msg reply -> ( model, Cmd msg )
76
-
reducto updator translator ( model, cmd, maybeReplies ) =
77
-
maybeReplies
78
-
|> Maybe.withDefault []
79
-
|> List.map translator
80
-
|> List.foldl (andThenUpdate updator) ( model, cmd )
+13
-13
src/Library/Tracks.elm
+13
-13
src/Library/Tracks.elm
···
1
-
module Tracks exposing (Collection, Favourite, IdentifiedTrack, Identifiers, Parcel, SortBy(..), SortDirection(..), Tags, Track, emptyCollection, emptyIdentifiedTrack, emptyTags, emptyTrack, makeTrack, missingId)
1
+
module Tracks exposing (Collection, CollectionDependencies, Favourite, IdentifiedTrack, Identifiers, Parcel, SortBy(..), SortDirection(..), Tags, Track, emptyCollection, emptyIdentifiedTrack, emptyTags, emptyTrack, makeTrack, missingId)
2
2
3
3
import Base64
4
4
import Bytes.Encode
···
81
81
}
82
82
83
83
84
+
type alias CollectionDependencies =
85
+
{ enabledSourceIds : List String
86
+
, favourites : List Favourite
87
+
, favouritesOnly : Bool
88
+
, nowPlaying : Maybe IdentifiedTrack
89
+
, searchResults : Maybe (List String)
90
+
, sortBy : SortBy
91
+
, sortDirection : SortDirection
92
+
}
93
+
94
+
84
95
type alias Parcel =
85
-
( -- Things I need to make a proper collection:
86
-
{ enabledSourceIds : List String
87
-
, favourites : List Favourite
88
-
, favouritesOnly : Bool
89
-
, nowPlaying : Maybe IdentifiedTrack
90
-
, searchResults : Maybe (List String)
91
-
, sortBy : SortBy
92
-
, sortDirection : SortDirection
93
-
}
94
-
-- The collection itself:
95
-
, Collection
96
-
)
96
+
( CollectionDependencies, Collection )
97
97
98
98
99
99
+47
src/Library/Tracks/Collection.elm
+47
src/Library/Tracks/Collection.elm
···
1
+
module Tracks.Collection exposing (add, arrange, harvest, identify, map)
2
+
3
+
import Flip exposing (flip)
4
+
import Tracks exposing (..)
5
+
import Tracks.Collection.Internal as Internal
6
+
7
+
8
+
9
+
-- 🔱
10
+
11
+
12
+
identify : Parcel -> Parcel
13
+
identify =
14
+
Internal.identify >> Internal.arrange >> Internal.harvest
15
+
16
+
17
+
arrange : Parcel -> Parcel
18
+
arrange =
19
+
Internal.arrange >> Internal.harvest
20
+
21
+
22
+
harvest : Parcel -> Parcel
23
+
harvest =
24
+
Internal.harvest
25
+
26
+
27
+
map : (List IdentifiedTrack -> List IdentifiedTrack) -> Parcel -> Parcel
28
+
map fn ( model, collection ) =
29
+
( model
30
+
, { collection
31
+
| identified = fn collection.identified
32
+
, arranged = fn collection.arranged
33
+
, harvested = fn collection.harvested
34
+
}
35
+
)
36
+
37
+
38
+
39
+
-- ⚗️
40
+
41
+
42
+
add : List Track -> Parcel -> Parcel
43
+
add tracks ( deps, { untouched } ) =
44
+
identify
45
+
( deps
46
+
, { emptyCollection | untouched = untouched ++ tracks }
47
+
)
-29
src/Library/Tracks/Collection/Internal.elm
-29
src/Library/Tracks/Collection/Internal.elm
···
1
1
module Tracks.Collection.Internal exposing
2
2
( arrange
3
-
, build
4
-
, buildf
5
3
, harvest
6
4
, identify
7
-
, initialize
8
5
)
9
6
10
-
import Flip exposing (flip)
11
7
import Tracks exposing (Parcel, Track)
12
8
import Tracks.Collection.Internal.Arrange as Internal
13
9
import Tracks.Collection.Internal.Harvest as Internal
···
16
12
17
13
18
14
-- 🔱
19
-
20
-
21
-
build : List Track -> Parcel -> Parcel
22
-
build tracks =
23
-
initialize tracks >> identify >> arrange >> harvest
24
-
25
-
26
-
buildf : Parcel -> List Track -> Parcel
27
-
buildf =
28
-
flip build
29
-
30
-
31
-
32
-
-- INITIALIZE
33
-
34
-
35
-
initialize : List Track -> Parcel -> Parcel
36
-
initialize tracks ( dependencies, collection ) =
37
-
( dependencies
38
-
, { collection | untouched = tracks }
39
-
)
40
-
41
-
42
-
43
-
-- RE-EXPORT
44
15
45
16
46
17
identify : Parcel -> Parcel