Add part11

This commit is contained in:
Richard Feldman
2016-09-02 22:27:19 -07:00
parent f5f0f37180
commit dcfb00620b
16 changed files with 808 additions and 0 deletions

1
part11/.gitignore vendored Normal file
View File

@@ -0,0 +1 @@
!Auth.elm

126
part11/Main.elm Normal file
View File

@@ -0,0 +1,126 @@
module Main exposing (..)
import Page.Home
import Page.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
type Model
= Home Page.Home.Model
| Repository Page.Repository.Model
| NotFound
type Msg
= HomeMsg Page.Home.Msg
| RepositoryMsg Page.Repository.Msg
main : Program Never
main =
Navigation.program (Navigation.makeParser Page.parser)
{ init = init
, subscriptions = subscriptions
, view = view
, update = update
, urlUpdate = urlUpdate
}
subscriptions : Model -> Sub Msg
subscriptions model =
case model of
Home pageModel ->
Page.Home.subscriptions pageModel
|> Sub.map HomeMsg
Repository pageModel ->
-- Repository has no subscriptions, so there's nothing to translate!
Sub.none
NotFound ->
-- NotFound has no subscriptions, so there's nothing to translate!
Sub.none
init : Result String Page -> ( Model, Cmd Msg )
init result =
case result of
Ok (Page.Home) ->
Page.Home.init
|> Tuple2.mapEach Home (Cmd.map HomeMsg)
Ok (Page.Repository repoOwner repoName) ->
Page.Repository.init repoOwner repoName
|> Tuple2.mapEach Repository (Cmd.map RepositoryMsg)
Ok (Page.NotFound) ->
( NotFound, Cmd.none )
Err err ->
( NotFound, Cmd.none )
view : Model -> Html Msg
view model =
withHeader <|
case model of
Home pageModel ->
Page.Home.view pageModel
|> Html.map HomeMsg
Repository pageModel ->
Page.Repository.view pageModel
|> Html.map RepositoryMsg
NotFound ->
h1 [] [ text "Page Not Found" ]
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 ) ->
Page.Home.update pageMsg pageModel
|> Tuple2.mapEach Home (Cmd.map HomeMsg)
( RepositoryMsg pageMsg, Repository pageModel ) ->
Page.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) ->
Page.Home.init
|> Tuple2.mapEach Home (Cmd.map HomeMsg)
Ok (Page.Repository repoOwner repoName) ->
Page.Repository.init repoOwner repoName
|> Tuple2.mapEach Repository (Cmd.map RepositoryMsg)
Ok (Page.NotFound) ->
( NotFound, Cmd.none )
Err err ->
( NotFound, Cmd.none )

26
part11/Page.elm Normal file
View File

@@ -0,0 +1,26 @@
module Page exposing (..)
import Navigation
import UrlParser exposing (Parser, (</>), format, int, s, string)
import String
type Page
= Home
| Repository String String
| NotFound
pageParser : Parser (Page -> a) a
pageParser =
UrlParser.oneOf
[ format Home (s "")
, format Repository (s "repositories" </> string </> string)
]
parser : Navigation.Location -> Result String Page
parser location =
location.pathname
|> String.dropLeft 1
|> UrlParser.parse identity pageParser

166
part11/Page/Home.elm Normal file
View File

