asonix/elm-in-action
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Part 3 complete

Browse source
This commit is contained in:
asonix 2022-10-17 18:38:57 -05:00
parent 568aab9a9f
commit 3bc94db825
10 changed files with 390 additions and 62 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.gitignore vendored
View file

@ -1,2 +1,3 @@
elm-stuff
app.js
node_modules

4
elm.json
View file

@ -12,13 +12,13 @@
"elm/html": "1.0.0",
"elm/http": "2.0.0",
"elm/json": "1.1.3",
"elm/random": "1.0.0"
"elm/random": "1.0.0",
"elm/url": "1.0.0"
},
"indirect": {
"elm/bytes": "1.0.8",
"elm/file": "1.0.5",
"elm/time": "1.0.0",
"elm/url": "1.0.0",
"elm/virtual-dom": "1.0.3"
}
},

5
index.html
View file

@ -39,10 +39,11 @@
<body>
<div id="app"></div>
<script src="http://elm-in-action.com/pasta.js"></script>
<script src="app.js"></script>
<script src="/app.js"></script>
<script>
const app = Elm.PhotoFolders.init({
const app = Elm.Main.init({
node: document.getElementById("app"),
flags: Pasta.version,
});
app.ports.setFilters.subscribe(function (options) {

49
package-lock.json generated Normal file
View file

@ -0,0 +1,49 @@
{
"name": "photo-groove",
"lockfileVersion": 2,
"requires": true,
"packages": {
"": {
"dependencies": {
"http-server-spa": "^1.3.0"
}
},
"node_modules/http-server-spa": {
"version": "1.3.0",
"resolved": "https://registry.npmjs.org/http-server-spa/-/http-server-spa-1.3.0.tgz",
"integrity": "sha512-NfXBksDzoiBOo1IrMDtxpKJ8FOHLqy0YdijYjqMoRcS7AWPf6MzhRvKe2KiXxENlqTRqkOH418SvbxC6GzG2TA==",
"dependencies": {
"mime": "^1.3.4"
},
"bin": {
"http-server-spa": "server.js"
}
},
"node_modules/mime": {
"version": "1.6.0",
"resolved": "https://registry.npmjs.org/mime/-/mime-1.6.0.tgz",
"integrity": "sha512-x0Vn8spI+wuJ1O6S7gnbaQg8Pxh4NNHb7KSINmEWKiPE4RKOplvijn+NkmYmmRgP68mc70j2EbeTFRsrswaQeg==",
"bin": {
"mime": "cli.js"
},
"engines": {
"node": ">=4"
}
}
},
"dependencies": {
"http-server-spa": {
"version": "1.3.0",
"resolved": "https://registry.npmjs.org/http-server-spa/-/http-server-spa-1.3.0.tgz",
"integrity": "sha512-NfXBksDzoiBOo1IrMDtxpKJ8FOHLqy0YdijYjqMoRcS7AWPf6MzhRvKe2KiXxENlqTRqkOH418SvbxC6GzG2TA==",
"requires": {
"mime": "^1.3.4"
}
},
"mime": {
"version": "1.6.0",
"resolved": "https://registry.npmjs.org/mime/-/mime-1.6.0.tgz",
"integrity": "sha512-x0Vn8spI+wuJ1O6S7gnbaQg8Pxh4NNHb7KSINmEWKiPE4RKOplvijn+NkmYmmRgP68mc70j2EbeTFRsrswaQeg=="
}
}
}

5
package.json Normal file
View file

@ -0,0 +1,5 @@
{
"dependencies": {
"http-server-spa": "^1.3.0"
}
}

239
src/Main.elm Normal file
View file

@ -0,0 +1,239 @@
module Main exposing (main)
import Browser exposing (Document)
import Browser.Navigation as Nav
import Html exposing (Html, a, footer, h1, li, nav, text, ul)
import Html.Attributes exposing (classList, href)
import Html.Lazy exposing (lazy)
import PhotoFolders as Folders
import PhotoGroove as Gallery
import Url exposing (Url)
import Url.Parser as Parser exposing ((</>), Parser, s)
type alias Model =
{ page : Page
, version : Float
, key : Nav.Key
}
type Page
= GalleryPage Gallery.Model
| FoldersPage Folders.Model
| NotFound
type Route
= Gallery
| Folders
| SelectedPhoto String
view : Model -> Document Msg
view model =
let
title =
case model.page of
FoldersPage _ ->
Folders.pageTitle
GalleryPage _ ->
Gallery.pageTitle
_ ->
"Not Found"
content =
case model.page of
FoldersPage folders ->
Folders.view folders
|> Html.map GotFoldersMsg
GalleryPage gallery ->
Gallery.view gallery
|> Html.map GotGalleryMsg
NotFound ->
text "Not Found"
in
{ title = "Photo Groove | " ++ title
, body =
[ lazy viewHeader model.page
, content
, viewFooter
]
}
viewHeader : Page -> Html Msg
viewHeader page =
let
logo =
h1 [] [ text "Photo Groove" ]
links =
ul []
[ navLink Folders { url = "/", caption = "Folders" }
, navLink Gallery { url = "/gallery", caption = "Gallery" }
]
navLink : Route -> { url : String, caption : String } -> Html Msg
navLink targetRoute { url, caption } =
li [ classList [ ( "active", isActive { link = targetRoute, page = page } ) ] ]
[ a [ href url ] [ text caption ] ]
in
nav [] [ logo, links ]
isActive : { link : Route, page : Page } -> Bool
isActive { link, page } =
case ( link, page ) of
( Gallery, GalleryPage _ ) ->
True
( Gallery, _ ) ->
False
( Folders, FoldersPage _ ) ->
True
( Folders, _ ) ->
False
( SelectedPhoto _, _ ) ->
False
viewFooter : Html Msg
viewFooter =
footer []
[ text "One is never alone with a rubber duck. -Douglas Adams"
]
type Msg
= ClickedLink Browser.UrlRequest
| ChangedUrl Url
| GotGalleryMsg Gallery.Msg
| GotFoldersMsg Folders.Msg
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
ClickedLink (Browser.External href) ->
( model, Nav.load href )
ClickedLink (Browser.Internal url) ->
( model, Nav.pushUrl model.key (Url.toString url) )
ChangedUrl url ->
updateUrl url model
GotGalleryMsg galleryMsg ->
case model.page of
GalleryPage gallery ->
toGallery model (Gallery.update galleryMsg gallery)
_ ->
( model, Cmd.none )
GotFoldersMsg foldersMsg ->
case model.page of
FoldersPage folders ->
toFolders model (Folders.update foldersMsg folders)
_ ->
( model, Cmd.none )
toGallery : Model -> ( Gallery.Model, Cmd Gallery.Msg ) -> ( Model, Cmd Msg )
toGallery model ( galleryModel, galleryCmd ) =
( { model | page = GalleryPage galleryModel }
, Cmd.map GotGalleryMsg galleryCmd
)
toFolders : Model -> ( Folders.Model, Cmd Folders.Msg ) -> ( Model, Cmd Msg )
toFolders model ( foldersModel, foldersCmd ) =
( { model | page = FoldersPage foldersModel }
, Cmd.map GotFoldersMsg foldersCmd
)
subscriptions : Model -> Sub Msg
subscriptions model =
case model.page of
GalleryPage gallery ->
Gallery.subscriptions gallery
|> Sub.map GotGalleryMsg
_ ->
Sub.none
init : Float -> Url -> Nav.Key -> ( Model, Cmd Msg )
init version url key =
updateUrl
url
{ page = NotFound
, version = version
, key = key
}
mergeFolders : Model -> ( Folders.Model, Cmd Folders.Msg ) -> ( Model, Cmd Msg )
mergeFolders model foldersTuple =
case model.page of
FoldersPage oldModel ->
( { model
| page =
FoldersPage <|
Folders.merge
{ oldModel = oldModel
, newModel = Tuple.first foldersTuple
}
}
, Cmd.none
)
_ ->
toFolders model foldersTuple
updateUrl : Url -> Model -> ( Model, Cmd Msg )
updateUrl url model =
case Parser.parse parser url of
Just Gallery ->
toGallery model <| Gallery.init model.version
Just Folders ->
mergeFolders model <| Folders.init Nothing
Just (SelectedPhoto filename) ->
mergeFolders model <| Folders.init <| Just filename
Nothing ->
( { model | page = NotFound }, Cmd.none )
parser : Parser (Route -> a) a
parser =
Parser.oneOf
[ Parser.map Folders Parser.top
, Parser.map Gallery (s "gallery")
, Parser.map SelectedPhoto (s "photos" </> Parser.string)
]
main : Program Float Model Msg
main =
Browser.application
{ init = init
, subscriptions = subscriptions
, update = update
, view = view
, onUrlRequest = ClickedLink
, onUrlChange = ChangedUrl
}

88
src/PhotoFolders.elm
View file

@ -1,13 +1,14 @@
module PhotoFolders exposing (main)
module PhotoFolders exposing (Model, Msg, init, main, merge, pageTitle, update, view)
import Browser
import Dict exposing (Dict)
import Html exposing (..)
import Html.Attributes exposing (class, src)
import Html.Attributes exposing (class, href, src)
import Html.Events exposing (onClick)
import Http
import Json.Decode as Decode exposing (Decoder, int, list, string, succeed)
import Json.Decode.Pipeline exposing (required)
import UrlPrefix
type Folder
@ -40,9 +41,9 @@ initialModel =
}
init : () -> ( Model, Cmd Msg )
init _ =
( initialModel
init : Maybe String -> ( Model, Cmd Msg )
init selectedFilename =
( { initialModel | selectedPhotoUrl = selectedFilename }
, Http.get
{ url = "http://elm-in-action.com/folders/list"
, expect = Http.expectJson GotInitialModel modelDecoder
@ -50,6 +51,22 @@ init _ =
)
merge : { oldModel : Model, newModel : Model } -> Model
merge { oldModel, newModel } =
let
root : Folder
root =
newModel.selectedPhotoUrl
|> Maybe.andThen (findUrl oldModel.root)
|> Maybe.map (expandPath oldModel.root)
|> Maybe.withDefault oldModel.root
in
{ oldModel
| selectedPhotoUrl = newModel.selectedPhotoUrl
, root = root
}
modelDecoder : Decoder Model
modelDecoder =
Decode.map
@ -63,8 +80,7 @@ modelDecoder =
type Msg
= ClickedPhoto String
| GotInitialModel (Result Http.Error Model)
= GotInitialModel (Result Http.Error Model)
| ClickedFolder FolderPath
@ -74,23 +90,18 @@ update msg model =
ClickedFolder folderPath ->
( { model | root = toggleExpanded folderPath model.root }, Cmd.none )
ClickedPhoto url ->
let
root : Folder
root =
findUrl url model.root
|> Maybe.map (expandPath model.root)
|> Maybe.withDefault model.root
in
( { model | selectedPhotoUrl = Just url, root = root }, Cmd.none )
GotInitialModel (Ok newModel) ->
( newModel, Cmd.none )
( { newModel | selectedPhotoUrl = model.selectedPhotoUrl }, Cmd.none )
GotInitialModel (Err _) ->
( model, Cmd.none )
pageTitle : String
pageTitle =
"Folders"
view : Model -> Html Msg
view model =
let
@ -109,8 +120,7 @@ view model =
in
div [ class "content" ]
[ div [ class "folders" ]
[ h1 [] [ text "Folders" ]
, viewFolder End model.root
[ viewFolder End model.root
]
, div [ class "selected-photo" ] [ selectedPhoto ]
]
@ -119,7 +129,7 @@ view model =
main : Program () Model Msg
main =
Browser.element
{ init = init
{ init = \_ -> init Nothing
, view = view
, update = update
, subscriptions = \_ -> Sub.none
@ -136,7 +146,7 @@ type alias Photo =
viewPhoto : String -> Html Msg
viewPhoto url =
div [ class "photo", onClick (ClickedPhoto url) ]
a [ href ("/photos/" ++ url), class "photo" ]
[ text url ]
@ -146,7 +156,7 @@ viewSelectedPhoto photo =
[ class "selected-photo"
]
[ h2 [] [ text photo.title ]
, img [ src (urlPrefix ++ "photos/" ++ photo.url ++ "/full") ] []
, img [ src (UrlPrefix.fullUrl photo.url) ] []
, span [] [ text <| String.fromInt photo.size ++ "KB" ]
, h3 [] [ text "Related" ]
, div [ class "related-photos" ] <| List.map viewRelatedPhotos photo.relatedUrls
@ -155,12 +165,13 @@ viewSelectedPhoto photo =
viewRelatedPhotos : String -> Html Msg
viewRelatedPhotos url =
img
[ class "related-photo"
, onClick (ClickedPhoto url)
, src (urlPrefix ++ "photos/" ++ url ++ "/thumb")
a [ href ("/photos/" ++ url) ]
[ img
[ class "related-photo"
, src (UrlPrefix.thumbnailUrl url)
]
[]
]
[]
viewFolder : FolderPath -> Folder -> Html Msg
@ -202,11 +213,6 @@ appendIndex index path =
Subfolder subfolderIndex <| appendIndex index remainingPath
urlPrefix : String
urlPrefix =
"http://elm-in-action.com/"
type FolderPath
= End
| Subfolder Int FolderPath
@ -225,12 +231,12 @@ traversePath mapFolder path (Folder folder) =
List.indexedMap transform folder.subfolders
transform : Int -> Folder -> Folder
transform currentIndex subFolder =
transform currentIndex subfolder =
if index == currentIndex then
traversePath mapFolder nestedPath subFolder
traversePath mapFolder nestedPath subfolder
else
subFolder
subfolder
in
mapFolder False (Folder { folder | subfolders = subfolders })
@ -253,14 +259,14 @@ expandPath : Folder -> FolderPath -> Folder
expandPath folder path =
let
expandFolder : Bool -> Folder -> Folder
expandFolder _ (Folder subFolder) =
Folder { subFolder | expanded = True }
expandFolder _ (Folder subfolder) =
Folder { subfolder | expanded = True }
in
traversePath expandFolder path folder
findUrl : String -> Folder -> Maybe FolderPath
findUrl url (Folder folder) =
findUrl : Folder -> String -> Maybe FolderPath
findUrl (Folder folder) url =
let
foundPhoto : Bool
foundPhoto =
@ -273,7 +279,7 @@ findUrl url (Folder folder) =
let
mapPath : ( Int, Folder ) -> Maybe FolderPath
mapPath ( index, subfolder ) =
findUrl url subfolder
findUrl subfolder url
|> Maybe.map (Subfolder index)
reducer : ( Int, Folder ) -> Maybe FolderPath -> Maybe FolderPath

20
src/PhotoGroove.elm
View file

@ -1,4 +1,4 @@
port module PhotoGroove exposing (Model, Msg(..), Photo, Status(..), initialModel, main, photoDecoder, update, urlPrefix, view)
port module PhotoGroove exposing (Model, Msg(..), Photo, Status(..), init, initialModel, main, pageTitle, photoDecoder, subscriptions, update, view)
import Browser
import Html exposing (..)
@ -9,11 +9,7 @@ import Json.Decode exposing (Decoder, at, int, list, string, succeed)
import Json.Decode.Pipeline exposing (optional, required)
import Json.Encode
import Random
urlPrefix : String
urlPrefix =
"http://elm-in-action.com/"
import UrlPrefix
type Msg
@ -28,6 +24,11 @@ type Msg
| GotActivity String
pageTitle : String
pageTitle =
"Gallery"
view : Model -> Html Msg
view model =
div [ class "content" ] <|
@ -58,8 +59,7 @@ viewFilter toMsg name magnitude =
viewLoaded : List Photo -> String -> Model -> List (Html Msg)
viewLoaded photos selectedUrl model =
[ h1 [] [ text "Photo Groove" ]
, button
[ button
[ onClick ClickedSurpriseMe ]
[ text "Surprise Me" ]
, div [ class "activity" ] [ text model.activity ]
@ -80,7 +80,7 @@ viewLoaded photos selectedUrl model =
viewThumbnail : String -> Photo -> Html Msg
viewThumbnail selectedUrl thumb =
img
[ src (urlPrefix ++ thumb.url)
[ src (UrlPrefix.thumbUrl thumb.url)
, title (thumb.title ++ " [" ++ String.fromInt thumb.size ++ " KB]")
, classList [ ( "selected", selectedUrl == thumb.url ) ]
, onClick (ClickedPhoto thumb.url)
@ -225,7 +225,7 @@ applyFilters model =
]
url =
urlPrefix ++ "large/" ++ selectedUrl
UrlPrefix.largeUrl selectedUrl
cmd =
setFilters { url = url, filters = filters }

26
src/UrlPrefix.elm Normal file
View file

@ -0,0 +1,26 @@
module UrlPrefix exposing (..)
urlPrefix : String
urlPrefix =
"http://elm-in-action.com/"
thumbnailUrl : String -> String
thumbnailUrl url =
urlPrefix ++ "photos/" ++ url ++ "/thumb"
fullUrl : String -> String
fullUrl url =
urlPrefix ++ "photos/" ++ url ++ "/full"
largeUrl : String -> String
largeUrl url =
urlPrefix ++ "large/" ++ url
thumbUrl : String -> String
thumbUrl url =
urlPrefix ++ url

15
tests/PhotoGrooveTests.elm
View file

@ -1,15 +1,16 @@
module PhotoGrooveTests exposing (..)
import Expect exposing (Expectation)
import Fuzz exposing (Fuzzer, int, list, string)
import Html.Attributes as Attr exposing (src)
import Json.Decode as Decode exposing (decodeValue)
import Fuzz exposing (Fuzzer, int, string)
import Html.Attributes as Attr
import Json.Decode exposing (decodeValue)
import Json.Encode as Encode
import PhotoGroove exposing (Model, Msg(..), Photo, Status(..), initialModel, photoDecoder, update, urlPrefix, view)
import PhotoGroove exposing (Model, Msg(..), Photo, Status(..), initialModel, photoDecoder, update, view)
import Test exposing (..)
import Test.Html.Event as Event
import Test.Html.Query as Query
import Test.Html.Selector exposing (attribute, tag, text)
import Test.Html.Selector exposing (attribute, tag)
import UrlPrefix
decoderTest : Test
@ -92,7 +93,7 @@ clickThumbnailWorks =
srcToClick : String
srcToClick =
urlPrefix ++ url
UrlPrefix.thumbUrl url
in
{ initialModel | status = Loaded photos "" }
|> view
@ -105,7 +106,7 @@ clickThumbnailWorks =
thumbnailRendered : String -> Query.Single msg -> Expectation
thumbnailRendered url query =
query
|> Query.findAll [ tag "img", attribute (Attr.src (urlPrefix ++ url)) ]
|> Query.findAll [ tag "img", attribute (Attr.src (UrlPrefix.thumbUrl url)) ]
|> Query.count (Expect.atLeast 1)