feat: Finish chapter 7

PhotoGroove/.gitignore

@@ -0,0 +1 @@
+elm-stuff

PhotoGroove/elm.json

@@ -23,7 +23,9 @@
         }
     },
     "test-dependencies": {
-        "direct": {},
+        "direct": {
+            "elm-explorations/test": "2.2.0"
+        },
         "indirect": {}
     }
 }

PhotoGroove/index.html

@@ -39,21 +39,7 @@
     <script src="http://elm-in-action.com/pasta.js"></script>
     <script src="app.js"></script> <!-- PhotoGroove.elm will get compiled into app.js --!>
     <script>
-      var app = Elm.PhotoGroove.init({
-        node: document.getElementById("app"),
-        flags: Pasta.version
-      }); // Elm object comes from app.js
-
-      app.ports.setFilters.subscribe(function(options) {
-        requestAnimationFrame(function() {
-           Pasta.apply(document.getElementById("main-canvas"), options);
-        });
-      });
-
-      Pasta.addActivityListener(function(activity) {
-        console.log("Got some activity to send to Elm:", activity);
-        app.ports.activityChanges.send(activity);
-      });
+      var app = Elm.PhotoFolders.init({ node: document.getElementById("app"), }); // Elm object comes from app.js
     </script>
   </body>
 </html>

PhotoGroove/src/PhotoFolders.elm

