feat: add CookLog module with types and DB operations

This commit is contained in:
2026-05-25 21:55:43 -04:00
parent 0b5fa61acd
commit ceadf50c59
+116
View File
@@ -0,0 +1,116 @@
{-# LANGUAGE OverloadedStrings #-}
{- | Cook log: track which recipes were cooked when, with optional notes.
Uses sqlite-simple for persistence. The database file lives alongside the
recipe directory as @cook-log.db@.
-}
module Roux.CookLog (
CookEntry (..),
initDb,
insertEntry,
fetchEntries,
fetchAllEntries,
) where
import Data.Aeson (FromJSON, ToJSON)
import qualified Data.Aeson as A
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar (Day, fromGregorianValid)
import Data.Time.Clock (UTCTime, getCurrentTime)
import qualified Data.Time.Format as Time
import Database.SQLite.Simple (Connection, FromRow (..), Only (..), Query)
import qualified Database.SQLite.Simple as SQL
-- | A single cooking log entry.
data CookEntry = CookEntry
{ ceId :: !Int
, ceRecipeFilename :: !Text
, ceCookedDate :: !Day
, ceComment :: !Text
, ceCreatedAt :: !UTCTime
}
deriving stock (Eq, Show)
instance FromRow CookEntry where
fromRow = CookEntry <$> SQL.field <*> SQL.field <*> SQL.field <*> SQL.field <*> SQL.field
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 (show (ceCreatedAt e))
]
instance FromJSON CookEntry where
parseJSON = A.withObject "CookEntry" $ \o ->
CookEntry
<$> o A..: "id"
<*> o A..: "recipe_filename"
<*> (parseDate =<< o A..: "cooked_date")
<*> o A..: "comment"
<*> (parseUTC =<< o A..: "created_at")
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
Just day -> pure day
Nothing -> fail "invalid date"
_ -> 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.
initDb :: FilePath -> IO Connection
initDb dbPath = do
conn <- SQL.open dbPath
SQL.execute_ conn createTableSQL
pure conn
where
createTableSQL :: Query
createTableSQL =
"CREATE TABLE IF NOT EXISTS cook_log ( \
\ id INTEGER PRIMARY KEY AUTOINCREMENT, \
\ recipe_filename TEXT NOT NULL, \
\ cooked_date TEXT NOT NULL, \
\ comment TEXT NOT NULL DEFAULT '', \
\ created_at TEXT NOT NULL \
\)"
-- | Insert a new cook log entry. Returns the new row id.
insertEntry :: Connection -> Text -> Day -> Maybe Text -> IO Int
insertEntry conn filename day mComment = do
now <- getCurrentTime
SQL.withTransaction conn $ do
SQL.execute
conn
"INSERT INTO cook_log (recipe_filename, cooked_date, comment, created_at) VALUES (?, ?, ?, ?)"
(filename, show day, T.strip (fromMaybe "" mComment), show now)
rows <- SQL.query conn "SELECT last_insert_rowid()" ()
case rows of
[Only i] -> pure i
_ -> fail "expected last_insert_rowid() to return a row"
where
fromMaybe d Nothing = d
fromMaybe _ (Just x) = x
-- | Fetch all entries for a given recipe, newest first.
fetchEntries :: Connection -> Text -> IO [CookEntry]
fetchEntries conn filename =
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)
-- | Fetch all entries across all recipes, newest first.
fetchAllEntries :: Connection -> IO [CookEntry]
fetchAllEntries conn =
SQL.query_ conn
"SELECT id, recipe_filename, cooked_date, comment, created_at \
\ FROM cook_log ORDER BY cooked_date DESC, id DESC"