fix: use Text for created_at, fix show-bug in ToJSON, add /cook-history route
Build and Deploy / build-and-deploy (push) Failing after 21s

This commit is contained in:
2026-05-25 22:10:23 -04:00
parent 90971568a3
commit 0b6b9c3d17
4 changed files with 22 additions and 13 deletions
+1
View File
@@ -10,3 +10,4 @@ build/
__pycache__ __pycache__
.worktrees/ .worktrees/
.superpowers/ .superpowers/
recipes/
+1
View File
@@ -20,6 +20,7 @@ library
Roux Roux
Roux.Config Roux.Config
Roux.CooklangPrint Roux.CooklangPrint
Roux.CookLog
Roux.Html Roux.Html
Roux.NYTimes Roux.NYTimes
Roux.Parser Roux.Parser
+12 -11
View File
@@ -18,7 +18,7 @@ import qualified Data.Aeson as A
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar (Day, fromGregorianValid) import Data.Time.Calendar (Day, fromGregorianValid)
import Data.Time.Clock (UTCTime, getCurrentTime) import Data.Time.Clock (getCurrentTime)
import qualified Data.Time.Format as Time import qualified Data.Time.Format as Time
import Database.SQLite.Simple (Connection, FromRow (..), Only (..), Query) import Database.SQLite.Simple (Connection, FromRow (..), Only (..), Query)
import qualified Database.SQLite.Simple as SQL import qualified Database.SQLite.Simple as SQL
@@ -29,12 +29,17 @@ data CookEntry = CookEntry
, ceRecipeFilename :: !Text , ceRecipeFilename :: !Text
, ceCookedDate :: !Day , ceCookedDate :: !Day
, ceComment :: !Text , ceComment :: !Text
, ceCreatedAt :: !UTCTime , 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 <*> 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.
-- This handles any accidental quote wrapping from the DB round-trip.
trimQuotes :: Text -> Text
trimQuotes = T.dropAround (== '"')
instance ToJSON CookEntry where instance ToJSON CookEntry where
toJSON e = A.object toJSON e = A.object
@@ -42,7 +47,7 @@ instance ToJSON CookEntry where
, "recipe_filename" A..= A.toJSON (ceRecipeFilename e) , "recipe_filename" A..= A.toJSON (ceRecipeFilename e)
, "cooked_date" A..= A.toJSON (show (ceCookedDate e)) , "cooked_date" A..= A.toJSON (show (ceCookedDate e))
, "comment" A..= A.toJSON (ceComment e) , "comment" A..= A.toJSON (ceComment e)
, "created_at" A..= A.toJSON (show (ceCreatedAt e)) , "created_at" A..= A.toJSON (ceCreatedAt e)
] ]
instance FromJSON CookEntry where instance FromJSON CookEntry where
@@ -52,7 +57,7 @@ instance FromJSON CookEntry where
<*> o A..: "recipe_filename" <*> o A..: "recipe_filename"
<*> (parseDate =<< o A..: "cooked_date") <*> (parseDate =<< o A..: "cooked_date")
<*> o A..: "comment" <*> o A..: "comment"
<*> (parseUTC =<< o A..: "created_at") <*> o A..: "created_at"
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
@@ -60,11 +65,6 @@ instance FromJSON CookEntry where
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"
parseUTC t = case T.unpack t of
"" -> fail "empty datetime"
s -> case Time.parseTimeM True Time.defaultTimeLocale "%Y-%m-%d %H:%M:%S" s of
Just ut -> pure ut
Nothing -> fail "invalid datetime"
-- | Open or create the DB, ensuring the table exists. -- | Open or create the DB, ensuring the table exists.
initDb :: FilePath -> IO Connection initDb :: FilePath -> IO Connection
@@ -87,11 +87,12 @@ initDb dbPath = do
insertEntry :: Connection -> Text -> Day -> Maybe Text -> IO Int insertEntry :: Connection -> Text -> Day -> Maybe Text -> IO Int
insertEntry conn filename day mComment = do insertEntry conn filename day mComment = do
now <- getCurrentTime now <- getCurrentTime
let nowStr = T.pack $ Time.formatTime Time.defaultTimeLocale "%Y-%m-%d %H:%M:%S" now
SQL.withTransaction conn $ do SQL.withTransaction conn $ do
SQL.execute SQL.execute
conn conn
"INSERT INTO cook_log (recipe_filename, cooked_date, comment, created_at) VALUES (?, ?, ?, ?)" "INSERT INTO cook_log (recipe_filename, cooked_date, comment, created_at) VALUES (?, ?, ?, ?)"
(filename, show day, T.strip (fromMaybe "" mComment), show now) (filename, T.pack (show day), T.strip (fromMaybe "" mComment), nowStr)
rows <- SQL.query conn "SELECT last_insert_rowid()" () rows <- SQL.query conn "SELECT last_insert_rowid()" ()
case rows of case rows of
[Only i] -> pure i [Only i] -> pure i
+7 -1
View File
@@ -649,10 +649,16 @@ handleRequest state db request respond = do
[("Content-Type", "application/json")] [("Content-Type", "application/json")]
body body
-- Cook history page (all entries across recipes) -- Cook history page (all entries across recipes)
["cook-log"] -> do ["cook-history"] -> do
entries <- CookLog.fetchAllEntries db entries <- CookLog.fetchAllEntries db
let grouped = groupEntries entries let grouped = groupEntries entries
respond $ htmlResponse (Html.cookHistoryPage grouped) respond $ htmlResponse (Html.cookHistoryPage grouped)
-- 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 notFound _ -> respond notFound
-- | Handle POST /cook-log/{filename} -- | Handle POST /cook-log/{filename}