@@ -0,0 +1,258 @@
+module PhotoFolders exposing (main)
+
+import Browser
+import Dict exposing (Dict)
+import Html exposing (..)
+import Html.Attributes exposing (class, src)
+import Html.Events exposing (onClick)
+import Http
+import Json.Decode as Decode exposing (Decoder, int, list, string)
+import Json.Decode.Pipeline exposing (required)
+
+type Folder =
+    Folder
+        { name : String
+        , photoUrls : List String
+        , subfolders : List Folder
+        , expanded : Bool
+        }
+
+type alias Model =
+    { selectedPhotoUrl : Maybe String
+    , photos : Dict String Photo
+    , root : Folder
+    }
+
+initialModel : Model
+initialModel =
+    { selectedPhotoUrl = Nothing
+    , photos = Dict.empty
+    , root = Folder { name = "Loading...", expanded = True, photoUrls = [], subfolders = [] }
+    }
+
+init : () -> ( Model, Cmd Msg )
+init _ =
+    ( initialModel
+    , Http.get
+        { url = "http://elm-in-action.com/folders/list"
+        , expect = Http.expectJson GotInitialModel modelDecoder 
+        }
+    )
+
+modelDecoder : Decoder Model
+modelDecoder =
+    Decode.map2
+        (\photos root ->
+            { photos = photos, root = root, selectedPhotoUrl = Nothing }
+        )
+        modelPhotosDecoder
+        folderDecoder
+
+type Msg
+    = ClickedPhoto String
+    | GotInitialModel (Result Http.Error Model)
+    | ClickedFolder FolderPath
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case msg of
+        ClickedFolder path ->
+            ( { model | root = toggleExpanded path model.root }, Cmd.none )
+
+        ClickedPhoto url ->
+            ( { model | selectedPhotoUrl = Just url }, Cmd.none )
+
+        GotInitialModel (Ok newModel) ->
+            ( newModel, Cmd.none )
+
+        GotInitialModel (Err _) ->
+            ( model, Cmd.none  )
+
+view : Model -> Html Msg
+view model =
+    let
+        photoByUrl : String -> Maybe Photo
+        photoByUrl url =
+            Dict.get url model.photos
+
+        selectedPhoto : Html Msg
+        selectedPhoto =
+            case Maybe.andThen photoByUrl model.selectedPhotoUrl of
+                Just photo ->
+                    viewSelectedPhoto photo
+
+                Nothing ->
+                    text ""
+    in
+    div [ class "content" ]
+        [ div [ class "folders" ] 
+            [ h1 [] [ text "Folders" ]
+            , viewFolder End model.root
+            ]
+        , div [ class "selected-photo"] [ selectedPhoto ] 
+        ]
+
+main : Program () Model Msg
+main =
+    Browser.element
+        { init = init
+        , view = view
+        , update = update
+        , subscriptions = \_ -> Sub.none
+        }
+
+type alias Photo =
+    { title : String
+    , size : Int
+    , relatedUrls : List String
+    , url : String
+    }
+
+viewPhoto : String -> Html Msg
+viewPhoto url =
+    div [ class "photo", onClick (ClickedPhoto url) ]
+        [ text url ]
+
+viewSelectedPhoto : Photo -> Html Msg
+viewSelectedPhoto photo =
+    div
+        [ class "selected-photo" ]
+        [ h2 [] [ text photo.title]
+        , img [ src (urlPrefix ++ "photos/" ++ photo.url ++ "/full") ] []
+        , span [] [ text (String.fromInt photo.size ++ "KB") ]
+        , h3 [] [ text "Related" ]
+        , div [ class "related-photos" ]
+            (List.map viewRelatedPhoto photo.relatedUrls)
+        ]
+
+viewRelatedPhoto : String -> Html Msg
+viewRelatedPhoto url =
+    img
+        [ class "related-photo" 
+        , onClick (ClickedPhoto url)
+        , src (urlPrefix ++ "photos/" ++ url ++ "/thumb")
+        ]
+        []
+
+viewFolder : FolderPath -> Folder -> Html Msg
+viewFolder path (Folder folder) =
+    let
+        viewSubfolder : Int -> Folder -> Html Msg
+        viewSubfolder index subfolder =
+            viewFolder (appendIndex index path) subfolder
+
+        folderLabel =
+            label [ onClick (ClickedFolder path) ] [ text folder.name ]
+    in
+    if folder.expanded then
+        let
+            contents =
+                List.append
+                    (List.indexedMap viewSubfolder folder.subfolders)
+                    (List.map viewPhoto folder.photoUrls)
+        in
+        div [ class "folder expanded" ]
+            [ folderLabel
+            , div [ class "contents" ] contents
+            ]
+    else 
+        div [ class "folder collapsed" ] [ folderLabel ]
+
+appendIndex : Int -> FolderPath -> FolderPath
+appendIndex index path =
+    case path of
+        End ->
+            Subfolder index End
+
+        Subfolder subfolderIndex remainingPath ->
+            Subfolder subfolderIndex (appendIndex index remainingPath)
+
+urlPrefix : String
+urlPrefix =
+    "http://elm-in-action.com/"
+
+type FolderPath
+    = End
+    | Subfolder Int FolderPath
+
+toggleExpanded : FolderPath -> Folder -> Folder
+toggleExpanded path (Folder folder) =
+    case path of
+        End ->
+            Folder { folder | expanded = not folder.expanded }
+
+        Subfolder targetIndex remainingPath ->
+            let
+                subfolders : List Folder
+                subfolders =
+                    List.indexedMap transform folder.subfolders
+
+                transform : Int -> Folder -> Folder
+                transform currentIndex currentSubfolder =
+                    if currentIndex == targetIndex then
+                        toggleExpanded remainingPath currentSubfolder
+
+                    else
+                        currentSubfolder 
+            in
+            Folder { folder | subfolders = subfolders }
+
+type alias JsonPhoto =
+    { title : String
+    , size : Int
+    , relatedUrls : List String
+    }
+
+jsonPhotoDecoder : Decoder JsonPhoto
+jsonPhotoDecoder =
+    Decode.succeed JsonPhoto
+        |> required "title" string
+        |> required "size" int
+        |> required "related_photos" (list string)
+
+finishPhoto : ( String, JsonPhoto ) -> ( String, Photo )
+finishPhoto ( url, json ) =
+    ( url
+    , { url = url
+      , size = json.size
+      , title = json.title
+      , relatedUrls = json.relatedUrls
+      }
+    )
+
+fromPairs : List ( String, JsonPhoto ) -> Dict String Photo
+fromPairs pairs =
+    pairs
+        |> List.map finishPhoto
+        |> Dict.fromList
+
+photosDecoder : Decoder (Dict String Photo)
+photosDecoder =
+    Decode.keyValuePairs jsonPhotoDecoder
+        |> Decode.map fromPairs
+
+folderDecoder : Decoder Folder
+folderDecoder =
+    Decode.succeed folderFromJson
+        |> required "name" string
+        |> required "photos" photosDecoder
+        |> required "subfolders" (Decode.lazy (\_ -> list folderDecoder))
+
+folderFromJson : String -> Dict String Photo -> List Folder -> Folder
+folderFromJson name photos subfolders =
+    Folder 
+        { name = name
+        , expanded = True
+        , subfolders = subfolders
+        , photoUrls = Dict.keys photos
+        }
+
+modelPhotosDecoder : Decoder (Dict String Photo)
+modelPhotosDecoder =
+    Decode.succeed modelPhotosFromJson
+        |> required "photos" photosDecoder
+        |> required "subfolders" (Decode.lazy (\_ -> list modelPhotosDecoder))
+
+modelPhotosFromJson : Dict String Photo -> List (Dict String Photo) -> Dict String Photo
+modelPhotosFromJson folderPhotos subfolderPhotos =
+    List.foldl Dict.union folderPhotos subfolderPhotos

