Add three browse modes to index page: alphabetical, by tag, by course
- Add SortMode type (AlphaSort | TagSort | CourseSort) to Roux.Html - Routes: / (alpha), /sorted/tags, /sorted/course - AlphaSort: recipes sorted by title (from metadata) or filename - TagSort: recipes grouped under tag headings, empty state when none - CourseSort: recipes grouped by course/category metadata - Navigation bar in index page with active-highlighted buttons - Add metaCourse field to Metadata model (+ emptyMetadata update) - Add nubOrd helper for deduplicating tag/course lists - All 26 tests passing, hlint clean
This commit is contained in:
+114
-8
@@ -8,6 +8,7 @@ Blaze-html re-exports many common names (title, meta, step, a, b, …)
|
||||
so name-shadowing is unavoidable with local bindings.
|
||||
-}
|
||||
module Roux.Html (
|
||||
SortMode (..),
|
||||
indexPage,
|
||||
recipePage,
|
||||
urlEncode,
|
||||
@@ -17,8 +18,9 @@ module Roux.Html (
|
||||
import Control.Monad (unless)
|
||||
import Data.ByteString.Lazy (ByteString)
|
||||
import Data.Function ((&))
|
||||
import Data.List (sortOn)
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import Data.Maybe (catMaybes, fromMaybe)
|
||||
import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
|
||||
import Data.Ratio (denominator, numerator)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
@@ -29,6 +31,17 @@ import Text.Blaze.Html5.Attributes as A
|
||||
import qualified Roux.RecipeIndex as Idx
|
||||
import Roux.Types
|
||||
|
||||
-- ---------------------------------------------------------------------------
|
||||
-- Sort mode for the index page
|
||||
-- ---------------------------------------------------------------------------
|
||||
|
||||
-- | How to group or sort recipes on the index page.
|
||||
data SortMode
|
||||
= AlphaSort
|
||||
| TagSort
|
||||
| CourseSort
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
-- ---------------------------------------------------------------------------
|
||||
-- Helpers used throughout
|
||||
-- ---------------------------------------------------------------------------
|
||||
@@ -79,22 +92,104 @@ page title content =
|
||||
-- ---------------------------------------------------------------------------
|
||||
|
||||
-- | Render the recipe index page.
|
||||
indexPage :: [Idx.RecipeInfo] -> ByteString
|
||||
indexPage recipes =
|
||||
indexPage :: SortMode -> [Idx.RecipeInfo] -> ByteString
|
||||
indexPage mode recipes =
|
||||
page "Roux — Recipes" $ do
|
||||
H.nav $ H.ul $ H.li $ H.strong "Roux"
|
||||
H.nav $ do
|
||||
H.ul $ H.li $ H.strong "Roux"
|
||||
H.ul $ do
|
||||
H.li $ sortLink "A-Z" AlphaSort "/" mode
|
||||
H.li $ sortLink "By Tag" TagSort "/sorted/tags" mode
|
||||
H.li $ sortLink "By Course" CourseSort "/sorted/course" mode
|
||||
H.h2 "Recipes"
|
||||
H.p "Your personal recipe collection."
|
||||
case filter (isRight . Idx.riRecipe) recipes of
|
||||
[] -> H.p "No recipes found."
|
||||
good ->
|
||||
H.ul $ mapM_ (recipeItem . Idx.riFilename) good
|
||||
let good = filter (isRight . Idx.riRecipe) recipes
|
||||
case mode of
|
||||
AlphaSort -> renderAlpha good
|
||||
TagSort -> renderByTags good
|
||||
CourseSort -> renderByCourse good
|
||||
-- Show parse errors separately
|
||||
let bad = filter (isLeft . Idx.riRecipe) recipes
|
||||
unless (null bad) $ do
|
||||
H.h3 "Unparseable recipes"
|
||||
H.ul $ mapM_ (H.li . H.toHtml . Idx.riTitle) bad
|
||||
|
||||
-- | A navigation link for a sort mode, highlighted when active.
|
||||
sortLink :: Text -> SortMode -> Text -> SortMode -> Html
|
||||
sortLink label linkMode url currentMode =
|
||||
if linkMode == currentMode
|
||||
then H.a ! A.href (H.toValue url) ! A.role "button" ! A.class_ "contrast outline" $ H.toHtml label
|
||||
else H.a ! A.href (H.toValue url) $ H.toHtml label
|
||||
|
||||
-- | Render recipes sorted alphabetically by title.
|
||||
renderAlpha :: [Idx.RecipeInfo] -> Html
|
||||
renderAlpha recipes
|
||||
| null recipes = H.p "No recipes found."
|
||||
| otherwise =
|
||||
let sorted = sortOn alphaSortKey recipes
|
||||
in H.ul $ mapM_ (recipeItem . Idx.riFilename) sorted
|
||||
|
||||
-- | Sort key for alphabetical ordering by title, falling back to filename.
|
||||
alphaSortKey :: Idx.RecipeInfo -> Text
|
||||
alphaSortKey info = case Idx.riRecipe info of
|
||||
Right r -> case metaTitle (recipeMetadata r) of
|
||||
Just t -> t
|
||||
Nothing -> T.pack (takeBaseName (Idx.riFilename info))
|
||||
Left _ -> T.pack "zzzz"
|
||||
|
||||
-- | Render recipes grouped by tags.
|
||||
renderByTags :: [Idx.RecipeInfo] -> Html
|
||||
renderByTags recipes = do
|
||||
let tags = collectTags recipes
|
||||
if null tags
|
||||
then H.p "No tagged recipes."
|
||||
else mapM_ renderTagGroup tags
|
||||
where
|
||||
collectTags rs =
|
||||
let entries = mapMaybe tagEntries rs
|
||||
allTags = concat entries
|
||||
uniqueTags = sortOn Prelude.id (nubOrd allTags)
|
||||
in [(tag, filter (hasTag tag) rs) | tag <- uniqueTags]
|
||||
tagEntries r = case Idx.riRecipe r of
|
||||
Right recipe ->
|
||||
let tags = metaTags (recipeMetadata recipe)
|
||||
in if null tags then Nothing else Just tags
|
||||
Left _ -> Nothing
|
||||
hasTag tag r = case Idx.riRecipe r of
|
||||
Right recipe -> tag `elem` metaTags (recipeMetadata recipe)
|
||||
Left _ -> False
|
||||
|
||||
-- | Render recipes grouped by course/category.
|
||||
renderByCourse :: [Idx.RecipeInfo] -> Html
|
||||
renderByCourse recipes = do
|
||||
let groups = collectCourses recipes
|
||||
if null groups
|
||||
then H.p "No recipes with course metadata."
|
||||
else mapM_ renderCourseGroup groups
|
||||
where
|
||||
collectCourses rs =
|
||||
let entries = mapMaybe courseEntry rs
|
||||
uniqueCourses = sortOn Prelude.id (nubOrd (Prelude.map fst entries))
|
||||
in [(course, [r | r <- rs, courseOf r == Just course]) | course <- uniqueCourses]
|
||||
courseEntry r = case Idx.riRecipe r of
|
||||
Right recipe -> (,) <$> metaCourse (recipeMetadata recipe) <*> pure ()
|
||||
Left _ -> Nothing
|
||||
courseOf r = case Idx.riRecipe r of
|
||||
Right recipe -> metaCourse (recipeMetadata recipe)
|
||||
Left _ -> Nothing
|
||||
|
||||
-- | Render a group of recipes under a tag heading.
|
||||
renderTagGroup :: (Text, [Idx.RecipeInfo]) -> Html
|
||||
renderTagGroup (tag, rs) = do
|
||||
H.h3 $ H.toHtml tag
|
||||
H.ul $ mapM_ (recipeItem . Idx.riFilename) rs
|
||||
|
||||
-- | Render a group of recipes under a course heading.
|
||||
renderCourseGroup :: (Text, [Idx.RecipeInfo]) -> Html
|
||||
renderCourseGroup (course, rs) = do
|
||||
H.h3 $ H.toHtml course
|
||||
H.ul $ mapM_ (recipeItem . Idx.riFilename) rs
|
||||
|
||||
-- | Render a single recipe link on the index page.
|
||||
recipeItem :: FilePath -> Html
|
||||
recipeItem fp =
|
||||
@@ -322,3 +417,14 @@ isLeft _ = False
|
||||
-- | Check if an 'Either' is 'Right'.
|
||||
isRight :: Either a b -> Bool
|
||||
isRight = not . isLeft
|
||||
|
||||
{- | Remove duplicate elements from a list while preserving order of first
|
||||
occurrence.
|
||||
-}
|
||||
nubOrd :: (Eq a) => [a] -> [a]
|
||||
nubOrd = go []
|
||||
where
|
||||
go _ [] = []
|
||||
go seen (x : xs)
|
||||
| x `elem` seen = go seen xs
|
||||
| otherwise = x : go (x : seen) xs
|
||||
|
||||
+2
-2
@@ -364,8 +364,8 @@ groupSections items =
|
||||
-- Items before the first header → unnamed section, then named
|
||||
(before, (RawSectionHeader name) : rest) ->
|
||||
let pre =
|
||||
[Section Nothing (makeNonEmpty (map rawToBody before))
|
||||
| not (null before)
|
||||
[ Section Nothing (makeNonEmpty (map rawToBody before))
|
||||
| not (null before)
|
||||
]
|
||||
named = collectNamedSection name rest
|
||||
in pre ++ named
|
||||
|
||||
+7
-1
@@ -41,7 +41,13 @@ app recipeDir = do
|
||||
handleRequest :: [Idx.RecipeInfo] -> Wai.Application
|
||||
handleRequest recipes request respond =
|
||||
case Wai.pathInfo request of
|
||||
[] -> respond (htmlResponse (Html.indexPage recipes))
|
||||
-- Index page (default: alphabetical)
|
||||
[] -> respond (htmlResponse (Html.indexPage Html.AlphaSort recipes))
|
||||
-- Index page (sorted by tags)
|
||||
["sorted", "tags"] -> respond (htmlResponse (Html.indexPage Html.TagSort recipes))
|
||||
-- Index page (sorted by course/category)
|
||||
["sorted", "course"] -> respond (htmlResponse (Html.indexPage Html.CourseSort recipes))
|
||||
-- Recipe detail page
|
||||
["recipes", rawPath] ->
|
||||
case lookupRecipe (urlDecodePath rawPath) recipes of
|
||||
Just info -> respond (htmlResponse (Html.recipePage info))
|
||||
|
||||
@@ -205,6 +205,7 @@ data Metadata = Metadata
|
||||
, metaCookTime :: !(Maybe Duration)
|
||||
, metaDifficulty :: !(Maybe Text)
|
||||
, metaCuisine :: !(Maybe Text)
|
||||
, metaCourse :: !(Maybe Text)
|
||||
, metaDiet :: ![Text]
|
||||
, metaTags :: ![Text]
|
||||
, metaImage :: !(Maybe Text)
|
||||
@@ -226,6 +227,7 @@ emptyMetadata =
|
||||
, metaCookTime = Nothing
|
||||
, metaDifficulty = Nothing
|
||||
, metaCuisine = Nothing
|
||||
, metaCourse = Nothing
|
||||
, metaDiet = []
|
||||
, metaTags = []
|
||||
, metaImage = Nothing
|
||||
|
||||
Reference in New Issue
Block a user