diff --git a/package.yaml b/package.yaml index 6eafb2b..9e82980 100644 --- a/package.yaml +++ b/package.yaml @@ -41,6 +41,7 @@ dependencies: - http-types - optparse-applicative - parsec + - process - text - time - wai diff --git a/roux-server.cabal b/roux-server.cabal index e93ca4a..22a1224 100644 --- a/roux-server.cabal +++ b/roux-server.cabal @@ -18,6 +18,7 @@ library exposed-modules: Data.CookLang Roux + Roux.CooklangPrint Roux.Html Roux.NYTimes Roux.Parser @@ -52,6 +53,7 @@ library , json-fleece-core , optparse-applicative , parsec + , process , text , time , wai @@ -87,6 +89,7 @@ executable check-recipes , json-fleece-core , optparse-applicative , parsec + , process , roux-server , text , time @@ -123,6 +126,7 @@ executable roux-server , json-fleece-core , optparse-applicative , parsec + , process , roux-server , text , time @@ -165,6 +169,7 @@ test-suite roux-server-test , json-fleece-core , optparse-applicative , parsec + , process , roux-server , tasty , tasty-golden diff --git a/src/Roux/Server.hs b/src/Roux/Server.hs index 45e0861..369c7fd 100644 --- a/src/Roux/Server.hs +++ b/src/Roux/Server.hs @@ -41,8 +41,28 @@ import System.FSNotify ( ) import System.FilePath (makeRelative, ()) +import qualified Data.Aeson as A +import qualified Data.ByteString as BS +import Data.Maybe (mapMaybe) +import qualified Data.Text.Encoding as TE +import qualified Roux.CooklangPrint as CooklangPrint import qualified Roux.Html as Html import qualified Roux.RecipeIndex as Idx +import Roux.SchemaOrg (SchemaOrgRecipe (..), parseSchemaOrgRecipe, schemaOrgToCooklang) +import System.Exit (ExitCode (..)) +import System.Process (readProcessWithExitCode) + +-- | Read the full request body as a lazy ByteString. +readRequestBody :: Wai.Request -> IO LB.ByteString +readRequestBody req = do + chunks <- gather [] + pure (LB.fromChunks chunks) + where + gather acc = do + chunk <- Wai.getRequestBodyChunk req + if BS.null chunk + then pure (reverse acc) + else gather (chunk : acc) {- | Build the WAI 'Application' given a path to the recipe directory. @@ -71,7 +91,7 @@ app recipeDir = do forkIO $ watchRecipes absDir state changeLog `catch` \e -> putStrLn $ "[roux] watcher thread crashed: " <> show (e :: SomeException) - pure (router state changeLog) + pure (router absDir state changeLog) where isRight (Right _) = True isRight (Left _) = False @@ -152,13 +172,109 @@ sseHandler changeLog _request respond = do sendPing go `finally` pure () --- | Route requests — SSE endpoint or recipe pages. -router :: IORef (Map FilePath Idx.RecipeInfo) -> ChangeLog -> Wai.Application -router state changeLog request respond = +-- | Route requests — SSE endpoint, recipe pages, or import. +router :: FilePath -> IORef (Map FilePath Idx.RecipeInfo) -> ChangeLog -> Wai.Application +router recipeDir state changeLog request respond = case Wai.pathInfo request of ["events"] -> sseHandler changeLog request respond + ["import"] -> importHandler recipeDir state request respond _ -> handleRequest state request respond +{- | Handle GET and POST requests to /import. +GET — show the import form. +POST — scrape the URL, convert to Cooklang, save the file. +-} +importHandler :: FilePath -> IORef (Map FilePath Idx.RecipeInfo) -> Wai.Application +importHandler recipeDir _state request respond = + case Wai.requestMethod request of + "GET" -> + respond (htmlResponse (Html.importPage Nothing)) + "POST" -> do + body <- readRequestBody request + let params = parseFormBody body + url = maybe "" id (lookup "url" params) + if T.null url + then respond (htmlResponse (Html.importPage (Just ("URL is required" :: Text)))) + else do + result <- try $ runImportPipeline recipeDir url + case result of + Left (e :: SomeException) -> + respond $ + htmlResponse $ + Html.importResultPage $ + Html.ImportError ("Unexpected error: " <> T.pack (show e)) + Right (Left err) -> + respond $ + htmlResponse $ + Html.importResultPage err + Right (Right filename) -> + respond $ + Wai.responseLBS + HTTP.status303 + [("Location", "/recipes/" <> TE.encodeUtf8 (T.pack filename))] + "" + _ -> respond notFound + +-- | Parse URL-encoded form body into key-value pairs. +parseFormBody :: LB.ByteString -> [(Text, Text)] +parseFormBody body = + let decoded = TE.decodeUtf8 $ LB.toStrict body + parts = T.splitOn "&" decoded + in mapMaybe parsePair parts + where + parsePair part = case T.splitOn "=" part of + [key, val] -> Just (urldecode key, urldecode val) + _ -> Nothing + urldecode = T.pack . Html.urlDecode . T.replace "+" " " + +-- | Run the full import pipeline: scrape -> parse -> convert -> render -> save. +runImportPipeline :: FilePath -> Text -> IO (Either Html.ImportError FilePath) +runImportPipeline recipeDir url = do + -- Step 1: scrape the URL + (exitCode, stdout, stderr) <- + readProcessWithExitCode + "scripts/scrape-recipe" + ["--pretty", T.unpack url] + "" + case exitCode of + ExitFailure _ -> + return $ + Left $ + Html.ImportError $ + "Could not scrape URL. The scraper exited with: " <> T.pack stderr + ExitSuccess -> do + -- Step 2: decode stdout (String) as JSON Value + -- stdout from readProcessWithExitCode is a locale-decoded String; + -- re-encode to UTF-8 for JSON decoding. + let jsonBytes = LB.fromStrict (TE.encodeUtf8 (T.pack stdout)) + jsonVal = A.decode jsonBytes :: Maybe A.Value + case jsonVal of + Nothing -> + return $ + Left $ + Html.ImportError $ + "Could not parse JSON from scraper output." + Just val -> case parseSchemaOrgRecipe val of + Nothing -> + return $ + Left $ + Html.ImportError $ + "Could not parse recipe data. The page may not have schema.org recipe data." + Just schema -> case schemaOrgToCooklang schema of + Left err -> + return $ + Left $ + Html.ImportError $ + "Could not convert recipe: " <> T.pack err + Right recipe -> do + -- Step 3: render to Cooklang text + let cookText = CooklangPrint.renderRecipe recipe + filename = CooklangPrint.filenameFromTitle (soName schema) + filepath = recipeDir filename + -- Step 4: write the .cook file + BS.writeFile filepath (TE.encodeUtf8 cookText) + return $ Right filename + {- | Watch a directory for .cook file changes and update the shared state. Uses watchDir callback for simplicity. -}