diff --git a/elm.json b/elm.json index 2add2916..aaf6b16b 100644 --- a/elm.json +++ b/elm.json @@ -8,6 +8,7 @@ "dependencies": { "direct": { "Chadtech/return": "1.0.2", + "NoRedInk/elm-json-decode-pipeline": "1.0.0", "avh4/elm-color": "1.0.0", "danfishgold/base64-bytes": "1.0.1", "danmarcab/material-icons": "1.0.0", diff --git a/src/Applications/Brain.elm b/src/Applications/Brain.elm index f630c542..b193025f 100644 --- a/src/Applications/Brain.elm +++ b/src/Applications/Brain.elm @@ -1,15 +1,20 @@ module Brain exposing (main) import Alien +import Authentication exposing (HypaethralUserData) import Brain.Authentication as Authentication import Brain.Core exposing (..) import Brain.Ports import Brain.Reply as Reply exposing (Reply(..)) import Brain.Sources.Processing as Processing import Brain.Sources.Processing.Common as Processing -import Json.Decode +import Json.Decode as Json +import Json.Decode.Pipeline exposing (optional) +import Json.Encode import Replying exposing (return) +import Sources.Encoding as Sources import Sources.Processing.Encoding as Processing +import Tracks.Encoding as Tracks @@ -35,6 +40,7 @@ init flags = -- Initial model ----------------------------------------- { authentication = Authentication.initialModel + , hypaethralUserData = Authentication.emptyHypaethralUserData , processing = Processing.initialModel } ----------------------------------------- @@ -67,25 +73,52 @@ update msg model = ----------------------------------------- -- Children ----------------------------------------- + AuthenticationMsg Authentication.PerformSignOut -> + -- When signing out, remove all traces of the user's data. + updateAuthentication + { model | hypaethralUserData = Authentication.emptyHypaethralUserData } + Authentication.PerformSignOut + AuthenticationMsg sub -> - updateChild - { mapCmd = AuthenticationMsg - , mapModel = \child -> { model | authentication = child } - , update = Authentication.update - } - { model = model.authentication - , msg = sub - } + updateAuthentication model sub ProcessingMsg sub -> - updateChild - { mapCmd = ProcessingMsg - , mapModel = \child -> { model | processing = child } - , update = Processing.update - } - { model = model.processing - , msg = sub - } + updateProcessing model sub + + ----------------------------------------- + -- User data + ----------------------------------------- + LoadHypaethralUserData value -> + let + decodedData = + value + |> Authentication.decode + |> Result.withDefault model.hypaethralUserData + in + ( { model | hypaethralUserData = decodedData } + , Brain.Ports.toUI (Alien.broadcast Alien.LoadHypaethralUserData value) + ) + + SaveFavourites value -> + value + |> Json.decodeValue (Json.list Tracks.favouriteDecoder) + |> Result.withDefault model.hypaethralUserData.favourites + |> hypaethralLenses.setFavourites model + |> saveHypaethralData + + SaveSources value -> + value + |> Json.decodeValue (Json.list Sources.decoder) + |> Result.withDefault model.hypaethralUserData.sources + |> hypaethralLenses.setSources model + |> saveHypaethralData + + SaveTracks value -> + value + |> Json.decodeValue (Json.list Tracks.trackDecoder) + |> Result.withDefault model.hypaethralUserData.tracks + |> hypaethralLenses.setTracks model + |> saveHypaethralData @@ -101,6 +134,9 @@ translateReply reply = ----------------------------------------- -- To UI ----------------------------------------- + GiveUI Alien.LoadHypaethralUserData data -> + LoadHypaethralUserData data + GiveUI tag data -> NotifyUI (Alien.broadcast tag data) @@ -112,6 +148,66 @@ updateChild = Replying.updateChild update translateReply +updateAuthentication : Model -> Authentication.Msg -> ( Model, Cmd Msg ) +updateAuthentication model sub = + updateChild + { mapCmd = AuthenticationMsg + , mapModel = \child -> { model | authentication = child } + , update = Authentication.update + } + { model = model.authentication + , msg = sub + } + + +updateProcessing : Model -> Processing.Msg -> ( Model, Cmd Msg ) +updateProcessing model sub = + updateChild + { mapCmd = ProcessingMsg + , mapModel = \child -> { model | processing = child } + , update = Processing.update + } + { model = model.processing + , msg = sub + } + + + +-- 📣 ░░ USER DATA + + +hypaethralLenses = + { setFavourites = makeHypaethralLens (\h f -> { h | favourites = f }) + , setSources = makeHypaethralLens (\h s -> { h | sources = s }) + , setTracks = makeHypaethralLens (\h t -> { h | tracks = t }) + } + + +makeHypaethralLens : (HypaethralUserData -> a -> HypaethralUserData) -> Model -> a -> Model +makeHypaethralLens setter model value = + let + h = + model.hypaethralUserData + in + { model | hypaethralUserData = setter h value } + + +saveHypaethralData : Model -> ( Model, Cmd Msg ) +saveHypaethralData model = + let + { favourites, sources, tracks } = + model.hypaethralUserData + in + [ ( "favourites", Json.Encode.list Tracks.encodeFavourite favourites ) + , ( "sources", Json.Encode.list Sources.encode sources ) + , ( "tracks", Json.Encode.list Tracks.encodeTrack tracks ) + ] + |> Json.Encode.object + |> Authentication.SaveHypaethralData + |> AuthenticationMsg + |> (\msg -> update msg model) + + -- 📰 @@ -141,7 +237,7 @@ translateAlienEvent event = Just Alien.ProcessSources -> -- Only proceed to the processing if we got all the necessary data, -- otherwise report an error in the UI. - case Json.Decode.decodeValue Processing.argumentsDecoder event.data of + case Json.decodeValue Processing.argumentsDecoder event.data of Ok arguments -> arguments |> Processing.Process @@ -149,15 +245,21 @@ translateAlienEvent event = Err error -> error - |> Json.Decode.errorToString + |> Json.errorToString |> Alien.report Alien.ReportGenericError |> NotifyUI Just Alien.SaveEnclosedUserData -> AuthenticationMsg (Authentication.SaveEnclosedData event.data) - Just Alien.SaveHypaethralUserData -> - AuthenticationMsg (Authentication.SaveHypaethralData event.data) + Just Alien.SaveFavourites -> + SaveFavourites event.data + + Just Alien.SaveSources -> + SaveSources event.data + + Just Alien.SaveTracks -> + SaveTracks event.data Just Alien.SignIn -> AuthenticationMsg (Authentication.PerformSignIn event.data) diff --git a/src/Applications/Brain/Authentication.elm b/src/Applications/Brain/Authentication.elm index a4cea465..3dfe0c9e 100644 --- a/src/Applications/Brain/Authentication.elm +++ b/src/Applications/Brain/Authentication.elm @@ -16,7 +16,7 @@ Methods: Steps: 1. Get active method (if none, we're signed out) - 2. Get unrestricted data + 2. Get hypaethral data -} diff --git a/src/Applications/Brain/Core.elm b/src/Applications/Brain/Core.elm index 582e3e7f..f5d861e8 100644 --- a/src/Applications/Brain/Core.elm +++ b/src/Applications/Brain/Core.elm @@ -1,8 +1,10 @@ module Brain.Core exposing (Flags, Model, Msg(..)) import Alien +import Authentication import Brain.Authentication as Authentication import Brain.Sources.Processing.Common as Processing +import Json.Decode as Json @@ -19,6 +21,7 @@ type alias Flags = type alias Model = { authentication : Authentication.Model + , hypaethralUserData : Authentication.HypaethralUserData , processing : Processing.Model } @@ -35,3 +38,10 @@ type Msg ----------------------------------------- | AuthenticationMsg Authentication.Msg | ProcessingMsg Processing.Msg + ----------------------------------------- + -- User data + ----------------------------------------- + | LoadHypaethralUserData Json.Value + | SaveFavourites Json.Value + | SaveSources Json.Value + | SaveTracks Json.Value diff --git a/src/Applications/UI.elm b/src/Applications/UI.elm index d2aabe2f..60de7fe1 100644 --- a/src/Applications/UI.elm +++ b/src/Applications/UI.elm @@ -122,39 +122,6 @@ update msg model = , Cmd.none ) - ----------------------------------------- - -- Children - ----------------------------------------- - BackdropMsg sub -> - updateChild - { mapCmd = BackdropMsg - , mapModel = \child -> { model | backdrop = child } - , update = UI.Backdrop.update - } - { model = model.backdrop - , msg = sub - } - - SourcesMsg sub -> - updateChild - { mapCmd = SourcesMsg - , mapModel = \child -> { model | sources = child } - , update = UI.Sources.update - } - { model = model.sources - , msg = sub - } - - TracksMsg sub -> - updateChild - { mapCmd = TracksMsg - , mapModel = \child -> { model | tracks = child } - , update = UI.Tracks.update - } - { model = model.tracks - , msg = sub - } - ----------------------------------------- -- Brain ----------------------------------------- @@ -185,13 +152,26 @@ update msg model = , Cmd.none ) - Core.SaveHypaethralUserData -> - ( model - , model - |> UI.UserData.exportHypaethral - |> Alien.broadcast Alien.SaveHypaethralUserData + Core.SaveFavourites -> + model + |> UI.UserData.encodedFavourites + |> Alien.broadcast Alien.SaveFavourites |> Ports.toBrain - ) + |> Return2.withModel model + + Core.SaveSources -> + model + |> UI.UserData.encodedSources + |> Alien.broadcast Alien.SaveSources + |> Ports.toBrain + |> Return2.withModel model + + Core.SaveTracks -> + model + |> UI.UserData.encodedTracks + |> Alien.broadcast Alien.SaveTracks + |> Ports.toBrain + |> Return2.withModel model SignIn method -> ( model @@ -210,6 +190,39 @@ update msg model = |> Ports.toBrain ) + ----------------------------------------- + -- Children + ----------------------------------------- + BackdropMsg sub -> + updateChild + { mapCmd = BackdropMsg + , mapModel = \child -> { model | backdrop = child } + , update = UI.Backdrop.update + } + { model = model.backdrop + , msg = sub + } + + SourcesMsg sub -> + updateChild + { mapCmd = SourcesMsg + , mapModel = \child -> { model | sources = child } + , update = UI.Sources.update + } + { model = model.sources + , msg = sub + } + + TracksMsg sub -> + updateChild + { mapCmd = TracksMsg + , mapModel = \child -> { model | tracks = child } + , update = UI.Tracks.update + } + { model = model.tracks + , msg = sub + } + ----------------------------------------- -- URL ----------------------------------------- @@ -261,8 +274,14 @@ translateReply reply = Reply.SaveEnclosedUserData -> Core.SaveEnclosedUserData - Reply.SaveHypaethralUserData -> - Core.SaveHypaethralUserData + Reply.SaveFavourites -> + Core.SaveFavourites + + Reply.SaveSources -> + Core.SaveSources + + Reply.SaveTracks -> + Core.SaveTracks updateChild = diff --git a/src/Applications/UI/Core.elm b/src/Applications/UI/Core.elm index 1ed78798..e50b6627 100644 --- a/src/Applications/UI/Core.elm +++ b/src/Applications/UI/Core.elm @@ -51,21 +51,23 @@ type Msg | LoadHypaethralUserData Json.Value | SetCurrentTime Time.Posix | ToggleLoadingScreen Switch - ----------------------------------------- - -- Children - ----------------------------------------- - | BackdropMsg UI.Backdrop.Msg - | SourcesMsg UI.Sources.Msg - | TracksMsg UI.Tracks.Msg ----------------------------------------- -- Brain ----------------------------------------- | NotifyBrain Alien.Event | ProcessSources | SaveEnclosedUserData - | SaveHypaethralUserData + | SaveFavourites + | SaveSources + | SaveTracks | SignIn Authentication.Method | SignOut + ----------------------------------------- + -- Children + ----------------------------------------- + | BackdropMsg UI.Backdrop.Msg + | SourcesMsg UI.Sources.Msg + | TracksMsg UI.Tracks.Msg ----------------------------------------- -- URL ----------------------------------------- diff --git a/src/Applications/UI/Reply.elm b/src/Applications/UI/Reply.elm index 12384f5b..97020e1c 100644 --- a/src/Applications/UI/Reply.elm +++ b/src/Applications/UI/Reply.elm @@ -1,5 +1,7 @@ module UI.Reply exposing (Reply(..)) +import Alien +import Json.Decode as Json import Sources exposing (Source) import UI.Page exposing (Page) @@ -14,4 +16,6 @@ type Reply | GoToPage Page | ProcessSources | SaveEnclosedUserData - | SaveHypaethralUserData + | SaveFavourites + | SaveSources + | SaveTracks diff --git a/src/Applications/UI/Sources.elm b/src/Applications/UI/Sources.elm index afc97aee..c6fe55e2 100644 --- a/src/Applications/UI/Sources.elm +++ b/src/Applications/UI/Sources.elm @@ -51,15 +51,15 @@ type Msg = Bypass | FinishedProcessing | Process + ----------------------------------------- + -- Children + ----------------------------------------- + | FormMsg Form.Msg ----------------------------------------- -- Collection ----------------------------------------- | AddToCollection Source | RemoveFromCollection String - ----------------------------------------- - -- Children - ----------------------------------------- - | FormMsg Form.Msg update : Msg -> Model -> R3D3 Model Msg Reply @@ -80,6 +80,15 @@ update msg model = , Just [ UI.Reply.ProcessSources ] ) + ----------------------------------------- + -- Children + ----------------------------------------- + FormMsg sub -> + model.form + |> Form.update sub + |> Return3.mapModel (\f -> { model | form = f }) + |> Return3.mapCmd FormMsg + ----------------------------------------- -- Collection ----------------------------------------- @@ -90,23 +99,14 @@ update msg model = |> List.append model.collection |> (\c -> { model | collection = c }) |> Return2.withNoCmd - |> Return3.withReply [ UI.Reply.SaveHypaethralUserData ] + |> Return3.withReply [ UI.Reply.SaveSources ] RemoveFromCollection sourceId -> model.collection |> List.filter (.id >> (/=) sourceId) |> (\c -> { model | collection = c }) |> Return2.withNoCmd - |> Return3.withReply [ UI.Reply.SaveHypaethralUserData ] - - ----------------------------------------- - -- Children - ----------------------------------------- - FormMsg sub -> - model.form - |> Form.update sub - |> Return3.mapModel (\f -> { model | form = f }) - |> Return3.mapCmd FormMsg + |> Return3.withReply [ UI.Reply.SaveSources ] diff --git a/src/Applications/UI/Tracks.elm b/src/Applications/UI/Tracks.elm index 39dd8902..0bf60bb0 100644 --- a/src/Applications/UI/Tracks.elm +++ b/src/Applications/UI/Tracks.elm @@ -148,7 +148,7 @@ resolveParcel model ( _, newCollection ) = if model.collection.untouched /= newCollection.untouched then ( modelWithNewCollection , Cmd.none - , Just [ SaveHypaethralUserData ] + , Just [ SaveTracks ] ) else diff --git a/src/Applications/UI/UserData.elm b/src/Applications/UI/UserData.elm index 2d394d20..2c7887e5 100644 --- a/src/Applications/UI/UserData.elm +++ b/src/Applications/UI/UserData.elm @@ -1,11 +1,9 @@ -module UI.UserData exposing (exportHypaethral, importHypaethral) - -{-| Import user data into or export user data from the UI.Core.Model --} +module UI.UserData exposing (encodedFavourites, encodedSources, encodedTracks, importHypaethral) import Authentication exposing (..) -import Json.Decode as Decode -import Json.Encode as Encode +import Json.Decode as Json +import Json.Decode.Pipeline exposing (..) +import Json.Encode import Replying exposing (R3D3) import Sources.Encoding as Sources import Tracks exposing (emptyCollection) @@ -18,12 +16,25 @@ import UI.Tracks as Tracks ------------------------------------------ --- 📭 ------------------------------------------ +-- 🔱 + + +encodedFavourites : UI.Core.Model -> Json.Value +encodedFavourites { tracks } = + Json.Encode.list Tracks.encodeFavourite tracks.favourites + +encodedSources : UI.Core.Model -> Json.Value +encodedSources { sources } = + Json.Encode.list Sources.encode sources.collection -importHypaethral : Decode.Value -> UI.Core.Model -> R3D3 UI.Core.Model UI.Core.Msg UI.Reply + +encodedTracks : UI.Core.Model -> Json.Value +encodedTracks { tracks } = + Json.Encode.list Tracks.encodeTrack tracks.collection.untouched + + +importHypaethral : Json.Value -> UI.Core.Model -> R3D3 UI.Core.Model UI.Core.Msg UI.Reply importHypaethral value model = let data = @@ -50,30 +61,14 @@ importHypaethral value model = ) -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 +-- ㊙️ importSources : Sources.Model -> HypaethralUserData -> R3D3 Sources.Model Sources.Msg UI.Reply importSources model data = ( { model - | collection = Maybe.withDefault [] data.sources + | collection = data.sources } , Cmd.none , Nothing @@ -83,13 +78,10 @@ importSources model data = 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 + | collection = { emptyCollection | untouched = data.tracks } + , favourites = data.favourites } in adjustedModel @@ -98,55 +90,17 @@ importTracks model data = |> Tracks.resolveParcel adjustedModel +mergeReplies : List (Maybe (List UI.Reply)) -> Maybe (List UI.Reply) +mergeReplies list = + list + |> List.foldl + (\maybeReply replies -> + case maybeReply of + Just r -> + replies ++ r --- ░░ DECODING - - -decode : Decode.Value -> Result Decode.Error HypaethralUserData -decode = - Decode.decodeValue decoder - - -decoder : Decode.Decoder HypaethralUserData -decoder = - 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 - - -emptyHypaethralUserData : HypaethralUserData -emptyHypaethralUserData = - { favourites = Nothing - , sources = Nothing - , tracks = Nothing - } - - - ------------------------------------------ --- 📮 ------------------------------------------ - - -exportHypaethral : UI.Core.Model -> Encode.Value -exportHypaethral = - encode - - - --- ░░ ENCODING - - -encode : UI.Core.Model -> Encode.Value -encode model = - Encode.object - [ ( "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 ) - ] + Nothing -> + replies + ) + [] + |> Just diff --git a/src/Library/Alien.elm b/src/Library/Alien.elm index 8ad9774a..640b029b 100644 --- a/src/Library/Alien.elm +++ b/src/Library/Alien.elm @@ -25,7 +25,9 @@ type Tag -- from UI | ProcessSources | SaveEnclosedUserData - | SaveHypaethralUserData + | SaveFavourites + | SaveSources + | SaveTracks | SignIn | SignOut -- to UI @@ -89,8 +91,14 @@ tagToString tag = SaveEnclosedUserData -> "SAVE_ENCLOSED_USER_DATA" - SaveHypaethralUserData -> - "SAVE_HYPAETHRAL_USER_DATA" + SaveFavourites -> + "SAVE_FAVOURITES" + + SaveSources -> + "SAVE_SOURCES" + + SaveTracks -> + "SAVE_TRACKS" SignIn -> "SIGN_IN" @@ -150,8 +158,14 @@ tagFromString string = "SAVE_ENCLOSED_USER_DATA" -> Just SaveEnclosedUserData - "SAVE_HYPAETHRAL_USER_DATA" -> - Just SaveHypaethralUserData + "SAVE_FAVOURITES" -> + Just SaveFavourites + + "SAVE_SOURCES" -> + Just SaveSources + + "SAVE_TRACKS" -> + Just SaveTracks "SIGN_IN" -> Just SignIn diff --git a/src/Library/Authentication.elm b/src/Library/Authentication.elm index f44ec152..258dbe17 100644 --- a/src/Library/Authentication.elm +++ b/src/Library/Authentication.elm @@ -1,7 +1,11 @@ -module Authentication exposing (EnclosedUserData, HypaethralUserData, Method(..), methodFromString, methodToString) +module Authentication exposing (EnclosedUserData, HypaethralUserData, Method(..), decode, decoder, emptyHypaethralUserData, methodFromString, methodToString) +import Json.Decode as Json +import Json.Decode.Pipeline exposing (optional) import Sources +import Sources.Encoding as Sources import Tracks +import Tracks.Encoding as Tracks @@ -17,9 +21,9 @@ type alias EnclosedUserData = type alias HypaethralUserData = - { favourites : Maybe (List Tracks.Favourite) - , sources : Maybe (List Sources.Source) - , tracks : Maybe (List Tracks.Track) + { favourites : List Tracks.Favourite + , sources : List Sources.Source + , tracks : List Tracks.Track } @@ -27,6 +31,14 @@ type alias HypaethralUserData = -- 🔱 +emptyHypaethralUserData : HypaethralUserData +emptyHypaethralUserData = + { favourites = [] + , sources = [] + , tracks = [] + } + + methodToString : Method -> String methodToString method = case method of @@ -42,3 +54,20 @@ methodFromString string = _ -> Nothing + + + +-- 🔱 ░░ DECODING + + +decode : Json.Value -> Result Json.Error HypaethralUserData +decode = + Json.decodeValue decoder + + +decoder : Json.Decoder HypaethralUserData +decoder = + Json.succeed HypaethralUserData + |> optional "favourites" (Json.list Tracks.favouriteDecoder) [] + |> optional "sources" (Json.list Sources.decoder) [] + |> optional "tracks" (Json.list Tracks.trackDecoder) []