diff --git a/src/Roux/Html.hs b/src/Roux/Html.hs
index 93cd114..a740f4e 100644
--- a/src/Roux/Html.hs
+++ b/src/Roux/Html.hs
@@ -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
diff --git a/src/Roux/Parser.hs b/src/Roux/Parser.hs
index e1f5085..f50811f 100644
--- a/src/Roux/Parser.hs
+++ b/src/Roux/Parser.hs
@@ -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
diff --git a/src/Roux/Server.hs b/src/Roux/Server.hs
index 3128945..493953b 100644
--- a/src/Roux/Server.hs
+++ b/src/Roux/Server.hs
@@ -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))
diff --git a/src/Roux/Types.hs b/src/Roux/Types.hs
index 6dbfc87..0bd1100 100644
--- a/src/Roux/Types.hs
+++ b/src/Roux/Types.hs
@@ -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