PhotoGroove/src/PhotoGroove.elm

@@ -1,20 +1,34 @@
-port module PhotoGroove exposing (main)
+port module PhotoGroove exposing
+    ( Model
+    , Msg(..)
+    , Photo
+    , Status(..)
+    , initialModel
+    , main
+    , photoDecoder
+    , photoFromUrl
+    , update
+    , urlPrefix
+    , view
+    )
 
 import Array exposing (Array)
 import Browser
 import Html exposing (..)
 import Html.Attributes as Attr exposing (class, classList, id, name, src, title, type_)
-import Html.Events exposing (onClick, on)
+import Html.Events exposing (on, onClick)
 import Http
 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 =
     "https://elm-in-action.com/"
 
+
 type Msg
     = ClickedPhoto String
     | SetSize ThumbnailSize
@@ -26,6 +40,7 @@ type Msg
     | SlidRipple Int
     | SlidNoise Int
 
+
 view : Model -> Html Msg
 view model =
     div [ class "content" ] <|
@@ -39,6 +54,7 @@ view model =
             Errored errorMessage ->
                 [ text ("Error: " ++ errorMessage) ]
 
+
 viewFilter : (Int -> Msg) -> String -> Int -> Html Msg
 viewFilter toMsg name magnitude =
     div [ class "filter-slider" ]
@@ -52,6 +68,7 @@ viewFilter toMsg name magnitude =
         , label [] [ text (String.fromInt magnitude) ]
         ]
 
+
 viewLoaded : List Photo -> String -> Model -> List (Html Msg)
 viewLoaded photos selectedUrl model =
     [ h1 [] [ text "Photo Groove" ]
@@ -72,6 +89,7 @@ viewLoaded photos selectedUrl model =
     , canvas [ id "main-canvas", class "large" ] []
     ]
 
+
 viewThumbnail : String -> Photo -> Html Msg
 viewThumbnail selectedUrl thumb =
     img
@@ -82,6 +100,7 @@ viewThumbnail selectedUrl thumb =
         ]
         []
 
+
 viewSizeChooser : ThumbnailSize -> Html Msg
 viewSizeChooser size =
     label []
@@ -89,35 +108,45 @@ viewSizeChooser size =
         , text (sizeToString size)
         ]
 
+
 sizeToString : ThumbnailSize -> String
 sizeToString size =
     case size of
         Small ->
             "small"
+
         Medium ->
             "medium"
+
         Large ->
             "large"
 
