Add part11

This commit is contained in:
Richard Feldman
2016-09-06 17:50:35 -07:00
parent 32bb5dd913
commit 4ce7510e1b
16 changed files with 683 additions and 7 deletions

1
part11/.gitignore vendored Normal file
View File

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

150
part11/ElmHub.elm Normal file
View File

@@ -0,0 +1,150 @@
module ElmHub exposing (..)
import Html exposing (..)
import Html.Attributes exposing (class, target, href, defaultValue, type', checked, placeholder, value)
import Html.Events exposing (..)
import Html.App as Html
import Json.Decode exposing (Decoder)
import Json.Decode.Pipeline exposing (..)
import Search
import Tuple2
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 =
{ results : List SearchResult
, errorMessage : Maybe String
, search : Search.Model
}
type alias SearchResult =
{ id : Int
, name : String
, stars : Int
}
initialModel : Model
initialModel =
{ results = []
, errorMessage = Nothing
, search = Search.initialModel
}
type Msg
= SearchMsg Search.Msg
| DeleteById Int
| HandleSearchResponse (List SearchResult)
| HandleSearchError (Maybe String)
| DoNothing
init : ( Model, Cmd Msg )
init =
-- TODO Incorporate Search.init
--
-- Search.init has the type ( Search.Model, Cmd Search.Msg )
-- which we will convert to ( Model, Cmd Msg )
--
-- Use Tuple2.mapEach to translate, by passing functions with these types:
--
-- (Search.Model -> Model)
-- (Cmd Search.Msg -> Cmd Msg)
--
-- For reference:
--
-- mapEach : (a -> newA) -> (b -> newB) -> ( a, b ) -> ( newA, newB )
( initialModel, Cmd.none )
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
SearchMsg searchMsg ->
-- TODO Call Search.update passing the appropriate two arguments.
--
-- Then, since Search.update's return type is the same as Search.init,
-- use the same process as we did with Search.init and init
-- to translate between Search.update and update.
--
-- HINT: When you're done here, don't forget the TODO in Search.elm!
Search.update searchMsg model.search
|> Tuple2.mapEach (\search -> { model | search = search }) (Cmd.map SearchMsg)
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 )
view : Model -> Html Msg
view model =
div [ class "content" ]
[ header []
[ h1 [] [ text "ElmHub" ]
, span [ class "tagline" ] [ text "Like GitHub, but for Elm things." ]
]
, Html.map SearchMsg (Search.view model.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" ]
]
decodeGithubResponse : Json.Decode.Value -> Msg
decodeGithubResponse value =
case Json.Decode.decodeValue responseDecoder value of
Ok results ->
HandleSearchResponse results
Err err ->
HandleSearchError (Just err)

28
part11/Main.elm Normal file
View File

@@ -0,0 +1,28 @@
port module Main exposing (..)
import ElmHub exposing (..)
import Html.App as Html
import Json.Decode
main : Program Never
main =
Html.program
{ view = view
, update = update
, init = init
, subscriptions = \_ -> githubResponse decodeResponse
}
decodeResponse : Json.Decode.Value -> Msg
decodeResponse json =
case Json.Decode.decodeValue responseDecoder json of
Err err ->
HandleSearchError (Just err)
Ok results ->
HandleSearchResponse results
port githubResponse : (Json.Decode.Value -> msg) -> Sub msg

42
part11/README.md Normal file
View File

@@ -0,0 +1,42 @@
Part 11
=======
## 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/elm-community/elm-test/latest)
* [`(<|)` documentation](http://package.elm-lang.org/packages/elm-lang/core/latest/Basics#<|)

139
part11/Search.elm Normal file
View File

@@ -0,0 +1,139 @@
port module Search exposing (..)
import Html exposing (..)
import Html.Attributes exposing (class, target, href, defaultValue, type', checked, placeholder, value)
import Html.Events exposing (..)
import Json.Decode exposing (Decoder)
import Auth
import String
port githubSearch : String -> Cmd msg
type alias Model =
{ query : String
, sort : String
, ascending : Bool
, searchInDescription : Bool
, userFilter : String
}
type Msg
= SetQuery String
| SetSort String
| SetAscending Bool
| SetSearchInDescription Bool
| SetUserFilter String
| Search
init : ( Model, Cmd Msg )
init =
( initialModel, githubSearch (getQueryString initialModel) )
initialModel : Model
initialModel =
{ query = "tutorial"
, sort = "stars"
, ascending = False
, searchInDescription = True
, userFilter = ""
}
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
Search ->
-- TODO instead of Cmd.none, run this:
-- githubSearch (getQueryString model)
( model, Cmd.none )
SetQuery query ->
( { model | query = query }, Cmd.none )
SetSort sort ->
( { model | sort = sort }, Cmd.none )
SetAscending ascending ->
( { model | ascending = ascending }, Cmd.none )
SetSearchInDescription searchInDescription ->
( { model | searchInDescription = searchInDescription }, Cmd.none )
SetUserFilter userFilter ->
( { model | userFilter = userFilter }, Cmd.none )
view : Model -> Html Msg
view model =
div [ class "search" ]
[ div [ class "search-options" ]
[ div [ class "search-option" ]
[ label [ class "top-label" ] [ text "Sort by" ]
, select [ onChange SetSort, value model.sort ]
[ option [ value "stars" ] [ text "Stars" ]
, option [ value "forks" ] [ text "Forks" ]
, option [ value "updated" ] [ text "Updated" ]
]
]
, div [ class "search-option" ]
[ label [ class "top-label" ] [ text "Owned by" ]
, input
[ type' "text"
, placeholder "Enter a username"
, defaultValue model.userFilter
, onInput SetUserFilter
]
[]
]
, label [ class "search-option" ]
[ input [ type' "checkbox", checked model.ascending, onCheck SetAscending ] []
, text "Sort ascending"
]
, label [ class "search-option" ]
[ input [ type' "checkbox", checked model.searchInDescription, onCheck SetSearchInDescription ] []
, text "Search in description"
]
]
, div [ class "search-input" ]
[ input [ class "search-query", onInput SetQuery, defaultValue model.query ] []
, button [ class "search-button", onClick Search ] [ text "Search" ]
]
]
onChange : (String -> msg) -> Attribute msg
onChange toMsg =
on "change" (Json.Decode.map toMsg Html.Events.targetValue)
getQueryString : Model -> String
getQueryString model =
-- See https://developer.github.com/v3/search/#example for how to customize!
"access_token="
++ Auth.token
++ "&q="
++ model.query
++ (if model.searchInDescription then
"+in:name,description"
else
"+in:name"
)
++ "+language:elm"
++ (if String.isEmpty model.userFilter then
""
else
"+user:" ++ model.userFilter
)
++ "&sort="
++ model.sort
++ "&order="
++ (if model.ascending then
"asc"
else
"desc"
)

BIN
part11/elm-hub.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.1 KiB

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

@@ -0,0 +1,19 @@
{
"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",
"evancz/elm-http": "3.0.1 <= v < 4.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

32
part11/index.html Normal file
View File

@@ -0,0 +1,32 @@
<!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) {
github.getSearch(query).repositories({}, function (err, repositories) {
app.ports.githubResponse.send(repositories);
});
}
app.ports.githubSearch.subscribe(searchGithub);
</script>
</html>

139
part11/style.css Normal file
View File

@@ -0,0 +1,139 @@
.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;
}
.search-input {
display: block;
float: left;
width: 50%;
}
.search-options {
position: relative;
float: right;
width: 50%;
box-sizing: border-box;
padding: 20px;
}
.search-option {
display: block;
float: left;
width: 50%;
box-sizing: border-box;
}
.search-option input[type="text"] {
padding: 5px;
box-sizing: border-box;
width: 90%;
}
.search:after {
content: "";
display: table;
clear: both;
}
.top-label {
display: block;
color: #555;
}

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"
}