cerchez07/elm-0.19-workshop
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Rename 12 to 14 and 11 to 13

Browse Source
This commit is contained in:
Richard Feldman
2016-09-04 16:23:56 -07:00
parent d4e291d074
commit d8380e1763
25 changed files with 0 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

146
part12/ElmHub.elm
View File

@@ -1,146 +0,0 @@
module ElmHub exposing (..)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Html.App as Html
import Http
import Auth
import Task exposing (Task)
import Json.Decode exposing (Decoder)
import Dict exposing (Dict)
import SearchResult
searchFeed : String -> Cmd Msg
searchFeed query =
let
url =
"https://api.github.com/search/repositories?access_token="
++ Auth.token
++ "&q="
++ query
++ "+language:elm&sort=stars&order=desc"
in
Task.perform HandleSearchError HandleSearchResponse (Http.get responseDecoder url)
responseDecoder : Decoder (List SearchResult.Model)
responseDecoder =
Json.Decode.at [ "items" ] (Json.Decode.list SearchResult.decoder)
type alias Model =
{ query : String
, results : Dict Int SearchResult.Model
, errorMessage : Maybe String
}
initialModel : Model
initialModel =
{ query = "tutorial"
, results = Dict.empty
, 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" ] (viewSearchResults model.results)
]
viewErrorMessage : Maybe String -> Html a
viewErrorMessage errorMessage =
case errorMessage of
Just message ->
div [ class "error" ] [ text message ]
Nothing ->
text ""
viewSearchResults : Dict Int SearchResult.Model -> List (Html Msg)
viewSearchResults results =
results
|> Dict.values
|> List.sortBy (.stars >> negate)
|> filterResults
|> List.map viewSearchResult
filterResults : List SearchResult.Model -> List SearchResult.Model
filterResults results =
-- TODO filter out repos with 0 stars
-- using a case-expression rather than List.filter
results
viewSearchResult : SearchResult.Model -> Html Msg
viewSearchResult result =
result
|> SearchResult.view
|> Html.App.map (UpdateSearchResult result.id)
type Msg
= Search
| SetQuery String
| UpdateSearchResult Int SearchResult.Msg
| HandleSearchResponse (List SearchResult.Model)
| HandleSearchError Http.Error
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
Search ->
model ! [ searchFeed model.query ]
SetQuery query ->
{ model | query = query, errorMessage = Nothing } ! []
HandleSearchError error ->
case error of
Http.UnexpectedPayload str ->
{ model | errorMessage = Just str } ! []
_ ->
{ model | errorMessage = Just "Error loading search results" } ! []
HandleSearchResponse results ->
let
resultsById : Dict Int SearchResult.Model
resultsById =
results
|> List.map (\result -> ( result.id, result ))
|> Dict.fromList
in
{ model | results = resultsById } ! []
UpdateSearchResult id childMsg ->
case Dict.get id model.results of
Nothing ->
model ! []
Just childModel ->
let
( newChildModel, childCmd ) =
SearchResult.update childMsg childModel
cmd =
Cmd.map (UpdateSearchResult id) childCmd
newResults =
Dict.insert id newChildModel model.results
in
{ model | results = newResults } ! [ cmd ]

15
part12/ElmHubCss.elm
View File

@@ -1,15 +0,0 @@
module ElmHubCss exposing (..)
import Css exposing (..)
css : Stylesheet
css =
stylesheet
[ ((.) "content")
[ width (px 960)
, margin2 zero auto
, padding (px 30)
, fontFamilies [ "Helvetica", "Arial", "serif" ]
]
]

126
part12/Main.elm
View File

@@ -1,126 +0,0 @@
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
part12/Page.elm
View File

@@ -1,26 +0,0 @@
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

204
part12/Page/Home.elm
View File

@@ -1,204 +0,0 @@
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
import Table
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
, tableState : Table.State
}
initialQuery : String
initialQuery =
"tutorial"
init : ( Model, Cmd Msg )
init =
( { query = initialQuery
, results = []
, errorMessage = Nothing
, tableState = Table.initialSort "Stars"
}
, githubSearch (getQueryString initialQuery)
)
view : Model -> Html Msg
view model =
div [ class "home-container" ]
[ input [ class "search-query", onInput SetQuery, defaultValue model.query ] []
, button [ class "search-button", onClick Search ] [ text "Search" ]
, viewErrorMessage model.errorMessage
, Table.view tableConfig model.tableState model.results
]
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
}
viewErrorMessage : Maybe String -> Html a
viewErrorMessage errorMessage =
case errorMessage of
Just message ->
div [ class "error" ] [ text message ]
Nothing ->
text ""
viewStars : SearchResult -> Table.HtmlDetails Msg
viewStars result =
Table.HtmlDetails []
[ span [ class "star-count" ] [ text (toString result.stars) ] ]
viewSearchResult : SearchResult -> Table.HtmlDetails Msg
viewSearchResult result =
Table.HtmlDetails []
[ 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)
| SetTableState Table.State
| 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 )
SetTableState newState ->
( { model | tableState = newState }, 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
part12/Page/Repository.elm
View File

@@ -1,136 +0,0 @@
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 )

27
part12/README.md
View File

@@ -1,27 +0,0 @@
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)

63
part12/SearchResult.elm
View File

@@ -1,63 +0,0 @@
module SearchResult exposing (..)
import Html exposing (..)
import Html.Attributes exposing (class, target, href, property, defaultValue)
import Html.Events exposing (..)
import Json.Decode exposing (Decoder)
import Json.Decode.Pipeline exposing (..)
type alias Model =
{ id : Int
, name : String
, stars : Int
, expanded : Bool
}
type Msg
= Expand
| Collapse
decoder : Decoder Model
decoder =
decode Model
|> required "id" Json.Decode.int
|> required "full_name" Json.Decode.string
|> required "stargazers_count" Json.Decode.int
|> hardcoded True
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
Expand ->
{ model | expanded = True } ! []
Collapse ->
{ model | expanded = False } ! []
view : Model -> Html Msg
view model =
li [] <|
if model.expanded then
[ span [ class "star-count" ] [ text (toString model.stars) ]
, a
[ href
("https://github.com/"
++ (Debug.log "TODO we should not see this when typing in the search box!"
model.name
)
)
, target "_blank"
]
[ text model.name ]
, button [ class "hide-result", onClick Collapse ]
[ text "X" ]
]
else
[ button [ class "expand-result", onClick Expand ]
[ text "Show" ]
]

24
part12/Stylesheets.elm
View File

@@ -1,24 +0,0 @@
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
part12/elm-hub.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 2.1 KiB

23
part12/elm-package.json
View File

@@ -1,23 +0,0 @@
{
"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/elm-sortable-table": "1.0.0 <= v < 2.0.0",
"evancz/url-parser": "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
part12/github.js
View File

File diff suppressed because one or more lines are too long

32
part12/index.html
View File

@@ -1,32 +0,0 @@
<!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>

101
part12/style.css
View File

@@ -1,101 +0,0 @@
.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;
}