+
 type ThumbnailSize
     = Small
     | Medium
     | Large
 
+
 port setFilters : FilterOptions -> Cmd msg
 
+
 port activityChanges : (String -> msg) -> Sub msg
+
+
 type alias FilterOptions =
     { url : String
     , filters : List { name : String, amount : Float }
     }
 
+
 type alias Photo =
     { url : String
     , size : Int
     , title : String
     }
 
+
 photoDecoder : Decoder Photo
 photoDecoder =
     succeed Photo
@@ -125,11 +154,13 @@ photoDecoder =
         |> required "size" int
         |> optional "title" string "(untitled)"
 
+
 type Status
     = Loading
     | Loaded (List Photo) String
     | Errored String
 
+
 type alias Model =
     { status : Status
     , activity : String
@@ -139,15 +170,16 @@ type alias Model =
     , noise : Int
     }
 
+
 update : Msg -> Model -> ( Model, Cmd Msg )
 update msg model =
     case msg of
         GotActivity activity ->
-            ( { model | activity = activity }, Cmd.none)
+            ( { model | activity = activity }, Cmd.none )
 
         GotPhotos (Ok photos) ->
             case photos of
-                first ::rest -> 
+                first :: rest ->
                     applyFilters
                         { model
                             | status =
@@ -160,7 +192,7 @@ update msg model =
                         }
 
                 [] ->
-                    ( { model | status = Errored "0 photos found"}, Cmd.none )
+                    ( { model | status = Errored "0 photos found" }, Cmd.none )
 
         GotPhotos (Err _) ->
             ( model, Cmd.none )
@@ -200,15 +232,16 @@ update msg model =
         SlidNoise noise ->
             applyFilters { model | noise = noise }
 
+
 applyFilters : Model -> ( Model, Cmd msg )
 applyFilters model =
     case model.status of
         Loaded photos selectedUrl ->
             let
                 filters =
-                    [ { name = "Hue", amount = toFloat model.hue / 11}
-                    , { name = "Ripple", amount = toFloat model.ripple / 11}
-                    , { name = "Noise", amount = toFloat model.noise / 11}
+                    [ { name = "Hue", amount = toFloat model.hue / 11 }
+                    , { name = "Ripple", amount = toFloat model.ripple / 11 }
+                    , { name = "Noise", amount = toFloat model.noise / 11 }
                     ]
 
                 url =
@@ -222,16 +255,20 @@ applyFilters model =
         Errored errorMessage ->
             ( model, Cmd.none )
 
+
 selectUrl : String -> Status -> Status
 selectUrl url status =
     case status of
         Loaded photos _ ->
             Loaded photos url
+
         Loading ->
             status
+
         Errored errorMessage ->
             status
 
+
 initialModel : Model
 initialModel =
     { status = Loading
@@ -242,6 +279,7 @@ initialModel =
     , noise = 5
     }
 
+
 initialCmd : Cmd Msg
 initialCmd =
     Http.get
@@ -249,6 +287,7 @@ initialCmd =
         , expect = Http.expectJson GotPhotos (list photoDecoder)
         }
 
+
 main : Program Float Model Msg
 main =
     Browser.element
@@ -258,6 +297,7 @@ main =
         , subscriptions = subscriptions
         }
 
+
 init : Float -> ( Model, Cmd Msg )
 init flags =
     let
@@ -266,16 +306,24 @@ init flags =
     in
     ( { initialModel | activity = activity }, initialCmd )
 
+
 subscriptions : Model -> Sub Msg
 subscriptions model =
     activityChanges GotActivity
 
+
 rangeSlider : List (Attribute msg) -> List (Html msg) -> Html msg
 rangeSlider attributes children =
     node "range-slider" attributes children
 
+
 onSlide : (Int -> msg) -> Attribute msg
 onSlide toMsg =
     at [ "detail", "userSlidTo" ] int
         |> Json.Decode.map toMsg
         |> on "slide"
