From 8d6cc1db714bc982fd2116f1e902c175a5372ad1 Mon Sep 17 00:00:00 2001 From: Louis Pearson Date: Wed, 31 Jan 2024 02:15:36 -0700 Subject: [PATCH] feat: complete chapter 6 - testing --- PhotoGroove/.gitignore | 1 + PhotoGroove/elm.json | 4 +- PhotoGroove/src/PhotoGroove.elm | 136 +++++++++++++++++-------- PhotoGroove/tests/PhotoGrooveTests.elm | 124 ++++++++++++++++++++++ 4 files changed, 220 insertions(+), 45 deletions(-) create mode 100644 PhotoGroove/.gitignore create mode 100644 PhotoGroove/tests/PhotoGrooveTests.elm diff --git a/PhotoGroove/.gitignore b/PhotoGroove/.gitignore new file mode 100644 index 0000000..4bc8535 --- /dev/null +++ b/PhotoGroove/.gitignore @@ -0,0 +1 @@ +elm-stuff diff --git a/PhotoGroove/elm.json b/PhotoGroove/elm.json index 0e317c3..98cd0d2 100644 --- a/PhotoGroove/elm.json +++ b/PhotoGroove/elm.json @@ -23,7 +23,9 @@ } }, "test-dependencies": { - "direct": {}, + "direct": { + "elm-explorations/test": "2.2.0" + }, "indirect": {} } } diff --git a/PhotoGroove/src/PhotoGroove.elm b/PhotoGroove/src/PhotoGroove.elm index 3706899..dc012f3 100644 --- a/PhotoGroove/src/PhotoGroove.elm +++ b/PhotoGroove/src/PhotoGroove.elm @@ -1,22 +1,36 @@ -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 + +type Msg + = ClickedPhoto String | SetSize ThumbnailSize | ClickedSurpriseMe | GotRandomPhoto Photo @@ -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,36 +68,39 @@ 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" ] - , button - [ onClick ClickedSurpriseMe ] - [ text "Surprise Me!" ] - , div [ class "activity" ] [ text model.activity ] - , div [ class "filters" ] - [ viewFilter SlidHue "Hue" model.hue - , viewFilter SlidRipple "Ripple" model.ripple - , viewFilter SlidNoise "Noise" model.noise - ] - , h3 [] [ text "Thumbnail Size:" ] - , div [ id "choose-size" ] - (List.map viewSizeChooser [ Small, Medium, Large ]) - , div [ id "thumbnails", class (sizeToString model.chosenSize) ] - (List.map (viewThumbnail selectedUrl) photos) - , canvas [ id "main-canvas", class "large" ] [] + [ h1 [] [ text "Photo Groove" ] + , button + [ onClick ClickedSurpriseMe ] + [ text "Surprise Me!" ] + , div [ class "activity" ] [ text model.activity ] + , div [ class "filters" ] + [ viewFilter SlidHue "Hue" model.hue + , viewFilter SlidRipple "Ripple" model.ripple + , viewFilter SlidNoise "Noise" model.noise ] + , h3 [] [ text "Thumbnail Size:" ] + , div [ id "choose-size" ] + (List.map viewSizeChooser [ Small, Medium, Large ]) + , div [ id "thumbnails", class (sizeToString model.chosenSize) ] + (List.map (viewThumbnail selectedUrl) photos) + , canvas [ id "main-canvas", class "large" ] [] + ] + viewThumbnail : String -> Photo -> Html Msg viewThumbnail selectedUrl thumb = - img - [ src (urlPrefix ++ thumb.url) + img + [ src (urlPrefix ++ thumb.url) , title (thumb.title ++ " [" ++ String.fromInt thumb.size ++ " KB]") , classList [ ( "selected", selectedUrl == thumb.url ) ] - , onClick (ClickedPhoto thumb.url) + , onClick (ClickedPhoto thumb.url) ] [] + 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 -> "small" - Medium -> + + Medium -> "medium" - Large -> + + 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,31 +170,32 @@ 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 -> - applyFilters - { model - | status = - case List.head photos of + first :: rest -> + applyFilters + { model + | status = + case List.head photos of Just photo -> Loaded photos photo.url Nothing -> Loaded [] "" } - + [] -> - ( { model | status = Errored "0 photos found"}, Cmd.none ) + ( { model | status = Errored "0 photos found" }, Cmd.none ) GotPhotos (Err _) -> - ( model, Cmd.none ) + ( model, Cmd.none ) GotRandomPhoto photo -> applyFilters { model | status = selectUrl photo.url model.status } @@ -174,7 +206,7 @@ update msg model = SetSize size -> ( { model | chosenSize = size }, Cmd.none ) - ClickedSurpriseMe -> + ClickedSurpriseMe -> case model.status of Loaded (firstPhoto :: otherPhotos) _ -> ( model @@ -191,7 +223,7 @@ update msg model = Errored errorMessage -> ( model, Cmd.none ) - SlidHue hue -> + SlidHue hue -> applyFilters { model | hue = hue } SlidRipple ripple -> @@ -200,19 +232,20 @@ update msg model = SlidNoise noise -> applyFilters { model | noise = noise } + applyFilters : Model -> ( Model, Cmd msg ) applyFilters model = case model.status of Loaded photos selectedUrl -> - let + 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 = - urlPrefix ++ "large/" ++ selectedUrl + urlPrefix ++ "large/" ++ selectedUrl in ( model, setFilters { url = url, filters = filters } ) @@ -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 @@ -240,7 +277,8 @@ initialModel = , hue = 5 , ripple = 5 , noise = 5 - } + } + initialCmd : Cmd Msg initialCmd = @@ -249,6 +287,7 @@ initialCmd = , expect = Http.expectJson GotPhotos (list photoDecoder) } + main : Program Float Model Msg main = Browser.element @@ -258,24 +297,33 @@ main = , subscriptions = subscriptions } + init : Float -> ( Model, Cmd Msg ) init flags = let activity = "Initializing Pasta v" ++ String.fromFloat flags in - ( { initialModel | activity = activity }, initialCmd ) + ( { 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 = "" } diff --git a/PhotoGroove/tests/PhotoGrooveTests.elm b/PhotoGroove/tests/PhotoGrooveTests.elm new file mode 100644 index 0000000..ee66790 --- /dev/null +++ b/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)