@@ -0,0 +1,166 @@
port module Page.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 Json.Decode.Pipeline exposing (decode, required)
import Navigation
type alias SearchResult =
{ id : Int
, name : String
, stars : Int
}
searchResultDecoder : Decoder SearchResult
searchResultDecoder =
decode SearchResult
|> required "id" Json.Decode.int
|> required "full_name" Json.Decode.string
|> required "stargazers_count" Json.Decode.int
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)
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/" ++ result.name)) ]
[ 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

136
part11/Page/Repository.elm Normal file
View File

@@ -0,0 +1,136 @@
module Page.Repository exposing (..)
import Html exposing (..)
import Html.Attributes exposing (class, target, href, property, defaultValue, src)
import Auth
import Http
import Task
import Json.Decode exposing (Decoder, int, string, list)
import Json.Decode.Pipeline exposing (decode, required)
type alias Model =
{ repoOwner : String
, repoName : String
, repository : Maybe Repository
}
type alias Repository =
{ id : Int
, issues : Int
, forks : Int
, watchers : Int
, owner : User
, description : String
}
type alias User =
{ id : Int
, username : String
, avatarUrl : String
, profileUrl : String
}
userDecoder : Decoder User
userDecoder =
decode User
|> required "id" int
|> required "login" string
|> required "avatar_url" string
|> required "url" string
repoDecoder : Decoder Repository
repoDecoder =
decode Repository
|> required "id" int
|> required "open_issues_count" int
|> required "forks" int
|> required "watchers" int
|> required "owner" userDecoder
|> required "description" string
init : String -> String -> ( Model, Cmd Msg )
init repoOwner repoName =
( { repoOwner = repoOwner
, repoName = repoName
, repository = Nothing
}
, getRepoInfo repoOwner repoName
)
view : Model -> Html Msg
view model =
let
ownerUrl =
"https://github.com/" ++ model.repoOwner
repoUrl =
ownerUrl ++ "/" ++ model.repoName
details =
model.repository
|> Maybe.map viewDetails
|> Maybe.withDefault (text "")
in
div []
[ h2 []
[ a [ href repoUrl ] [ text model.repoName ] ]
, details
]
viewDetails : Repository -> Html Msg
viewDetails repo =
div []
[ p [ class "repo-description" ] [ text repo.description ]
, h3 []
[ a [ href repo.owner.profileUrl ]
[ img [ class "profile-photo", src repo.owner.avatarUrl ] []
, text repo.owner.username
]
]
, table []
[ tbody []
[ tr [] [ th [] [ text "issues" ], td [] [ text (toString repo.issues) ] ]
, tr [] [ th [] [ text "forks" ], td [] [ text (toString repo.forks) ] ]
, tr [] [ th [] [ text "watchers" ], td [] [ text (toString repo.watchers) ] ]
]
]
]
type Msg
= HandleRepoError Http.Error
| HandleRepoResponse Repository
getRepoInfo : String -> String -> Cmd Msg
getRepoInfo repoOwner repoName =
let
url =
"https://api.github.com/repos/"
++ repoOwner
++ "/"
++ repoName
++ "?access_token="
++ Auth.token
|> Debug.log "getRepoInfo"
in
Http.get repoDecoder url
|> Task.perform HandleRepoError HandleRepoResponse
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
HandleRepoError err ->
( model, Cmd.none )
HandleRepoResponse repository ->
( { model | repository = Just repository }, Cmd.none )

45
part11/README.md Normal file
View File

@@ -0,0 +1,45 @@
Part 10
=======
The instructor will paste notes from the lesson, including code examples from
Q&A, in [this document](https://docs.google.com/document/d/1ApuSOk9DP0YsQrxhW7-WE8UOEAV4PPnLDDeqUOL2o5k/edit?usp=sharing).
## Installation
```bash
elm-package install
```
(Answer `y` when prompted.)
## Building
```bash
elm-live Main.elm --open --pushstate --output=elm.js
```
## Running Tests
Do either (or both!) of the following:
#### Running tests on the command line
```bash
elm-test
```
#### Running tests in a browser
```bash
cd tests
elm-reactor
```
Then visit [localhost:8000](http://localhost:8000) and choose `HtmlRunner.elm`.
## References
* [Using Elm packages](https://github.com/elm-lang/elm-package/blob/master/README.md#basic-usage)
* [elm-test documentation](http://package.elm-lang.org/packages/project-fuzzball/test/latest)
* [`(<|)` documentation](http://package.elm-lang.org/packages/elm-lang/core/4.0.0/Basics#<|)

BIN
part11/elm-hub.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.1 KiB

21
part11/elm-package.json Normal file
View File

@@ -0,0 +1,21 @@
{
"version": "1.0.0",
"summary": "Like GitHub, but for Elm stuff.",
"repository": "https://github.com/rtfeldman/elm-workshop.git",
"license": "BSD-3-Clause",
"source-directories": [
".",
".."
],
"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",
"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"
}

2
part11/github.js Normal file

File diff suppressed because one or more lines are too long

36
part11/index.html Normal file
View File

@@ -0,0 +1,36 @@
<!DOCTYPE HTML>
<html>
<head>
<meta charset="UTF-8">
<title>ElmHub</title>
<script type="text/javascript" src="/github.js"></script>
<script type="text/javascript" src="/elm.js"></script>
<link rel="stylesheet" href="/style.css">
<link rel="icon" type="image/png" href="/elm-hub.png">
</head>
<body>
<div id="elm-landing-pad"></div>
</body>
<script type="text/javascript">
// documentation: https://github.com/michael/github
var github = new Github();
var app = Elm.Main.embed(document.getElementById("elm-landing-pad"));
function searchGithub(query) {
console.log("Searching for", query);
github.getSearch(query).repositories({}, function (err, repositories) {
console.log("Got response", repositories);
app.ports.githubResponse.send(repositories);
});
}
app.ports.githubSearch.subscribe(searchGithub);
</script>
</html>

123
part11/style.css Normal file
View File

@@ -0,0 +1,123 @@
.content {
width: 960px;
margin: 0 auto;
padding: 30px;
font-family: Helvetica, Arial, serif;
}
header {
position: relative;
padding: 6px 12px;
height: 36px;
background-color: rgb(96, 181, 204);
}
h1 {
color: white;
font-weight: normal;
margin: 0;
}
.tagline {
color: #eee;
position: absolute;
right: 16px;
top: 12px;
font-size: 24px;
font-style: italic;
}
.results {
list-style-image: url('http://img-cache.cdn.gaiaonline.com/76bd5c99d8f2236e9d3672510e933fdf/http://i278.photobucket.com/albums/kk81/d3m3nt3dpr3p/Tiny-Star-Icon.png');
list-style-position: inside;
padding: 0;
}
.results li {
font-size: 18px;
margin-bottom: 16px;
}
.star-count {
font-weight: bold;
margin-right: 16px;
}
a {
color: rgb(96, 181, 204);
text-decoration: none;
}
a:hover {
text-decoration: underline;
}
.search-query {
padding: 8px;
font-size: 24px;
margin-bottom: 18px;
margin-top: 36px;
}
.search-button {
padding: 8px 16px;
font-size: 24px;
color: white;
border: 1px solid #ccc;
background-color: rgb(96, 181, 204);
margin-left: 12px
}
.search-button:hover {
color: rgb(96, 181, 204);
background-color: white;
}
.hide-result {
background-color: transparent;
border: 0;
font-weight: bold;
font-size: 18px;
margin-left: 18px;
cursor: pointer;
}
.hide-result:hover {
color: rgb(96, 181, 204);
}
button:focus, input:focus {
outline: none;
}
.error {
background-color: #FF9632;
padding: 20px;
box-sizing: border-box;
overflow-x: auto;
font-family: monospace;
font-size: 18px;
}
a {
cursor: pointer;
}
.repo-description {
font-size: 18px;
}
.profile-photo {
width: 32px;
margin-right: 10px;
}
th {
text-align: left;
}
th, td {
font-size: 18px;
padding-right: 20px;
}

7
part11/tests/Auth.elm Normal file
View File

@@ -0,0 +1,7 @@
module Auth exposing (token)
token : String
token =
-- Tests don't need a real token.
""

View File

@@ -0,0 +1,16 @@
module HtmlRunner exposing (..)
import Tests
import Test.Runner.Html as Runner
-- To run this:
--
-- cd into part8/test
-- elm-reactor
-- navigate to HtmlRunner.elm
main : Program Never
main =
Runner.run Tests.all

18
part11/tests/Main.elm Normal file
View File

@@ -0,0 +1,18 @@
port module Main exposing (..)
import Tests
import Test.Runner.Node as Runner
import Json.Decode exposing (Value)
-- To run this:
--
-- elm-test
main : Program Value
main =
Runner.run emit Tests.all
port emit : ( String, Value ) -> Cmd msg

64
part11/tests/Tests.elm Normal file
View File

@@ -0,0 +1,64 @@
module Tests exposing (..)
import Test exposing (..)
import Fuzz exposing (..)
import Expect exposing (Expectation)
import ElmHub exposing (responseDecoder)
import Json.Decode exposing (decodeString, Value)
import String
all : Test
all =
describe "GitHub Response Decoder"
[ test "it results in an Err for invalid JSON" <|
\() ->
let
json =
"""{ "pizza": [] }"""
isErrorResult result =
case result of
Err _ ->
True
Ok _ ->
False
in
json
|> decodeString responseDecoder
|> isErrorResult
|> Expect.true "Expected decoding an invalid response to return an Err."
, test "it successfully decodes a valid response" <|
\() ->
"""{ "items": [
{ "id": 5, "full_name": "foo", "stargazers_count": 42 },
{ "id": 3, "full_name": "bar", "stargazers_count": 77 }
] }"""
|> decodeString responseDecoder
|> Expect.equal
(Ok
[ { id = 5, name = "foo", stars = 42 }
, { id = 3, name = "bar", stars = 77 }
]
)
, fuzz (list int) "it decodes one SearchResult for each 'item' in the JSON" <|
\ids ->
let
jsonFromId id =
"""{"id": """ ++ toString id ++ """, "full_name": "foo", "stargazers_count": 42}"""
jsonItems =
String.join ", " (List.map jsonFromId ids)
json =
"""{ "items": [""" ++ jsonItems ++ """] }"""
in
case decodeString responseDecoder json of
Ok results ->
List.length results
|> Expect.equal (List.length ids)
Err err ->
Expect.fail ("JSON decoding failed unexpectedly: " ++ err)
]

View File

@@ -0,0 +1,21 @@
{
"version": "1.0.0",
"summary": "Like GitHub, but for Elm stuff.",
"repository": "https://github.com/rtfeldman/elm-workshop.git",
"license": "BSD-3-Clause",
"source-directories": [
".",
".."
],
"exposed-modules": [],
"dependencies": {
"NoRedInk/elm-decode-pipeline": "1.1.2 <= v < 2.0.0",
"elm-community/elm-test": "2.0.1 <= v < 3.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",
"rtfeldman/html-test-runner": "1.0.0 <= v < 2.0.0",
"rtfeldman/node-test-runner": "2.0.0 <= v < 3.0.0"
},
"elm-version": "0.17.0 <= v < 0.18.0"
}