Add save/restore through the URL
This commit is contained in:
parent
275c1e45a1
commit
1685ffc736
GPG key ID:
A12F2C2FFDC3D847
9
elm.json
9
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": {
|
||||
|
|
|
|||
130
src/Main.elm
130
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
|
||||
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
|
||||
}
|
||||
|> withoutCmd
|
||||
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
|
||||
|> 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
|
||||
Loading…
Reference in a new issue