WIP: Add personal quote list

Makefile

@@ -7,4 +7,4 @@ out/main.js:
 	elm make --yes src/Main.elm --warn --output out/main.js
 
 clean:
-	rm -rf out
+	rm -f out/main.js

elm-package.json

@@ -7,6 +7,7 @@
         "src"
     ],
     "exposed-modules": [],
+    "native-modules": true,
     "dependencies": {
         "elm-community/random-extra": "2.0.0 <= v < 3.0.0",
         "elm-lang/core": "5.0.0 <= v < 6.0.0",

src/Favs.elm

@@ -0,0 +1,56 @@
+module Favs exposing (isa, filter, bens)
+
+import Types exposing (Quote)
+import Set exposing (Set)
+
+
+{-| Check if the quote is a favorite, if its in the set of favs
+-}
+isa : Set ( Int, Int ) -> Quote -> Maybe Quote
+isa favSet quote =
+    if Set.member ( quote.book, quote.section ) favSet then
+        Just quote
+    else
+        Nothing
+
+
+{-| Really bad filter function, but it gets the job done
+-}
+filter : Set ( Int, Int ) -> List Quote -> List Quote
+filter favSet =
+    List.filterMap (isa favSet)
+
+
+{-| My favorites :D
+-}
+bens : Set.Set ( Int, Int )
+bens =
+    Set.fromList
+        [ ( 2, 1 )
+        , ( 2, 5 )
+        , ( 3, 5 )
+        , ( 3, 10 )
+        , ( 4, 7 )
+        , ( 5, 1 )
+        , ( 5, 20 )
+        , ( 5, 22 )
+        , ( 5, 37 )
+        , ( 6, 2 )
+        , ( 6, 6 )
+        , ( 6, 13 )
+        , ( 6, 39 )
+        , ( 6, 45 )
+        , ( 6, 48 )
+        , ( 6, 53 )
+        , ( 7, 22 )
+        , ( 7, 59 )
+        , ( 7, 69 )
+        , ( 9, 4 )
+        , ( 9, 5 )
+        , ( 9, 40 )
+        , ( 10, 1 )
+        , ( 10, 16 )
+        , ( 10, 27 )
+        , ( 10, 29 )
+        , ( 11, 7 )
+        ]

src/LocalStorage.elm

@@ -0,0 +1,88 @@
+-- copied from https://github.com/elm-lang/persistent-cache/blob/master/src/LocalStorage.elm
+-- The persistent-cache package isn't published yet, and I just need access to LocalStorage anyway
+
+
+module LocalStorage
+    exposing
+        ( get
+        , set
+        , remove
+        , clear
+        , keys
+        , Error
+        , Error(..)
+        )
+
+{-| Low-level bindings to the [localStorage][] API.
+
+[localStorage]: https://developer.mozilla.org/en-US/docs/Web/API/Window/localStorage
+
+# Storage
+@docs get, set, remove, Error
+
+# Curate your Storage
+@docs clear, keys
+
+-}
+
+import Native.LocalStorage
+import Task exposing (Task)
+
+
+{-| These low-level operations can fail in a few ways:
+
+  - `QuotaExceeded` means you exceeded your 5mb and need to `clear` or `remove`
+    some information to make more space.
+  - `Disabled` means the user turned off local storage. It is rare, but it can
+    happen.
+-}
+type Error
+    = QuotaExceeded
+    | Disabled
+
+
+{-| Get the value at a particular key.
+
+    get "age"
+-}
+get : String -> Task Error (Maybe String)
+get =
+    Native.LocalStorage.get
+
+
+{-| Set a key to a particular value. If the key does not exist, it is added.
+If the key already exists, we overwrite the old data.
+
+    set "age" "42"
+
+Most browsers cap you at 5MB of space, so this can trigger a `QuotaExceeded`
+error if you are adding enough data to cross that threshold.
+-}
+set : String -> String -> Task Error ()
+set =
+    Native.LocalStorage.set
+
+
+{-| Remove a particular key and its corresponding value.
+
+    remove "age"
+-}
+remove : String -> Task Error ()
+remove =
+    Native.LocalStorage.remove
+
+
+{-| Remove everything in local storage.
+-}
+clear : Task Error ()
+clear =
+    Native.LocalStorage.clear
+
+
+{-| Get all the keys currently stored. So if you `set` two entries named
+`"draft"` and `"title"`, running the `keys` task will produce
+`["draft", "title"]`. If you have not `set` any entries yet, you will get `[]`.
+-}
+keys : Task Error (List String)
+keys =
+    Native.LocalStorage.keys

src/Main.elm

@@ -1,33 +1,32 @@
 module Main exposing (..)
 
-import Html exposing (Html, button, div, text, h1, h2, span, p, article, header, nav, a)
-import Html.Attributes exposing (class, style, id, href, target)
-import Html.Events exposing (onClick)
+import Html exposing (Html, div, text, p)
 import Navigation exposing (Location)
-import Markdown
 import Quote
 import Random
 import RemoteData exposing (RemoteData(..), WebData)
 import RemoteData.Infix exposing (..)
 import Routing exposing (parseLocation, Route(..))
-import Set
 import Types exposing (..)
+import Favs exposing (..)
+import View
 
 
 main : Program Never Model Msg
 main =
     Navigation.program OnLocationChange
         { init = init
-        , view = view
+        , view = root
         , update = update
-        , subscriptions = (\_ -> Sub.none)
+        , subscriptions = \_ -> Sub.none
         }
 
 
 init : Location -> ( Model, Cmd Msg )
 init loc =
-    ( { quotes = Loading
+    ( { quotes = NotAsked
       , route = parseLocation loc
+      , favs = NotAsked
       }
     , Quote.fetch
     )
@@ -62,14 +61,17 @@ update msg model =
                     ( { model | route = QuoteRoute quote.book quote.section }
                     , Navigation.newUrl <|
                         "/#/"
-                            ++ (toString quote.book)
+                            ++ toString quote.book
                             ++ "/"
-                            ++ (toString quote.section)
+                            ++ toString quote.section
                     )
 
                 _ ->
                     ( model, Cmd.none )
 
+        FavsResponse resp ->
+            ( { model | favs = resp }, Cmd.none )
+
         OnLocationChange location ->
             let
                 newRoute =
@@ -78,126 +80,63 @@ update msg model =
                 ( { model | route = newRoute }, Cmd.none )
 
 
-shoveWebData : (a -> Html Msg) -> WebData a -> Html Msg
-shoveWebData viewer data =
-    case data of
-        NotAsked ->
-            wrap <| p [] [ text "Initializing." ]
+root : Model -> Html Msg
+root model =
+    case model.route of
+        NotFoundRoute ->
+            View.wrap <| p [] [ text "Not Found..." ]
 
-        Loading ->
-            wrap <| p [] [ text "Loading..." ]
+        Index ->
+            View.wrap <| p [] [ text "Loading..." ]
 
-        Failure err ->
-            wrap <|
-                div []
-                    [ p [] [ text <| "Error: " ++ (toString err) ]
-                    , Markdown.toHtml [ class "content" ]
-                        """
-Try refreshing?
+        AllQuotes ->
+            case model.quotes of
+                NotAsked ->
+                    View.notAsked
 
-If the problem persists, please report
-the error at [GitHub](https://github.com/bsima/aurelius/issues)
-and I will fix it right away. Thanks!
-"""
-                    ]
+                Loading ->
+                    View.loading
 
-        Success stuff ->
-            wrap <| viewer stuff
+                Failure err ->
+                    View.failure err
 
+                Success quotes ->
+                    div [] <| List.map Quote.view_ quotes
 
-view : Model -> Html Msg
-view model =
-    case model.route of
-        NotFoundRoute ->
-            wrap <| p [] [ text "Not Found..." ]
+        QuoteRoute _ _ ->
+            View.webData (Quote.view model.route) model.quotes
 
-        Index ->
-            wrap <| p [] [ text "Loading..." ]
+        Favorites ->
+            getFavSet model.quotes model.favs
+                |> View.webData (div [] << List.map Quote.view_)
 
-        AllQuotes ->
+        Ben ->
             model.quotes
-                |> shoveWebData (\xs -> div [] <| List.map Quote.view_ xs)
+                |> View.webData (Favs.filter Favs.bens >> List.map Quote.view_ >> div [])
 
-        QuoteRoute book section ->
-            shoveWebData (Quote.view model.route) model.quotes
 
-        Ben ->
-            model.quotes
-                |> shoveWebData (List.filterMap isaFav >> List.map Quote.view_ >> div [])
-
-wrap : Html Msg -> Html Msg
-wrap kids =
-    div []
-        [ navbar
-        , div
-            [ id "content", class "wrapper" ]
-            [ h1 [] [ text "Marcus Aurelius" ]
-            , p [ class "subtitle" ] [ text "Meditations" ]
-            , kids
-            ]
-        ]
-
-
-navbar : Html Msg
-navbar =
-    header [ class "scroll wrapper" ]
-        [ nav []
-            [ a
-                [ href "#"
-                , id "refresh"
-                , onClick Refresh
-                ]
-                [ text "Refresh" ]
-            , a [ href "#/all" ] [ text "All Quotes" ]
-            , a
-                [ href "https://goo.gl/forms/zivB95KX91rzcPHT2"
-                , target "_blank"
-                ]
-                [ text "Submit a Quote" ]
-            , a
-                [ href "https://github.com/bsima/aurelius"
-                , target "_blank"
-                ]
-                [ text "GitHub" ]
-            ]
-        ]
-
-
-isaFav : Quote -> Maybe Quote
-isaFav quote =
-    if Set.member ( quote.book, quote.section ) bensFavs
-    then Just quote
-    else Nothing
-
-
-bensFavs : Set.Set ( Int, Int )
-bensFavs =
-    Set.fromList
-        [ ( 2, 1 )
-        , ( 2, 5 )
-        , ( 3, 5 )
-        , ( 3, 10 )
-        , ( 4, 7 )
-        , ( 5, 1 )
-        , ( 5, 20 )
-        , ( 5, 22 )
-        , ( 5, 37 )
-        , ( 6, 2 )
-        , ( 6, 6 )
-        , ( 6, 13 )
-        , ( 6, 39 )
-        , ( 6, 45 )
-        , ( 6, 48 )
-        , ( 6, 53 )
-        , ( 7, 22 )
-        , ( 7, 59 )
-        , ( 7, 69 )
-        , ( 9, 4 )
-        , ( 9, 5 )
-        , ( 9, 40 )
-        , ( 10, 1 )
-        , ( 10, 16 )
-        , ( 10, 27 )
-        , ( 10, 29 )
-        , ( 11, 7 )
-        ]
+getFavSet : WebData (List Quote) -> FavSet -> RemoteData Error (List Quote)
+getFavSet quotes favs =
+    case quotes of
+        Loading ->
+            Loading
+
+        Failure _ ->
+            Failure HttpError
+
+        NotAsked ->
+            NotAsked
+
+        Success qs ->
+            case favs of
+                Success fs ->
+                    Success (Favs.filter fs qs)
+
+                Loading ->
+                    Loading
+
+                Failure _ ->
+                    Failure LocalStorageError
+
+                NotAsked ->
+                    NotAsked