Formats repo
Build and Deploy / build-and-deploy (push) Successful in 15m3s

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