diff --git a/part10/ElmHub.elm b/part10/ElmHub.elm index 6a47dcc..6275b46 100644 --- a/part10/ElmHub.elm +++ b/part10/ElmHub.elm @@ -1,43 +1,9 @@ module ElmHub exposing (..) -import Html exposing (..) -import Html.Attributes exposing (class, target, href, property, defaultValue) -import Html.Events exposing (..) -import Auth import Json.Decode exposing (Decoder) import Json.Decode.Pipeline exposing (..) -getQueryString : String -> String -getQueryString query = - -- See https://developer.github.com/v3/search/#example for how to customize! - "access_token=" - ++ Auth.token - ++ "&q=" - ++ query - ++ "+language:elm&sort=stars&order=desc" - - -responseDecoder : Decoder (List SearchResult) -responseDecoder = - Json.Decode.at [ "items" ] (Json.Decode.list searchResultDecoder) - - -searchResultDecoder : Decoder SearchResult -searchResultDecoder = - decode SearchResult - |> required "id" Json.Decode.int - |> required "full_name" Json.Decode.string - |> required "stargazers_count" Json.Decode.int - - -type alias Model = - { query : String - , results : List SearchResult - , errorMessage : Maybe String - } - - type alias SearchResult = { id : Int , name : String @@ -45,93 +11,9 @@ type alias SearchResult = } -initialModel : Model -initialModel = - { query = "tutorial" - , results = [] - , errorMessage = Nothing - } - - -view : Model -> Html Msg -view model = - div [ class "content" ] - [ header [] - [ h1 [] [ text "ElmHub" ] - , span [ class "tagline" ] [ text "Like GitHub, but for Elm things." ] - ] - , input [ class "search-query", onInput SetQuery, defaultValue model.query ] [] - , button [ class "search-button", onClick Search ] [ text "Search" ] - , viewErrorMessage model.errorMessage - , ul [ class "results" ] (List.map viewSearchResult model.results) - ] - - -viewErrorMessage : Maybe String -> Html a -viewErrorMessage errorMessage = - case errorMessage of - Just message -> - div [ class "error" ] [ text message ] - - Nothing -> - text "" - - -viewSearchResult : SearchResult -> Html Msg -viewSearchResult result = - li [] - [ span [ class "star-count" ] [ text (toString result.stars) ] - , a [ href ("https://github.com/" ++ result.name), target "_blank" ] - [ text result.name ] - , button [ class "hide-result", onClick (DeleteById result.id) ] - [ text "X" ] - ] - - -type Msg - = Search - | SetQuery String - | DeleteById Int - | HandleSearchResponse (List SearchResult) - | HandleSearchError (Maybe String) - | DoNothing - - -update : (String -> Cmd Msg) -> Msg -> Model -> ( Model, Cmd Msg ) -update searchFeed msg model = - case msg of - Search -> - ( model, searchFeed (getQueryString model.query) ) - - SetQuery query -> - ( { model | query = query }, Cmd.none ) - - HandleSearchResponse results -> - ( { model | results = results }, Cmd.none ) - - HandleSearchError error -> - ( { model | errorMessage = error }, Cmd.none ) - - DeleteById idToHide -> - let - newResults = - model.results - |> List.filter (\{ id } -> id /= idToHide) - - newModel = - { model | results = newResults } - in - ( newModel, Cmd.none ) - - DoNothing -> - ( model, Cmd.none ) - - -decodeGithubResponse : Json.Decode.Value -> Msg -decodeGithubResponse value = - case Json.Decode.decodeValue responseDecoder value of - Ok results -> - HandleSearchResponse results - - Err err -> - HandleSearchError (Just err) +searchResultDecoder : Decoder SearchResult +searchResultDecoder = + decode SearchResult + |> required "id" Json.Decode.int + |> required "full_name" Json.Decode.string + |> required "stargazers_count" Json.Decode.int diff --git a/part10/Main.elm b/part10/Main.elm index 6c8a8fe..a5576be 100644 --- a/part10/Main.elm +++ b/part10/Main.elm @@ -1,31 +1,105 @@ -port module Main exposing (..) +module Main exposing (..) -import ElmHub exposing (..) +import Pages.Home +import Pages.Repository +import Navigation +import Page exposing (Page(..)) +import Tuple2 +import Html exposing (Html, div, h1, header, text, span) +import Html.Attributes exposing (class) import Html.App as Html -import Json.Decode + + +type Model + = Home Pages.Home.Model + | Repository Pages.Repository.Model + + +type Msg + = HomeMsg Pages.Home.Msg + | RepositoryMsg Pages.Repository.Msg main : Program Never main = - Html.program - { view = view - , update = update githubSearch - , init = ( initialModel, githubSearch (getQueryString initialModel.query) ) - , subscriptions = \_ -> githubResponse decodeResponse + Navigation.program (Navigation.makeParser Page.parser) + { init = init + , subscriptions = subscriptions + , view = view + , update = update + , urlUpdate = urlUpdate } -decodeResponse : Json.Decode.Value -> Msg -decodeResponse json = - case Json.Decode.decodeValue responseDecoder json of - Err err -> - HandleSearchError (Just err) +subscriptions : Model -> Sub Msg +subscriptions model = + case model of + Home pageModel -> + Pages.Home.subscriptions pageModel + |> Sub.map HomeMsg - Ok results -> - HandleSearchResponse results + Repository pageModel -> + Sub.none -port githubSearch : String -> Cmd msg +init : Result String Page -> ( Model, Cmd Msg ) +init result = + Home (fst Pages.Home.init) + |> urlUpdate result -port githubResponse : (Json.Decode.Value -> msg) -> Sub msg +view : Model -> Html Msg +view model = + withHeader <| + case model of + Home pageModel -> + Pages.Home.view pageModel + |> Html.map HomeMsg + + Repository pageModel -> + Pages.Repository.view pageModel + |> Html.map RepositoryMsg + + +withHeader : Html msg -> Html msg +withHeader innerContent = + div [ class "content" ] + [ header [] + [ h1 [] [ text "ElmHub" ] + , span [ class "tagline" ] [ text "Like GitHub, but for Elm things." ] + ] + , innerContent + ] + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case ( msg, model ) of + ( HomeMsg pageMsg, Home pageModel ) -> + Pages.Home.update pageMsg pageModel + |> Tuple2.mapEach Home (Cmd.map HomeMsg) + + ( RepositoryMsg pageMsg, Repository pageModel ) -> + Pages.Repository.update pageMsg pageModel + |> Tuple2.mapEach Repository (Cmd.map RepositoryMsg) + + ( _, _ ) -> + ( model, Cmd.none ) + + +urlUpdate : Result String Page -> Model -> ( Model, Cmd Msg ) +urlUpdate result model = + case result of + Ok (Page.Home) -> + Pages.Home.init + |> Tuple2.mapEach Home (Cmd.map HomeMsg) + + Ok (Page.Repository id) -> + Pages.Repository.init id + |> Tuple2.mapEach Repository (Cmd.map RepositoryMsg) + + Ok NotFound -> + ( model, Cmd.none ) + + Err _ -> + ( model, Navigation.modifyUrl "/" ) diff --git a/part10/Page.elm b/part10/Page.elm new file mode 100644 index 0000000..8b17668 --- /dev/null +++ b/part10/Page.elm @@ -0,0 +1,26 @@ +module Page exposing (..) + +import Navigation +import UrlParser exposing (Parser, (), format, int, s, string) +import String + + +type Page + = Home + | Repository Int + | NotFound + + +pageParser : Parser (Page -> a) a +pageParser = + UrlParser.oneOf + [ format Home (s "") + , format Repository (s "repositories" int) + ] + + +parser : Navigation.Location -> Result String Page +parser location = + location.pathname + |> String.dropLeft 1 + |> UrlParser.parse identity pageParser diff --git a/part10/Pages/Home.elm b/part10/Pages/Home.elm new file mode 100644 index 0000000..827d921 --- /dev/null +++ b/part10/Pages/Home.elm @@ -0,0 +1,151 @@ +port module Pages.Home exposing (..) + +import Html exposing (..) +import Html.Attributes exposing (class, target, href, property, defaultValue) +import Html.Events exposing (..) +import Auth +import Json.Decode exposing (Decoder) +import ElmHub exposing (SearchResult) +import Navigation + + +getQueryString : String -> String +getQueryString query = + -- See https://developer.github.com/v3/search/#example for how to customize! + "access_token=" + ++ Auth.token + ++ "&q=" + ++ query + ++ "+language:elm&sort=stars&order=desc" + + +responseDecoder : Decoder (List SearchResult) +responseDecoder = + Json.Decode.at [ "items" ] (Json.Decode.list ElmHub.searchResultDecoder) + + +type alias Model = + { query : String + , results : List SearchResult + , errorMessage : Maybe String + } + + +initialQuery : String +initialQuery = + "tutorial" + + +init : ( Model, Cmd Msg ) +init = + ( { query = initialQuery + , results = [] + , errorMessage = Nothing + } + , githubSearch (getQueryString initialQuery) + ) + + +view : Model -> Html Msg +view model = + div [] + [ input [ class "search-query", onInput SetQuery, defaultValue model.query ] [] + , button [ class "search-button", onClick Search ] [ text "Search" ] + , viewErrorMessage model.errorMessage + , ul [ class "results" ] (List.map viewSearchResult model.results) + ] + + +viewErrorMessage : Maybe String -> Html a +viewErrorMessage errorMessage = + case errorMessage of + Just message -> + div [ class "error" ] [ text message ] + + Nothing -> + text "" + + +viewSearchResult : SearchResult -> Html Msg +viewSearchResult result = + li [] + [ span [ class "star-count" ] [ text (toString result.stars) ] + , a [ onClick (Visit ("/repositories/" ++ toString result.id)) ] + [ text result.name ] + , button [ class "hide-result", onClick (DeleteById result.id) ] + [ text "X" ] + ] + + +type Msg + = Search + | Visit String + | SetQuery String + | DeleteById Int + | HandleSearchResponse (List SearchResult) + | HandleSearchError (Maybe String) + | DoNothing + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + Visit url -> + ( model, Navigation.newUrl url ) + + Search -> + ( model, githubSearch (getQueryString model.query) ) + + SetQuery query -> + ( { model | query = query }, Cmd.none ) + + HandleSearchResponse results -> + ( { model | results = results }, Cmd.none ) + + HandleSearchError error -> + ( { model | errorMessage = error }, Cmd.none ) + + DeleteById idToHide -> + let + newResults = + model.results + |> List.filter (\{ id } -> id /= idToHide) + + newModel = + { model | results = newResults } + in + ( newModel, Cmd.none ) + + DoNothing -> + ( model, Cmd.none ) + + +decodeGithubResponse : Json.Decode.Value -> Msg +decodeGithubResponse value = + case Json.Decode.decodeValue responseDecoder value of + Ok results -> + HandleSearchResponse results + + Err err -> + HandleSearchError (Just err) + + +decodeResponse : Json.Decode.Value -> Msg +decodeResponse json = + case Json.Decode.decodeValue responseDecoder json of + Err err -> + HandleSearchError (Just err) + + Ok results -> + HandleSearchResponse results + + +subscriptions : Model -> Sub Msg +subscriptions _ = + githubResponse decodeResponse + + +port githubSearch : String -> Cmd msg + + +port githubResponse : (Json.Decode.Value -> msg) -> Sub msg diff --git a/part10/Pages/Repository.elm b/part10/Pages/Repository.elm new file mode 100644 index 0000000..075ee09 --- /dev/null +++ b/part10/Pages/Repository.elm @@ -0,0 +1,37 @@ +module Pages.Repository exposing (..) + +import Html exposing (..) +import Html.Attributes exposing (class, target, href, property, defaultValue) +import ElmHub exposing (SearchResult) + + +type alias Model = + SearchResult + + +init : Int -> ( Model, Cmd Msg ) +init id = + ( { id = id + , name = "" + , stars = id + } + , Cmd.none + ) + + +view : Model -> Html Msg +view model = + div [] + [ div [] [ text ("repo" ++ toString model.stars) ] + ] + + +type Msg + = NoOp + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + NoOp -> + ( model, Cmd.none ) diff --git a/part10/elm-package.json b/part10/elm-package.json index a9183a1..54c81f1 100644 --- a/part10/elm-package.json +++ b/part10/elm-package.json @@ -9,10 +9,13 @@ ], "exposed-modules": [], "dependencies": { + "Fresheyeball/elm-tuple-extra": "2.1.0 <= v < 3.0.0", "NoRedInk/elm-decode-pipeline": "1.1.2 <= v < 2.0.0", "elm-lang/core": "4.0.1 <= v < 5.0.0", "elm-lang/html": "1.0.0 <= v < 2.0.0", - "evancz/elm-http": "3.0.1 <= v < 4.0.0" + "elm-lang/navigation": "1.0.0 <= v < 2.0.0", + "evancz/elm-http": "3.0.1 <= v < 4.0.0", + "evancz/url-parser": "1.0.0 <= v < 2.0.0" }, "elm-version": "0.17.0 <= v < 0.18.0" } diff --git a/part10/style.css b/part10/style.css index d030733..b7772e1 100644 --- a/part10/style.css +++ b/part10/style.css @@ -99,3 +99,7 @@ button:focus, input:focus { font-family: monospace; font-size: 18px; } + +a { + cursor: pointer; +}