This commit is contained in:
+22
-16
@@ -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
@@ -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
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user