Reactive front-end for an RSS compilator using Elm.

RssCompilatorFrontEnd.elm

import Html exposing (..)
import Html.App as Html
import Html.Attributes exposing (href, style, target)
import WebSocket
import Json.Decode exposing (..)
import Time exposing (Time)
import Date exposing (..)
import List exposing (append, sortBy, reverse)
import String exposing (pad)

wsUrl = "ws://localhost:3000/"

main = Html.program
    { init = init
    , subscriptions = subscriptions
    , view = view
    , update = update
    }

init = (Model Nothing 0 Nothing [] Nothing, Cmd.none)

type alias Post = 
    { title : String
    , link : String
    , description : String
    , pubDate : Time
    }

updatePostDecoder = 
    object4
        Post
        ("title" := string)
        ("link" := string)
        ("description" := string)
        ("pubDate" := float)

type alias Model = 
    { total : Maybe Int
    , current : Int
    , remaining : Maybe (List String)
    , updates : List Post
    , errors : Maybe (List String)
    }

type alias InitMsg = 
    { count : Int
    , urls : List String
    }

initMsgDecoder = 
    object2 
        InitMsg
        ("count" := int)
        ("urls" := list string)

type alias ErrorMsg = 
    { url : String
    , message : String
    }

errorMsgDecoder = 
    object2 
        ErrorMsg
        ("url" := string)
        ("message" := string)

type alias UpdateMsg = 
    { url : String
    , posts : List Post
    }

updateMsgDecoder = 
    object2 
        UpdateMsg
        ("url" := string)
        ("posts" := list updatePostDecoder)

type Msg
    = Init InitMsg
    | Update UpdateMsg
    | UnknownMsg String
    | Error ErrorMsg

update msg model = 
    case msg of
        Init {count, urls} -> 
            ({ current = 0
             , total = Just count
             , remaining = Just urls
             , errors = Nothing
             , updates = []
             }, Cmd.none) 
        Update updateMsg -> 
            ({model | 
                current = model.current + 1,
                updates = 
                    append updateMsg.posts model.updates |> sortBy .pubDate |> reverse,
                remaining = case model.remaining of 
                    Just remaining -> Just <| List.filter ((/=) updateMsg.url) remaining
                    _ -> Nothing}, Cmd.none)
        UnknownMsg err -> 
            let 
                msg = "Unknown message object: " ++ err 
            in
                ({model | errors = case model.errors of 
                    Just list -> Just <| msg :: list 
                    Nothing -> Just [msg]
                        }, Cmd.none)
        Error msg -> 
            let 
                repr = msg.url ++ ": " ++ msg.message 
            in
                ({model | 
                    current = model.current + 1,
                    errors = case model.errors of 
                        Just list -> Just <| repr :: list 
                        Nothing -> Just [repr],
                    remaining = case model.remaining of 
                        Just remaining -> Just <| List.filter ((/=) msg.url) remaining
                        _ -> Nothing}, Cmd.none)

progressMsg model = case model.total of
    Just total ->
        if model.current == total then
            div [] []
        else 
            div [ style 
                    [ ("border", "1px solid black")
                    , ("height", "40px")
                    , ("position", "relative")
                    , ("line-height", "40px")
                    , ("font-size", "1.5em")
                    , ("text-align", "center")
                    ] ]
                [ span [ style 
                    [ ("position", "absolute")
                    , ("top", "0")
                    , ("left", "0")
                    , ("z-index", "-1")
                    , ("background-color", "green")
                    , ("height", "100%")
                    , ("width", toString (toFloat model.current / toFloat total * 100) ++ "%")
                    ] ] []
                , span [] [text <| toString model.current ++ " of " ++ toString total ++ " done"]
                ]
    Nothing -> div [] [ text "Waiting for the server" ]

remaining model = case model.remaining of
    Just remaining -> case remaining of
        [] -> div [] []
        _ -> div [] 
            [ h1 [] [text "Remaining urls to be checked:"]
            , ul [] <| List.map (\url -> li [] [text url]) remaining
            ]
    Nothing -> div [] []

formatDate date = 
    let 
        day' = pad 2 '0' <| toString (day date)
        month' = toString (month date)
        year' = toString (year date)
        hour' = pad 2 '0' <| toString (hour date)
        secs' = pad 2 '0' <| toString (second date)
    in
        day' ++ "-" ++ month' ++ "-" ++ year' ++ " " ++ hour' ++ ":" ++ secs'

posts updates = div [] <| List.map (\post -> 
        div [] 
            [ h2 [] [ a [target "_blank", href post.link] [text post.title] ]
            , div [ style [("font-weight", "bold")] ] 
                [ text <| formatDate <| fromTime post.pubDate ]
            , div [] [ text post.description ]
            ] 
    ) updates

errors model = case model.errors of
    Just errors -> div [ style [("background-color", "red"), ("padding", "10px")] ] 
        [ h1 [] [text "There were errors encountered:"]
        , ul [] <| List.map (\error -> li [] [text error]) errors
        ]
    Nothing -> div [] []

view model = div []
    [ div [ style [("margin", "20px")] ] 
        [ progressMsg model
        , remaining model
        , errors model
        , posts model.updates
        ]
    ]

subscriptions model = 
    WebSocket.listen wsUrl getMsg 

getMsg json = 
    case decodeString initMsgDecoder json of
        Ok initMsg -> Init initMsg
        _ -> case decodeString updateMsgDecoder json of
            Ok updateMsg -> Update updateMsg
            _ -> case decodeString errorMsgDecoder json of 
                Ok err -> Error err
                Err err -> UnknownMsg json