diff --git a/src/Roux/Server.hs b/src/Roux/Server.hs index 3ef78e7..a7967ef 100644 --- a/src/Roux/Server.hs +++ b/src/Roux/Server.hs @@ -43,6 +43,7 @@ import System.FSNotify ( 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 (mapMaybe) import qualified Data.Text.Encoding as TE @@ -183,6 +184,9 @@ router recipeDir config state changeLog request respond = ["import"] -> importHandler recipeDir config state request respond ["upload-image"] -> uploadImageHandler recipeDir state request respond ["recipe-images", filename] -> serveRecipeImage recipeDir (T.unpack filename) request respond + ["recipes", _, "title"] + | Wai.requestMethod request == "PATCH" -> + titleUpdateHandler recipeDir state request respond _ -> handleRequest state request respond {- | Handle GET and POST requests to /import. @@ -743,6 +747,20 @@ updateImageMetadata cookFilePath imageUrl = do "---\nimage: " <> imageUrl <> "\n---\n\n" <> text BS.writeFile cookFilePath (TE.encodeUtf8 updated) +-- | Update the title in a .cook file's YAML front matter. +updateTitleInCookFile :: FilePath -> Text -> IO () +updateTitleInCookFile filepath newTitle = do + content <- BS.readFile filepath + let text = TE.decodeUtf8 content + updated = case T.stripPrefix "---\n" text of + Just afterOpen -> + let (yamlBlock, rest) = T.breakOn "\n---" afterOpen + newYaml = addOrUpdateYamlKey "title" newTitle yamlBlock + in "---\n" <> newYaml <> rest + Nothing -> + "---\ntitle: " <> newTitle <> "\n---\n\n" <> text + BS.writeFile filepath (TE.encodeUtf8 updated) + -- | Add or update a key: value line in a YAML block, preserving other keys. addOrUpdateYamlKey :: Text -> Text -> Text -> Text addOrUpdateYamlKey key value yaml = @@ -773,3 +791,43 @@ jsonError msg = HTTP.status400 [("Content-Type", "application/json")] (LB.fromStrict (encodeUtf8 ("{\"error\":\"" <> msg <> "\"}"))) + +-- | Handle PATCH /recipes/{filename}/title -- update the recipe title. +titleUpdateHandler :: FilePath -> IORef (Map FilePath Idx.RecipeInfo) -> Wai.Application +titleUpdateHandler recipeDir state request respond = do + recipes <- readIORef state + case Wai.pathInfo request of + ["recipes", rawPath, "title"] -> do + let key = map toLower (stripCookExt (T.unpack rawPath)) + case Map.lookup key recipes of + Nothing -> respond (jsonError "Recipe not found") + Just info -> do + body <- readRequestBody request + case A.decode body of + Nothing -> respond (jsonError "Invalid JSON body") + Just (val :: A.Value) -> + case titleFromJson val of + Nothing -> respond (jsonError "Missing 'title' field") + Just title -> do + let trimmed = T.strip title + if T.null trimmed + then respond (jsonError "Title cannot be empty") + else do + let filepath = recipeDir Idx.riFilename info + result <- try $ updateTitleInCookFile filepath trimmed + case result of + Left (_ :: IOException) -> + respond (jsonError "Could not update recipe file") + Right () -> + respond $ + jsonOk + [ ("success", "true") + , ("title", trimmed) + ] + _ -> respond notFound + where + titleFromJson :: A.Value -> Maybe Text + titleFromJson (A.Object obj) = case KM.lookup "title" obj of + Just (A.String t) -> Just t + _ -> Nothing + titleFromJson _ = Nothing