feat: add CookLog module with types and DB operations
This commit is contained in:
@@ -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"
|
||||||
Reference in New Issue
Block a user