Getting the Reddit Home Page using Elm Promises

RedditHomePage.elm

--------------------------
-- 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 (<|)

-- Cute operator to make CSS styling more readable
(:::) = (,)

-- Alias type to make CSS easier to work with
type alias Style = List (String, String)

-----------------------
-- APP COLOR PALETTE --
-----------------------

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

------------------------
-- STYLING PARAMETERS --
------------------------

headerHeight  = "80px"
logoSize      = "50px"
postSize      = "60px"

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

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

-- 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 is how the app starts
-- It is not yet loaded and currently has received no posts
initialModel : Model
initialModel =
  { status = Loading
  , posts  = []
  }


-- 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 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 RedditJsonPost =
  { data : RedditJsonPostData }

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

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

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



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


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


-- This is the signal of actions.
-- Whenever this updates, the model will update.
actions : Signal Action
actions =
  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 ->
    { model | status <- Loading }
  Fail ->
    { model | status <- Failed  }
  SetPosts posts ->
    { model | status <- Ready
            , posts  <- posts
    }

----------
-- 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   -> 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 =
  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 =
  div
    [ style failedPageStyle ]
    [ text "Oh noes! Request went bad!"
    , button
        [ style retryButtonStyle
        , onClick mainTaskMailbox.address mainTask
        ]
        [ text "Retry" ]

    ]


-- 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
        [ 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 =
  li
    [ style postStyle ]
    [ div
        [ style scoreContainerStyle ]
        [ div
            [ style scoreStyle ]
            [ text (toString post.score) ]
        ]
    , div
        [ style linkContainerStyle ]
        [ a
            [ style linkStyle
            , href post.url
            ]
            [ text post.title ]
        ]
    ]


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

headerTextStyle : Style
headerTextStyle =
  [ "font-size"       ::: titleFontSize
  , "font-family"     ::: titleFont
  , "font-weight"     ::: titleFontWeight
  , "flex"            ::: "1"
  , "display"         ::: "flex"
  , "justify-content" ::: "center"
  , "color"           ::: "white"
  ]

pageHeader : Html
pageHeader =
  header
    [ style headerStyle ]
    [ elmLogo
    , div
        [ style headerTextStyle ]
        [ text "Reddit Home Page in Elm" ]
    ]

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

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

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
      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
      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 : Signal Html
main =
  Signal.map view
    (Signal.foldp update initialModel actions)