From 01eb57142a5ee1111b50768a8806b7dca3648f52 Mon Sep 17 00:00:00 2001 From: Steven Vandevelde Date: Mon, 14 Jan 2019 17:17:39 +0100 Subject: [PATCH] Add processed tracks to the collection --- src/Applications/Brain/Authentication.elm | 2 +- src/Applications/UI.elm | 66 +++++++------ src/Applications/UI/Kit.elm | 14 ++- src/Applications/UI/Settings.elm | 2 +- src/Applications/UI/Sources.elm | 2 +- src/Applications/UI/Tracks.elm | 91 +++++++++++++++++- src/Applications/UI/UserData.elm | 106 ++++++++++++++++----- src/Library/Authentication.elm | 5 +- src/Library/Common.elm | 26 +++++ src/Library/Replying.elm | 28 +++--- src/Library/Tracks.elm | 26 ++--- src/Library/Tracks/Collection.elm | 47 +++++++++ src/Library/Tracks/Collection/Internal.elm | 29 ------ 13 files changed, 330 insertions(+), 114 deletions(-) create mode 100644 src/Library/Common.elm create mode 100644 src/Library/Tracks/Collection.elm diff --git a/src/Applications/Brain/Authentication.elm b/src/Applications/Brain/Authentication.elm index d77eb475..a4cea465 100644 --- a/src/Applications/Brain/Authentication.elm +++ b/src/Applications/Brain/Authentication.elm @@ -157,7 +157,7 @@ update msg model = ) ----------------------------------------- - -- DATA + -- Data ----------------------------------------- RetrieveEnclosedData -> ( model diff --git a/src/Applications/UI.elm b/src/Applications/UI.elm index 7f9222d2..8c430aae 100644 --- a/src/Applications/UI.elm +++ b/src/Applications/UI.elm @@ -7,13 +7,14 @@ import Browser.Navigation as Nav import Chunky exposing (..) import Color import Color.Ext as Color +import Common import Css exposing (url) import Css.Global import Html.Styled as Html exposing (Html, div, section, text, toUnstyled) import Html.Styled.Attributes exposing (id, style) import Html.Styled.Lazy as Lazy import Json.Encode as Encode -import Replying exposing (return) +import Replying exposing (do, return) import Return2 import Return3 import Sources @@ -97,10 +98,9 @@ update msg model = ) LoadHypaethralUserData json -> - ( { model | isAuthenticated = True, isLoading = False } + { model | isAuthenticated = True, isLoading = False } |> UI.UserData.importHypaethral json - , Cmd.none - ) + |> Replying.reducto update translateReply ToggleLoadingScreen On -> ( { model | isLoading = True } @@ -155,9 +155,15 @@ update msg model = Core.ProcessSources -> ( model - , [ ( "origin", Encode.string "TODO" ) - , ( "sources", Encode.list Sources.Encoding.encode model.sources.collection ) - , ( "tracks", Encode.list Tracks.Encoding.encodeTrack [] ) + , [ ( "origin" + , Encode.string (Common.urlOrigin model.url) + ) + , ( "sources" + , Encode.list Sources.Encoding.encode model.sources.collection + ) + , ( "tracks" + , Encode.list Tracks.Encoding.encodeTrack model.tracks.collection.untouched + ) ] |> Encode.object |> Alien.broadcast Alien.ProcessSources @@ -187,6 +193,7 @@ update msg model = ) SignOut -> + -- TODO: Reset user data ( { model | isAuthenticated = False } , Alien.SignOut |> Alien.trigger @@ -265,12 +272,7 @@ translateAlienEvent : Alien.Event -> Msg translateAlienEvent event = case Alien.tagFromString event.tag of Just Alien.AddTracks -> - let - dbg = - -- TODO - Debug.log "addTracks" event - in - Bypass + TracksMsg (UI.Tracks.Add event.data) Just Alien.FinishedProcessingSources -> SourcesMsg UI.Sources.FinishedProcessing @@ -362,22 +364,28 @@ defaultScreen model = ----------------------------------------- -- Main ----------------------------------------- - , case model.page of - Page.Index -> - model.tracks - |> Lazy.lazy UI.Tracks.view - |> Html.map TracksMsg - - Page.NotFound -> - text "Page not found." - - Page.Settings -> - UI.Settings.view model - - Page.Sources subPage -> - model.sources - |> Lazy.lazy2 UI.Sources.view subPage - |> Html.map SourcesMsg + , UI.Kit.vessel + [ model.tracks + |> Lazy.lazy UI.Tracks.view + |> Html.map TracksMsg + + -- Pages + -------- + , case model.page of + Page.Index -> + empty + + Page.NotFound -> + UI.Kit.receptacle [ text "Page not found." ] + + Page.Settings -> + UI.Settings.view model + + Page.Sources subPage -> + model.sources + |> Lazy.lazy2 UI.Sources.view subPage + |> Html.map SourcesMsg + ] ----------------------------------------- -- Controls diff --git a/src/Applications/UI/Kit.elm b/src/Applications/UI/Kit.elm index 3db360ae..e3d61055 100644 --- a/src/Applications/UI/Kit.elm +++ b/src/Applications/UI/Kit.elm @@ -1,4 +1,4 @@ -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) +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) import Chunky exposing (..) import Color @@ -315,6 +315,17 @@ logoBackdrop = [] +receptacle : List (Html msg) -> Html msg +receptacle = + chunk + [ T.absolute + , T.absolute__fill + , T.bg_white + , T.flex + , T.flex_column + ] + + select : (String -> msg) -> List (Html msg) -> Html msg select inputHandler options = brick @@ -375,6 +386,7 @@ vessel = , T.flex_column , T.flex_grow_1 , T.overflow_hidden + , T.relative , T.w_100 ] diff --git a/src/Applications/UI/Settings.elm b/src/Applications/UI/Settings.elm index 6eea97d4..ad7dbd73 100644 --- a/src/Applications/UI/Settings.elm +++ b/src/Applications/UI/Settings.elm @@ -17,7 +17,7 @@ import UI.Page as Page view : UI.Core.Model -> Html UI.Core.Msg view = - UI.Kit.vessel << index + UI.Kit.receptacle << index diff --git a/src/Applications/UI/Sources.elm b/src/Applications/UI/Sources.elm index 850c05ed..08e9ee20 100644 --- a/src/Applications/UI/Sources.elm +++ b/src/Applications/UI/Sources.elm @@ -112,7 +112,7 @@ update msg model = view : Sources.Page -> Model -> Html Msg view page model = - UI.Kit.vessel + UI.Kit.receptacle (case page of Index -> index model diff --git a/src/Applications/UI/Tracks.elm b/src/Applications/UI/Tracks.elm index afe4989c..5a925b30 100644 --- a/src/Applications/UI/Tracks.elm +++ b/src/Applications/UI/Tracks.elm @@ -1,12 +1,15 @@ -module UI.Tracks exposing (Model, Msg(..), initialModel, update, view) +module UI.Tracks exposing (Model, Msg(..), initialModel, makeParcel, resolveParcel, update, view) import Chunky exposing (..) import Html.Styled as Html exposing (Html, text) +import Json.Decode import Replying exposing (R3D3) import Return3 import Tracks exposing (..) +import Tracks.Collection exposing (..) +import Tracks.Encoding as Encoding import UI.Kit -import UI.Reply exposing (Reply) +import UI.Reply exposing (Reply(..)) @@ -15,12 +18,28 @@ import UI.Reply exposing (Reply) type alias Model = { collection : Collection + , enabledSourceIds : List String + , favourites : List Favourite + , favouritesOnly : Bool + , nowPlaying : Maybe IdentifiedTrack + , searchResults : Maybe (List String) + , searchTerm : Maybe String + , sortBy : SortBy + , sortDirection : SortDirection } initialModel : Model initialModel = { collection = emptyCollection + , enabledSourceIds = [] + , favourites = [] + , favouritesOnly = False + , nowPlaying = Nothing + , searchResults = Nothing + , searchTerm = Nothing + , sortBy = Artist + , sortDirection = Asc } @@ -30,6 +49,13 @@ initialModel = type Msg = Bypass + ----------------------------------------- + -- Collection, Pt. 1 + ----------------------------------------- + ----------------------------------------- + -- Collection, Pt. 2 + ----------------------------------------- + | Add Json.Decode.Value update : Msg -> Model -> R3D3 Model Msg Reply @@ -38,6 +64,61 @@ update msg model = Bypass -> Return3.withNothing model + ----------------------------------------- + -- Collection, Pt. 1 + ----------------------------------------- + ----------------------------------------- + -- Collection, Pt. 2 + ----------------------------------------- + -- # Add + -- > Add tracks to the collection. + -- + Add json -> + let + tracks = + json + |> Json.Decode.decodeValue (Json.Decode.list Encoding.trackDecoder) + |> Result.withDefault [] + in + model + |> makeParcel + |> add tracks + |> resolveParcel model + + + +-- 📣 ░░ PARCEL + + +makeParcel : Model -> Parcel +makeParcel model = + ( { enabledSourceIds = model.enabledSourceIds + , favourites = model.favourites + , favouritesOnly = model.favouritesOnly + , nowPlaying = model.nowPlaying + , searchResults = model.searchResults + , sortBy = model.sortBy + , sortDirection = model.sortDirection + } + , model.collection + ) + + +resolveParcel : Model -> Parcel -> R3D3 Model Msg Reply +resolveParcel model ( _, newCollection ) = + let + modelWithNewCollection = + { model | collection = newCollection } + in + if model.collection.untouched /= newCollection.untouched then + ( modelWithNewCollection + , Cmd.none + , Just [ SaveHypaethralUserData ] + ) + + else + Return3.withNothing modelWithNewCollection + -- 🗺 @@ -45,4 +126,8 @@ update msg model = view : Model -> Html Msg view model = - UI.Kit.vessel [] + raw + (List.map + (\t -> text t.tags.title) + model.collection.untouched + ) diff --git a/src/Applications/UI/UserData.elm b/src/Applications/UI/UserData.elm index d31c6e28..2d394d20 100644 --- a/src/Applications/UI/UserData.elm +++ b/src/Applications/UI/UserData.elm @@ -1,4 +1,4 @@ -module UI.UserData exposing (HypaethralBundle, exportHypaethral, importHypaethral) +module UI.UserData exposing (exportHypaethral, importHypaethral) {-| Import user data into or export user data from the UI.Core.Model -} @@ -6,9 +6,15 @@ module UI.UserData exposing (HypaethralBundle, exportHypaethral, importHypaethra import Authentication exposing (..) import Json.Decode as Decode import Json.Encode as Encode +import Replying exposing (R3D3) import Sources.Encoding as Sources +import Tracks exposing (emptyCollection) +import Tracks.Collection as Tracks +import Tracks.Encoding as Tracks import UI.Core -import UI.Sources +import UI.Reply as UI +import UI.Sources as Sources +import UI.Tracks as Tracks @@ -17,35 +23,83 @@ import UI.Sources ----------------------------------------- -type alias HypaethralBundle = - ( HypaethralUserData, Decode.Value ) - - -importHypaethral : Decode.Value -> UI.Core.Model -> UI.Core.Model +importHypaethral : Decode.Value -> UI.Core.Model -> R3D3 UI.Core.Model UI.Core.Msg UI.Reply importHypaethral value model = let data = Result.withDefault emptyHypaethralUserData (decode value) - bundle = - ( data - , Encode.null - ) + ( sourcesModel, sourcesCmd, sourcesReply ) = + importSources model.sources data + + ( tracksModel, tracksCmd, tracksReply ) = + importTracks model.tracks data in - { model | sources = importSources model.sources bundle } + ( { model + | sources = sourcesModel + , tracks = tracksModel + } + , Cmd.batch + [ Cmd.map UI.Core.SourcesMsg sourcesCmd + , Cmd.map UI.Core.TracksMsg tracksCmd + ] + , mergeReplies + [ sourcesReply + , tracksReply + ] + ) + + +mergeReplies : List (Maybe (List UI.Reply)) -> Maybe (List UI.Reply) +mergeReplies list = + list + |> List.foldl + (\maybeReply replies -> + case maybeReply of + Just r -> + replies ++ r + + Nothing -> + replies + ) + [] + |> Just --- 📭 ░░ IMPORTING HYPAETHRAL +-- ░░ IMPORTING HYPAETHRAL -importSources : UI.Sources.Model -> HypaethralBundle -> UI.Sources.Model -importSources model ( data, _ ) = - { model | collection = Maybe.withDefault [] data.sources } +importSources : Sources.Model -> HypaethralUserData -> R3D3 Sources.Model Sources.Msg UI.Reply +importSources model data = + ( { model + | collection = Maybe.withDefault [] data.sources + } + , Cmd.none + , Nothing + ) + + +importTracks : Tracks.Model -> HypaethralUserData -> R3D3 Tracks.Model Tracks.Msg UI.Reply +importTracks model data = + let + tracks = + Maybe.withDefault [] data.tracks + + adjustedModel = + { model + | collection = { emptyCollection | untouched = tracks } + , favourites = Maybe.withDefault [] data.favourites + } + in + adjustedModel + |> Tracks.makeParcel + |> Tracks.identify + |> Tracks.resolveParcel adjustedModel --- 📭 ░░ DECODING +-- ░░ DECODING decode : Decode.Value -> Result Decode.Error HypaethralUserData @@ -55,18 +109,23 @@ decode = decoder : Decode.Decoder HypaethralUserData decoder = - Decode.map + Decode.map3 HypaethralUserData + (Decode.maybe <| Decode.field "favourites" <| Decode.list Tracks.favouriteDecoder) (Decode.maybe <| Decode.field "sources" <| Decode.list Sources.decoder) + (Decode.maybe <| Decode.field "tracks" <| Decode.list Tracks.trackDecoder) --- 📭 ░░ FALLBACKS +-- ░░ FALLBACKS emptyHypaethralUserData : HypaethralUserData emptyHypaethralUserData = - { sources = Nothing } + { favourites = Nothing + , sources = Nothing + , tracks = Nothing + } @@ -81,10 +140,13 @@ exportHypaethral = --- 📮 ░░ ENCODING +-- ░░ ENCODING encode : UI.Core.Model -> Encode.Value encode model = Encode.object - [ ( "sources", Encode.list Sources.encode model.sources.collection ) ] + [ ( "favourites", Encode.list Tracks.encodeFavourite model.tracks.favourites ) + , ( "sources", Encode.list Sources.encode model.sources.collection ) + , ( "tracks", Encode.list Tracks.encodeTrack model.tracks.collection.untouched ) + ] diff --git a/src/Library/Authentication.elm b/src/Library/Authentication.elm index 755c3162..f44ec152 100644 --- a/src/Library/Authentication.elm +++ b/src/Library/Authentication.elm @@ -1,6 +1,7 @@ module Authentication exposing (EnclosedUserData, HypaethralUserData, Method(..), methodFromString, methodToString) import Sources +import Tracks @@ -16,7 +17,9 @@ type alias EnclosedUserData = type alias HypaethralUserData = - { sources : Maybe (List Sources.Source) + { favourites : Maybe (List Tracks.Favourite) + , sources : Maybe (List Sources.Source) + , tracks : Maybe (List Tracks.Track) } diff --git a/src/Library/Common.elm b/src/Library/Common.elm new file mode 100644 index 00000000..a41ca2d0 --- /dev/null +++ b/src/Library/Common.elm @@ -0,0 +1,26 @@ +module Common exposing (urlOrigin) + +import Url exposing (Protocol(..), Url) + + + +-- 🔱 + + +urlOrigin : Url -> String +urlOrigin { host, port_, protocol } = + let + scheme = + case protocol of + Http -> + "http://" + + Https -> + "https://" + + thePort = + port_ + |> Maybe.map (String.fromInt >> (++) ":") + |> Maybe.withDefault "" + in + scheme ++ host ++ thePort diff --git a/src/Library/Replying.elm b/src/Library/Replying.elm index e69882eb..8e131c89 100644 --- a/src/Library/Replying.elm +++ b/src/Library/Replying.elm @@ -1,4 +1,4 @@ -module Replying exposing (R3D3, do, return, updateChild) +module Replying exposing (R3D3, Updator, do, reducto, return, updateChild) import Return3 import Task @@ -12,6 +12,10 @@ type alias R3D3 model msg reply = ( model, Cmd msg, Maybe (List reply) ) +type alias Updator msg model = + msg -> model -> ( model, Cmd msg ) + + -- 🔱 @@ -46,6 +50,16 @@ return model msg = ( model, msg ) +{-| Reduce a `R3D3` to a `R2D2`. +-} +reducto : Updator msg model -> (reply -> msg) -> R3D3 model msg reply -> ( model, Cmd msg ) +reducto updator translator ( model, cmd, maybeReplies ) = + maybeReplies + |> Maybe.withDefault [] + |> List.map translator + |> List.foldl (andThenUpdate updator) ( model, cmd ) + + -- 🔱 ░░ TASKS @@ -61,20 +75,8 @@ do msg = ----------------------------------------- -type alias Updator msg model = - msg -> model -> ( model, Cmd msg ) - - andThenUpdate : Updator msg model -> msg -> ( model, Cmd msg ) -> ( model, Cmd msg ) andThenUpdate updator msg ( model, cmd ) = model |> updator msg |> Tuple.mapSecond (\c -> Cmd.batch [ cmd, c ]) - - -reducto : Updator msg model -> (reply -> msg) -> R3D3 model msg reply -> ( model, Cmd msg ) -reducto updator translator ( model, cmd, maybeReplies ) = - maybeReplies - |> Maybe.withDefault [] - |> List.map translator - |> List.foldl (andThenUpdate updator) ( model, cmd ) diff --git a/src/Library/Tracks.elm b/src/Library/Tracks.elm index ca9aeed2..ad4259d7 100644 --- a/src/Library/Tracks.elm +++ b/src/Library/Tracks.elm @@ -1,4 +1,4 @@ -module Tracks exposing (Collection, Favourite, IdentifiedTrack, Identifiers, Parcel, SortBy(..), SortDirection(..), Tags, Track, emptyCollection, emptyIdentifiedTrack, emptyTags, emptyTrack, makeTrack, missingId) +module Tracks exposing (Collection, CollectionDependencies, Favourite, IdentifiedTrack, Identifiers, Parcel, SortBy(..), SortDirection(..), Tags, Track, emptyCollection, emptyIdentifiedTrack, emptyTags, emptyTrack, makeTrack, missingId) import Base64 import Bytes.Encode @@ -81,19 +81,19 @@ type alias Collection = } +type alias CollectionDependencies = + { enabledSourceIds : List String + , favourites : List Favourite + , favouritesOnly : Bool + , nowPlaying : Maybe IdentifiedTrack + , searchResults : Maybe (List String) + , sortBy : SortBy + , sortDirection : SortDirection + } + + type alias Parcel = - ( -- Things I need to make a proper collection: - { enabledSourceIds : List String - , favourites : List Favourite - , favouritesOnly : Bool - , nowPlaying : Maybe IdentifiedTrack - , searchResults : Maybe (List String) - , sortBy : SortBy - , sortDirection : SortDirection - } - -- The collection itself: - , Collection - ) + ( CollectionDependencies, Collection ) diff --git a/src/Library/Tracks/Collection.elm b/src/Library/Tracks/Collection.elm new file mode 100644 index 00000000..1ca80b5e --- /dev/null +++ b/src/Library/Tracks/Collection.elm @@ -0,0 +1,47 @@ +module Tracks.Collection exposing (add, arrange, harvest, identify, map) + +import Flip exposing (flip) +import Tracks exposing (..) +import Tracks.Collection.Internal as Internal + + + +-- 🔱 + + +identify : Parcel -> Parcel +identify = + Internal.identify >> Internal.arrange >> Internal.harvest + + +arrange : Parcel -> Parcel +arrange = + Internal.arrange >> Internal.harvest + + +harvest : Parcel -> Parcel +harvest = + Internal.harvest + + +map : (List IdentifiedTrack -> List IdentifiedTrack) -> Parcel -> Parcel +map fn ( model, collection ) = + ( model + , { collection + | identified = fn collection.identified + , arranged = fn collection.arranged + , harvested = fn collection.harvested + } + ) + + + +-- ⚗️ + + +add : List Track -> Parcel -> Parcel +add tracks ( deps, { untouched } ) = + identify + ( deps + , { emptyCollection | untouched = untouched ++ tracks } + ) diff --git a/src/Library/Tracks/Collection/Internal.elm b/src/Library/Tracks/Collection/Internal.elm index d6b38b4a..26ac836f 100644 --- a/src/Library/Tracks/Collection/Internal.elm +++ b/src/Library/Tracks/Collection/Internal.elm @@ -1,13 +1,9 @@ module Tracks.Collection.Internal exposing ( arrange - , build - , buildf , harvest , identify - , initialize ) -import Flip exposing (flip) import Tracks exposing (Parcel, Track) import Tracks.Collection.Internal.Arrange as Internal import Tracks.Collection.Internal.Harvest as Internal @@ -18,31 +14,6 @@ import Tracks.Collection.Internal.Identify as Internal -- 🔱 -build : List Track -> Parcel -> Parcel -build tracks = - initialize tracks >> identify >> arrange >> harvest - - -buildf : Parcel -> List Track -> Parcel -buildf = - flip build - - - --- INITIALIZE - - -initialize : List Track -> Parcel -> Parcel -initialize tracks ( dependencies, collection ) = - ( dependencies - , { collection | untouched = tracks } - ) - - - --- RE-EXPORT - - identify : Parcel -> Parcel identify = Internal.identify -- 2.51.2