Web server with recipe index page
- Add Roux.Server: WAI application using wai+warp directly - Scans .cook files from recipe directory on startup - GET / → HTML index page listing all recipes - Other routes → 404 - Add Roux.RecipeIndex: directory scanning and recipe parsing - scanRecipes: lists .cook files, parses each, extracts titles - Falls back to filename when metadata title is absent - Add Roux.Html: blaze-html rendering with Pico CSS - indexPage: renders recipe list with links - urlEncode: percent-encodes filenames for URLs - Update Roux.hs: re-exports Server.app and Types - Add filepath to dependencies
This commit is contained in:
@@ -31,6 +31,7 @@ dependencies:
|
||||
- bytestring
|
||||
- containers
|
||||
- directory
|
||||
- filepath
|
||||
- http-types
|
||||
- optparse-applicative
|
||||
- parsec
|
||||
|
||||
@@ -17,7 +17,10 @@ build-type: Simple
|
||||
library
|
||||
exposed-modules:
|
||||
Roux
|
||||
Roux.Html
|
||||
Roux.Parser
|
||||
Roux.RecipeIndex
|
||||
Roux.Server
|
||||
Roux.Types
|
||||
other-modules:
|
||||
Paths_roux_server
|
||||
@@ -36,6 +39,7 @@ library
|
||||
, bytestring
|
||||
, containers
|
||||
, directory
|
||||
, filepath
|
||||
, http-types
|
||||
, optparse-applicative
|
||||
, parsec
|
||||
@@ -64,6 +68,7 @@ executable roux-server
|
||||
, bytestring
|
||||
, containers
|
||||
, directory
|
||||
, filepath
|
||||
, http-types
|
||||
, optparse-applicative
|
||||
, parsec
|
||||
@@ -96,6 +101,7 @@ test-suite roux-server-test
|
||||
, bytestring
|
||||
, containers
|
||||
, directory
|
||||
, filepath
|
||||
, hspec
|
||||
, http-types
|
||||
, optparse-applicative
|
||||
|
||||
+1
-13
@@ -4,17 +4,5 @@ module Roux (
|
||||
module X,
|
||||
) where
|
||||
|
||||
import qualified Network.HTTP.Types as HTTP
|
||||
import qualified Network.Wai as Wai
|
||||
|
||||
import Roux.Server (app)
|
||||
import Roux.Types as X
|
||||
|
||||
-- | Build the WAI 'Application' given a path to the recipe directory.
|
||||
app :: FilePath -> IO Wai.Application
|
||||
app _recipeDir =
|
||||
pure $ \_request respond ->
|
||||
respond $
|
||||
Wai.responseLBS
|
||||
HTTP.status200
|
||||
[("Content-Type", "text/plain")]
|
||||
"Hello from Roux!"
|
||||
|
||||
@@ -0,0 +1,55 @@
|
||||
{- | HTML rendering for the Roux web interface.
|
||||
|
||||
Uses blaze-html directly. Styling via Pico CSS (inlined in the page).
|
||||
-}
|
||||
module Roux.Html (
|
||||
indexPage,
|
||||
) where
|
||||
|
||||
import Data.ByteString.Lazy (ByteString)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Text.Blaze.Html.Renderer.Utf8 as R
|
||||
import Text.Blaze.Html5 as H
|
||||
import Text.Blaze.Html5.Attributes as A
|
||||
|
||||
import qualified Roux.RecipeIndex as Idx
|
||||
|
||||
-- | Render the recipe index page.
|
||||
indexPage :: [Idx.RecipeInfo] -> ByteString
|
||||
indexPage recipes =
|
||||
R.renderHtml $
|
||||
H.docTypeHtml $ do
|
||||
H.head $ do
|
||||
H.meta ! A.charset "utf-8"
|
||||
H.meta ! A.name "viewport" ! A.content "width=device-width, initial-scale=1"
|
||||
H.title "Roux — Recipes"
|
||||
H.link ! A.rel "stylesheet" ! A.href "https://cdn.jsdelivr.net/npm/@picocss/pico@2/css/pico.min.css"
|
||||
H.body $ do
|
||||
H.main ! A.class_ "container" $ do
|
||||
H.h1 "Roux"
|
||||
H.p "Your personal recipe collection."
|
||||
H.h2 "Recipes"
|
||||
H.ul $ mapM_ recipeItem recipes
|
||||
|
||||
-- | Render a single recipe list item.
|
||||
recipeItem :: Idx.RecipeInfo -> Html
|
||||
recipeItem info =
|
||||
H.li $ case Idx.riRecipe info of
|
||||
Left _err ->
|
||||
H.span ! A.class_ "error" $ do
|
||||
H.toHtml (Idx.riTitle info)
|
||||
" (parse error)"
|
||||
Right _recipe ->
|
||||
H.a ! A.href (H.toValue ("/recipes/" <> urlEncode (Idx.riFilename info))) $
|
||||
H.toHtml (Idx.riTitle info)
|
||||
|
||||
-- | Percent-encode a filename for use in a URL path segment.
|
||||
urlEncode :: FilePath -> Text
|
||||
urlEncode = T.pack . concatMap encodeChar
|
||||
where
|
||||
encodeChar c
|
||||
| c == ' ' = "%20"
|
||||
| c == '#' = "%23"
|
||||
| c == '%' = "%25"
|
||||
| otherwise = [c]
|
||||
@@ -0,0 +1,55 @@
|
||||
-- | Scanning and indexing of Cooklang recipe files on disk.
|
||||
module Roux.RecipeIndex (
|
||||
RecipeInfo (..),
|
||||
scanRecipes,
|
||||
) where
|
||||
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import System.Directory (listDirectory)
|
||||
import System.FilePath (takeBaseName, takeExtension, (</>))
|
||||
|
||||
import Roux.Parser (parseCookFile)
|
||||
import Roux.Types
|
||||
|
||||
-- | Metadata about a single recipe discovered on disk.
|
||||
data RecipeInfo = RecipeInfo
|
||||
{ riFilename :: FilePath
|
||||
-- ^ Path relative to the recipe directory
|
||||
, riTitle :: Text
|
||||
-- ^ Display title (from metadata or filename)
|
||||
, riRecipe :: Either String Recipe
|
||||
-- ^ Parsed recipe (or error message)
|
||||
}
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
-- | Scan a directory for @.cook@ files and parse each one.
|
||||
scanRecipes :: FilePath -> IO [RecipeInfo]
|
||||
scanRecipes dir = do
|
||||
entries <- listDirectory dir
|
||||
let cookFiles = filter ((== ".cook") . takeExtension) entries
|
||||
mapM (loadRecipe dir) cookFiles
|
||||
|
||||
-- | Load and parse a single recipe file.
|
||||
loadRecipe :: FilePath -> FilePath -> IO RecipeInfo
|
||||
loadRecipe dir filename = do
|
||||
content <- readFile (dir </> filename)
|
||||
let parsed = parseCookFile (T.pack content)
|
||||
title = case parsed of
|
||||
Right r -> extractTitle r filename
|
||||
Left _err -> T.pack (takeBaseName filename)
|
||||
return
|
||||
RecipeInfo
|
||||
{ riFilename = filename
|
||||
, riTitle = title
|
||||
, riRecipe = parsed
|
||||
}
|
||||
|
||||
{- | Extract a display title from the recipe's metadata or fall back to the
|
||||
filename.
|
||||
-}
|
||||
extractTitle :: Recipe -> FilePath -> Text
|
||||
extractTitle recipe filename =
|
||||
case metaTitle (recipeMetadata recipe) of
|
||||
Just t -> t
|
||||
Nothing -> T.pack (takeBaseName filename)
|
||||
@@ -0,0 +1,63 @@
|
||||
{- | WAI application for the Roux recipe server.
|
||||
|
||||
Handles HTTP requests directly via wai — no framework. Currently serves
|
||||
a single index page listing all discovered recipes.
|
||||
-}
|
||||
module Roux.Server (
|
||||
app,
|
||||
) where
|
||||
|
||||
import Control.Monad (when)
|
||||
import Data.ByteString.Lazy (ByteString)
|
||||
import qualified Network.HTTP.Types as HTTP
|
||||
import qualified Network.Wai as Wai
|
||||
|
||||
import qualified Roux.Html as Html
|
||||
import qualified Roux.RecipeIndex as Idx
|
||||
|
||||
{- | Build the WAI 'Application' given a path to the recipe directory.
|
||||
|
||||
Recipes are scanned once at startup. A future improvement could watch
|
||||
the directory for changes and rebuild the index.
|
||||
-}
|
||||
app :: FilePath -> IO Wai.Application
|
||||
app recipeDir = do
|
||||
putStrLn $ "[roux] scanning recipes from " <> recipeDir
|
||||
recipes <- Idx.scanRecipes recipeDir
|
||||
let count = length recipes
|
||||
ok = length [() | r <- recipes, isRight (Idx.riRecipe r)]
|
||||
errs = count - ok
|
||||
putStrLn $ "[roux] found " <> show count <> " recipe(s)"
|
||||
when (errs > 0) $
|
||||
putStrLn $
|
||||
"[roux] " <> show errs <> " had parse errors"
|
||||
-- Return the application; recipes are captured in the closure.
|
||||
pure (handleRequest recipes)
|
||||
|
||||
-- | Route an incoming request to the appropriate handler.
|
||||
handleRequest :: [Idx.RecipeInfo] -> Wai.Application
|
||||
handleRequest recipes request respond =
|
||||
case Wai.pathInfo request of
|
||||
[] -> respond (htmlResponse (Html.indexPage recipes))
|
||||
_ -> respond notFound
|
||||
|
||||
-- | Build a 200 HTML response.
|
||||
htmlResponse :: ByteString -> Wai.Response
|
||||
htmlResponse body =
|
||||
Wai.responseLBS
|
||||
HTTP.status200
|
||||
[("Content-Type", "text/html; charset=utf-8")]
|
||||
body
|
||||
|
||||
-- | 404 response.
|
||||
notFound :: Wai.Response
|
||||
notFound =
|
||||
Wai.responseLBS
|
||||
HTTP.status404
|
||||
[("Content-Type", "text/plain")]
|
||||
"Not found"
|
||||
|
||||
-- | Check if an 'Either' is 'Right'.
|
||||
isRight :: Either a b -> Bool
|
||||
isRight (Right _) = True
|
||||
isRight (Left _) = False
|
||||
Reference in New Issue
Block a user