chore: Move everything into an internal module

This commit is contained in:
Alexander Kobjolke 2023-12-17 18:50:14 +01:00
parent 796b1697b8
commit a0c0a8354a
4 changed files with 755 additions and 746 deletions

759
app.js

File diff suppressed because it is too large Load diff

View file

@ -1,370 +1,8 @@
port module PhotoGroove exposing (main, photoDecoder) module PhotoGroove exposing (main)
import Browser import PhotoGroove.Internal as Internal
import Html exposing (Attribute, Html, button, canvas, div, h1, h3, img, input, label, node, text)
import Html.Attributes as Attr exposing (..)
import Html.Events exposing (on, onClick)
import Http
import Json.Decode as D exposing (Decoder)
import Json.Decode.Pipeline as D
import Json.Encode
import Random
type Status main : Program Float Internal.Model Internal.Message
= Loading
| Loaded (List Photo) String
| Errored String
type alias FilterValues =
{ hue : Int
, ripple : Int
, noise : Int
}
type alias FilterOptions =
{ url : String
, filters : List { name : String, amount : Float }
}
port setFilters : FilterOptions -> Cmd msg
port activityChanges : (String -> msg) -> Sub msg
type alias Model =
{ status : Status
, chosenSize : ThumbnailSize
, filterValues : FilterValues
, activity : String
}
type alias Photo =
{ url : String
, size : Int
, title : String
}
photoDecoder : Decoder Photo
photoDecoder =
D.succeed Photo
|> D.required "url" D.string
|> D.required "size" D.int
|> D.optional "title" D.string "(untitled)"
type ThumbnailSize
= Small
| Medium
| Large
initialModel : Model
initialModel =
{ status = Loading
, chosenSize = Medium
, filterValues = { hue = 0, ripple = 0, noise = 0 }
, activity = ""
}
initialCommand : Cmd Message
initialCommand =
Http.get
{ url = "list"
, expect = Http.expectJson GotPhotos (D.list photoDecoder)
}
view : Model -> Html Message
view model =
div [ class "content" ] <|
case model.status of
Loading ->
[]
Loaded photos selected ->
viewLoaded model photos selected
Errored error ->
[ text ("Error: " ++ error) ]
viewLoaded : Model -> List Photo -> String -> List (Html Message)
viewLoaded model photos selected =
[ h1 [] [ text "Photo Groove" ]
, button [ onClick ClickedSurpriseMe ] [ text "Surprise me!" ]
, div [ class "activity" ] [ text model.activity ]
, div [ class "filters" ]
[ viewFilter Hue model.filterValues.hue
, viewFilter Ripple model.filterValues.ripple
, viewFilter Noise model.filterValues.noise
]
, h3 [] [ text "Thumbnail Size:" ]
, div [ id "choose-size" ]
(List.map viewSizeChooser [ Small, Medium, Large ])
, div
[ id "thumbnails"
, class (sizeToClass model.chosenSize)
]
(List.map (viewThumbnail selected) photos)
, img [ class "large", src (urlPrefix ++ "large/" ++ selected) ] []
, canvas [ id "canvas-main", class "large" ] []
]
viewThumbnail : String -> Photo -> Html Message
viewThumbnail selectedUrl thumb =
img
[ src (urlPrefix ++ thumb.url)
, title (thumb.title ++ " [" ++ String.fromInt thumb.size ++ " KB]")
, classList [ ( "selected", selectedUrl == thumb.url ) ]
, onClick (ClickedThumbnail thumb.url)
]
[]
viewSizeChooser : ThumbnailSize -> Html Message
viewSizeChooser size =
label []
[ input
[ type_ "radio"
, name "size"
, onClick (ClickedSize size)
]
[]
, text (sizeToString size)
]
viewFilter : FilterType -> Int -> Html Message
viewFilter filterType magnitude =
div
[ class "filter-slider"
]
[ label [] [ text <| filterTypeToName filterType ]
, rangeSlider
[ Attr.max "11"
, property "val" (Json.Encode.int magnitude)
, onSlide (ChangedFilter filterType)
]
[]
, label [] [ text (String.fromInt magnitude) ]
]
sizeToString : ThumbnailSize -> String
sizeToString size =
case size of
Small ->
"small"
Medium ->
"medium"
Large ->
"large"
sizeToClass : ThumbnailSize -> String
sizeToClass size =
case size of
Small ->
"small"
Medium ->
"med"
Large ->
"large"
type Message
= ClickedThumbnail String
| ClickedSurpriseMe
| ClickedSize ThumbnailSize
| ChangedFilter FilterType Int
| GotRandomPhoto Photo
| GotPhotos (Result Http.Error (List Photo))
| GotActivity String
type FilterType
= Hue
| Ripple
| Noise
filterTypeToName : FilterType -> String
filterTypeToName t =
case t of
Hue ->
"Hue"
Ripple ->
"Ripple"
Noise ->
"Noise"
update : Message -> Model -> ( Model, Cmd Message )
update msg model =
case msg of
ClickedThumbnail thumb ->
applyFilters { model | status = selectUrl thumb model.status }
ClickedSurpriseMe ->
case model.status of
Loaded (photo :: morePhotos) _ ->
Random.uniform photo morePhotos
|> Random.generate GotRandomPhoto
|> Tuple.pair model
Loaded [] _ ->
( model, Cmd.none )
Loading ->
( model, Cmd.none )
Errored _ ->
( model, Cmd.none )
ClickedSize size ->
( { model | chosenSize = size }, Cmd.none )
ChangedFilter f val ->
applyFilters { model | filterValues = setFilterValue f val model.filterValues }
GotRandomPhoto photo ->
applyFilters { model | status = selectUrl photo.url model.status }
GotPhotos (Ok ((firstPhoto :: _) as photos)) ->
applyFilters { model | status = Loaded photos firstPhoto.url }
GotPhotos (Ok []) ->
( { model | status = Errored "No photos!" }, Cmd.none )
GotPhotos (Err httpError) ->
( { model | status = Errored <| ("Failed to load photos: " ++ httpErrorToString httpError) }, Cmd.none )
GotActivity activity ->
( { model | activity = activity }, Cmd.none )
subscriptions : Model -> Sub Message
subscriptions _ =
activityChanges GotActivity
init : Float -> ( Model, Cmd Message )
init flags =
let
activity =
"Initializing Pasta v" ++ String.fromFloat flags
in
( { initialModel | activity = activity }, initialCommand )
setFilterValue : FilterType -> Int -> FilterValues -> FilterValues
setFilterValue filterType val values =
case filterType of
Hue ->
{ values | hue = val }
Ripple ->
{ values | ripple = val }
Noise ->
{ values | noise = val }
applyFilters : Model -> ( Model, Cmd msg )
applyFilters model =
case model.status of
Loaded photos selectedUrl ->
let
inPecent v =
toFloat v / 11
filters =
[ { name = filterTypeToName Hue, amount = inPecent model.filterValues.hue }
, { name = filterTypeToName Ripple, amount = inPecent model.filterValues.ripple }
, { name = filterTypeToName Noise, amount = inPecent model.filterValues.noise }
]
url =
urlPrefix ++ "large/" ++ selectedUrl
in
( model, setFilters { url = url, filters = filters } )
Loading ->
( model, Cmd.none )
Errored _ ->
( model, Cmd.none )
selectUrl : String -> Status -> Status
selectUrl url status =
case status of
Loading ->
status
Loaded photos _ ->
Loaded photos url
Errored _ ->
status
httpErrorToString : Http.Error -> String
httpErrorToString err =
case err of
Http.BadUrl msg ->
"bad URL: " ++ msg
Http.Timeout ->
"timeout"
Http.NetworkError ->
"network error"
Http.BadStatus status ->
"bad status: " ++ String.fromInt status
Http.BadBody msg ->
"bad body: " ++ msg
urlPrefix : String
urlPrefix =
"http://elm-in-action.com/"
main : Program Float Model Message
main = main =
Browser.element Internal.main
{ init = init
, subscriptions = subscriptions
, view = view
, update = update
}
rangeSlider : List (Html.Attribute msg) -> List (Html msg) -> Html msg
rangeSlider =
node "range-slider"
onSlide : (Int -> msg) -> Attribute msg
onSlide toMsg =
D.at [ "detail", "userSlidTo" ] D.int
|> D.map toMsg
|> on "slide"

