diff --git a/src/Roux/Html.hs b/src/Roux/Html.hs index 1660e5f..4324fc6 100644 --- a/src/Roux/Html.hs +++ b/src/Roux/Html.hs @@ -15,6 +15,7 @@ module Roux.Html ( indexPage, recipePage, cookHistoryPage, + landingPage, urlEncode, urlDecode, ) where @@ -933,7 +934,7 @@ renderRecipe :: FilePath -> Recipe -> [CookLog.CookEntry] -> Html renderRecipe filename recipe entries = do H.nav ! A.class_ "roux-navbar" $ do H.ul $ H.li $ H.a ! A.class_ "roux-logo" ! A.href "/" $ "Roux" - H.ul $ H.li $ H.a ! A.href "/" $ "Recipes" + H.ul $ H.li $ H.a ! A.href "/recipes" $ "Recipes" let meta = recipeMetadata recipe course = metaCourse meta desc = metaDescription meta @@ -1293,7 +1294,7 @@ cookHistoryPage grouped = H.nav ! A.class_ "roux-navbar" $ do H.ul $ H.li $ H.a ! A.class_ "roux-logo" ! A.href "/" $ "Roux" H.ul $ do - H.li $ H.a ! A.href "/" $ "Recipes" + H.li $ H.a ! A.href "/recipes" $ "Recipes" H.li $ H.a ! A.class_ "active" ! A.href "/cook-history" $ "Cook History" H.h1 "Cook History" mapM_ renderMonthGroup grouped @@ -1314,3 +1315,157 @@ renderHistoryEntry entry = do unless (T.null (CookLog.ceComment entry)) $ do H.br H.span $ H.toHtml (CookLog.ceComment entry) + +-- --------------------------------------------------------------------------- +-- Landing page +-- --------------------------------------------------------------------------- + +-- | CSS for the landing page layout. +landingStyles :: Text +landingStyles = + T.unlines + [ ".lnd-page { max-width: 980px; margin: 0 auto; padding: 36px 48px 80px; }" + , ".lnd-nav { display: flex; justify-content: space-between; align-items: center; border-bottom: 0.5px solid rgba(61,44,30,0.18); padding-bottom: 12px; margin-bottom: 32px; font-size: 12px; letter-spacing: 0.12em; color: #6B5847; text-transform: uppercase; }" + , ".lnd-logo { font-family: \"Fraunces\", serif; font-size: 22px; font-weight: 500; letter-spacing: 0.08em; }" + , ".lnd-nav-links { display: flex; gap: 28px; }" + , ".lnd-nav-links a { color: #6B5847; text-decoration: none; }" + , ".lnd-nav-links a.active { color: #B85C38; }" + , ".lnd-nav-links a:hover { color: #B85C38; }" + , "" + , ".lnd-shuffle { background: rgba(184,92,56,0.08); border-radius: 12px; padding: 20px 24px; display: flex; justify-content: space-between; align-items: center; gap: 24px; margin-bottom: 36px; }" + , ".lnd-shuffle-meta { font-size: 12px; letter-spacing: 0.12em; color: #8A7560; text-transform: uppercase; margin-bottom: 4px; }" + , ".lnd-shuffle h3 { font-family: \"Fraunces\", serif; font-size: 20px; font-weight: 500; margin: 0; }" + , ".lnd-shuffle-actions { display: flex; gap: 14px; align-items: center; flex-shrink: 0; }" + , "" + , ".lnd-btn { background: #B85C38; color: #FDF6E7; border: none; border-radius: 8px; padding: 10px 18px; font-size: 13px; font-weight: 500; cursor: pointer; font-family: inherit; }" + , ".lnd-btn:hover { filter: brightness(0.95); }" + , ".lnd-btn-ghost { background: none; border: none; color: #B85C38; font-size: 13px; cursor: pointer; padding: 0; font-family: inherit; }" + , ".lnd-btn-ghost:hover { text-decoration: underline; }" + , "" + , ".lnd-shelf-header { display: flex; justify-content: space-between; align-items: baseline; margin-bottom: 14px; }" + , ".lnd-shelf { margin-bottom: 36px; }" + , ".lnd-shelf h3 { font-family: \"Fraunces\", serif; font-size: 20px; font-weight: 500; margin: 0; }" + , ".lnd-shelf-row { display: grid; grid-template-columns: repeat(3, 1fr); gap: 18px; }" + , "" + , ".lnd-card { cursor: pointer; }" + , ".lnd-card-image { width: 100%; aspect-ratio: 1.3; border-radius: 8px; background-size: cover; background-position: center; background: linear-gradient(135deg, #E8B86A, #C9893F 60%, #8A5A2A); transition: opacity 0.15s; }" + , ".lnd-card:hover .lnd-card-image { opacity: 0.92; }" + , ".lnd-card-title { font-family: \"Fraunces\", serif; font-size: 17px; font-weight: 500; margin: 10px 0 4px; }" + , ".lnd-card-meta { font-size: 12px; color: #8A7560; }" + , "" + , ".lnd-img-1 { background: linear-gradient(135deg, #E8B86A, #C9893F 60%, #8A5A2A); }" + , ".lnd-img-2 { background: linear-gradient(135deg, #A8C77A, #6B8E3D 60%, #3D5A1F); }" + , ".lnd-img-3 { background: linear-gradient(135deg, #D4A574, #9C6B3F 60%, #5C3A1F); }" + , ".lnd-img-4 { background: linear-gradient(135deg, #E8C46A, #B8902F 60%, #7A5E1A); }" + , ".lnd-img-5 { background: linear-gradient(135deg, #C7A878, #8E6B3D 60%, #5A4520); }" + , ".lnd-img-6 { background: linear-gradient(135deg, #B5D4A1, #7AA862 60%, #4D7038); }" + , "" + , "@media (max-width: 720px) { .lnd-page { padding: 24px 24px 60px; } .lnd-shelf-row { grid-template-columns: 1fr 1fr; } .lnd-shuffle { flex-direction: column; align-items: flex-start; } .lnd-shuffle-actions { width: 100%; justify-content: flex-end; } }" + ] + +-- | Inline JavaScript for the landing page shuffle and navigation. +landingJs :: Text +landingJs = + T.unlines + [ "(function(){" + , "'use strict';" + , "var data = JSON.parse(document.getElementById('lnd-recipe-data').textContent);" + , "var shuffleName = document.getElementById('lnd-shuffle-name');" + , "var shuffleBtn = document.getElementById('lnd-shuffle-btn');" + , "var openBtn = document.getElementById('lnd-open-btn');" + , "" + , "function pickRandom() {" + , " return data[Math.floor(Math.random() * data.length)];" + , "}" + , "" + , "function setCurrent(r) {" + , " shuffleName.textContent = r.title;" + , " openBtn.onclick = function() { window.location.href = '/recipes/' + encodeURIComponent(r.filename); };" + , " openBtn.style.cursor = 'pointer';" + , "}" + , "" + , "if (data.length > 0) { setCurrent(pickRandom()); }" + , "shuffleBtn.addEventListener('click', function() { setCurrent(pickRandom()); });" + , "})();" + ] + +{- | Render the landing page with recently cooked (from cook log DB), +recently added recipes, and a shuffle card. +-} +landingPage :: [Idx.RecipeInfo] -> [(CookLog.CookEntry, Idx.RecipeInfo)] -> [Idx.RecipeInfo] -> ByteString +landingPage allRecipes recentlyCooked recentlyAdded = + page "Roux" $ do + H.style $ H.toHtml landingStyles + H.div ! A.class_ "lnd-page" $ do + -- Nav + H.nav ! A.class_ "lnd-nav" $ do + H.span ! A.class_ "lnd-logo" $ "ROUX" + H.div ! A.class_ "lnd-nav-links" $ do + H.a ! A.class_ "active" $ "Home" + H.a ! A.href "/recipes" $ "Recipes" + H.a ! A.href "/cook-history" $ "Cook History" + -- Shuffle card + H.div ! A.class_ "lnd-shuffle" $ do + H.div $ do + H.div ! A.class_ "lnd-shuffle-meta" $ "Don\x2019t know what to cook?" + H.h3 ! A.id "lnd-shuffle-name" $ "Loading..." + H.div ! A.class_ "lnd-shuffle-actions" $ do + H.button ! A.class_ "lnd-btn-ghost" ! A.id "lnd-shuffle-btn" $ "\x21BB Shuffle" + H.button ! A.class_ "lnd-btn" ! A.id "lnd-open-btn" $ "Open recipe" + -- Recently cooked shelf + H.section ! A.class_ "lnd-shelf" $ do + H.div ! A.class_ "lnd-shelf-header" $ do + H.h3 "Recently cooked" + H.a ! A.class_ "lnd-btn-ghost" ! A.href "/cook-history" $ "All history \x2192" + H.div ! A.class_ "lnd-shelf-row" $ do + let cookedGrads = ["lnd-img-1", "lnd-img-2", "lnd-img-3"] + mapM_ (\(i, (e, r)) -> renderLandingCookedCard (cookedGrads !! i) e r) (zip [0 ..] (take 3 recentlyCooked)) + -- Recently added shelf + H.section ! A.class_ "lnd-shelf" $ do + H.div ! A.class_ "lnd-shelf-header" $ do + H.h3 "Recently added" + H.a ! A.class_ "lnd-btn-ghost" ! A.href "/recipes" $ "All recipes \x2192" + H.div ! A.class_ "lnd-shelf-row" $ do + let addedGrads = ["lnd-img-4", "lnd-img-5", "lnd-img-6"] + mapM_ (\(i, r) -> renderLandingCard (addedGrads !! i) r) (zip [0 ..] (take 3 recentlyAdded)) + -- Embedded JSON for shuffle + H.script ! A.id "lnd-recipe-data" ! A.type_ "application/json" $ + H.toHtml (encodeRecipeJson (take 100 (filterOk allRecipes))) + H.script ! A.type_ "text/javascript" $ H.preEscapedText landingJs + where + filterOk = filter (isRight . Idx.riRecipe) + +-- | Encode recipe list as JSON for the shuffle JS. +encodeRecipeJson :: [Idx.RecipeInfo] -> Text +encodeRecipeJson recipes = + let entries = Prelude.map toSimpleEntry recipes + items = T.intercalate ", " entries + in "[" <> items <> "]" + where + toSimpleEntry r = + let title = escapeJson (Idx.riTitle r) + filename = escapeJson (T.pack (Idx.riFilename r)) + in "{\"title\":\"" <> title <> "\",\"filename\":\"" <> filename <> "\"}" + escapeJson = T.concatMap escapeChar + escapeChar '"' = "\\\"" + escapeChar '\\' = "\\\\" + escapeChar '\n' = "\\n" + escapeChar '\r' = "\\r" + escapeChar '\t' = "\\t" + escapeChar c = T.singleton c + +-- | Render a landing page card for recently cooked (with date). +renderLandingCookedCard :: Text -> CookLog.CookEntry -> Idx.RecipeInfo -> Html +renderLandingCookedCard imgClass entry info = + H.div ! A.class_ "lnd-card" $ do + H.div ! A.class_ (H.toValue ("lnd-card-image " <> imgClass)) $ "" + H.div ! A.class_ "lnd-card-title" $ H.toHtml (Idx.riTitle info) + H.div ! A.class_ "lnd-card-meta" $ H.toHtml (formatDay (CookLog.ceCookedDate entry)) + +-- | Render a landing page card for recently added (with "Added" date). +renderLandingCard :: Text -> Idx.RecipeInfo -> Html +renderLandingCard imgClass info = + H.div ! A.class_ "lnd-card" $ do + H.div ! A.class_ (H.toValue ("lnd-card-image " <> imgClass)) $ "" + H.div ! A.class_ "lnd-card-title" $ H.toHtml (Idx.riTitle info) + H.div ! A.class_ "lnd-card-meta" $ H.toHtml ("Recently added" :: Text) diff --git a/src/Roux/Server.hs b/src/Roux/Server.hs index 8e1e654..c94931a 100644 --- a/src/Roux/Server.hs +++ b/src/Roux/Server.hs @@ -20,7 +20,8 @@ import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as LB import Data.Char (digitToInt, isAlphaNum, toLower) import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef, writeIORef) -import Data.List (isSuffixOf) +import Data.List (isSuffixOf, sortOn) +import Data.Ord (Down (Down)) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Text (Text) @@ -29,7 +30,7 @@ import Data.Text.Encoding (encodeUtf8) import qualified Network.HTTP.Types as HTTP import qualified Network.Wai as Wai -import System.Directory (createDirectoryIfMissing, doesFileExist, findExecutable, makeAbsolute, removeFile) +import System.Directory (createDirectoryIfMissing, doesFileExist, findExecutable, getModificationTime, makeAbsolute, removeFile) import System.FSNotify ( Event (..), EventIsDirectory (..), @@ -44,7 +45,7 @@ import System.FilePath (makeRelative, takeBaseName, takeExtension, ()) import qualified Data.Aeson as A import qualified Data.Aeson.KeyMap as KM import qualified Data.ByteString as BS -import Data.Maybe (fromMaybe, mapMaybe) +import Data.Maybe (catMaybes, fromMaybe, mapMaybe) import qualified Data.Text.Encoding as TE import Data.Time.Calendar (Day, fromGregorianValid) import Data.Time.Clock (diffUTCTime, getCurrentTime, utctDay) @@ -200,7 +201,7 @@ router recipeDir config state changeLog db request respond = | Just filename <- dispatchLogPost pathInfo , Wai.requestMethod request == "POST" -> handleCookLogPost db filename request respond - _ -> handleRequest state db request respond + _ -> handleRequest recipeDir state db request respond -- | Extract filename from /cook-log/{filename} POST path, if it matches. dispatchLogPost :: [Text] -> Maybe Text @@ -622,17 +623,29 @@ reReadRecipe dir path state changeLog = do putStrLn $ "[roux] updated " <> path -- | Route an incoming request to the appropriate handler. -handleRequest :: IORef (Map FilePath Idx.RecipeInfo) -> SQL.Connection -> Wai.Application -handleRequest state db request respond = do +handleRequest :: FilePath -> IORef (Map FilePath Idx.RecipeInfo) -> SQL.Connection -> Wai.Application +handleRequest recipeDir state db request respond = do recipes <- readIORef state let recipeList = Map.elems recipes case Wai.pathInfo request of - -- Index page (default: alphabetical) - [] -> respond (htmlResponse (Html.indexPage Html.AlphaSort recipeList)) - -- Index page (sorted by tags) — sort mode ignored, driven client-side - ["sorted", "tags"] -> respond (htmlResponse (Html.indexPage Html.AlphaSort recipeList)) - -- Index page (sorted by course/category) — sort mode ignored, driven client-side - ["sorted", "course"] -> respond (htmlResponse (Html.indexPage Html.AlphaSort recipeList)) + -- Landing page (root) + [] -> do + allEntries <- CookLog.fetchAllEntries db + let okRecipes = filter (\r -> case Idx.riRecipe r of Right _ -> True; _ -> False) recipeList + -- Deduplicate cook entries by recipe filename, keep most recent + let deduped = deduplicateByRecipe allEntries + -- Look up recipe info for each recently cooked entry + lookupInfo e = case Map.lookup (map toLower (stripCookExt (T.unpack (CookLog.ceRecipeFilename e)))) recipes of + Just info -> Just (e, info) + Nothing -> Nothing + cookedWithInfo = mapMaybe lookupInfo (take 10 deduped) + -- Get recently added recipes (by modification time) + recentlyAdded <- getRecentlyAdded recipeDir okRecipes + respond $ htmlResponse (Html.landingPage okRecipes cookedWithInfo recentlyAdded) + -- Recipe index page + ["recipes"] -> respond (htmlResponse (Html.indexPage Html.AlphaSort recipeList)) + ["recipes", "sorted", "tags"] -> respond (htmlResponse (Html.indexPage Html.AlphaSort recipeList)) + ["recipes", "sorted", "course"] -> respond (htmlResponse (Html.indexPage Html.AlphaSort recipeList)) -- Recipe detail page ["recipes", rawPath] -> case lookupRecipe (urlDecodePath rawPath) recipes of @@ -665,9 +678,38 @@ handleRequest state db request respond = do (A.encode entries) _ -> respond notFound --- | Handle POST /cook-log/{filename} --- | Normalize a recipe filename to match the recipe index key: --- lowercased, with @.cook@ extension stripped. +-- | Deduplicate cook entries by recipe filename, keeping the most recent entry per recipe. +deduplicateByRecipe :: [CookLog.CookEntry] -> [CookLog.CookEntry] +deduplicateByRecipe entries = + let seen = foldl' addIfNew [] entries + in reverse seen + where + addIfNew acc e = + if any ((== CookLog.ceRecipeFilename e) . CookLog.ceRecipeFilename) acc + then acc + else e : acc + +-- | Get recently added recipes sorted by modification time (newest first). +getRecentlyAdded :: FilePath -> [Idx.RecipeInfo] -> IO [Idx.RecipeInfo] +getRecentlyAdded recipeDir recipes = do + times <- + mapM + ( \r -> do + let filepath = recipeDir Idx.riFilename r + result <- try (getModificationTime filepath) + case result of + Left (_ :: IOException) -> pure Nothing + Right t -> pure (Just (r, t)) + ) + recipes + let valid = catMaybes times + sorted = sortOn (Down . snd) valid + pure (Prelude.map fst (take 10 sorted)) + +{- | Handle POST /cook-log/{filename} +| Normalize a recipe filename to match the recipe index key: +lowercased, with @.cook@ extension stripped. +-} normalizeRecipeKey :: Text -> Text normalizeRecipeKey = T.pack . map toLower . stripCookExt . T.unpack