+
+
+photoFromUrl : String -> Photo
+photoFromUrl url =
+    { url = url, size = 0, title = "" }

PhotoGroove/tests/PhotoGrooveTests.elm

@@ -0,0 +1,124 @@
+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 Json.Encode as Encode
+import PhotoGroove
+    exposing
+        ( Model
+        , Msg(..)
+        , Photo
+        , Status(..)
+        , initialModel
+        , photoFromUrl
+        , update
+        , urlPrefix
+        , view
+        )
+import Test exposing (..)
+import Test.Html.Event as Event
+import Test.Html.Query as Query
+import Test.Html.Selector exposing (attribute, tag, text)
+
+
+decoderTest : Test
+decoderTest =
+    fuzz2 string int "title defaults to (untitled)" <|
+        \url size ->
+            [ ( "url", Encode.string url )
+            , ( "size", Encode.int size )
+            ]
+                |> Encode.object
+                |> decodeValue PhotoGroove.photoDecoder
+                |> Result.map .title
+                |> Expect.equal (Ok "(untitled)")
+
+
+sliders : Test
+sliders =
+    describe "Slider sets the desired field in the model"
+        [ testSlider "SlidHue" SlidHue .hue
+        , testSlider "SlidRipple" SlidRipple .ripple
+        , testSlider "SlidNoise" SlidNoise .noise
+        ]
+
+
+testSlider : String -> (Int -> Msg) -> (Model -> Int) -> Test
+testSlider description toMsg amountFromModel =
+    fuzz int description <|
+        \amount ->
+            initialModel
+                |> update (toMsg amount)
+                |> Tuple.first
+                |> amountFromModel
+                |> Expect.equal amount
+
+
+noPhotosNoThumbnails : Test
+noPhotosNoThumbnails =
+    test "No thumbnails render when there are no photos to render." <|
+        \_ ->
+            initialModel
+                |> PhotoGroove.view
+                |> Query.fromHtml
+                |> Query.findAll [ tag "img" ]
+                |> Query.count (Expect.equal 0)
+
+
+thumbnailRendered : String -> Query.Single msg -> Expectation
+thumbnailRendered url query =
+    query
+        |> Query.findAll [ tag "img", attribute (Attr.src (urlPrefix ++ url)) ]
+        |> Query.count (Expect.atLeast 1)
+
+
+thumbnailsWork : Test
+thumbnailsWork =
+    fuzz urlFuzzer "URLs render as thumbnail" <|
+        \urls ->
+            let
+                thumbnailChecks : List (Query.Single msg -> Expectation)
+                thumbnailChecks =
+                    List.map thumbnailRendered urls
+            in
+            { initialModel | status = Loaded (List.map photoFromUrl urls) "" }
+                |> view
+                |> Query.fromHtml
+                |> Expect.all thumbnailChecks
+
+
+urlFuzzer : Fuzzer (List String)
+urlFuzzer =
+    Fuzz.intRange 1 5
+        |> Fuzz.map urlsFromCount
+
+
+urlsFromCount : Int -> List String
+urlsFromCount urlCount =
+    List.range 1 urlCount
+        |> List.map (\num -> String.fromInt num ++ ".png")
+
+
+clickThumbnail : Test
+clickThumbnail =
+    fuzz3 urlFuzzer string urlFuzzer "clicking a thumbnail selects it" <|
+        \urlsBefore urlToSelect urlsAfter ->
+            let
+                url =
+                    urlToSelect ++ ".jpeg"
+
+                photos =
+                    (urlsBefore ++ url :: urlsAfter)
+                        |> List.map photoFromUrl
+
+                srcToClick =
+                    urlPrefix ++ url
+            in
+            { initialModel | status = Loaded photos "" }
+                |> view
+                |> Query.fromHtml
+                |> Query.find [ tag "img", attribute (Attr.src srcToClick) ]
+                |> Event.simulate Event.click
+                |> Event.expect (ClickedPhoto url)