Add part13

This commit is contained in:
Richard Feldman
2016-09-06 20:57:27 -07:00
parent f98c04ce71
commit 50a29747ff
9 changed files with 568 additions and 0 deletions

302
part13/ElmHub.elm Normal file
View File

@@ -0,0 +1,302 @@
port 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 Html.Lazy exposing (lazy, lazy3)
import Auth
import Json.Decode exposing (Decoder)
import Json.Decode.Pipeline exposing (..)
import String
import Table
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
, options : SearchOptions
, tableState : Table.State
}
type alias SearchOptions =
{ sort : String
, ascending : Bool
, searchInDescription : Bool
, userFilter : String
}
type alias SearchResult =
{ id : Int
, name : String
, stars : Int
}
initialModel : Model
initialModel =
{ query = "tutorial"
, results = []
, errorMessage = Nothing
, options =
{ sort = "stars"
, ascending = False
, searchInDescription = True
, userFilter = ""
}
, tableState = Table.initialSort "Stars"
}
init : ( Model, Cmd Msg )
init =
( initialModel, githubSearch (getQueryString initialModel) )
subscriptions : Model -> Sub Msg
subscriptions _ =
githubResponse decodeResponse
type Msg
= Search
| Options OptionsMsg
| SetQuery String
| DeleteById Int
| HandleSearchResponse (List SearchResult)
| HandleSearchError (Maybe String)
| SetTableState Table.State
| DoNothing
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
Options optionsMsg ->
( { model | options = updateOptions optionsMsg model.options }, Cmd.none )
Search ->
( model, githubSearch (getQueryString model) )
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 )
SetTableState tableState ->
( { model | tableState = tableState }, Cmd.none )
DoNothing ->
( model, Cmd.none )
tableConfig : Table.Config SearchResult Msg
tableConfig =
Table.config
{ toId = .id >> toString
, toMsg = SetTableState
, columns = [ starsColumn, nameColumn ]
}
starsColumn : Table.Column SearchResult Msg
starsColumn =
Table.veryCustomColumn
{ name = "Stars"
, viewData = viewStars
, sorter = Table.increasingOrDecreasingBy (negate << .stars)
}
nameColumn : Table.Column SearchResult Msg
nameColumn =
Table.veryCustomColumn
{ name = "Name"
, viewData = viewSearchResult
, sorter = Table.increasingOrDecreasingBy .name
}
updateOptions : OptionsMsg -> SearchOptions -> SearchOptions
updateOptions optionsMsg options =
case optionsMsg of
SetSort sort ->
{ options | sort = sort }
SetAscending ascending ->
{ options | ascending = ascending }
SetSearchInDescription searchInDescription ->
{ options | searchInDescription = searchInDescription }
SetUserFilter userFilter ->
{ options | userFilter = userFilter }
view : Model -> Html Msg
view model =
div [ class "content" ]
[ header []
[ h1 [] [ text "ElmHub" ]
, span [ class "tagline" ] [ text "Like GitHub, but for Elm things." ]
]
, div [ class "search" ]
[ Html.map Options (lazy viewOptions model.options)
, div [ class "search-input" ]
[ input [ class "search-query", onInput SetQuery, defaultValue model.query ] []
, button [ class "search-button", onClick Search ] [ text "Search" ]
]
]
, viewErrorMessage model.errorMessage
, lazy3 Table.view tableConfig model.tableState 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 OptionsMsg
= SetSort String
| SetAscending Bool
| SetSearchInDescription Bool
| SetUserFilter String
viewOptions : SearchOptions -> Html OptionsMsg
viewOptions opts =
div [ class "search-options" ]
[ div [ class "search-option" ]
[ label [ class "top-label" ] [ text "Sort by" ]
, select [ onChange SetSort, value opts.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 opts.userFilter
, onInput SetUserFilter
]
[]
]
, label [ class "search-option" ]
[ input [ type' "checkbox", checked opts.ascending, onCheck SetAscending ] []
, text "Sort ascending"
]
, label [ class "search-option" ]
[ input [ type' "checkbox", checked opts.searchInDescription, onCheck SetSearchInDescription ] []
, text "Search in description"
]
]
decodeGithubResponse : Json.Decode.Value -> Msg
decodeGithubResponse value =
case Json.Decode.decodeValue responseDecoder value of
Ok results ->
HandleSearchResponse results
Err err ->
HandleSearchError (Just err)
onChange : (String -> msg) -> Attribute msg
onChange toMsg =
on "change" (Json.Decode.map toMsg Html.Events.targetValue)
decodeResponse : Json.Decode.Value -> Msg
decodeResponse json =
case Json.Decode.decodeValue responseDecoder json of
Err err ->
HandleSearchError (Just err)
Ok results ->
HandleSearchResponse results
port githubSearch : String -> Cmd msg
port githubResponse : (Json.Decode.Value -> msg) -> Sub msg
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.options.searchInDescription then
"+in:name,description"
else
"+in:name"
)
++ "+language:elm"
++ (if String.isEmpty model.options.userFilter then
""
else
"+user:" ++ model.options.userFilter
)
++ "&sort="
++ model.options.sort
++ "&order="
++ (if model.options.ascending then
"asc"
else
"desc"
)

148
part13/ElmHubCss.elm Normal file
View File

@@ -0,0 +1,148 @@
module ElmHubCss exposing (..)
import Css exposing (..)
css : Stylesheet
css =
stylesheet
[ ((.) "content")
[ width (px 960)
, margin2 zero auto
, padding (px 30)
, fontFamilies [ "Helvetica", "Arial", "serif" ]
]
-- TODO convert these remaining styles to use elm-css.
--
-- 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;
-- }
]

14
part13/Main.elm Normal file
View File

@@ -0,0 +1,14 @@
module Main exposing (main)
import ElmHub
import Html.App as Html
main : Program Never
main =
Html.program
{ view = ElmHub.view
, update = ElmHub.update
, init = ElmHub.init
, subscriptions = ElmHub.subscriptions
}

27
part13/README.md Normal file
View File

@@ -0,0 +1,27 @@
Part 12
=======
## Installation
```bash
elm-package install
```
(Answer `y` when prompted.)
## Building
```bash
elm-live Main.elm --open --pushstate --output=elm.js
```
## Compiling CSS
```bash
elm-css Stylesheets.elm
```
## References
* [Elm CSS documentation](http://package.elm-lang.org/packages/rtfeldman/elm-css/latest)

24
part13/Stylesheets.elm Normal file
View File

@@ -0,0 +1,24 @@
port module Stylesheets exposing (..)
import Css.File exposing (..)
import ElmHubCss
import Html exposing (div)
import Html.App as Html
port files : CssFileStructure -> Cmd msg
cssFiles : CssFileStructure
cssFiles =
toFileStructure [ ( "style.css", compile [ ElmHubCss.css ] ) ]
main : Program Never
main =
Html.program
{ init = ( (), files cssFiles )
, view = \_ -> (div [] [])
, update = \_ _ -> ( (), Cmd.none )
, subscriptions = \_ -> Sub.none
}

BIN
part13/elm-hub.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.1 KiB

19
part13/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": {
"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-sortable-table": "1.0.0 <= v < 2.0.0",
"rtfeldman/elm-css": "5.0.0 <= v < 6.0.0"
},
"elm-version": "0.17.0 <= v < 0.18.0"
}

2
part13/github.js Normal file

File diff suppressed because one or more lines are too long

32
part13/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>