From 1685ffc7361a727e72ddea2d6214178a82fedf47 Mon Sep 17 00:00:00 2001 From: Emi Simpson Date: Thu, 6 Jul 2023 09:52:17 -0400 Subject: [PATCH] Add save/restore through the URL --- elm.json | 9 +++- src/Main.elm | 136 ++++++++++++++++++++++++++++++++++++++++----------- 2 files changed, 114 insertions(+), 31 deletions(-) diff --git a/elm.json b/elm.json index e66b72c..82b7279 100644 --- a/elm.json +++ b/elm.json @@ -6,6 +6,7 @@ "elm-version": "0.19.1", "dependencies": { "direct": { + "chelovek0v/bbase64": "1.0.1", "elm/browser": "1.0.2", "elm/core": "1.0.5", "elm/html": "1.0.0", @@ -14,13 +15,17 @@ "elm/url": "1.0.0", "elm-community/array-extra": "2.6.0", "elm-community/html-extra": "3.4.0", + "elm-community/list-extra": "8.7.0", "elm-community/maybe-extra": "5.3.0", - "elm-community/string-extra": "4.0.1" + "elm-community/string-extra": "4.0.1", + "elm-toulouse/cbor": "1.1.0" }, "indirect": { + "elm/bytes": "1.0.8", "elm/regex": "1.0.0", "elm/time": "1.0.0", - "elm/virtual-dom": "1.0.3" + "elm/virtual-dom": "1.0.3", + "elm-toulouse/float16": "1.0.1" } }, "test-dependencies": { diff --git a/src/Main.elm b/src/Main.elm index f257fe7..5158b92 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -6,10 +6,15 @@ import Stickers exposing (Sticker, StickerContent(..), viewSticker) import Array exposing (Array, get, set) import Array.Extra as Array +import Base64.Encode as B64E +import Base64.Decode as B64D import Browser import Browser.Dom exposing (focus, getViewport, Viewport) -import Browser.Navigation exposing (Key) +import Browser.Navigation exposing (Key, pushUrl) import Browser.Events exposing (onMouseMove, onMouseUp, onResize) +import Cbor exposing (CborItem(..)) +import Cbor.Encode as CE +import Cbor.Decode as CD import Html exposing (Attribute, button, div, h3, input, Html, section, text) import Html.Attributes exposing (class, disabled, id, style, value) import Html.Attributes.Extra as Attributes exposing (attributeIf) @@ -19,7 +24,10 @@ import Html.Events.Extra exposing (onEnter) import Html.Lazy exposing (lazy, lazy2) import Json.Decode as D import List exposing (map, singleton) +import List.Extra exposing (elemIndex, getAt) +import Maybe exposing (andThen) import Maybe.Extra exposing (isJust) +import Result exposing (toMaybe) import String exposing (fromInt, isEmpty) import String.Extra exposing (isBlank) import Svg exposing (path, Svg, svg) @@ -52,12 +60,10 @@ type alias Model = { columns: Array Column , heldTile: Maybe HeldTile , mousePos: (Int, Int) + , browserKey: Key } -type alias Column = - { name: String - , tiles: Array Tile - } +type alias Column = { tiles: Array Tile } type alias Tile = { text: String @@ -74,25 +80,17 @@ blankTile = { text = "", stickers = [] } init : () -> Url -> Key -> (Model, Cmd Msg) init flags url browserKey = - { columns = - [ { name = "Into" - , tiles = Array.empty - } - , { name = "Willing" - , tiles = Array.empty - } - , { name = "Maybe" - , tiles = Array.empty - } - , { name = "No" - , tiles = Array.empty - } - ] - |> Array.fromList - , mousePos = (200, 200) - , heldTile = Nothing - } - |> withoutCmd + let + m = + case load browserKey url of + Just model -> model + Nothing -> + { columns = Array.repeat 4 (Column Array.empty) + , mousePos = (200, 200) + , heldTile = Nothing + , browserKey = browserKey + } + in m |> withoutCmd subscriptions : Model -> Sub Msg subscriptions model = @@ -140,7 +138,7 @@ viewFloatyTile (mouseX, mouseY) { tile, hoveredColumnIndex } = viewHoverTile = div [id "hover-tile"] [] viewColumn : Maybe HeldTile -> Int -> Column -> Html Msg -viewColumn heldOverTile columnIndex {name, tiles} = +viewColumn heldOverTile columnIndex {tiles} = let isTileHeld = isJust heldOverTile tileCount = Array.length tiles @@ -163,11 +161,19 @@ viewColumn heldOverTile columnIndex {name, tiles} = ] ( ( h3 [] - [text name] + [text <| columnIndexToName columnIndex] ) :: tilesList ++ [ viewAddTile isTileHeld columnIndex tileCount ] ) +columnIndexToName : Int -> String +columnIndexToName i = case i of + 0 -> "Into" + 1 -> "Willing" + 2 -> "Maybe" + 3 -> "No" + _ -> "Too Many Columns" + viewTile : Bool -> Int -> Int -> Tile -> Html Msg viewTile isTileHeld columnIndex tileIndex tile = div @@ -313,7 +319,7 @@ update msg model = case Debug.log "UPDATE" msg of (modColumnInPage columnIndex << modTileInColumn tileIndex) (updateTileText newText) model - |> withoutCmd + |> withSaveCmd AddTile columnIndex -> modColumnInPage columnIndex addTileToColumn @@ -323,7 +329,7 @@ update msg model = case Debug.log "UPDATE" msg of modColumnInPage columnIndex (removeTileFromColumn tileIndex) model - |> withoutCmd + |> withSaveCmd HeldOverNewTile columnIndex tileIndex -> case model.heldTile of Nothing -> model |> withoutCmd Just oldHeldTileInfo -> @@ -374,4 +380,76 @@ update msg model = case Debug.log "UPDATE" msg of model in { modelWithTileInserted | heldTile = Nothing } - |> withoutCmd \ No newline at end of file + |> withSaveCmd + +withSaveCmd : Model -> (Model, Cmd Msg) +withSaveCmd model = (model, save model) + +andSaveCmd : (Model, Cmd Msg) -> (Model, Cmd Msg) +andSaveCmd (model, cmd) = (model, Cmd.batch [cmd, save model]) + +save : Model -> Cmd Msg +save model = + saveModel model + |> CE.encode + |> B64E.bytes + |> B64E.encode + |> (++) "#" + |> pushUrl model.browserKey + +load : Key -> Url -> Maybe Model +load key url = + url.fragment + |> andThen (B64D.decode B64D.bytes >> toMaybe) + |> andThen (CD.decode (loadModel key)) + + +saveModel : Model -> CE.Encoder +saveModel { columns } = + Array.toList columns + |> map saveColumn + |> CE.sequence + +array4 a b c d = Array.fromList [a, b, c, d] + +loadModel : Key -> CD.Decoder Model +loadModel key = + CD.map4 array4 loadColumn loadColumn loadColumn loadColumn + |> CD.map Model + |> CD.map ((|>) Nothing) + |> CD.map ((|>) (0, 0)) + |> CD.map ((|>) key) + +saveColumn : Column -> CE.Encoder +saveColumn { tiles } = CE.list saveTile (Array.toList tiles) + +loadColumn : CD.Decoder Column +loadColumn = + CD.list loadTile + |> CD.map Array.fromList + |> CD.map Column + +saveTile : Tile -> CE.Encoder +saveTile { text } = + case elemIndex text activities of + Just index -> CE.int index + Nothing -> CE.string text + +loadTile : CD.Decoder Tile +loadTile = + CD.any + |> CD.andThen loadTileInner + +loadTileInner : CborItem -> CD.Decoder Tile +loadTileInner item = + let + word = + case item of + CborInt i -> + case getAt i activities of + Just activity -> CD.succeed activity + Nothing -> CD.fail + CborString s -> CD.succeed s + _ -> CD.fail + in + CD.map (flip Tile []) word \ No newline at end of file