View file

@ -0,0 +1,370 @@
port module PhotoGroove.Internal exposing (..)
import Browser
import Html exposing (Attribute, Html, button, canvas, div, h1, h3, img, input, label, node, text)
import Html.Attributes as Attr exposing (..)
import Html.Events exposing (on, onClick)
import Http
import Json.Decode as D exposing (Decoder)
import Json.Decode.Pipeline as D
import Json.Encode
import Random
type Status
= Loading
| Loaded (List Photo) String
| Errored String
type alias FilterValues =
{ hue : Int
, ripple : Int
, noise : Int
}
type alias FilterOptions =
{ url : String
, filters : List { name : String, amount : Float }
}
port setFilters : FilterOptions -> Cmd msg
port activityChanges : (String -> msg) -> Sub msg
type alias Model =
{ status : Status
, chosenSize : ThumbnailSize
, filterValues : FilterValues
, activity : String
}
type alias Photo =
{ url : String
, size : Int
, title : String
}
photoDecoder : Decoder Photo
photoDecoder =
D.succeed Photo
|> D.required "url" D.string
|> D.required "size" D.int
|> D.optional "title" D.string "(untitled)"
type ThumbnailSize
= Small
| Medium
| Large
initialModel : Model
initialModel =
{ status = Loading
, chosenSize = Medium
, filterValues = { hue = 0, ripple = 0, noise = 0 }
, activity = ""
}
initialCommand : Cmd Message
initialCommand =
Http.get
{ url = "list"
, expect = Http.expectJson GotPhotos (D.list photoDecoder)
}
view : Model -> Html Message
view model =
div [ class "content" ] <|
case model.status of
Loading ->
[]
Loaded photos selected ->
viewLoaded model photos selected
Errored error ->
[ text ("Error: " ++ error) ]
viewLoaded : Model -> List Photo -> String -> List (Html Message)
viewLoaded model photos selected =
[ h1 [] [ text "Photo Groove" ]
, button [ onClick ClickedSurpriseMe ] [ text "Surprise me!" ]
, div [ class "activity" ] [ text model.activity ]
, div [ class "filters" ]
[ viewFilter Hue model.filterValues.hue
, viewFilter Ripple model.filterValues.ripple
, viewFilter Noise model.filterValues.noise
]
, h3 [] [ text "Thumbnail Size:" ]
, div [ id "choose-size" ]
(List.map viewSizeChooser [ Small, Medium, Large ])
, div
[ id "thumbnails"
, class (sizeToClass model.chosenSize)
]
(List.map (viewThumbnail selected) photos)
, img [ class "large", src (urlPrefix ++ "large/" ++ selected) ] []
, canvas [ id "canvas-main", class "large" ] []
]
viewThumbnail : String -> Photo -> Html Message
viewThumbnail selectedUrl thumb =
img
[ src (urlPrefix ++ thumb.url)
, title (thumb.title ++ " [" ++ String.fromInt thumb.size ++ " KB]")
, classList [ ( "selected", selectedUrl == thumb.url ) ]
, onClick (ClickedThumbnail thumb.url)
]
[]
viewSizeChooser : ThumbnailSize -> Html Message
viewSizeChooser size =
label []
[ input
[ type_ "radio"
, name "size"
, onClick (ClickedSize size)
]
[]
, text (sizeToString size)
]
viewFilter : FilterType -> Int -> Html Message
viewFilter filterType magnitude =
div
[ class "filter-slider"
]
[ label [] [ text <| filterTypeToName filterType ]
, rangeSlider
[ Attr.max "11"
, property "val" (Json.Encode.int magnitude)
, onSlide (ChangedFilter filterType)
]
[]
, label [] [ text (String.fromInt magnitude) ]
]
sizeToString : ThumbnailSize -> String
sizeToString size =
case size of
Small ->
"small"
Medium ->
"medium"
Large ->
"large"
sizeToClass : ThumbnailSize -> String
sizeToClass size =
case size of
Small ->
"small"
Medium ->
"med"
Large ->
"large"
type Message
= ClickedThumbnail String
| ClickedSurpriseMe
| ClickedSize ThumbnailSize
| ChangedFilter FilterType Int
| GotRandomPhoto Photo
| GotPhotos (Result Http.Error (List Photo))
| GotActivity String
type FilterType
= Hue
| Ripple
| Noise
filterTypeToName : FilterType -> String
filterTypeToName t =
case t of
Hue ->
"Hue"
Ripple ->
"Ripple"
Noise ->
"Noise"
update : Message -> Model -> ( Model, Cmd Message )
update msg model =
case msg of
ClickedThumbnail thumb ->
applyFilters { model | status = selectUrl thumb model.status }
ClickedSurpriseMe ->
case model.status of
Loaded (photo :: morePhotos) _ ->
Random.uniform photo morePhotos
|> Random.generate GotRandomPhoto
|> Tuple.pair model
Loaded [] _ ->
( model, Cmd.none )
Loading ->
( model, Cmd.none )
Errored _ ->
( model, Cmd.none )
ClickedSize size ->
( { model | chosenSize = size }, Cmd.none )
ChangedFilter f val ->
applyFilters { model | filterValues = setFilterValue f val model.filterValues }
GotRandomPhoto photo ->
applyFilters { model | status = selectUrl photo.url model.status }
GotPhotos (Ok ((firstPhoto :: _) as photos)) ->
applyFilters { model | status = Loaded photos firstPhoto.url }
GotPhotos (Ok []) ->
( { model | status = Errored "No photos!" }, Cmd.none )
GotPhotos (Err httpError) ->
( { model | status = Errored <| ("Failed to load photos: " ++ httpErrorToString httpError) }, Cmd.none )
GotActivity activity ->
( { model | activity = activity }, Cmd.none )
subscriptions : Model -> Sub Message
subscriptions _ =
activityChanges GotActivity
init : Float -> ( Model, Cmd Message )
init flags =
let
activity =
"Initializing Pasta v" ++ String.fromFloat flags
in
( { initialModel | activity = activity }, initialCommand )
setFilterValue : FilterType -> Int -> FilterValues -> FilterValues
setFilterValue filterType val values =
case filterType of
Hue ->
{ values | hue = val }
Ripple ->
{ values | ripple = val }
Noise ->
{ values | noise = val }
applyFilters : Model -> ( Model, Cmd msg )
applyFilters model =
case model.status of
Loaded photos selectedUrl ->
let
inPecent v =
toFloat v / 11
filters =
[ { name = filterTypeToName Hue, amount = inPecent model.filterValues.hue }
, { name = filterTypeToName Ripple, amount = inPecent model.filterValues.ripple }
, { name = filterTypeToName Noise, amount = inPecent model.filterValues.noise }
]
url =
urlPrefix ++ "large/" ++ selectedUrl
in
( model, setFilters { url = url, filters = filters } )
Loading ->
( model, Cmd.none )
Errored _ ->
( model, Cmd.none )
selectUrl : String -> Status -> Status
selectUrl url status =
case status of
Loading ->
status
Loaded photos _ ->
Loaded photos url
Errored _ ->
status
httpErrorToString : Http.Error -> String
httpErrorToString err =
case err of
Http.BadUrl msg ->
"bad URL: " ++ msg
Http.Timeout ->
"timeout"
Http.NetworkError ->
"network error"
Http.BadStatus status ->
"bad status: " ++ String.fromInt status
Http.BadBody msg ->
"bad body: " ++ msg
urlPrefix : String
urlPrefix =
"http://elm-in-action.com/"
main : Program Float Model Message
main =
Browser.element
{ init = init
, subscriptions = subscriptions
, view = view
, update = update
}
rangeSlider : List (Html.Attribute msg) -> List (Html msg) -> Html msg
rangeSlider =
node "range-slider"
onSlide : (Int -> msg) -> Attribute msg
onSlide toMsg =
D.at [ "detail", "userSlidTo" ] D.int
|> D.map toMsg
|> on "slide"

View file

@ -4,7 +4,7 @@ import Expect exposing (Expectation)
import Fuzz exposing (Fuzzer, int, list, string) import Fuzz exposing (Fuzzer, int, list, string)
import Json.Decode as J import Json.Decode as J
import Json.Encode as Encode exposing (Value) import Json.Encode as Encode exposing (Value)
import PhotoGroove as Testee import PhotoGroove.Internal as Testee
import Test exposing (..) import Test exposing (..)