diff --git a/package.yaml b/package.yaml index 389f898..9ab1389 100644 --- a/package.yaml +++ b/package.yaml @@ -31,6 +31,7 @@ dependencies: - bytestring - containers - directory + - filepath - http-types - optparse-applicative - parsec diff --git a/roux-server.cabal b/roux-server.cabal index 7f8bceb..5f77b41 100644 --- a/roux-server.cabal +++ b/roux-server.cabal @@ -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 diff --git a/src/Roux.hs b/src/Roux.hs index bc1281c..3ce3766 100644 --- a/src/Roux.hs +++ b/src/Roux.hs @@ -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!" diff --git a/src/Roux/Html.hs b/src/Roux/Html.hs new file mode 100644 index 0000000..5305c71 --- /dev/null +++ b/src/Roux/Html.hs @@ -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] diff --git a/src/Roux/RecipeIndex.hs b/src/Roux/RecipeIndex.hs new file mode 100644 index 0000000..78753f4 --- /dev/null +++ b/src/Roux/RecipeIndex.hs @@ -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) diff --git a/src/Roux/Server.hs b/src/Roux/Server.hs new file mode 100644 index 0000000..be97d70 --- /dev/null +++ b/src/Roux/Server.hs @@ -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