Skip to content

Instantly share code, notes, and snippets.

@imnutz

imnutz/RedditHomePage.elm

Forked from TheSeamau5/RedditHomePage.elm
Last active August 29, 2015 14:25
Show Gist options
  • Save imnutz/bf826e7d1b0500f3d64f to your computer and use it in GitHub Desktop.
Save imnutz/bf826e7d1b0500f3d64f to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. @TheSeamau5 TheSeamau5 revised this gist Apr 21, 2015. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion RedditHomePage.elm
    View file
    Original file line number Diff line number Diff line change
    @@ -360,7 +360,7 @@ viewFailedPage =
    [ style retryButtonStyle
    , onClick mainTaskMailbox.address mainTask
    ]
    [ text "Retry"]
    [ text "Retry" ]

    ]

  2. @TheSeamau5 TheSeamau5 revised this gist Apr 21, 2015. 1 changed file with 24 additions and 21 deletions.
    45 changes: 24 additions & 21 deletions RedditHomePage.elm
    View file
    Original file line number Diff line number Diff line change
    @@ -126,6 +126,7 @@ redditJsonDecoder : Decoder RedditJson
    redditJsonDecoder = RedditJson
    `map` ("data" := redditJsonDataDecoder)


    type alias RedditJsonData =
    { children : List RedditJsonPost }

    @@ -153,6 +154,8 @@ redditJsonPostDataDecoder = RedditJsonPostData
    `andMap` ("title" := string)
    `andMap` ("score" := int)



    -----------------------------
    -- CONVERT POSTS FROM JSON --
    -----------------------------
    @@ -386,7 +389,7 @@ viewMainPage posts =
    [ pageHeader
    , ul
    [ style postListStyle ]
    (List.map viewPost posts)
    ( List.map viewPost posts )
    ]


    @@ -421,14 +424,14 @@ linkStyle =

    linkContainerStyle : Style
    linkContainerStyle =
    [ "flex" ::: "1"]
    [ "flex" ::: "1" ]

    viewPost : Post -> Html
    viewPost post =
    li
    [ style postStyle ]
    [ div
    [ style scoreContainerStyle]
    [ style scoreContainerStyle ]
    [ div
    [ style scoreStyle ]
    [ text (toString post.score) ]
    @@ -527,24 +530,24 @@ makePetal total n =
    angle = ratio * 360
    in
    rect
    [ x "46.5"
    , y "40"
    , width "7"
    , height "20"
    , rx "5"
    , ry "5"
    , fill peterRiver
    , transform <| "rotate(" ++ (toString angle) ++ " 50 50) translate (0 -30)"
    ]
    [ animate
    [ attributeName "opacity"
    , from "1"
    , to "0"
    , dur "1s"
    , begin (toString ratio ++ "s")
    , repeatCount "indefinite"
    ] []
    ]
    [ x "46.5"
    , y "40"
    , width "7"
    , height "20"
    , rx "5"
    , ry "5"
    , fill peterRiver
    , transform <| "rotate(" ++ (toString angle) ++ " 50 50) translate (0 -30)"
    ]
    [ animate
    [ attributeName "opacity"
    , from "1"
    , to "0"
    , dur "1s"
    , begin (toString ratio ++ "s")
    , repeatCount "indefinite"
    ] []
    ]


    ----------
  3. @TheSeamau5 TheSeamau5 revised this gist Apr 20, 2015. 1 changed file with 7 additions and 3 deletions.
    10 changes: 7 additions & 3 deletions RedditHomePage.elm
    View file
    Original file line number Diff line number Diff line change
    @@ -49,6 +49,10 @@ headerHeight = "80px"
    logoSize = "50px"
    postSize = "60px"

    titleFont = "Helvetica Neue, Helvetica, Arial, sans-serif"
    titleFontWeight = "100"
    titleFontSize = "24pt"

    -----------
    -- MODEL --
    -----------
    @@ -451,9 +455,9 @@ headerStyle =

    headerTextStyle : Style
    headerTextStyle =
    [ "font-size" ::: "24pt"
    , "font-family" ::: "Helvetica Neue, Helvetica, Arial, sans-serif"
    , "font-weight" ::: "100"
    [ "font-size" ::: titleFontSize
    , "font-family" ::: titleFont
    , "font-weight" ::: titleFontWeight
    , "flex" ::: "1"
    , "display" ::: "flex"
    , "justify-content" ::: "center"
  4. @TheSeamau5 TheSeamau5 revised this gist Apr 20, 2015. 1 changed file with 411 additions and 169 deletions.
    580 changes: 411 additions & 169 deletions RedditHomePage.elm
    View file
    Original file line number Diff line number Diff line change
    @@ -1,90 +1,118 @@
    import Html exposing (..)
    import Html.Events exposing (..)
    import Html.Attributes exposing (href, style, src)
    --------------------------
    -- CORE LIBRARY IMPORTS --
    --------------------------
    import Task exposing (Task, succeed, andThen, onError)
    import Json.Decode exposing (Decoder, object2, (:=), string, int, list, map)
    import Signal exposing (Signal, Mailbox, mailbox, send)
    import List

    ---------------------------------
    -- THIRD PARTY LIBRARY IMPORTS --
    ---------------------------------
    import Html exposing (Html, div, a, text, header, img, ul, li, button)
    import Html.Attributes exposing (src, href, style)
    import Html.Events exposing (onClick)
    import Svg exposing (Svg, svg, rect, animate)
    import Svg.Attributes exposing (width, height, viewBox, preserveAspectRatio, x, y, rx, ry, fill, transform, attributeName, from, to, dur, begin, repeatCount)
    import Http exposing (Error, get)


    ----------------------
    -- HELPER FUNCTIONS --
    ----------------------

    -- Useful for decoding large objects
    andMap : Decoder (a -> b) -> Decoder a -> Decoder b
    andMap = object2 (<|)

    import Task exposing (Task, onError)
    import Http exposing (Error)
    import Port exposing (Port)
    -- Cute operator to make CSS styling more readable
    (:::) = (,)

    import JavaScript.Decode exposing (..)
    -- Alias type to make CSS easier to work with
    type alias Style = List (String, String)

    import List as L
    -----------------------
    -- APP COLOR PALETTE --
    -----------------------

    --------------
    -- HELPER CODE
    --------------
    -- taken from flatuicolors.com
    peterRiver = "#3498db"
    clouds = "#ecf0f1"
    emerald = "#2ecc71"
    alizarin = "#e74c3c"

    -- Javascript Decoding Helper
    ------------------------
    -- STYLING PARAMETERS --
    ------------------------

    andMap : Decoder (a -> b) -> Decoder a -> Decoder b
    andMap = object2 (<|)


    -- Status type
    type Status
    = Loading
    | Ready
    | Failed
    headerHeight = "80px"
    logoSize = "50px"
    postSize = "60px"

    --------
    -- MODEL
    --------
    -----------
    -- MODEL --
    -----------

    -- The entire model for the app
    -- Model represents the full app state
    type alias Model =
    { status : Status
    , posts : List Post
    }

    -- Status represents the status of the app
    -- The home page is either loading, ready, or has failed to load
    type Status
    = Loading
    | Ready
    | Failed

    -- A Reddit post is defined by a url which the post links,
    -- a descriptive title, and a score.
    type alias Post =
    { url : String
    , title : String
    , score : Int
    }

    -- The initial model
    -- The initial model is how the app starts
    -- It is not yet loaded and currently has received no posts
    initialModel : Model
    initialModel =
    { status = Loading
    , posts = []
    }


    ------------------
    -- Reddit Homepage
    ------------------

    -- This is the page where the app will mine the data from
    -- The page contains a json representation of the front page of reddit
    redditHomeUrl : String
    redditHomeUrl =
    "https://www.reddit.com/.json"


    ----------------------------
    -- JSON Parsing and Decoding
    ----------------------------

    -------------------
    -- JSON DECODING --
    -------------------
    {-| Reddit JSON data appears as :
    {
    "data": {
    "children": [
    {
    "data": {
    "url": "www.catsareawesome.org",
    "title": "Cats are amazing",
    "score": 100
    }
    },
    {
    "data": {
    "url": "www.dogsareawesome.org",
    "title": "Dogs are amazing",
    "score": 90
    {
    "data": {
    "children": [
    {
    "data": {
    "url": "www.catsareawesome.org",
    "title": "Cats are amazing",
    "score": 100
    }
    },
    {
    "data": {
    "url": "www.dogsareawesome.org",
    "title": "Dogs are amazing",
    "score": 90
    }
    }
    }
    ]
    ]
    }
    }
    }
    -}

    type alias RedditJson =
    @@ -121,11 +149,9 @@ redditJsonPostDataDecoder = RedditJsonPostData
    `andMap` ("title" := string)
    `andMap` ("score" := int)


    --------------------------
    -- Convert Posts from JSON
    --------------------------

    -----------------------------
    -- CONVERT POSTS FROM JSON --
    -----------------------------
    postsFromJson : RedditJson -> List Post
    postsFromJson json =
    let
    @@ -140,60 +166,90 @@ postsFromJson json =
    List.map convertChild json.data.children




    ---------
    -- INPUTS
    ---------

    -- The results from requesting the url
    port results : Port (Result Error RedditJson)


    -- Perform main task
    perform requestRedditPage redditHomeUrl
    `Task.andThen` (Ok >> Port.send results.address)
    `Task.onError` (Err >> Port.send results.address)



    --------
    -- TASKS
    --------

    requestRedditPage : String -> Task Error RedditJson
    requestRedditPage url =
    Http.get redditJsonDecoder url



    ----------
    -- ACTIONS
    ----------

    ---------------
    -- MAILBOXES --
    ---------------

    -- Whenever you want to get the reddit page, you send a main task to this
    -- mailbox.
    mainTaskMailbox : Mailbox (Task Error ())
    mainTaskMailbox =
    mailbox mainTask

    -- This mailbox is for any new actions like Load, Fail or SetPosts
    -- Whenever you want to change from Loading to Ready or Failing, send a message
    -- to this mailbox.
    actionsMailbox : Mailbox Action
    actionsMailbox =
    mailbox Load

    -----------
    -- TASKS --
    -----------

    -- This task represents the getting of the reddit url and parsing it as json
    getRedditHomePage : Task Error RedditJson
    getRedditHomePage =
    get redditJsonDecoder redditHomeUrl

    -- The main task of the application
    -- 1) you tell the system that the web page is loading
    -- 2) you then get the reddit home page and parse the json
    -- 3) you then tell the system that the home page has arrived with given posts
    -- 4) if anything went wrong along the way, tell the system that the task
    -- has failed.
    mainTask : Task Error ()
    mainTask = send actionsMailbox.address Load
    `andThen` (\_ -> getRedditHomePage)
    `andThen` (postsFromJson >> SetPosts >> send actionsMailbox.address)
    `onError` (\_ -> send actionsMailbox.address Fail)

    -----------
    -- PORTS --
    -----------

    -- The port associated with the main task. The main task will not be run
    -- if this port is not opened. By opening this port, we state explicitly
    -- that we actually want to run the main task along with its effects.
    -- This gives us a nice view of all the effects of our system.
    -- In this case, we only have one, the main task.
    port mainPort : Signal (Task Error ())
    port mainPort =
    mainTaskMailbox.signal

    -------------
    -- ACTIONS --
    -------------

    -- An action is fed into the update loop
    -- Load is the base action, it tells the state the it should
    -- load the reddit home page.
    -- SetPosts is the action that appears after a successful request
    -- was made. This will tell the model that it is ready to display
    -- the list of posts.
    -- Fail is the action that appeats after a failed request.
    type Action
    = Load
    | SetPosts (List Post)
    | Fail


    resultToAction : Result Error RedditJson -> Action
    resultToAction result = case result of
    Err _ -> Fail
    Ok json -> SetPosts (postsFromJson json)


    actions : Stream Action
    -- This is the signal of actions.
    -- Whenever this updates, the model will update.
    actions : Signal Action
    actions =
    Stream.map resultToAction results.stream




    ---------
    -- UPDATE
    ---------

    actionsMailbox.signal

    ------------
    -- UPDATE --
    ------------

    -- update takes updates a model with an action
    -- This is a very simple function:
    -- If we get a Load action, the model is now loading
    -- If we get a Fail action, the model is now failed
    -- If we get a SetPosts action, the model is now ready
    -- to display the list of posts it was given by the action
    update : Action -> Model -> Model
    update action model = case action of
    Load ->
    @@ -205,107 +261,293 @@ update action model = case action of
    , posts <- posts
    }

    ----------
    -- VIEW --
    ----------

    -------
    -- VIEW
    -------

    -- The main view function. Given the status of the model,
    -- it will display one of three pages.
    -- If the page is loading, it will display a loading page
    -- If the page is ready to display posts, it will display them
    -- If the page has failed to get the posts, it will display a failed page
    view : Model -> Html
    view model = case model.status of
    Loading -> viewLoadingPage
    Ready -> viewPage model.posts
    Ready -> viewMainPage model.posts
    Failed -> viewFailedPage



    -- LOADING PAGE

    loadingPageStyle : Style
    loadingPageStyle =
    [ "width" ::: "100vw"
    , "height" ::: "100vh"
    , "display" ::: "flex"
    , "align-items" ::: "center"
    , "justify-content" ::: "center"
    ]

    loadingPageCentralContainerStyle : Style
    loadingPageCentralContainerStyle =
    [ "max-height" ::: "400px"
    , "max-width" ::: "500px"
    , "width" ::: "80%"
    , "height" ::: "60%"
    , "display" ::: "flex"
    , "flex-direction" ::: "column"
    , "align-items" ::: "center"
    , "justify-content" ::: "space-around"
    , "font-size" ::: "32pt"
    ]

    -- The loading page contains a message indicating that the page is loading
    -- along with a cute svg spinner
    viewLoadingPage : Html
    viewLoadingPage =
    text "Loading Reddit...."
    div
    [ style loadingPageStyle ]
    [ div
    [ style loadingPageCentralContainerStyle ]
    [ text "Loading Reddit..."
    , loadingSpinner
    ]
    ]


    -- FAILED PAGE

    failedPageStyle : Style
    failedPageStyle =
    [ "display" ::: "flex"
    , "flex-direction" ::: "column"
    , "color" ::: alizarin
    , "align-items" ::: "center"
    , "justify-content" ::: "center"
    , "height" ::: "100vh"
    , "width" ::: "100vw"
    , "font-size" ::: "32pt"
    , "text-align" ::: "center"
    ]

    retryButtonStyle : Style
    retryButtonStyle =
    [ "height" ::: "44px"
    , "width" ::: "88px"
    , "border-radius" ::: "4px"
    , "border-color" ::: "white"
    , "background-color" ::: emerald
    , "color" ::: "white"
    ]

    -- The Failed Page contains an error message and a retry button
    -- when you click on the retry button, it will send the main task
    -- to the mainTaskMailbox, effectively, trying to get the main reddit
    -- page again
    viewFailedPage : Html
    viewFailedPage =
    section []
    [ p [] [ text "Oh noes! Request went bad!" ]
    div
    [ style failedPageStyle ]
    [ text "Oh noes! Request went bad!"
    , button
    [ style retryButtonStyle
    , onClick mainTaskMailbox.address mainTask
    ]
    [ text "Retry"]

    ]


    viewPage : List Post -> Html
    viewPage posts =
    div []
    -- MAIN PAGE

    mainPageStyle : Style
    mainPageStyle =
    [ "display" ::: "flex"
    , "flex-direction" ::: "column"
    ]

    postListStyle : Style
    postListStyle =
    [ "padding" ::: "0"
    , "margin" ::: "0"
    ]


    -- The main page has two parts, a header with the tile of the app
    -- and the Elm logo, and the list of posts along with their reddit scores
    viewMainPage : List Post -> Html
    viewMainPage posts =
    div
    [ style mainPageStyle ]
    [ pageHeader
    , ul [] (List.map viewPost posts)
    , ul
    [ style postListStyle ]
    (List.map viewPost posts)
    ]


    postStyle : Style
    postStyle =
    [ "display" ::: "flex"
    , "margin-left" ::: "0px"
    , "border-bottom" ::: ("1px solid " ++ clouds)
    , "height" ::: postSize
    , "align-items" ::: "center"
    ]

    scoreStyle : Style
    scoreStyle =
    [ "width" ::: logoSize
    , "text-align" ::: "center"
    , "color" ::: emerald
    ]

    scoreContainerStyle : Style
    scoreContainerStyle =
    [ "height" ::: logoSize
    , "width" ::: headerHeight
    , "display" ::: "flex"
    , "align-items" ::: "center"
    , "justify-content" ::: "center"
    ]

    linkStyle : Style
    linkStyle =
    [ "color" ::: peterRiver ]

    linkContainerStyle : Style
    linkContainerStyle =
    [ "flex" ::: "1"]

    viewPost : Post -> Html
    viewPost post =
    let
    scoreStyle = style
    [("height", "50px")
    ,("flex", "1")
    ,("align-self", "center")
    li
    [ style postStyle ]
    [ div
    [ style scoreContainerStyle]
    [ div
    [ style scoreStyle ]
    [ text (toString post.score) ]
    ]

    itemStyle = style
    [("display", "flex")
    ,("margin-bottom", "10px")
    , div
    [ style linkContainerStyle ]
    [ a
    [ style linkStyle
    , href post.url
    ]
    [ text post.title ]
    ]
    ]

    linkStyle = style
    [("flex", "8")
    ,("align-self", "flex-start")
    ]
    in
    li [ itemStyle ]
    [ div [ scoreStyle ]
    [ text (toString post.score) ]
    ,
    a
    [ linkStyle
    , href post.url
    ]
    [ div [] [text post.title] ]
    ]

    headerStyle : Style
    headerStyle =
    [ "display" ::: "flex"
    , "flex-direction" ::: "row"
    , "height" ::: headerHeight
    , "align-items" ::: "center"
    , "background-color" ::: peterRiver
    ]

    headerTextStyle : Style
    headerTextStyle =
    [ "font-size" ::: "24pt"
    , "font-family" ::: "Helvetica Neue, Helvetica, Arial, sans-serif"
    , "font-weight" ::: "100"
    , "flex" ::: "1"
    , "display" ::: "flex"
    , "justify-content" ::: "center"
    , "color" ::: "white"
    ]

    pageHeader : Html
    pageHeader =
    let
    headerStyle = style
    [ ("display", "flex")
    , ("align-items", "center")
    ]
    header
    [ style headerStyle ]
    [ elmLogo
    , div
    [ style headerTextStyle ]
    [ text "Reddit Home Page in Elm" ]
    ]

    textStyle = style
    [ ("flex", "8") ]
    in
    header [ headerStyle ]
    [ elmLogo
    , div [ textStyle ] [ text "Reddit Client in Elm" ]
    ]
    logoContainerStyle : Style
    logoContainerStyle =
    [ "height" ::: headerHeight
    , "width" ::: headerHeight
    , "display" ::: "flex"
    , "justify-content" ::: "center"
    , "align-items" ::: "center"
    ]

    logoStyle : Style
    logoStyle =
    [ "height" ::: logoSize
    , "width" ::: logoSize
    ]

    -- The Glorious Elm logo!
    elmLogo : Html
    elmLogo =
    div
    [ style logoContainerStyle ]
    [ img
    [ style logoStyle
    , src "http://elm-lang.org/logo.svg"
    ]
    []
    ]

    ---------------------
    -- LOADING SPINNER --
    ---------------------

    -- From loading.io
    loadingSpinner : Svg
    loadingSpinner =
    let
    logoStyle = style
    [("height", "50px")
    ,("width", "50px")
    ,("min-height", "40px")
    ,("min-width", "40px")
    ,("flex", "1")
    petals = List.map (makePetal 12) [0..11]

    in
    svg
    [ width "120px"
    , height "120px"
    , viewBox "0 0 100 100"
    , preserveAspectRatio "xMidYMid"
    ]
    (petals)


    makePetal : Int -> Int -> Svg
    makePetal total n =
    let
    ratio = toFloat n / toFloat total
    angle = ratio * 360
    in
    img
    [ src "http://elm-lang.org/logo.svg"
    , logoStyle
    ][]
    rect
    [ x "46.5"
    , y "40"
    , width "7"
    , height "20"
    , rx "5"
    , ry "5"
    , fill peterRiver
    , transform <| "rotate(" ++ (toString angle) ++ " 50 50) translate (0 -30)"
    ]
    [ animate
    [ attributeName "opacity"
    , from "1"
    , to "0"
    , dur "1s"
    , begin (toString ratio ++ "s")
    , repeatCount "indefinite"
    ] []
    ]


    -------
    -- MAIN
    -------
    ----------
    -- MAIN --
    ----------

    main : Signal Html
    main =
    Signal.map view
    (Stream.fold update initialModel actions)
    (Signal.foldp update initialModel actions)
  5. @TheSeamau5 TheSeamau5 revised this gist Mar 28, 2015. 1 changed file with 4 additions and 4 deletions.
    8 changes: 4 additions & 4 deletions RedditHomePage.elm
    View file
    Original file line number Diff line number Diff line change
    @@ -151,12 +151,12 @@ port results : Port (Result Error RedditJson)


    -- Perform main task
    perform requestRedditPage redditHomeUrl
    perform requestRedditPage redditHomeUrl
    `Task.andThen` (Ok >> Port.send results.address)
    `Task.onError` (Err >> Port.send results.address)



    --------
    -- TASKS
    --------
    @@ -166,7 +166,7 @@ requestRedditPage url =
    Http.get redditJsonDecoder url



    ----------
    -- ACTIONS
    ----------
    @@ -307,5 +307,5 @@ elmLogo =
    -------

    main =
    Varying.map view
    Signal.map view
    (Stream.fold update initialModel actions)
  6. @TheSeamau5 TheSeamau5 revised this gist Mar 21, 2015. 1 changed file with 8 additions and 23 deletions.
    31 changes: 8 additions & 23 deletions RedditHomePage.elm
    View file
    Original file line number Diff line number Diff line change
    @@ -2,7 +2,7 @@ import Html exposing (..)
    import Html.Events exposing (..)
    import Html.Attributes exposing (href, style, src)

    import Task exposing (Task)
    import Task exposing (Task, onError)
    import Http exposing (Error)
    import Port exposing (Port)

    @@ -14,10 +14,6 @@ import List as L
    -- HELPER CODE
    --------------

    -- Operator from Clojure
    (>!) : a -> Port a -> Port.Message
    (>!) a input' = Port.message input'.address a

    -- Javascript Decoding Helper

    andMap : Decoder (a -> b) -> Decoder a -> Decoder b
    @@ -26,8 +22,7 @@ andMap = object2 (<|)

    -- Status type
    type Status
    = Initial
    | Loading
    = Loading
    | Ready
    | Failed

    @@ -51,7 +46,7 @@ type alias Post =
    -- The initial model
    initialModel : Model
    initialModel =
    { status = Initial
    { status = Loading
    , posts = []
    }

    @@ -151,18 +146,17 @@ postsFromJson json =
    -- INPUTS
    ---------

    -- The url(s) requested by the user
    port urlRequests : Port String

    -- The results from requesting the url
    port results : Port (Result Error RedditJson)


    -- Perform main task
    perform Task.subscribe (Stream.map requestRedditPage urlRequests.stream) <|
    \task -> (task `Task.andThen` (Ok >> Port.send results.address))
    perform requestRedditPage redditHomeUrl
    `Task.andThen` (Ok >> Port.send results.address)
    `Task.onError` (Err >> Port.send results.address)




    --------
    -- TASKS
    --------
    @@ -218,18 +212,11 @@ update action model = case action of

    view : Model -> Html
    view model = case model.status of
    Initial -> viewInitialPage
    Loading -> viewLoadingPage
    Ready -> viewPage model.posts
    Failed -> viewFailedPage


    viewInitialPage : Html
    viewInitialPage =
    button
    [ onClick (redditHomeUrl >! urlRequests) ]
    [ text "Get Reddit Front Page" ]


    viewLoadingPage : Html
    viewLoadingPage =
    @@ -240,8 +227,6 @@ viewFailedPage : Html
    viewFailedPage =
    section []
    [ p [] [ text "Oh noes! Request went bad!" ]
    , p [] [ text "Care to try again?" ]
    , viewInitialPage
    ]


  7. @TheSeamau5 TheSeamau5 revised this gist Mar 21, 2015. 1 changed file with 11 additions and 7 deletions.
    18 changes: 11 additions & 7 deletions RedditHomePage.elm
    View file
    Original file line number Diff line number Diff line change
    @@ -4,6 +4,7 @@ import Html.Attributes exposing (href, style, src)

    import Task exposing (Task)
    import Http exposing (Error)
    import Port exposing (Port)

    import JavaScript.Decode exposing (..)

    @@ -14,8 +15,8 @@ import List as L
    --------------

    -- Operator from Clojure
    (>!) : a -> Stream.Input a -> Stream.Message
    (>!) a input' = Stream.message input'.address a
    (>!) : a -> Port a -> Port.Message
    (>!) a input' = Port.message input'.address a

    -- Javascript Decoding Helper

    @@ -151,13 +152,16 @@ postsFromJson json =
    ---------

    -- The url(s) requested by the user
    input urlRequests : Stream.Input String
    port urlRequests : Port String

    -- The results from requesting the url
    input results : Stream.Stream (Result Error RedditJson)
    input results from
    Stream.map requestRedditPage urlRequests.stream
    port results : Port (Result Error RedditJson)

    -- Perform main task
    perform Task.subscribe (Stream.map requestRedditPage urlRequests.stream) <|
    \task -> (task `Task.andThen` (Ok >> Port.send results.address))
    `Task.onError` (Err >> Port.send results.address)


    --------
    -- TASKS
    @@ -187,7 +191,7 @@ resultToAction result = case result of

    actions : Stream Action
    actions =
    Stream.map resultToAction results
    Stream.map resultToAction results.stream



  8. @TheSeamau5 TheSeamau5 revised this gist Mar 17, 2015. 1 changed file with 12 additions and 7 deletions.
    19 changes: 12 additions & 7 deletions RedditHomePage.elm
    View file
    Original file line number Diff line number Diff line change
    @@ -158,6 +158,17 @@ input results : Stream.Stream (Result Error RedditJson)
    input results from
    Stream.map requestRedditPage urlRequests.stream


    --------
    -- TASKS
    --------

    requestRedditPage : String -> Task Error RedditJson
    requestRedditPage url =
    Http.get redditJsonDecoder url



    ----------
    -- ACTIONS
    ----------
    @@ -177,14 +188,8 @@ resultToAction result = case result of
    actions : Stream Action
    actions =
    Stream.map resultToAction results

    --------
    -- TASKS
    --------

    requestRedditPage : String -> Task Error RedditJson
    requestRedditPage url =
    Http.get redditJsonDecoder url



    ---------
  9. @TheSeamau5 TheSeamau5 revised this gist Mar 17, 2015. 1 changed file with 1 addition and 0 deletions.
    1 change: 1 addition & 0 deletions RedditHomePage.elm
    View file
    Original file line number Diff line number Diff line change
    @@ -177,6 +177,7 @@ resultToAction result = case result of
    actions : Stream Action
    actions =
    Stream.map resultToAction results

    --------
    -- TASKS
    --------
  10. @TheSeamau5 TheSeamau5 revised this gist Mar 17, 2015. 1 changed file with 232 additions and 82 deletions.
    314 changes: 232 additions & 82 deletions RedditHomePage.elm
    View file
    Original file line number Diff line number Diff line change
    @@ -7,6 +7,11 @@ import Http exposing (Error)

    import JavaScript.Decode exposing (..)

    import List as L

    --------------
    -- HELPER CODE
    --------------

    -- Operator from Clojure
    (>!) : a -> Stream.Input a -> Stream.Message
    @@ -18,71 +23,228 @@ andMap : Decoder (a -> b) -> Decoder a -> Decoder b
    andMap = object2 (<|)


    -- Model + Javascript Parsing
    -- Status type
    type Status
    = Initial
    | Loading
    | Ready
    | Failed

    --------
    -- MODEL
    --------

    -- The entire model for the app
    type alias Model =
    { status : Status
    , posts : List Post
    }


    type alias Post =
    { url : String
    , title : String
    , score : Int
    }

    -- The initial model
    initialModel : Model
    initialModel =
    { status = Initial
    , posts = []
    }


    ------------------
    -- Reddit Homepage
    ------------------

    redditHomeUrl : String
    redditHomeUrl =
    "https://www.reddit.com/.json"


    ----------------------------
    -- JSON Parsing and Decoding
    ----------------------------

    {-| Reddit JSON data appears as :
    {
    "data": {
    "children": [
    {
    "data": {
    "url": "www.catsareawesome.org",
    "title": "Cats are amazing",
    "score": 100
    }
    },
    {
    "data": {
    "url": "www.dogsareawesome.org",
    "title": "Dogs are amazing",
    "score": 90
    }
    }
    ]
    }
    }
    -}

    type alias RedditJson =
    { data : RedditJsonData }

    redditJsonDecoder : Decoder RedditJson
    redditJsonDecoder = RedditJson
    `map` ("data" := redditJsonDataDecoder)

    type alias RedditJsonData =
    { children : List RedditJsonPost }


    redditJsonDataDecoder : Decoder RedditJsonData
    redditJsonDataDecoder = RedditJsonData
    `map` ("children" := list redditJsonPostDecoder)

    type alias RedditPostData =
    { url : String
    type alias RedditJsonPost =
    { data : RedditJsonPostData }

    redditJsonPostDecoder : Decoder RedditJsonPost
    redditJsonPostDecoder = RedditJsonPost
    `map` ("data" := redditJsonPostDataDecoder)

    type alias RedditJsonPostData =
    { url : String
    , title : String
    , score : Int
    }

    redditPostData : Decoder RedditPostData
    redditPostData = RedditPostData
    `map` ("url" := string)
    redditJsonPostDataDecoder : Decoder RedditJsonPostData
    redditJsonPostDataDecoder = RedditJsonPostData
    `map` ("url" := string)
    `andMap` ("title" := string)
    `andMap` ("score" := int)

    type alias RedditPost =
    { data : RedditPostData }

    redditPost : Decoder RedditPost
    redditPost = RedditPost
    `map` ("data" := redditPostData )
    --------------------------
    -- Convert Posts from JSON
    --------------------------

    postsFromJson : RedditJson -> List Post
    postsFromJson json =
    let
    convertChild : RedditJsonPost -> Post
    convertChild child =
    { url = child.data.url
    , title = child.data.title
    , score = child.data.score
    }

    in
    List.map convertChild json.data.children

    type alias RedditListingData =
    { children : List RedditPost }

    redditListingData : Decoder RedditListingData
    redditListingData = RedditListingData
    `map` ("children" := list redditPost)


    type alias RedditListing =
    { data : RedditListingData }
    ---------
    -- INPUTS
    ---------

    redditListing : Decoder RedditListing
    redditListing = RedditListing
    `map` ("data" := redditListingData)
    -- The url(s) requested by the user
    input urlRequests : Stream.Input String

    -- The results from requesting the url
    input results : Stream.Stream (Result Error RedditJson)
    input results from
    Stream.map requestRedditPage urlRequests.stream

    testRedditListing : RedditListing
    testRedditListing =
    { data = { children = [] } }
    ----------
    -- ACTIONS
    ----------

    -- The Reddit Homepage!
    redditUrl : String
    redditUrl =
    "https://www.reddit.com/.json"
    type Action
    = Load
    | SetPosts (List Post)
    | Fail

    -- The main promise
    requestListing : String -> Task Error RedditListing
    requestListing url =
    Http.get redditListing url

    -- The url requested by the user
    input redditRequests : Stream.Input String
    resultToAction : Result Error RedditJson -> Action
    resultToAction result = case result of
    Err _ -> Fail
    Ok json -> SetPosts (postsFromJson json)

    -- The results from the query
    input results : Stream (Result Error RedditListing)
    input results from
    Stream.map requestListing redditRequests.stream

    actions : Stream Action
    actions =
    Stream.map resultToAction results
    --------
    -- TASKS
    --------

    requestRedditPage : String -> Task Error RedditJson
    requestRedditPage url =
    Http.get redditJsonDecoder url


    ---------
    -- UPDATE
    ---------

    update : Action -> Model -> Model
    update action model = case action of
    Load ->
    { model | status <- Loading }
    Fail ->
    { model | status <- Failed }
    SetPosts posts ->
    { model | status <- Ready
    , posts <- posts
    }


    -------
    -- VIEW
    -------

    view : Model -> Html
    view model = case model.status of
    Initial -> viewInitialPage
    Loading -> viewLoadingPage
    Ready -> viewPage model.posts
    Failed -> viewFailedPage


    viewInitialPage : Html
    viewInitialPage =
    button
    [ onClick (redditHomeUrl >! urlRequests) ]
    [ text "Get Reddit Front Page" ]


    viewLoadingPage : Html
    viewLoadingPage =
    text "Loading Reddit...."


    viewFailedPage : Html
    viewFailedPage =
    section []
    [ p [] [ text "Oh noes! Request went bad!" ]
    , p [] [ text "Care to try again?" ]
    , viewInitialPage
    ]


    -- View an individual Reddit post
    viewPost : RedditPost -> Html
    viewPost { data } =
    viewPage : List Post -> Html
    viewPage posts =
    div []
    [ pageHeader
    , ul [] (List.map viewPost posts)
    ]


    viewPost : Post -> Html
    viewPost post =
    let
    scoreStyle = style
    [("height", "50px")
    @@ -102,19 +264,35 @@ viewPost { data } =
    in
    li [ itemStyle ]
    [ div [ scoreStyle ]
    [ text (toString data.score) ]
    [ text (toString post.score) ]
    ,
    a
    [ linkStyle
    , href data.url
    , href post.url
    ]
    [ div [] [text data.title] ]
    [ div [] [text post.title] ]
    ]

    pageHeader : Html
    pageHeader =
    let
    headerStyle = style
    [ ("display", "flex")
    , ("align-items", "center")
    ]

    textStyle = style
    [ ("flex", "8") ]
    in
    header [ headerStyle ]
    [ elmLogo
    , div [ textStyle ] [ text "Reddit Client in Elm" ]
    ]

    -- The Glorious Elm logo!
    elmLogo : Html
    elmLogo =
    let
    elmLogo =
    let
    logoStyle = style
    [("height", "50px")
    ,("width", "50px")
    @@ -123,44 +301,16 @@ elmLogo =
    ,("flex", "1")
    ]
    in
    img
    img
    [ src "http://elm-lang.org/logo.svg"
    , logoStyle
    ][]


    clientHeader : Html
    clientHeader =
    let
    headerStyle = style
    [ ("display", "flex")
    , ("align-items", "center")
    ]
    textStyle = style
    [ ("flex", "8") ]
    in
    header [ headerStyle ]
    [ elmLogo
    , div [ textStyle ] [ text "Reddit Client in Elm" ]
    ]

    -- Global view function
    view : Result Error RedditListing -> Html
    view listingResult = case listingResult of
    Err error ->
    button
    [ onClick (redditUrl >! redditRequests) ]
    [ text "Get Reddit Front Page" ]
    Ok listing ->
    div []
    [ clientHeader
    , ul []
    (List.map viewPost listing.data.children)
    ]


    -- Main Function
    main : Varying Html


    -------
    -- MAIN
    -------

    main =
    Varying.map view
    (Varying.fromStream (Err Http.Timeout) results)
    (Stream.fold update initialModel actions)
  11. @TheSeamau5 TheSeamau5 revised this gist Mar 16, 2015. 1 changed file with 3 additions and 3 deletions.
    6 changes: 3 additions & 3 deletions RedditHomePage.elm
    View file
    Original file line number Diff line number Diff line change
    @@ -70,12 +70,12 @@ requestListing url =
    Http.get redditListing url

    -- The url requested by the user
    input redditRequest : Stream.Input String
    input redditRequests : Stream.Input String

    -- The results from the query
    input results : Stream (Result Error RedditListing)
    input results from
    Stream.map requestListing redditRequest.stream
    Stream.map requestListing redditRequests.stream


    -- VIEW
    @@ -149,7 +149,7 @@ view : Result Error RedditListing -> Html
    view listingResult = case listingResult of
    Err error ->
    button
    [ onClick (redditUrl >! redditRequest) ]
    [ onClick (redditUrl >! redditRequests) ]
    [ text "Get Reddit Front Page" ]
    Ok listing ->
    div []
  12. @TheSeamau5 TheSeamau5 revised this gist Mar 16, 2015. 1 changed file with 4 additions and 4 deletions.
    8 changes: 4 additions & 4 deletions RedditHomePage.elm
    View file
    Original file line number Diff line number Diff line change
    @@ -69,13 +69,13 @@ requestListing : String -> Task Error RedditListing
    requestListing url =
    Http.get redditListing url

    -- The query we send
    input query : Stream.Input String
    -- The url requested by the user
    input redditRequest : Stream.Input String

    -- The results from the query
    input results : Stream (Result Error RedditListing)
    input results from
    Stream.map requestListing query.stream
    Stream.map requestListing redditRequest.stream


    -- VIEW
    @@ -149,7 +149,7 @@ view : Result Error RedditListing -> Html
    view listingResult = case listingResult of
    Err error ->
    button
    [ onClick (redditUrl >! query) ]
    [ onClick (redditUrl >! redditRequest) ]
    [ text "Get Reddit Front Page" ]
    Ok listing ->
    div []
  13. @TheSeamau5 TheSeamau5 revised this gist Mar 16, 2015. 1 changed file with 2 additions and 2 deletions.
    4 changes: 2 additions & 2 deletions RedditHomePage.elm
    View file
    Original file line number Diff line number Diff line change
    @@ -2,7 +2,7 @@ import Html exposing (..)
    import Html.Events exposing (..)
    import Html.Attributes exposing (href, style, src)

    import Promise exposing (Promise)
    import Task exposing (Task)
    import Http exposing (Error)

    import JavaScript.Decode exposing (..)
    @@ -65,7 +65,7 @@ redditUrl =
    "https://www.reddit.com/.json"

    -- The main promise
    requestListing : String -> Promise Error RedditListing
    requestListing : String -> Task Error RedditListing
    requestListing url =
    Http.get redditListing url

  14. @TheSeamau5 TheSeamau5 revised this gist Mar 14, 2015. 1 changed file with 2 additions and 3 deletions.
    5 changes: 2 additions & 3 deletions RedditHomePage.elm
    View file
    Original file line number Diff line number Diff line change
    @@ -149,9 +149,8 @@ view : Result Error RedditListing -> Html
    view listingResult = case listingResult of
    Err error ->
    button
    -- [ onClick (Stream.message query.address redditUrl)]
    [ onClick (redditUrl >! query) ]
    [ text "Get Reddit Front Page" ]
    [ onClick (redditUrl >! query) ]
    [ text "Get Reddit Front Page" ]
    Ok listing ->
    div []
    [ clientHeader
  15. @TheSeamau5 TheSeamau5 revised this gist Mar 14, 2015. 1 changed file with 6 additions and 1 deletion.
    7 changes: 6 additions & 1 deletion RedditHomePage.elm
    View file
    Original file line number Diff line number Diff line change
    @@ -8,6 +8,10 @@ import Http exposing (Error)
    import JavaScript.Decode exposing (..)


    -- Operator from Clojure
    (>!) : a -> Stream.Input a -> Stream.Message
    (>!) a input' = Stream.message input'.address a

    -- Javascript Decoding Helper

    andMap : Decoder (a -> b) -> Decoder a -> Decoder b
    @@ -145,7 +149,8 @@ view : Result Error RedditListing -> Html
    view listingResult = case listingResult of
    Err error ->
    button
    [ onClick (Stream.message query.address redditUrl)]
    -- [ onClick (Stream.message query.address redditUrl)]
    [ onClick (redditUrl >! query) ]
    [ text "Get Reddit Front Page" ]
    Ok listing ->
    div []
  16. @TheSeamau5 TheSeamau5 revised this gist Mar 14, 2015. 1 changed file with 3 additions and 3 deletions.
    6 changes: 3 additions & 3 deletions RedditHomePage.elm
    View file
    Original file line number Diff line number Diff line change
    @@ -66,11 +66,11 @@ requestListing url =
    Http.get redditListing url

    -- The query we send
    loopback query : Stream.Mailbox String
    input query : Stream.Input String

    -- The results from the query
    loopback results : Stream (Result Error RedditListing)
    loopback results <-
    input results : Stream (Result Error RedditListing)
    input results from
    Stream.map requestListing query.stream


  17. @TheSeamau5 TheSeamau5 revised this gist Mar 10, 2015. 1 changed file with 1 addition and 0 deletions.
    1 change: 1 addition & 0 deletions RedditHomePage.elm
    View file
    Original file line number Diff line number Diff line change
    @@ -156,6 +156,7 @@ view listingResult = case listingResult of


    -- Main Function
    main : Varying Html
    main =
    Varying.map view
    (Varying.fromStream (Err Http.Timeout) results)
  18. @TheSeamau5 TheSeamau5 revised this gist Mar 10, 2015. 1 changed file with 39 additions and 6 deletions.
    45 changes: 39 additions & 6 deletions RedditHomePage.elm
    View file
    Original file line number Diff line number Diff line change
    @@ -1,6 +1,6 @@
    import Html exposing (..)
    import Html.Events exposing (..)
    import Html.Attributes exposing (href, style)
    import Html.Attributes exposing (href, style, src)

    import Promise exposing (Promise)
    import Http exposing (Error)
    @@ -107,16 +107,49 @@ viewPost { data } =
    [ div [] [text data.title] ]
    ]


    elmLogo : Html
    elmLogo =
    let
    logoStyle = style
    [("height", "50px")
    ,("width", "50px")
    ,("min-height", "40px")
    ,("min-width", "40px")
    ,("flex", "1")
    ]
    in
    img
    [ src "http://elm-lang.org/logo.svg"
    , logoStyle
    ][]


    clientHeader : Html
    clientHeader =
    let
    headerStyle = style
    [ ("display", "flex")
    , ("align-items", "center")
    ]
    textStyle = style
    [ ("flex", "8") ]
    in
    header [ headerStyle ]
    [ elmLogo
    , div [ textStyle ] [ text "Reddit Client in Elm" ]
    ]

    -- Global view function
    view : Result Error RedditListing -> Html
    view listingResult = case listingResult of
    Err error ->
    text (toString error)
    Ok listing ->
    div []
    [ button
    button
    [ onClick (Stream.message query.address redditUrl)]
    [ text "Get Reddit Front Page" ]
    Ok listing ->
    div []
    [ clientHeader
    , ul []
    (List.map viewPost listing.data.children)
    ]
    @@ -125,4 +158,4 @@ view listingResult = case listingResult of
    -- Main Function
    main =
    Varying.map view
    (Varying.fromStream (Ok testRedditListing) results)
    (Varying.fromStream (Err Http.Timeout) results)
  19. @TheSeamau5 TheSeamau5 revised this gist Mar 10, 2015. 1 changed file with 4 additions and 9 deletions.
    13 changes: 4 additions & 9 deletions RedditHomePage.elm
    View file
    Original file line number Diff line number Diff line change
    @@ -36,17 +36,15 @@ redditPost = RedditPost
    `map` ("data" := redditPostData )

    type alias RedditListingData =
    { children : List RedditPost
    }
    { children : List RedditPost }

    redditListingData : Decoder RedditListingData
    redditListingData = RedditListingData
    `map` ("children" := list redditPost)


    type alias RedditListing =
    { data : RedditListingData
    }
    { data : RedditListingData }

    redditListing : Decoder RedditListing
    redditListing = RedditListing
    @@ -55,10 +53,7 @@ redditListing = RedditListing

    testRedditListing : RedditListing
    testRedditListing =
    { data =
    { children = []
    }
    }
    { data = { children = [] } }

    -- The Reddit Homepage!
    redditUrl : String
    @@ -83,7 +78,7 @@ loopback results <-

    -- View an individual Reddit post
    viewPost : RedditPost -> Html
    viewPost {data} =
    viewPost { data } =
    let
    scoreStyle = style
    [("height", "50px")
  20. @TheSeamau5 TheSeamau5 revised this gist Mar 10, 2015. 1 changed file with 3 additions and 6 deletions.
    9 changes: 3 additions & 6 deletions RedditHomePage.elm
    View file
    Original file line number Diff line number Diff line change
    @@ -45,20 +45,17 @@ redditListingData = RedditListingData


    type alias RedditListing =
    { kind : String
    , data : RedditListingData
    { data : RedditListingData
    }

    redditListing : Decoder RedditListing
    redditListing = RedditListing
    `map` ("kind" := string)
    `andMap` ("data" := redditListingData)
    `map` ("data" := redditListingData)


    testRedditListing : RedditListing
    testRedditListing =
    { kind = "Yo"
    , data =
    { data =
    { children = []
    }
    }
  21. @TheSeamau5 TheSeamau5 revised this gist Mar 10, 2015. 1 changed file with 3 additions and 6 deletions.
    9 changes: 3 additions & 6 deletions RedditHomePage.elm
    View file
    Original file line number Diff line number Diff line change
    @@ -36,14 +36,12 @@ redditPost = RedditPost
    `map` ("data" := redditPostData )

    type alias RedditListingData =
    { modhash : String
    , children : List RedditPost
    { children : List RedditPost
    }

    redditListingData : Decoder RedditListingData
    redditListingData = RedditListingData
    `map` ("modhash" := string)
    `andMap` ("children" := list redditPost)
    `map` ("children" := list redditPost)


    type alias RedditListing =
    @@ -61,8 +59,7 @@ testRedditListing : RedditListing
    testRedditListing =
    { kind = "Yo"
    , data =
    { modhash = "Some really long hash"
    , children = []
    { children = []
    }
    }

  22. @TheSeamau5 TheSeamau5 created this gist Mar 10, 2015.
    139 changes: 139 additions & 0 deletions RedditHomePage.elm
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,139 @@
    import Html exposing (..)
    import Html.Events exposing (..)
    import Html.Attributes exposing (href, style)

    import Promise exposing (Promise)
    import Http exposing (Error)

    import JavaScript.Decode exposing (..)


    -- Javascript Decoding Helper

    andMap : Decoder (a -> b) -> Decoder a -> Decoder b
    andMap = object2 (<|)


    -- Model + Javascript Parsing

    type alias RedditPostData =
    { url : String
    , title : String
    , score : Int
    }

    redditPostData : Decoder RedditPostData
    redditPostData = RedditPostData
    `map` ("url" := string)
    `andMap` ("title" := string)
    `andMap` ("score" := int)

    type alias RedditPost =
    { data : RedditPostData }

    redditPost : Decoder RedditPost
    redditPost = RedditPost
    `map` ("data" := redditPostData )

    type alias RedditListingData =
    { modhash : String
    , children : List RedditPost
    }

    redditListingData : Decoder RedditListingData
    redditListingData = RedditListingData
    `map` ("modhash" := string)
    `andMap` ("children" := list redditPost)


    type alias RedditListing =
    { kind : String
    , data : RedditListingData
    }

    redditListing : Decoder RedditListing
    redditListing = RedditListing
    `map` ("kind" := string)
    `andMap` ("data" := redditListingData)


    testRedditListing : RedditListing
    testRedditListing =
    { kind = "Yo"
    , data =
    { modhash = "Some really long hash"
    , children = []
    }
    }

    -- The Reddit Homepage!
    redditUrl : String
    redditUrl =
    "https://www.reddit.com/.json"

    -- The main promise
    requestListing : String -> Promise Error RedditListing
    requestListing url =
    Http.get redditListing url

    -- The query we send
    loopback query : Stream.Mailbox String

    -- The results from the query
    loopback results : Stream (Result Error RedditListing)
    loopback results <-
    Stream.map requestListing query.stream


    -- VIEW

    -- View an individual Reddit post
    viewPost : RedditPost -> Html
    viewPost {data} =
    let
    scoreStyle = style
    [("height", "50px")
    ,("flex", "1")
    ,("align-self", "center")
    ]

    itemStyle = style
    [("display", "flex")
    ,("margin-bottom", "10px")
    ]

    linkStyle = style
    [("flex", "8")
    ,("align-self", "flex-start")
    ]
    in
    li [ itemStyle ]
    [ div [ scoreStyle ]
    [ text (toString data.score) ]
    ,
    a
    [ linkStyle
    , href data.url
    ]
    [ div [] [text data.title] ]
    ]

    -- Global view function
    view : Result Error RedditListing -> Html
    view listingResult = case listingResult of
    Err error ->
    text (toString error)
    Ok listing ->
    div []
    [ button
    [ onClick (Stream.message query.address redditUrl)]
    [ text "Get Reddit Front Page" ]
    , ul []
    (List.map viewPost listing.data.children)
    ]


    -- Main Function
    main =
    Varying.map view
    (Varying.fromStream (Ok testRedditListing) results)