This commit is contained in:
+22
-16
@@ -25,30 +25,32 @@ import qualified Database.SQLite.Simple as SQL
|
||||
|
||||
-- | A single cooking log entry.
|
||||
data CookEntry = CookEntry
|
||||
{ ceId :: !Int
|
||||
{ ceId :: !Int
|
||||
, ceRecipeFilename :: !Text
|
||||
, ceCookedDate :: !Day
|
||||
, ceComment :: !Text
|
||||
, ceCreatedAt :: !Text
|
||||
, ceCookedDate :: !Day
|
||||
, ceComment :: !Text
|
||||
, ceCreatedAt :: !Text
|
||||
}
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance FromRow CookEntry where
|
||||
fromRow = CookEntry <$> SQL.field <*> SQL.field <*> SQL.field <*> SQL.field <*> (trimQuotes <$> SQL.field)
|
||||
|
||||
-- | Strip leading/trailing double-quote characters from a Text value.
|
||||
-- This handles any accidental quote wrapping from the DB round-trip.
|
||||
{- | Strip leading/trailing double-quote characters from a Text value.
|
||||
This handles any accidental quote wrapping from the DB round-trip.
|
||||
-}
|
||||
trimQuotes :: Text -> Text
|
||||
trimQuotes = T.dropAround (== '"')
|
||||
|
||||
instance ToJSON CookEntry where
|
||||
toJSON e = A.object
|
||||
[ "id" A..= A.toJSON (ceId e)
|
||||
, "recipe_filename" A..= A.toJSON (ceRecipeFilename e)
|
||||
, "cooked_date" A..= A.toJSON (show (ceCookedDate e))
|
||||
, "comment" A..= A.toJSON (ceComment e)
|
||||
, "created_at" A..= A.toJSON (ceCreatedAt e)
|
||||
]
|
||||
toJSON e =
|
||||
A.object
|
||||
[ "id" A..= A.toJSON (ceId e)
|
||||
, "recipe_filename" A..= A.toJSON (ceRecipeFilename e)
|
||||
, "cooked_date" A..= A.toJSON (show (ceCookedDate e))
|
||||
, "comment" A..= A.toJSON (ceComment e)
|
||||
, "created_at" A..= A.toJSON (ceCreatedAt e)
|
||||
]
|
||||
|
||||
instance FromJSON CookEntry where
|
||||
parseJSON = A.withObject "CookEntry" $ \o ->
|
||||
@@ -61,7 +63,9 @@ instance FromJSON CookEntry where
|
||||
where
|
||||
parseDate t = case T.splitOn "-" t of
|
||||
[y, m, d] -> case fromGregorianValid
|
||||
(read (T.unpack y)) (read (T.unpack m)) (read (T.unpack d)) of
|
||||
(read (T.unpack y))
|
||||
(read (T.unpack m))
|
||||
(read (T.unpack d)) of
|
||||
Just day -> pure day
|
||||
Nothing -> fail "invalid date"
|
||||
_ -> fail "expected YYYY-MM-DD"
|
||||
@@ -104,7 +108,8 @@ insertEntry conn filename day mComment = do
|
||||
-- | Fetch all entries for a given recipe, newest first.
|
||||
fetchEntries :: Connection -> Text -> IO [CookEntry]
|
||||
fetchEntries conn filename =
|
||||
SQL.query conn
|
||||
SQL.query
|
||||
conn
|
||||
"SELECT id, recipe_filename, cooked_date, comment, created_at \
|
||||
\ FROM cook_log WHERE recipe_filename = ? ORDER BY cooked_date DESC, id DESC"
|
||||
(Only filename)
|
||||
@@ -112,6 +117,7 @@ fetchEntries conn filename =
|
||||
-- | Fetch all entries across all recipes, newest first.
|
||||
fetchAllEntries :: Connection -> IO [CookEntry]
|
||||
fetchAllEntries conn =
|
||||
SQL.query_ conn
|
||||
SQL.query_
|
||||
conn
|
||||
"SELECT id, recipe_filename, cooked_date, comment, created_at \
|
||||
\ FROM cook_log ORDER BY cooked_date DESC, id DESC"
|
||||
|
||||
+10
-5
@@ -853,11 +853,16 @@ renderCookLog filename entries = do
|
||||
H.form
|
||||
! A.class_ "roux-cook-log-form"
|
||||
! H.dataAttribute "filename" (H.toValue (T.pack filename))
|
||||
! A.style "display: flex; gap: 0.3rem; margin-bottom: 0.5rem;" $ do
|
||||
H.input ! A.type_ "date" ! A.name "cooked-date"
|
||||
H.input ! A.type_ "text" ! A.name "comment" ! A.placeholder "Optional note..."
|
||||
! A.maxlength "500" ! A.style "flex: 1;"
|
||||
H.button ! A.type_ "submit" $ "Log it"
|
||||
! A.style "display: flex; gap: 0.3rem; margin-bottom: 0.5rem;"
|
||||
$ do
|
||||
H.input ! A.type_ "date" ! A.name "cooked-date"
|
||||
H.input
|
||||
! A.type_ "text"
|
||||
! A.name "comment"
|
||||
! A.placeholder "Optional note..."
|
||||
! A.maxlength "500"
|
||||
! A.style "flex: 1;"
|
||||
H.button ! A.type_ "submit" $ "Log it"
|
||||
H.div ! A.class_ "roux-cook-entries" $ do
|
||||
mapM_ renderEntry entries
|
||||
|
||||
|
||||
+25
-16
@@ -47,19 +47,19 @@ import qualified Data.Aeson.KeyMap as KM
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.Maybe (fromMaybe, mapMaybe)
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import qualified Database.SQLite.Simple as SQL
|
||||
import Data.Time.Calendar (Day, fromGregorianValid)
|
||||
import qualified Data.Time.Format as Time
|
||||
import Text.Read (readMaybe)
|
||||
import qualified Database.SQLite.Simple as SQL
|
||||
import Roux.Config (AnthropicConfig (..), RouxConfig (..))
|
||||
import qualified Roux.CooklangPrint as CooklangPrint
|
||||
import qualified Roux.CookLog as CookLog
|
||||
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.IO (hSetBinaryMode)
|
||||
import System.Process (CreateProcess (..), StdStream (CreatePipe), createProcess, proc, waitForProcess)
|
||||
import Text.Read (readMaybe)
|
||||
|
||||
-- | Read the full request body as a lazy ByteString.
|
||||
readRequestBody :: Wai.Request -> IO LB.ByteString
|
||||
@@ -645,9 +645,11 @@ handleRequest state db request respond = do
|
||||
["cook-log", filename] -> do
|
||||
entries <- CookLog.fetchEntries db filename
|
||||
let body = A.encode entries
|
||||
respond $ Wai.responseLBS HTTP.status200
|
||||
[("Content-Type", "application/json")]
|
||||
body
|
||||
respond $
|
||||
Wai.responseLBS
|
||||
HTTP.status200
|
||||
[("Content-Type", "application/json")]
|
||||
body
|
||||
-- Cook history page (all entries across recipes)
|
||||
["cook-history"] -> do
|
||||
entries <- CookLog.fetchAllEntries db
|
||||
@@ -656,9 +658,11 @@ handleRequest state db request respond = do
|
||||
-- Cook log JSON endpoint for all entries
|
||||
["cook-log"] -> do
|
||||
entries <- CookLog.fetchAllEntries db
|
||||
respond $ Wai.responseLBS HTTP.status200
|
||||
[("Content-Type", "application/json")]
|
||||
(A.encode entries)
|
||||
respond $
|
||||
Wai.responseLBS
|
||||
HTTP.status200
|
||||
[("Content-Type", "application/json")]
|
||||
(A.encode entries)
|
||||
_ -> respond notFound
|
||||
|
||||
-- | Handle POST /cook-log/{filename}
|
||||
@@ -671,14 +675,19 @@ handleCookLogPost db filename request respond = do
|
||||
case parseDate dateStr of
|
||||
Just day -> do
|
||||
_ <- CookLog.insertEntry db filename day comment
|
||||
let resp = Wai.responseLBS HTTP.status200 [("Content-Type", "application/json")]
|
||||
(LB.fromStrict (encodeUtf8 "{\"ok\":true}"))
|
||||
let resp =
|
||||
Wai.responseLBS
|
||||
HTTP.status200
|
||||
[("Content-Type", "application/json")]
|
||||
(LB.fromStrict (encodeUtf8 "{\"ok\":true}"))
|
||||
respond resp
|
||||
Nothing ->
|
||||
let resp = Wai.responseLBS HTTP.status400
|
||||
[("Content-Type", "application/json")]
|
||||
(LB.fromStrict (encodeUtf8 "{\"error\":\"Invalid date format\"}"))
|
||||
in respond resp
|
||||
let resp =
|
||||
Wai.responseLBS
|
||||
HTTP.status400
|
||||
[("Content-Type", "application/json")]
|
||||
(LB.fromStrict (encodeUtf8 "{\"error\":\"Invalid date format\"}"))
|
||||
in respond resp
|
||||
|
||||
-- | Parse a YYYY-MM-DD date string.
|
||||
parseDate :: Text -> Maybe Day
|
||||
@@ -697,7 +706,7 @@ groupEntries entries =
|
||||
let monthKey d = T.pack $ Time.formatTime Time.defaultTimeLocale "%B %Y" d
|
||||
groups = Map.fromListWith (++) [(monthKey (CookLog.ceCookedDate e), [e]) | e <- entries]
|
||||
sortedMonths = reverse (Map.keys groups)
|
||||
in [(m, Map.findWithDefault [] m groups) | m <- sortedMonths]
|
||||
in [(m, Map.findWithDefault [] m groups) | m <- sortedMonths]
|
||||
|
||||
-- | Look up a recipe by filename (case-insensitive, .cook extension optional).
|
||||
lookupRecipe :: FilePath -> Map FilePath Idx.RecipeInfo -> Maybe Idx.RecipeInfo
|
||||
|
||||
Reference in New Issue
Block a user